summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/README5
-rw-r--r--generic/default.h29
-rw-r--r--generic/ks_names.h917
-rw-r--r--generic/tk.h1538
-rw-r--r--generic/tk3d.c949
-rw-r--r--generic/tk3d.h79
-rw-r--r--generic/tkArgv.c433
-rw-r--r--generic/tkAtom.c217
-rw-r--r--generic/tkBind.c4533
-rw-r--r--generic/tkBitmap.c585
-rw-r--r--generic/tkButton.c1347
-rw-r--r--generic/tkButton.h241
-rw-r--r--generic/tkCanvArc.c1716
-rw-r--r--generic/tkCanvBmap.c800
-rw-r--r--generic/tkCanvImg.c677
-rw-r--r--generic/tkCanvLine.c1623
-rw-r--r--generic/tkCanvPoly.c998
-rw-r--r--generic/tkCanvPs.c1163
-rw-r--r--generic/tkCanvText.c1313
-rw-r--r--generic/tkCanvUtil.c376
-rw-r--r--generic/tkCanvWind.c862
-rw-r--r--generic/tkCanvas.c3791
-rw-r--r--generic/tkCanvas.h257
-rw-r--r--generic/tkClipboard.c606
-rw-r--r--generic/tkCmds.c1646
-rw-r--r--generic/tkColor.c397
-rw-r--r--generic/tkColor.h60
-rw-r--r--generic/tkConfig.c990
-rw-r--r--generic/tkConsole.c616
-rw-r--r--generic/tkCursor.c384
-rw-r--r--generic/tkEntry.c2313
-rw-r--r--generic/tkError.c307
-rw-r--r--generic/tkEvent.c1038
-rw-r--r--generic/tkFileFilter.c486
-rw-r--r--generic/tkFileFilter.h83
-rw-r--r--generic/tkFocus.c998
-rw-r--r--generic/tkFont.c3008
-rw-r--r--generic/tkFont.h208
-rw-r--r--generic/tkFrame.c939
-rw-r--r--generic/tkGC.c363
-rw-r--r--generic/tkGeometry.c582
-rw-r--r--generic/tkGet.c586
-rw-r--r--generic/tkGrab.c1535
-rw-r--r--generic/tkGrid.c2615
-rw-r--r--generic/tkImage.c789
-rw-r--r--generic/tkImgBmap.c1061
-rw-r--r--generic/tkImgGIF.c1059
-rw-r--r--generic/tkImgPPM.c421
-rw-r--r--generic/tkImgPhoto.c4144
-rw-r--r--generic/tkImgUtil.c78
-rw-r--r--generic/tkInitScript.h73
-rw-r--r--generic/tkInt.h990
-rw-r--r--generic/tkListbox.c2335
-rw-r--r--generic/tkMacWinMenu.c134
-rw-r--r--generic/tkMain.c390
-rw-r--r--generic/tkMenu.c3057
-rw-r--r--generic/tkMenu.h541
-rw-r--r--generic/tkMenuDraw.c1018
-rw-r--r--generic/tkMenubutton.c865
-rw-r--r--generic/tkMenubutton.h207
-rw-r--r--generic/tkMessage.c848
-rw-r--r--generic/tkOption.c1397
-rw-r--r--generic/tkPack.c1727
-rw-r--r--generic/tkPlace.c1060
-rw-r--r--generic/tkPointer.c623
-rw-r--r--generic/tkPort.h36
-rw-r--r--generic/tkRectOval.c1030
-rw-r--r--generic/tkScale.c1143
-rw-r--r--generic/tkScale.h225
-rw-r--r--generic/tkScrollbar.c691
-rw-r--r--generic/tkScrollbar.h200
-rw-r--r--generic/tkSelect.c1341
-rw-r--r--generic/tkSelect.h184
-rw-r--r--generic/tkSquare.c587
-rw-r--r--generic/tkTest.c1134
-rw-r--r--generic/tkText.c2264
-rw-r--r--generic/tkText.h848
-rw-r--r--generic/tkTextBTree.c3594
-rw-r--r--generic/tkTextDisp.c5015
-rw-r--r--generic/tkTextImage.c898
-rw-r--r--generic/tkTextIndex.c840
-rw-r--r--generic/tkTextMark.c775
-rw-r--r--generic/tkTextTag.c1376
-rw-r--r--generic/tkTextWind.c1176
-rw-r--r--generic/tkTrig.c1467
-rw-r--r--generic/tkUtil.c348
-rw-r--r--generic/tkVisual.c540
-rw-r--r--generic/tkWindow.c2763
88 files changed, 95501 insertions, 0 deletions
diff --git a/generic/README b/generic/README
new file mode 100644
index 0000000..572cc93
--- /dev/null
+++ b/generic/README
@@ -0,0 +1,5 @@
+This directory contains Tk source files that work on all the platforms
+where Tk runs (e.g. UNIX, PCs, and Macintoshes). Platform-specific
+sources are in the directories ../unix, ../win, and ../mac.
+
+SCCS ID: @(#) README 1.1 95/09/11 14:02:45
diff --git a/generic/default.h b/generic/default.h
new file mode 100644
index 0000000..91a19f6
--- /dev/null
+++ b/generic/default.h
@@ -0,0 +1,29 @@
+/*
+ * default.h --
+ *
+ * This file defines the defaults for all options for all of
+ * the Tk widgets.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) default.h 1.4 96/02/07 17:33:39
+ */
+
+#ifndef _DEFAULT
+#define _DEFAULT
+
+#if defined(__WIN32__) || defined(_WIN32)
+# include "tkWinDefault.h"
+#else
+# if defined(MAC_TCL)
+# include "tkMacDefault.h"
+# else
+# include "tkUnixDefault.h"
+# endif
+#endif
+
+#endif /* _DEFAULT */
diff --git a/generic/ks_names.h b/generic/ks_names.h
new file mode 100644
index 0000000..3eee008
--- /dev/null
+++ b/generic/ks_names.h
@@ -0,0 +1,917 @@
+/*
+ * This file is generated from $(INCLUDESRC)/keysymdef.h. Do not edit.
+ */
+{ "BackSpace", 0xFF08 },
+{ "Tab", 0xFF09 },
+{ "Linefeed", 0xFF0A },
+{ "Clear", 0xFF0B },
+{ "Return", 0xFF0D },
+{ "Pause", 0xFF13 },
+{ "Escape", 0xFF1B },
+{ "Delete", 0xFFFF },
+{ "Multi_key", 0xFF20 },
+{ "Kanji", 0xFF21 },
+{ "Home", 0xFF50 },
+{ "Left", 0xFF51 },
+{ "Up", 0xFF52 },
+{ "Right", 0xFF53 },
+{ "Down", 0xFF54 },
+{ "Prior", 0xFF55 },
+{ "Next", 0xFF56 },
+{ "End", 0xFF57 },
+{ "Begin", 0xFF58 },
+{ "Select", 0xFF60 },
+{ "Print", 0xFF61 },
+{ "Execute", 0xFF62 },
+{ "Insert", 0xFF63 },
+{ "Undo", 0xFF65 },
+{ "Redo", 0xFF66 },
+{ "Menu", 0xFF67 },
+{ "Find", 0xFF68 },
+{ "Cancel", 0xFF69 },
+{ "Help", 0xFF6A },
+{ "Break", 0xFF6B },
+{ "Mode_switch", 0xFF7E },
+{ "script_switch", 0xFF7E },
+{ "Num_Lock", 0xFF7F },
+{ "KP_Space", 0xFF80 },
+{ "KP_Tab", 0xFF89 },
+{ "KP_Enter", 0xFF8D },
+{ "KP_F1", 0xFF91 },
+{ "KP_F2", 0xFF92 },
+{ "KP_F3", 0xFF93 },
+{ "KP_F4", 0xFF94 },
+{ "KP_Equal", 0xFFBD },
+{ "KP_Multiply", 0xFFAA },
+{ "KP_Add", 0xFFAB },
+{ "KP_Separator", 0xFFAC },
+{ "KP_Subtract", 0xFFAD },
+{ "KP_Decimal", 0xFFAE },
+{ "KP_Divide", 0xFFAF },
+{ "KP_0", 0xFFB0 },
+{ "KP_1", 0xFFB1 },
+{ "KP_2", 0xFFB2 },
+{ "KP_3", 0xFFB3 },
+{ "KP_4", 0xFFB4 },
+{ "KP_5", 0xFFB5 },
+{ "KP_6", 0xFFB6 },
+{ "KP_7", 0xFFB7 },
+{ "KP_8", 0xFFB8 },
+{ "KP_9", 0xFFB9 },
+{ "F1", 0xFFBE },
+{ "F2", 0xFFBF },
+{ "F3", 0xFFC0 },
+{ "F4", 0xFFC1 },
+{ "F5", 0xFFC2 },
+{ "F6", 0xFFC3 },
+{ "F7", 0xFFC4 },
+{ "F8", 0xFFC5 },
+{ "F9", 0xFFC6 },
+{ "F10", 0xFFC7 },
+{ "F11", 0xFFC8 },
+{ "L1", 0xFFC8 },
+{ "F12", 0xFFC9 },
+{ "L2", 0xFFC9 },
+{ "F13", 0xFFCA },
+{ "L3", 0xFFCA },
+{ "F14", 0xFFCB },
+{ "L4", 0xFFCB },
+{ "F15", 0xFFCC },
+{ "L5", 0xFFCC },
+{ "F16", 0xFFCD },
+{ "L6", 0xFFCD },
+{ "F17", 0xFFCE },
+{ "L7", 0xFFCE },
+{ "F18", 0xFFCF },
+{ "L8", 0xFFCF },
+{ "F19", 0xFFD0 },
+{ "L9", 0xFFD0 },
+{ "F20", 0xFFD1 },
+{ "L10", 0xFFD1 },
+{ "F21", 0xFFD2 },
+{ "R1", 0xFFD2 },
+{ "F22", 0xFFD3 },
+{ "R2", 0xFFD3 },
+{ "F23", 0xFFD4 },
+{ "R3", 0xFFD4 },
+{ "F24", 0xFFD5 },
+{ "R4", 0xFFD5 },
+{ "F25", 0xFFD6 },
+{ "R5", 0xFFD6 },
+{ "F26", 0xFFD7 },
+{ "R6", 0xFFD7 },
+{ "F27", 0xFFD8 },
+{ "R7", 0xFFD8 },
+{ "F28", 0xFFD9 },
+{ "R8", 0xFFD9 },
+{ "F29", 0xFFDA },
+{ "R9", 0xFFDA },
+{ "F30", 0xFFDB },
+{ "R10", 0xFFDB },
+{ "F31", 0xFFDC },
+{ "R11", 0xFFDC },
+{ "F32", 0xFFDD },
+{ "R12", 0xFFDD },
+{ "R13", 0xFFDE },
+{ "F33", 0xFFDE },
+{ "F34", 0xFFDF },
+{ "R14", 0xFFDF },
+{ "F35", 0xFFE0 },
+{ "R15", 0xFFE0 },
+{ "Shift_L", 0xFFE1 },
+{ "Shift_R", 0xFFE2 },
+{ "Control_L", 0xFFE3 },
+{ "Control_R", 0xFFE4 },
+{ "Caps_Lock", 0xFFE5 },
+{ "Shift_Lock", 0xFFE6 },
+{ "Meta_L", 0xFFE7 },
+{ "Meta_R", 0xFFE8 },
+{ "Alt_L", 0xFFE9 },
+{ "Alt_R", 0xFFEA },
+{ "Super_L", 0xFFEB },
+{ "Super_R", 0xFFEC },
+{ "Hyper_L", 0xFFED },
+{ "Hyper_R", 0xFFEE },
+{ "space", 0x020 },
+{ "exclam", 0x021 },
+{ "quotedbl", 0x022 },
+{ "numbersign", 0x023 },
+{ "dollar", 0x024 },
+{ "percent", 0x025 },
+{ "ampersand", 0x026 },
+{ "quoteright", 0x027 },
+{ "parenleft", 0x028 },
+{ "parenright", 0x029 },
+{ "asterisk", 0x02a },
+{ "plus", 0x02b },
+{ "comma", 0x02c },
+{ "minus", 0x02d },
+{ "period", 0x02e },
+{ "slash", 0x02f },
+{ "0", 0x030 },
+{ "1", 0x031 },
+{ "2", 0x032 },
+{ "3", 0x033 },
+{ "4", 0x034 },
+{ "5", 0x035 },
+{ "6", 0x036 },
+{ "7", 0x037 },
+{ "8", 0x038 },
+{ "9", 0x039 },
+{ "colon", 0x03a },
+{ "semicolon", 0x03b },
+{ "less", 0x03c },
+{ "equal", 0x03d },
+{ "greater", 0x03e },
+{ "question", 0x03f },
+{ "at", 0x040 },
+{ "A", 0x041 },
+{ "B", 0x042 },
+{ "C", 0x043 },
+{ "D", 0x044 },
+{ "E", 0x045 },
+{ "F", 0x046 },
+{ "G", 0x047 },
+{ "H", 0x048 },
+{ "I", 0x049 },
+{ "J", 0x04a },
+{ "K", 0x04b },
+{ "L", 0x04c },
+{ "M", 0x04d },
+{ "N", 0x04e },
+{ "O", 0x04f },
+{ "P", 0x050 },
+{ "Q", 0x051 },
+{ "R", 0x052 },
+{ "S", 0x053 },
+{ "T", 0x054 },
+{ "U", 0x055 },
+{ "V", 0x056 },
+{ "W", 0x057 },
+{ "X", 0x058 },
+{ "Y", 0x059 },
+{ "Z", 0x05a },
+{ "bracketleft", 0x05b },
+{ "backslash", 0x05c },
+{ "bracketright", 0x05d },
+{ "asciicircum", 0x05e },
+{ "underscore", 0x05f },
+{ "quoteleft", 0x060 },
+{ "a", 0x061 },
+{ "b", 0x062 },
+{ "c", 0x063 },
+{ "d", 0x064 },
+{ "e", 0x065 },
+{ "f", 0x066 },
+{ "g", 0x067 },
+{ "h", 0x068 },
+{ "i", 0x069 },
+{ "j", 0x06a },
+{ "k", 0x06b },
+{ "l", 0x06c },
+{ "m", 0x06d },
+{ "n", 0x06e },
+{ "o", 0x06f },
+{ "p", 0x070 },
+{ "q", 0x071 },
+{ "r", 0x072 },
+{ "s", 0x073 },
+{ "t", 0x074 },
+{ "u", 0x075 },
+{ "v", 0x076 },
+{ "w", 0x077 },
+{ "x", 0x078 },
+{ "y", 0x079 },
+{ "z", 0x07a },
+{ "braceleft", 0x07b },
+{ "bar", 0x07c },
+{ "braceright", 0x07d },
+{ "asciitilde", 0x07e },
+{ "nobreakspace", 0x0a0 },
+{ "exclamdown", 0x0a1 },
+{ "cent", 0x0a2 },
+{ "sterling", 0x0a3 },
+{ "currency", 0x0a4 },
+{ "yen", 0x0a5 },
+{ "brokenbar", 0x0a6 },
+{ "section", 0x0a7 },
+{ "diaeresis", 0x0a8 },
+{ "copyright", 0x0a9 },
+{ "ordfeminine", 0x0aa },
+{ "guillemotleft", 0x0ab },
+{ "notsign", 0x0ac },
+{ "hyphen", 0x0ad },
+{ "registered", 0x0ae },
+{ "macron", 0x0af },
+{ "degree", 0x0b0 },
+{ "plusminus", 0x0b1 },
+{ "twosuperior", 0x0b2 },
+{ "threesuperior", 0x0b3 },
+{ "acute", 0x0b4 },
+{ "mu", 0x0b5 },
+{ "paragraph", 0x0b6 },
+{ "periodcentered", 0x0b7 },
+{ "cedilla", 0x0b8 },
+{ "onesuperior", 0x0b9 },
+{ "masculine", 0x0ba },
+{ "guillemotright", 0x0bb },
+{ "onequarter", 0x0bc },
+{ "onehalf", 0x0bd },
+{ "threequarters", 0x0be },
+{ "questiondown", 0x0bf },
+{ "Agrave", 0x0c0 },
+{ "Aacute", 0x0c1 },
+{ "Acircumflex", 0x0c2 },
+{ "Atilde", 0x0c3 },
+{ "Adiaeresis", 0x0c4 },
+{ "Aring", 0x0c5 },
+{ "AE", 0x0c6 },
+{ "Ccedilla", 0x0c7 },
+{ "Egrave", 0x0c8 },
+{ "Eacute", 0x0c9 },
+{ "Ecircumflex", 0x0ca },
+{ "Ediaeresis", 0x0cb },
+{ "Igrave", 0x0cc },
+{ "Iacute", 0x0cd },
+{ "Icircumflex", 0x0ce },
+{ "Idiaeresis", 0x0cf },
+{ "Eth", 0x0d0 },
+{ "Ntilde", 0x0d1 },
+{ "Ograve", 0x0d2 },
+{ "Oacute", 0x0d3 },
+{ "Ocircumflex", 0x0d4 },
+{ "Otilde", 0x0d5 },
+{ "Odiaeresis", 0x0d6 },
+{ "multiply", 0x0d7 },
+{ "Ooblique", 0x0d8 },
+{ "Ugrave", 0x0d9 },
+{ "Uacute", 0x0da },
+{ "Ucircumflex", 0x0db },
+{ "Udiaeresis", 0x0dc },
+{ "Yacute", 0x0dd },
+{ "Thorn", 0x0de },
+{ "ssharp", 0x0df },
+{ "agrave", 0x0e0 },
+{ "aacute", 0x0e1 },
+{ "acircumflex", 0x0e2 },
+{ "atilde", 0x0e3 },
+{ "adiaeresis", 0x0e4 },
+{ "aring", 0x0e5 },
+{ "ae", 0x0e6 },
+{ "ccedilla", 0x0e7 },
+{ "egrave", 0x0e8 },
+{ "eacute", 0x0e9 },
+{ "ecircumflex", 0x0ea },
+{ "ediaeresis", 0x0eb },
+{ "igrave", 0x0ec },
+{ "iacute", 0x0ed },
+{ "icircumflex", 0x0ee },
+{ "idiaeresis", 0x0ef },
+{ "eth", 0x0f0 },
+{ "ntilde", 0x0f1 },
+{ "ograve", 0x0f2 },
+{ "oacute", 0x0f3 },
+{ "ocircumflex", 0x0f4 },
+{ "otilde", 0x0f5 },
+{ "odiaeresis", 0x0f6 },
+{ "division", 0x0f7 },
+{ "oslash", 0x0f8 },
+{ "ugrave", 0x0f9 },
+{ "uacute", 0x0fa },
+{ "ucircumflex", 0x0fb },
+{ "udiaeresis", 0x0fc },
+{ "yacute", 0x0fd },
+{ "thorn", 0x0fe },
+{ "ydiaeresis", 0x0ff },
+{ "Aogonek", 0x1a1 },
+{ "breve", 0x1a2 },
+{ "Lstroke", 0x1a3 },
+{ "Lcaron", 0x1a5 },
+{ "Sacute", 0x1a6 },
+{ "Scaron", 0x1a9 },
+{ "Scedilla", 0x1aa },
+{ "Tcaron", 0x1ab },
+{ "Zacute", 0x1ac },
+{ "Zcaron", 0x1ae },
+{ "Zabovedot", 0x1af },
+{ "aogonek", 0x1b1 },
+{ "ogonek", 0x1b2 },
+{ "lstroke", 0x1b3 },
+{ "lcaron", 0x1b5 },
+{ "sacute", 0x1b6 },
+{ "caron", 0x1b7 },
+{ "scaron", 0x1b9 },
+{ "scedilla", 0x1ba },
+{ "tcaron", 0x1bb },
+{ "zacute", 0x1bc },
+{ "doubleacute", 0x1bd },
+{ "zcaron", 0x1be },
+{ "zabovedot", 0x1bf },
+{ "Racute", 0x1c0 },
+{ "Abreve", 0x1c3 },
+{ "Cacute", 0x1c6 },
+{ "Ccaron", 0x1c8 },
+{ "Eogonek", 0x1ca },
+{ "Ecaron", 0x1cc },
+{ "Dcaron", 0x1cf },
+{ "Nacute", 0x1d1 },
+{ "Ncaron", 0x1d2 },
+{ "Odoubleacute", 0x1d5 },
+{ "Rcaron", 0x1d8 },
+{ "Uring", 0x1d9 },
+{ "Udoubleacute", 0x1db },
+{ "Tcedilla", 0x1de },
+{ "racute", 0x1e0 },
+{ "abreve", 0x1e3 },
+{ "cacute", 0x1e6 },
+{ "ccaron", 0x1e8 },
+{ "eogonek", 0x1ea },
+{ "ecaron", 0x1ec },
+{ "dcaron", 0x1ef },
+{ "nacute", 0x1f1 },
+{ "ncaron", 0x1f2 },
+{ "odoubleacute", 0x1f5 },
+{ "udoubleacute", 0x1fb },
+{ "rcaron", 0x1f8 },
+{ "uring", 0x1f9 },
+{ "tcedilla", 0x1fe },
+{ "abovedot", 0x1ff },
+{ "Hstroke", 0x2a1 },
+{ "Hcircumflex", 0x2a6 },
+{ "Iabovedot", 0x2a9 },
+{ "Gbreve", 0x2ab },
+{ "Jcircumflex", 0x2ac },
+{ "hstroke", 0x2b1 },
+{ "hcircumflex", 0x2b6 },
+{ "idotless", 0x2b9 },
+{ "gbreve", 0x2bb },
+{ "jcircumflex", 0x2bc },
+{ "Cabovedot", 0x2c5 },
+{ "Ccircumflex", 0x2c6 },
+{ "Gabovedot", 0x2d5 },
+{ "Gcircumflex", 0x2d8 },
+{ "Ubreve", 0x2dd },
+{ "Scircumflex", 0x2de },
+{ "cabovedot", 0x2e5 },
+{ "ccircumflex", 0x2e6 },
+{ "gabovedot", 0x2f5 },
+{ "gcircumflex", 0x2f8 },
+{ "ubreve", 0x2fd },
+{ "scircumflex", 0x2fe },
+{ "kappa", 0x3a2 },
+{ "Rcedilla", 0x3a3 },
+{ "Itilde", 0x3a5 },
+{ "Lcedilla", 0x3a6 },
+{ "Emacron", 0x3aa },
+{ "Gcedilla", 0x3ab },
+{ "Tslash", 0x3ac },
+{ "rcedilla", 0x3b3 },
+{ "itilde", 0x3b5 },
+{ "lcedilla", 0x3b6 },
+{ "emacron", 0x3ba },
+{ "gacute", 0x3bb },
+{ "tslash", 0x3bc },
+{ "ENG", 0x3bd },
+{ "eng", 0x3bf },
+{ "Amacron", 0x3c0 },
+{ "Iogonek", 0x3c7 },
+{ "Eabovedot", 0x3cc },
+{ "Imacron", 0x3cf },
+{ "Ncedilla", 0x3d1 },
+{ "Omacron", 0x3d2 },
+{ "Kcedilla", 0x3d3 },
+{ "Uogonek", 0x3d9 },
+{ "Utilde", 0x3dd },
+{ "Umacron", 0x3de },
+{ "amacron", 0x3e0 },
+{ "iogonek", 0x3e7 },
+{ "eabovedot", 0x3ec },
+{ "imacron", 0x3ef },
+{ "ncedilla", 0x3f1 },
+{ "omacron", 0x3f2 },
+{ "kcedilla", 0x3f3 },
+{ "uogonek", 0x3f9 },
+{ "utilde", 0x3fd },
+{ "umacron", 0x3fe },
+{ "overline", 0x47e },
+{ "kana_fullstop", 0x4a1 },
+{ "kana_openingbracket", 0x4a2 },
+{ "kana_closingbracket", 0x4a3 },
+{ "kana_comma", 0x4a4 },
+{ "kana_middledot", 0x4a5 },
+{ "kana_WO", 0x4a6 },
+{ "kana_a", 0x4a7 },
+{ "kana_i", 0x4a8 },
+{ "kana_u", 0x4a9 },
+{ "kana_e", 0x4aa },
+{ "kana_o", 0x4ab },
+{ "kana_ya", 0x4ac },
+{ "kana_yu", 0x4ad },
+{ "kana_yo", 0x4ae },
+{ "kana_tu", 0x4af },
+{ "prolongedsound", 0x4b0 },
+{ "kana_A", 0x4b1 },
+{ "kana_I", 0x4b2 },
+{ "kana_U", 0x4b3 },
+{ "kana_E", 0x4b4 },
+{ "kana_O", 0x4b5 },
+{ "kana_KA", 0x4b6 },
+{ "kana_KI", 0x4b7 },
+{ "kana_KU", 0x4b8 },
+{ "kana_KE", 0x4b9 },
+{ "kana_KO", 0x4ba },
+{ "kana_SA", 0x4bb },
+{ "kana_SHI", 0x4bc },
+{ "kana_SU", 0x4bd },
+{ "kana_SE", 0x4be },
+{ "kana_SO", 0x4bf },
+{ "kana_TA", 0x4c0 },
+{ "kana_TI", 0x4c1 },
+{ "kana_TU", 0x4c2 },
+{ "kana_TE", 0x4c3 },
+{ "kana_TO", 0x4c4 },
+{ "kana_NA", 0x4c5 },
+{ "kana_NI", 0x4c6 },
+{ "kana_NU", 0x4c7 },
+{ "kana_NE", 0x4c8 },
+{ "kana_NO", 0x4c9 },
+{ "kana_HA", 0x4ca },
+{ "kana_HI", 0x4cb },
+{ "kana_HU", 0x4cc },
+{ "kana_HE", 0x4cd },
+{ "kana_HO", 0x4ce },
+{ "kana_MA", 0x4cf },
+{ "kana_MI", 0x4d0 },
+{ "kana_MU", 0x4d1 },
+{ "kana_ME", 0x4d2 },
+{ "kana_MO", 0x4d3 },
+{ "kana_YA", 0x4d4 },
+{ "kana_YU", 0x4d5 },
+{ "kana_YO", 0x4d6 },
+{ "kana_RA", 0x4d7 },
+{ "kana_RI", 0x4d8 },
+{ "kana_RU", 0x4d9 },
+{ "kana_RE", 0x4da },
+{ "kana_RO", 0x4db },
+{ "kana_WA", 0x4dc },
+{ "kana_N", 0x4dd },
+{ "voicedsound", 0x4de },
+{ "semivoicedsound", 0x4df },
+{ "kana_switch", 0xFF7E },
+{ "Arabic_comma", 0x5ac },
+{ "Arabic_semicolon", 0x5bb },
+{ "Arabic_question_mark", 0x5bf },
+{ "Arabic_hamza", 0x5c1 },
+{ "Arabic_maddaonalef", 0x5c2 },
+{ "Arabic_hamzaonalef", 0x5c3 },
+{ "Arabic_hamzaonwaw", 0x5c4 },
+{ "Arabic_hamzaunderalef", 0x5c5 },
+{ "Arabic_hamzaonyeh", 0x5c6 },
+{ "Arabic_alef", 0x5c7 },
+{ "Arabic_beh", 0x5c8 },
+{ "Arabic_tehmarbuta", 0x5c9 },
+{ "Arabic_teh", 0x5ca },
+{ "Arabic_theh", 0x5cb },
+{ "Arabic_jeem", 0x5cc },
+{ "Arabic_hah", 0x5cd },
+{ "Arabic_khah", 0x5ce },
+{ "Arabic_dal", 0x5cf },
+{ "Arabic_thal", 0x5d0 },
+{ "Arabic_ra", 0x5d1 },
+{ "Arabic_zain", 0x5d2 },
+{ "Arabic_seen", 0x5d3 },
+{ "Arabic_sheen", 0x5d4 },
+{ "Arabic_sad", 0x5d5 },
+{ "Arabic_dad", 0x5d6 },
+{ "Arabic_tah", 0x5d7 },
+{ "Arabic_zah", 0x5d8 },
+{ "Arabic_ain", 0x5d9 },
+{ "Arabic_ghain", 0x5da },
+{ "Arabic_tatweel", 0x5e0 },
+{ "Arabic_feh", 0x5e1 },
+{ "Arabic_qaf", 0x5e2 },
+{ "Arabic_kaf", 0x5e3 },
+{ "Arabic_lam", 0x5e4 },
+{ "Arabic_meem", 0x5e5 },
+{ "Arabic_noon", 0x5e6 },
+{ "Arabic_heh", 0x5e7 },
+{ "Arabic_waw", 0x5e8 },
+{ "Arabic_alefmaksura", 0x5e9 },
+{ "Arabic_yeh", 0x5ea },
+{ "Arabic_fathatan", 0x5eb },
+{ "Arabic_dammatan", 0x5ec },
+{ "Arabic_kasratan", 0x5ed },
+{ "Arabic_fatha", 0x5ee },
+{ "Arabic_damma", 0x5ef },
+{ "Arabic_kasra", 0x5f0 },
+{ "Arabic_shadda", 0x5f1 },
+{ "Arabic_sukun", 0x5f2 },
+{ "Arabic_switch", 0xFF7E },
+{ "Serbian_dje", 0x6a1 },
+{ "Macedonia_gje", 0x6a2 },
+{ "Cyrillic_io", 0x6a3 },
+{ "Ukranian_je", 0x6a4 },
+{ "Macedonia_dse", 0x6a5 },
+{ "Ukranian_i", 0x6a6 },
+{ "Ukranian_yi", 0x6a7 },
+{ "Serbian_je", 0x6a8 },
+{ "Serbian_lje", 0x6a9 },
+{ "Serbian_nje", 0x6aa },
+{ "Serbian_tshe", 0x6ab },
+{ "Macedonia_kje", 0x6ac },
+{ "Byelorussian_shortu", 0x6ae },
+{ "Serbian_dze", 0x6af },
+{ "numerosign", 0x6b0 },
+{ "Serbian_DJE", 0x6b1 },
+{ "Macedonia_GJE", 0x6b2 },
+{ "Cyrillic_IO", 0x6b3 },
+{ "Ukranian_JE", 0x6b4 },
+{ "Macedonia_DSE", 0x6b5 },
+{ "Ukranian_I", 0x6b6 },
+{ "Ukranian_YI", 0x6b7 },
+{ "Serbian_JE", 0x6b8 },
+{ "Serbian_LJE", 0x6b9 },
+{ "Serbian_NJE", 0x6ba },
+{ "Serbian_TSHE", 0x6bb },
+{ "Macedonia_KJE", 0x6bc },
+{ "Byelorussian_SHORTU", 0x6be },
+{ "Serbian_DZE", 0x6bf },
+{ "Cyrillic_yu", 0x6c0 },
+{ "Cyrillic_a", 0x6c1 },
+{ "Cyrillic_be", 0x6c2 },
+{ "Cyrillic_tse", 0x6c3 },
+{ "Cyrillic_de", 0x6c4 },
+{ "Cyrillic_ie", 0x6c5 },
+{ "Cyrillic_ef", 0x6c6 },
+{ "Cyrillic_ghe", 0x6c7 },
+{ "Cyrillic_ha", 0x6c8 },
+{ "Cyrillic_i", 0x6c9 },
+{ "Cyrillic_shorti", 0x6ca },
+{ "Cyrillic_ka", 0x6cb },
+{ "Cyrillic_el", 0x6cc },
+{ "Cyrillic_em", 0x6cd },
+{ "Cyrillic_en", 0x6ce },
+{ "Cyrillic_o", 0x6cf },
+{ "Cyrillic_pe", 0x6d0 },
+{ "Cyrillic_ya", 0x6d1 },
+{ "Cyrillic_er", 0x6d2 },
+{ "Cyrillic_es", 0x6d3 },
+{ "Cyrillic_te", 0x6d4 },
+{ "Cyrillic_u", 0x6d5 },
+{ "Cyrillic_zhe", 0x6d6 },
+{ "Cyrillic_ve", 0x6d7 },
+{ "Cyrillic_softsign", 0x6d8 },
+{ "Cyrillic_yeru", 0x6d9 },
+{ "Cyrillic_ze", 0x6da },
+{ "Cyrillic_sha", 0x6db },
+{ "Cyrillic_e", 0x6dc },
+{ "Cyrillic_shcha", 0x6dd },
+{ "Cyrillic_che", 0x6de },
+{ "Cyrillic_hardsign", 0x6df },
+{ "Cyrillic_YU", 0x6e0 },
+{ "Cyrillic_A", 0x6e1 },
+{ "Cyrillic_BE", 0x6e2 },
+{ "Cyrillic_TSE", 0x6e3 },
+{ "Cyrillic_DE", 0x6e4 },
+{ "Cyrillic_IE", 0x6e5 },
+{ "Cyrillic_EF", 0x6e6 },
+{ "Cyrillic_GHE", 0x6e7 },
+{ "Cyrillic_HA", 0x6e8 },
+{ "Cyrillic_I", 0x6e9 },
+{ "Cyrillic_SHORTI", 0x6ea },
+{ "Cyrillic_KA", 0x6eb },
+{ "Cyrillic_EL", 0x6ec },
+{ "Cyrillic_EM", 0x6ed },
+{ "Cyrillic_EN", 0x6ee },
+{ "Cyrillic_O", 0x6ef },
+{ "Cyrillic_PE", 0x6f0 },
+{ "Cyrillic_YA", 0x6f1 },
+{ "Cyrillic_ER", 0x6f2 },
+{ "Cyrillic_ES", 0x6f3 },
+{ "Cyrillic_TE", 0x6f4 },
+{ "Cyrillic_U", 0x6f5 },
+{ "Cyrillic_ZHE", 0x6f6 },
+{ "Cyrillic_VE", 0x6f7 },
+{ "Cyrillic_SOFTSIGN", 0x6f8 },
+{ "Cyrillic_YERU", 0x6f9 },
+{ "Cyrillic_ZE", 0x6fa },
+{ "Cyrillic_SHA", 0x6fb },
+{ "Cyrillic_E", 0x6fc },
+{ "Cyrillic_SHCHA", 0x6fd },
+{ "Cyrillic_CHE", 0x6fe },
+{ "Cyrillic_HARDSIGN", 0x6ff },
+{ "Greek_ALPHAaccent", 0x7a1 },
+{ "Greek_EPSILONaccent", 0x7a2 },
+{ "Greek_ETAaccent", 0x7a3 },
+{ "Greek_IOTAaccent", 0x7a4 },
+{ "Greek_IOTAdiaeresis", 0x7a5 },
+{ "Greek_IOTAaccentdiaeresis", 0x7a6 },
+{ "Greek_OMICRONaccent", 0x7a7 },
+{ "Greek_UPSILONaccent", 0x7a8 },
+{ "Greek_UPSILONdieresis", 0x7a9 },
+{ "Greek_UPSILONaccentdieresis", 0x7aa },
+{ "Greek_OMEGAaccent", 0x7ab },
+{ "Greek_alphaaccent", 0x7b1 },
+{ "Greek_epsilonaccent", 0x7b2 },
+{ "Greek_etaaccent", 0x7b3 },
+{ "Greek_iotaaccent", 0x7b4 },
+{ "Greek_iotadieresis", 0x7b5 },
+{ "Greek_iotaaccentdieresis", 0x7b6 },
+{ "Greek_omicronaccent", 0x7b7 },
+{ "Greek_upsilonaccent", 0x7b8 },
+{ "Greek_upsilondieresis", 0x7b9 },
+{ "Greek_upsilonaccentdieresis", 0x7ba },
+{ "Greek_omegaaccent", 0x7bb },
+{ "Greek_ALPHA", 0x7c1 },
+{ "Greek_BETA", 0x7c2 },
+{ "Greek_GAMMA", 0x7c3 },
+{ "Greek_DELTA", 0x7c4 },
+{ "Greek_EPSILON", 0x7c5 },
+{ "Greek_ZETA", 0x7c6 },
+{ "Greek_ETA", 0x7c7 },
+{ "Greek_THETA", 0x7c8 },
+{ "Greek_IOTA", 0x7c9 },
+{ "Greek_KAPPA", 0x7ca },
+{ "Greek_LAMBDA", 0x7cb },
+{ "Greek_MU", 0x7cc },
+{ "Greek_NU", 0x7cd },
+{ "Greek_XI", 0x7ce },
+{ "Greek_OMICRON", 0x7cf },
+{ "Greek_PI", 0x7d0 },
+{ "Greek_RHO", 0x7d1 },
+{ "Greek_SIGMA", 0x7d2 },
+{ "Greek_TAU", 0x7d4 },
+{ "Greek_UPSILON", 0x7d5 },
+{ "Greek_PHI", 0x7d6 },
+{ "Greek_CHI", 0x7d7 },
+{ "Greek_PSI", 0x7d8 },
+{ "Greek_OMEGA", 0x7d9 },
+{ "Greek_alpha", 0x7e1 },
+{ "Greek_beta", 0x7e2 },
+{ "Greek_gamma", 0x7e3 },
+{ "Greek_delta", 0x7e4 },
+{ "Greek_epsilon", 0x7e5 },
+{ "Greek_zeta", 0x7e6 },
+{ "Greek_eta", 0x7e7 },
+{ "Greek_theta", 0x7e8 },
+{ "Greek_iota", 0x7e9 },
+{ "Greek_kappa", 0x7ea },
+{ "Greek_lambda", 0x7eb },
+{ "Greek_mu", 0x7ec },
+{ "Greek_nu", 0x7ed },
+{ "Greek_xi", 0x7ee },
+{ "Greek_omicron", 0x7ef },
+{ "Greek_pi", 0x7f0 },
+{ "Greek_rho", 0x7f1 },
+{ "Greek_sigma", 0x7f2 },
+{ "Greek_finalsmallsigma", 0x7f3 },
+{ "Greek_tau", 0x7f4 },
+{ "Greek_upsilon", 0x7f5 },
+{ "Greek_phi", 0x7f6 },
+{ "Greek_chi", 0x7f7 },
+{ "Greek_psi", 0x7f8 },
+{ "Greek_omega", 0x7f9 },
+{ "Greek_switch", 0xFF7E },
+{ "leftradical", 0x8a1 },
+{ "topleftradical", 0x8a2 },
+{ "horizconnector", 0x8a3 },
+{ "topintegral", 0x8a4 },
+{ "botintegral", 0x8a5 },
+{ "vertconnector", 0x8a6 },
+{ "topleftsqbracket", 0x8a7 },
+{ "botleftsqbracket", 0x8a8 },
+{ "toprightsqbracket", 0x8a9 },
+{ "botrightsqbracket", 0x8aa },
+{ "topleftparens", 0x8ab },
+{ "botleftparens", 0x8ac },
+{ "toprightparens", 0x8ad },
+{ "botrightparens", 0x8ae },
+{ "leftmiddlecurlybrace", 0x8af },
+{ "rightmiddlecurlybrace", 0x8b0 },
+{ "topleftsummation", 0x8b1 },
+{ "botleftsummation", 0x8b2 },
+{ "topvertsummationconnector", 0x8b3 },
+{ "botvertsummationconnector", 0x8b4 },
+{ "toprightsummation", 0x8b5 },
+{ "botrightsummation", 0x8b6 },
+{ "rightmiddlesummation", 0x8b7 },
+{ "lessthanequal", 0x8bc },
+{ "notequal", 0x8bd },
+{ "greaterthanequal", 0x8be },
+{ "integral", 0x8bf },
+{ "therefore", 0x8c0 },
+{ "variation", 0x8c1 },
+{ "infinity", 0x8c2 },
+{ "nabla", 0x8c5 },
+{ "approximate", 0x8c8 },
+{ "similarequal", 0x8c9 },
+{ "ifonlyif", 0x8cd },
+{ "implies", 0x8ce },
+{ "identical", 0x8cf },
+{ "radical", 0x8d6 },
+{ "includedin", 0x8da },
+{ "includes", 0x8db },
+{ "intersection", 0x8dc },
+{ "union", 0x8dd },
+{ "logicaland", 0x8de },
+{ "logicalor", 0x8df },
+{ "partialderivative", 0x8ef },
+{ "function", 0x8f6 },
+{ "leftarrow", 0x8fb },
+{ "uparrow", 0x8fc },
+{ "rightarrow", 0x8fd },
+{ "downarrow", 0x8fe },
+{ "blank", 0x9df },
+{ "soliddiamond", 0x9e0 },
+{ "checkerboard", 0x9e1 },
+{ "ht", 0x9e2 },
+{ "ff", 0x9e3 },
+{ "cr", 0x9e4 },
+{ "lf", 0x9e5 },
+{ "nl", 0x9e8 },
+{ "vt", 0x9e9 },
+{ "lowrightcorner", 0x9ea },
+{ "uprightcorner", 0x9eb },
+{ "upleftcorner", 0x9ec },
+{ "lowleftcorner", 0x9ed },
+{ "crossinglines", 0x9ee },
+{ "horizlinescan1", 0x9ef },
+{ "horizlinescan3", 0x9f0 },
+{ "horizlinescan5", 0x9f1 },
+{ "horizlinescan7", 0x9f2 },
+{ "horizlinescan9", 0x9f3 },
+{ "leftt", 0x9f4 },
+{ "rightt", 0x9f5 },
+{ "bott", 0x9f6 },
+{ "topt", 0x9f7 },
+{ "vertbar", 0x9f8 },
+{ "emspace", 0xaa1 },
+{ "enspace", 0xaa2 },
+{ "em3space", 0xaa3 },
+{ "em4space", 0xaa4 },
+{ "digitspace", 0xaa5 },
+{ "punctspace", 0xaa6 },
+{ "thinspace", 0xaa7 },
+{ "hairspace", 0xaa8 },
+{ "emdash", 0xaa9 },
+{ "endash", 0xaaa },
+{ "signifblank", 0xaac },
+{ "ellipsis", 0xaae },
+{ "doubbaselinedot", 0xaaf },
+{ "onethird", 0xab0 },
+{ "twothirds", 0xab1 },
+{ "onefifth", 0xab2 },
+{ "twofifths", 0xab3 },
+{ "threefifths", 0xab4 },
+{ "fourfifths", 0xab5 },
+{ "onesixth", 0xab6 },
+{ "fivesixths", 0xab7 },
+{ "careof", 0xab8 },
+{ "figdash", 0xabb },
+{ "leftanglebracket", 0xabc },
+{ "decimalpoint", 0xabd },
+{ "rightanglebracket", 0xabe },
+{ "marker", 0xabf },
+{ "oneeighth", 0xac3 },
+{ "threeeighths", 0xac4 },
+{ "fiveeighths", 0xac5 },
+{ "seveneighths", 0xac6 },
+{ "trademark", 0xac9 },
+{ "signaturemark", 0xaca },
+{ "trademarkincircle", 0xacb },
+{ "leftopentriangle", 0xacc },
+{ "rightopentriangle", 0xacd },
+{ "emopencircle", 0xace },
+{ "emopenrectangle", 0xacf },
+{ "leftsinglequotemark", 0xad0 },
+{ "rightsinglequotemark", 0xad1 },
+{ "leftdoublequotemark", 0xad2 },
+{ "rightdoublequotemark", 0xad3 },
+{ "prescription", 0xad4 },
+{ "minutes", 0xad6 },
+{ "seconds", 0xad7 },
+{ "latincross", 0xad9 },
+{ "hexagram", 0xada },
+{ "filledrectbullet", 0xadb },
+{ "filledlefttribullet", 0xadc },
+{ "filledrighttribullet", 0xadd },
+{ "emfilledcircle", 0xade },
+{ "emfilledrect", 0xadf },
+{ "enopencircbullet", 0xae0 },
+{ "enopensquarebullet", 0xae1 },
+{ "openrectbullet", 0xae2 },
+{ "opentribulletup", 0xae3 },
+{ "opentribulletdown", 0xae4 },
+{ "openstar", 0xae5 },
+{ "enfilledcircbullet", 0xae6 },
+{ "enfilledsqbullet", 0xae7 },
+{ "filledtribulletup", 0xae8 },
+{ "filledtribulletdown", 0xae9 },
+{ "leftpointer", 0xaea },
+{ "rightpointer", 0xaeb },
+{ "club", 0xaec },
+{ "diamond", 0xaed },
+{ "heart", 0xaee },
+{ "maltesecross", 0xaf0 },
+{ "dagger", 0xaf1 },
+{ "doubledagger", 0xaf2 },
+{ "checkmark", 0xaf3 },
+{ "ballotcross", 0xaf4 },
+{ "musicalsharp", 0xaf5 },
+{ "musicalflat", 0xaf6 },
+{ "malesymbol", 0xaf7 },
+{ "femalesymbol", 0xaf8 },
+{ "telephone", 0xaf9 },
+{ "telephonerecorder", 0xafa },
+{ "phonographcopyright", 0xafb },
+{ "caret", 0xafc },
+{ "singlelowquotemark", 0xafd },
+{ "doublelowquotemark", 0xafe },
+{ "cursor", 0xaff },
+{ "leftcaret", 0xba3 },
+{ "rightcaret", 0xba6 },
+{ "downcaret", 0xba8 },
+{ "upcaret", 0xba9 },
+{ "overbar", 0xbc0 },
+{ "downtack", 0xbc2 },
+{ "upshoe", 0xbc3 },
+{ "downstile", 0xbc4 },
+{ "underbar", 0xbc6 },
+{ "jot", 0xbca },
+{ "quad", 0xbcc },
+{ "uptack", 0xbce },
+{ "circle", 0xbcf },
+{ "upstile", 0xbd3 },
+{ "downshoe", 0xbd6 },
+{ "rightshoe", 0xbd8 },
+{ "leftshoe", 0xbda },
+{ "lefttack", 0xbdc },
+{ "righttack", 0xbfc },
+{ "hebrew_aleph", 0xce0 },
+{ "hebrew_beth", 0xce1 },
+{ "hebrew_gimmel", 0xce2 },
+{ "hebrew_daleth", 0xce3 },
+{ "hebrew_he", 0xce4 },
+{ "hebrew_waw", 0xce5 },
+{ "hebrew_zayin", 0xce6 },
+{ "hebrew_het", 0xce7 },
+{ "hebrew_teth", 0xce8 },
+{ "hebrew_yod", 0xce9 },
+{ "hebrew_finalkaph", 0xcea },
+{ "hebrew_kaph", 0xceb },
+{ "hebrew_lamed", 0xcec },
+{ "hebrew_finalmem", 0xced },
+{ "hebrew_mem", 0xcee },
+{ "hebrew_finalnun", 0xcef },
+{ "hebrew_nun", 0xcf0 },
+{ "hebrew_samekh", 0xcf1 },
+{ "hebrew_ayin", 0xcf2 },
+{ "hebrew_finalpe", 0xcf3 },
+{ "hebrew_pe", 0xcf4 },
+{ "hebrew_finalzadi", 0xcf5 },
+{ "hebrew_zadi", 0xcf6 },
+{ "hebrew_kuf", 0xcf7 },
+{ "hebrew_resh", 0xcf8 },
+{ "hebrew_shin", 0xcf9 },
+{ "hebrew_taf", 0xcfa },
+{ "Hebrew_switch", 0xFF7E },
diff --git a/generic/tk.h b/generic/tk.h
new file mode 100644
index 0000000..3e470f0
--- /dev/null
+++ b/generic/tk.h
@@ -0,0 +1,1538 @@
+/*
+ * tk.h --
+ *
+ * Declarations for Tk-related things that are visible
+ * outside of the Tk module itself.
+ *
+ * Copyright (c) 1989-1994 The Regents of the University of California.
+ * Copyright (c) 1994 The Australian National University.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tk.h 1.211 97/11/20 12:44:45
+ */
+
+#ifndef _TK
+#define _TK
+
+/*
+ * When version numbers change here, you must also go into the following files
+ * and update the version numbers:
+ *
+ * unix/configure.in
+ * win/makefile.bc
+ * win/makefile.vc
+ * library/tk.tcl
+ *
+ * The release level should be 0 for alpha, 1 for beta, and 2 for
+ * final/patch. The release serial value is the number that follows the
+ * "a", "b", or "p" in the patch level; for example, if the patch level
+ * is 4.3b2, TK_RELEASE_SERIAL is 2. It restarts at 1 whenever the
+ * release level is changed, except for the final release, which should
+ * be 0.
+ *
+ * You may also need to update some of these files when the numbers change
+ * for the version of Tcl that this release of Tk is compiled against.
+ */
+
+#define TK_MAJOR_VERSION 8
+#define TK_MINOR_VERSION 0
+#define TK_RELEASE_LEVEL 2
+#define TK_RELEASE_SERIAL 2
+
+#define TK_VERSION "8.0"
+#define TK_PATCH_LEVEL "8.0p2"
+
+/*
+ * A special definition used to allow this header file to be included
+ * in resource files.
+ */
+
+#ifndef RESOURCE_INCLUDED
+
+/*
+ * The following definitions set up the proper options for Macintosh
+ * compilers. We use this method because there is no autoconf equivalent.
+ */
+
+#ifdef MAC_TCL
+# ifndef REDO_KEYSYM_LOOKUP
+# define REDO_KEYSYM_LOOKUP
+# endif
+#endif
+
+#ifndef _TCL
+# include <tcl.h>
+#endif
+#ifndef _XLIB_H
+# ifdef MAC_TCL
+# include <Xlib.h>
+# include <X.h>
+# else
+# include <X11/Xlib.h>
+# endif
+#endif
+#ifdef __STDC__
+# include <stddef.h>
+#endif
+
+/*
+ * Decide whether or not to use input methods.
+ */
+
+#ifdef XNQueryInputStyle
+#define TK_USE_INPUT_METHODS
+#endif
+
+/*
+ * Dummy types that are used by clients:
+ */
+
+typedef struct Tk_BindingTable_ *Tk_BindingTable;
+typedef struct Tk_Canvas_ *Tk_Canvas;
+typedef struct Tk_Cursor_ *Tk_Cursor;
+typedef struct Tk_ErrorHandler_ *Tk_ErrorHandler;
+typedef struct Tk_Font_ *Tk_Font;
+typedef struct Tk_Image__ *Tk_Image;
+typedef struct Tk_ImageMaster_ *Tk_ImageMaster;
+typedef struct Tk_TextLayout_ *Tk_TextLayout;
+typedef struct Tk_Window_ *Tk_Window;
+typedef struct Tk_3DBorder_ *Tk_3DBorder;
+
+/*
+ * Additional types exported to clients.
+ */
+
+typedef char *Tk_Uid;
+
+/*
+ * Structure used to specify how to handle argv options.
+ */
+
+typedef struct {
+ char *key; /* The key string that flags the option in the
+ * argv array. */
+ int type; /* Indicates option type; see below. */
+ char *src; /* Value to be used in setting dst; usage
+ * depends on type. */
+ char *dst; /* Address of value to be modified; usage
+ * depends on type. */
+ char *help; /* Documentation message describing this option. */
+} Tk_ArgvInfo;
+
+/*
+ * Legal values for the type field of a Tk_ArgvInfo: see the user
+ * documentation for details.
+ */
+
+#define TK_ARGV_CONSTANT 15
+#define TK_ARGV_INT 16
+#define TK_ARGV_STRING 17
+#define TK_ARGV_UID 18
+#define TK_ARGV_REST 19
+#define TK_ARGV_FLOAT 20
+#define TK_ARGV_FUNC 21
+#define TK_ARGV_GENFUNC 22
+#define TK_ARGV_HELP 23
+#define TK_ARGV_CONST_OPTION 24
+#define TK_ARGV_OPTION_VALUE 25
+#define TK_ARGV_OPTION_NAME_VALUE 26
+#define TK_ARGV_END 27
+
+/*
+ * Flag bits for passing to Tk_ParseArgv:
+ */
+
+#define TK_ARGV_NO_DEFAULTS 0x1
+#define TK_ARGV_NO_LEFTOVERS 0x2
+#define TK_ARGV_NO_ABBREV 0x4
+#define TK_ARGV_DONT_SKIP_FIRST_ARG 0x8
+
+/*
+ * Structure used to describe application-specific configuration
+ * options: indicates procedures to call to parse an option and
+ * to return a text string describing an option.
+ */
+
+typedef int (Tk_OptionParseProc) _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin, char *value, char *widgRec,
+ int offset));
+typedef char *(Tk_OptionPrintProc) _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr));
+
+typedef struct Tk_CustomOption {
+ Tk_OptionParseProc *parseProc; /* Procedure to call to parse an
+ * option and store it in converted
+ * form. */
+ Tk_OptionPrintProc *printProc; /* Procedure to return a printable
+ * string describing an existing
+ * option. */
+ ClientData clientData; /* Arbitrary one-word value used by
+ * option parser: passed to
+ * parseProc and printProc. */
+} Tk_CustomOption;
+
+/*
+ * Structure used to specify information for Tk_ConfigureWidget. Each
+ * structure gives complete information for one option, including
+ * how the option is specified on the command line, where it appears
+ * in the option database, etc.
+ */
+
+typedef struct Tk_ConfigSpec {
+ int type; /* Type of option, such as TK_CONFIG_COLOR;
+ * see definitions below. Last option in
+ * table must have type TK_CONFIG_END. */
+ char *argvName; /* Switch used to specify option in argv.
+ * NULL means this spec is part of a group. */
+ char *dbName; /* Name for option in option database. */
+ char *dbClass; /* Class for option in database. */
+ char *defValue; /* Default value for option if not
+ * specified in command line or database. */
+ int offset; /* Where in widget record to store value;
+ * use Tk_Offset macro to generate values
+ * for this. */
+ int specFlags; /* Any combination of the values defined
+ * below; other bits are used internally
+ * by tkConfig.c. */
+ Tk_CustomOption *customPtr; /* If type is TK_CONFIG_CUSTOM then this is
+ * a pointer to info about how to parse and
+ * print the option. Otherwise it is
+ * irrelevant. */
+} Tk_ConfigSpec;
+
+/*
+ * Type values for Tk_ConfigSpec structures. See the user
+ * documentation for details.
+ */
+
+#define TK_CONFIG_BOOLEAN 1
+#define TK_CONFIG_INT 2
+#define TK_CONFIG_DOUBLE 3
+#define TK_CONFIG_STRING 4
+#define TK_CONFIG_UID 5
+#define TK_CONFIG_COLOR 6
+#define TK_CONFIG_FONT 7
+#define TK_CONFIG_BITMAP 8
+#define TK_CONFIG_BORDER 9
+#define TK_CONFIG_RELIEF 10
+#define TK_CONFIG_CURSOR 11
+#define TK_CONFIG_ACTIVE_CURSOR 12
+#define TK_CONFIG_JUSTIFY 13
+#define TK_CONFIG_ANCHOR 14
+#define TK_CONFIG_SYNONYM 15
+#define TK_CONFIG_CAP_STYLE 16
+#define TK_CONFIG_JOIN_STYLE 17
+#define TK_CONFIG_PIXELS 18
+#define TK_CONFIG_MM 19
+#define TK_CONFIG_WINDOW 20
+#define TK_CONFIG_CUSTOM 21
+#define TK_CONFIG_END 22
+
+/*
+ * Macro to use to fill in "offset" fields of Tk_ConfigInfos.
+ * Computes number of bytes from beginning of structure to a
+ * given field.
+ */
+
+#ifdef offsetof
+#define Tk_Offset(type, field) ((int) offsetof(type, field))
+#else
+#define Tk_Offset(type, field) ((int) ((char *) &((type *) 0)->field))
+#endif
+
+/*
+ * Possible values for flags argument to Tk_ConfigureWidget:
+ */
+
+#define TK_CONFIG_ARGV_ONLY 1
+
+/*
+ * Possible flag values for Tk_ConfigInfo structures. Any bits at
+ * or above TK_CONFIG_USER_BIT may be used by clients for selecting
+ * certain entries. Before changing any values here, coordinate with
+ * tkConfig.c (internal-use-only flags are defined there).
+ */
+
+#define TK_CONFIG_COLOR_ONLY 1
+#define TK_CONFIG_MONO_ONLY 2
+#define TK_CONFIG_NULL_OK 4
+#define TK_CONFIG_DONT_SET_DEFAULT 8
+#define TK_CONFIG_OPTION_SPECIFIED 0x10
+#define TK_CONFIG_USER_BIT 0x100
+
+/*
+ * Enumerated type for describing actions to be taken in response
+ * to a restrictProc established by Tk_RestrictEvents.
+ */
+
+typedef enum {
+ TK_DEFER_EVENT, TK_PROCESS_EVENT, TK_DISCARD_EVENT
+} Tk_RestrictAction;
+
+/*
+ * Priority levels to pass to Tk_AddOption:
+ */
+
+#define TK_WIDGET_DEFAULT_PRIO 20
+#define TK_STARTUP_FILE_PRIO 40
+#define TK_USER_DEFAULT_PRIO 60
+#define TK_INTERACTIVE_PRIO 80
+#define TK_MAX_PRIO 100
+
+/*
+ * Relief values returned by Tk_GetRelief:
+ */
+
+#define TK_RELIEF_RAISED 1
+#define TK_RELIEF_FLAT 2
+#define TK_RELIEF_SUNKEN 4
+#define TK_RELIEF_GROOVE 8
+#define TK_RELIEF_RIDGE 16
+#define TK_RELIEF_SOLID 32
+
+/*
+ * "Which" argument values for Tk_3DBorderGC:
+ */
+
+#define TK_3D_FLAT_GC 1
+#define TK_3D_LIGHT_GC 2
+#define TK_3D_DARK_GC 3
+
+/*
+ * Special EnterNotify/LeaveNotify "mode" for use in events
+ * generated by tkShare.c. Pick a high enough value that it's
+ * unlikely to conflict with existing values (like NotifyNormal)
+ * or any new values defined in the future.
+ */
+
+#define TK_NOTIFY_SHARE 20
+
+/*
+ * Enumerated type for describing a point by which to anchor something:
+ */
+
+typedef enum {
+ TK_ANCHOR_N, TK_ANCHOR_NE, TK_ANCHOR_E, TK_ANCHOR_SE,
+ TK_ANCHOR_S, TK_ANCHOR_SW, TK_ANCHOR_W, TK_ANCHOR_NW,
+ TK_ANCHOR_CENTER
+} Tk_Anchor;
+
+/*
+ * Enumerated type for describing a style of justification:
+ */
+
+typedef enum {
+ TK_JUSTIFY_LEFT, TK_JUSTIFY_RIGHT, TK_JUSTIFY_CENTER
+} Tk_Justify;
+
+/*
+ * The following structure is used by Tk_GetFontMetrics() to return
+ * information about the properties of a Tk_Font.
+ */
+
+typedef struct Tk_FontMetrics {
+ int ascent; /* The amount in pixels that the tallest
+ * letter sticks up above the baseline, plus
+ * any extra blank space added by the designer
+ * of the font. */
+ int descent; /* The largest amount in pixels that any
+ * letter sticks below the baseline, plus any
+ * extra blank space added by the designer of
+ * the font. */
+ int linespace; /* The sum of the ascent and descent. How
+ * far apart two lines of text in the same
+ * font should be placed so that none of the
+ * characters in one line overlap any of the
+ * characters in the other line. */
+} Tk_FontMetrics;
+
+/*
+ * Flags passed to Tk_MeasureChars:
+ */
+
+#define TK_WHOLE_WORDS 1
+#define TK_AT_LEAST_ONE 2
+#define TK_PARTIAL_OK 4
+
+/*
+ * Flags passed to Tk_ComputeTextLayout:
+ */
+
+#define TK_IGNORE_TABS 8
+#define TK_IGNORE_NEWLINES 16
+
+/*
+ * Each geometry manager (the packer, the placer, etc.) is represented
+ * by a structure of the following form, which indicates procedures
+ * to invoke in the geometry manager to carry out certain functions.
+ */
+
+typedef void (Tk_GeomRequestProc) _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+typedef void (Tk_GeomLostSlaveProc) _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+
+typedef struct Tk_GeomMgr {
+ char *name; /* Name of the geometry manager (command
+ * used to invoke it, or name of widget
+ * class that allows embedded widgets). */
+ Tk_GeomRequestProc *requestProc;
+ /* Procedure to invoke when a slave's
+ * requested geometry changes. */
+ Tk_GeomLostSlaveProc *lostSlaveProc;
+ /* Procedure to invoke when a slave is
+ * taken away from one geometry manager
+ * by another. NULL means geometry manager
+ * doesn't care when slaves are lost. */
+} Tk_GeomMgr;
+
+/*
+ * Result values returned by Tk_GetScrollInfo:
+ */
+
+#define TK_SCROLL_MOVETO 1
+#define TK_SCROLL_PAGES 2
+#define TK_SCROLL_UNITS 3
+#define TK_SCROLL_ERROR 4
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Extensions to the X event set
+ *
+ *---------------------------------------------------------------------------
+ */
+#define VirtualEvent (LASTEvent)
+#define ActivateNotify (LASTEvent + 1)
+#define DeactivateNotify (LASTEvent + 2)
+#define TK_LASTEVENT (LASTEvent + 3)
+
+#define VirtualEventMask (1L << 30)
+#define ActivateMask (1L << 29)
+#define TK_LASTEVENT (LASTEvent + 3)
+
+
+/*
+ * A virtual event shares most of its fields with the XKeyEvent and
+ * XButtonEvent structures. 99% of the time a virtual event will be
+ * an abstraction of a key or button event, so this structure provides
+ * the most information to the user. The only difference is the changing
+ * of the detail field for a virtual event so that it holds the name of the
+ * virtual event being triggered.
+ */
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* True if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window event; /* Window on which event was requested. */
+ Window root; /* root window that the event occured on */
+ Window subwindow; /* child window */
+ Time time; /* milliseconds */
+ int x, y; /* pointer x, y coordinates in event window */
+ int x_root, y_root; /* coordinates relative to root */
+ unsigned int state; /* key or button mask */
+ Tk_Uid name; /* Name of virtual event. */
+ Bool same_screen; /* same screen flag */
+} XVirtualEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* True if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window window; /* Window in which event occurred. */
+} XActivateDeactivateEvent;
+typedef XActivateDeactivateEvent XActivateEvent;
+typedef XActivateDeactivateEvent XDeactivateEvent;
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Macros for querying Tk_Window structures. See the
+ * manual entries for documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+#define Tk_Display(tkwin) (((Tk_FakeWin *) (tkwin))->display)
+#define Tk_ScreenNumber(tkwin) (((Tk_FakeWin *) (tkwin))->screenNum)
+#define Tk_Screen(tkwin) (ScreenOfDisplay(Tk_Display(tkwin), \
+ Tk_ScreenNumber(tkwin)))
+#define Tk_Depth(tkwin) (((Tk_FakeWin *) (tkwin))->depth)
+#define Tk_Visual(tkwin) (((Tk_FakeWin *) (tkwin))->visual)
+#define Tk_WindowId(tkwin) (((Tk_FakeWin *) (tkwin))->window)
+#define Tk_PathName(tkwin) (((Tk_FakeWin *) (tkwin))->pathName)
+#define Tk_Name(tkwin) (((Tk_FakeWin *) (tkwin))->nameUid)
+#define Tk_Class(tkwin) (((Tk_FakeWin *) (tkwin))->classUid)
+#define Tk_X(tkwin) (((Tk_FakeWin *) (tkwin))->changes.x)
+#define Tk_Y(tkwin) (((Tk_FakeWin *) (tkwin))->changes.y)
+#define Tk_Width(tkwin) (((Tk_FakeWin *) (tkwin))->changes.width)
+#define Tk_Height(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->changes.height)
+#define Tk_Changes(tkwin) (&((Tk_FakeWin *) (tkwin))->changes)
+#define Tk_Attributes(tkwin) (&((Tk_FakeWin *) (tkwin))->atts)
+#define Tk_IsEmbedded(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->flags & TK_EMBEDDED)
+#define Tk_IsContainer(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->flags & TK_CONTAINER)
+#define Tk_IsMapped(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->flags & TK_MAPPED)
+#define Tk_IsTopLevel(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->flags & TK_TOP_LEVEL)
+#define Tk_ReqWidth(tkwin) (((Tk_FakeWin *) (tkwin))->reqWidth)
+#define Tk_ReqHeight(tkwin) (((Tk_FakeWin *) (tkwin))->reqHeight)
+#define Tk_InternalBorderWidth(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->internalBorderWidth)
+#define Tk_Parent(tkwin) (((Tk_FakeWin *) (tkwin))->parentPtr)
+#define Tk_Colormap(tkwin) (((Tk_FakeWin *) (tkwin))->atts.colormap)
+
+/*
+ * The structure below is needed by the macros above so that they can
+ * access the fields of a Tk_Window. The fields not needed by the macros
+ * are declared as "dummyX". The structure has its own type in order to
+ * prevent applications from accessing Tk_Window fields except using
+ * official macros. WARNING!! The structure definition must be kept
+ * consistent with the TkWindow structure in tkInt.h. If you change one,
+ * then change the other. See the declaration in tkInt.h for
+ * documentation on what the fields are used for internally.
+ */
+
+typedef struct Tk_FakeWin {
+ Display *display;
+ char *dummy1;
+ int screenNum;
+ Visual *visual;
+ int depth;
+ Window window;
+ char *dummy2;
+ char *dummy3;
+ Tk_Window parentPtr;
+ char *dummy4;
+ char *dummy5;
+ char *pathName;
+ Tk_Uid nameUid;
+ Tk_Uid classUid;
+ XWindowChanges changes;
+ unsigned int dummy6;
+ XSetWindowAttributes atts;
+ unsigned long dummy7;
+ unsigned int flags;
+ char *dummy8;
+#ifdef TK_USE_INPUT_METHODS
+ XIC dummy9;
+#endif /* TK_USE_INPUT_METHODS */
+ ClientData *dummy10;
+ int dummy11;
+ int dummy12;
+ char *dummy13;
+ char *dummy14;
+ ClientData dummy15;
+ int reqWidth, reqHeight;
+ int internalBorderWidth;
+ char *dummy16;
+ char *dummy17;
+ ClientData dummy18;
+ char *dummy19;
+} Tk_FakeWin;
+
+/*
+ * Flag values for TkWindow (and Tk_FakeWin) structures are:
+ *
+ * TK_MAPPED: 1 means window is currently mapped,
+ * 0 means unmapped.
+ * TK_TOP_LEVEL: 1 means this is a top-level window (it
+ * was or will be created as a child of
+ * a root window).
+ * TK_ALREADY_DEAD: 1 means the window is in the process of
+ * being destroyed already.
+ * TK_NEED_CONFIG_NOTIFY: 1 means that the window has been reconfigured
+ * before it was made to exist. At the time of
+ * making it exist a ConfigureNotify event needs
+ * to be generated.
+ * TK_GRAB_FLAG: Used to manage grabs. See tkGrab.c for
+ * details.
+ * TK_CHECKED_IC: 1 means we've already tried to get an input
+ * context for this window; if the ic field
+ * is NULL it means that there isn't a context
+ * for the field.
+ * TK_DONT_DESTROY_WINDOW: 1 means that Tk_DestroyWindow should not
+ * invoke XDestroyWindow to destroy this widget's
+ * X window. The flag is set when the window
+ * has already been destroyed elsewhere (e.g.
+ * by another application) or when it will be
+ * destroyed later (e.g. by destroying its
+ * parent).
+ * TK_WM_COLORMAP_WINDOW: 1 means that this window has at some time
+ * appeared in the WM_COLORMAP_WINDOWS property
+ * for its toplevel, so we have to remove it
+ * from that property if the window is
+ * deleted and the toplevel isn't.
+ * TK_EMBEDDED: 1 means that this window (which must be a
+ * toplevel) is not a free-standing window but
+ * rather is embedded in some other application.
+ * TK_CONTAINER: 1 means that this window is a container, and
+ * that some other application (either in
+ * this process or elsewhere) may be
+ * embedding itself inside the window.
+ * TK_BOTH_HALVES: 1 means that this window is used for
+ * application embedding (either as
+ * container or embedded application), and
+ * both the containing and embedded halves
+ * are associated with windows in this
+ * particular process.
+ * TK_DEFER_MODAL: 1 means that this window has deferred a modal
+ * loop until all of the bindings for the current
+ * event have been invoked.
+ * TK_WRAPPER: 1 means that this window is the extra
+ * wrapper window created around a toplevel
+ * to hold the menubar under Unix. See
+ * tkUnixWm.c for more information.
+ * TK_REPARENTED: 1 means that this window has been reparented
+ * so that as far as the window system is
+ * concerned it isn't a child of its Tk
+ * parent. Initially this is used only for
+ * special Unix menubar windows.
+ */
+
+
+#define TK_MAPPED 1
+#define TK_TOP_LEVEL 2
+#define TK_ALREADY_DEAD 4
+#define TK_NEED_CONFIG_NOTIFY 8
+#define TK_GRAB_FLAG 0x10
+#define TK_CHECKED_IC 0x20
+#define TK_DONT_DESTROY_WINDOW 0x40
+#define TK_WM_COLORMAP_WINDOW 0x80
+#define TK_EMBEDDED 0x100
+#define TK_CONTAINER 0x200
+#define TK_BOTH_HALVES 0x400
+#define TK_DEFER_MODAL 0x800
+#define TK_WRAPPER 0x1000
+#define TK_REPARENTED 0x2000
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Procedure prototypes and structures used for defining new canvas
+ * items:
+ *
+ *--------------------------------------------------------------
+ */
+
+/*
+ * For each item in a canvas widget there exists one record with
+ * the following structure. Each actual item is represented by
+ * a record with the following stuff at its beginning, plus additional
+ * type-specific stuff after that.
+ */
+
+#define TK_TAG_SPACE 3
+
+typedef struct Tk_Item {
+ int id; /* Unique identifier for this item
+ * (also serves as first tag for
+ * item). */
+ struct Tk_Item *nextPtr; /* Next in display list of all
+ * items in this canvas. Later items
+ * in list are drawn on top of earlier
+ * ones. */
+ Tk_Uid staticTagSpace[TK_TAG_SPACE];/* Built-in space for limited # of
+ * tags. */
+ Tk_Uid *tagPtr; /* Pointer to array of tags. Usually
+ * points to staticTagSpace, but
+ * may point to malloc-ed space if
+ * there are lots of tags. */
+ int tagSpace; /* Total amount of tag space available
+ * at tagPtr. */
+ int numTags; /* Number of tag slots actually used
+ * at *tagPtr. */
+ struct Tk_ItemType *typePtr; /* Table of procedures that implement
+ * this type of item. */
+ int x1, y1, x2, y2; /* Bounding box for item, in integer
+ * canvas units. Set by item-specific
+ * code and guaranteed to contain every
+ * pixel drawn in item. Item area
+ * includes x1 and y1 but not x2
+ * and y2. */
+
+ /*
+ *------------------------------------------------------------------
+ * Starting here is additional type-specific stuff; see the
+ * declarations for individual types to see what is part of
+ * each type. The actual space below is determined by the
+ * "itemInfoSize" of the type's Tk_ItemType record.
+ *------------------------------------------------------------------
+ */
+} Tk_Item;
+
+/*
+ * Records of the following type are used to describe a type of
+ * item (e.g. lines, circles, etc.) that can form part of a
+ * canvas widget.
+ */
+
+typedef int Tk_ItemCreateProc _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv));
+typedef int Tk_ItemConfigureProc _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv, int flags));
+typedef int Tk_ItemCoordProc _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv));
+typedef void Tk_ItemDeleteProc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+typedef void Tk_ItemDisplayProc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+typedef double Tk_ItemPointProc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *pointPtr));
+typedef int Tk_ItemAreaProc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+typedef int Tk_ItemPostscriptProc _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+typedef void Tk_ItemScaleProc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+typedef void Tk_ItemTranslateProc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+typedef int Tk_ItemIndexProc _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, char *indexString,
+ int *indexPtr));
+typedef void Tk_ItemCursorProc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int index));
+typedef int Tk_ItemSelectionProc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int offset, char *buffer,
+ int maxBytes));
+typedef void Tk_ItemInsertProc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int beforeThis, char *string));
+typedef void Tk_ItemDCharsProc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int first, int last));
+
+typedef struct Tk_ItemType {
+ char *name; /* The name of this type of item, such
+ * as "line". */
+ int itemSize; /* Total amount of space needed for
+ * item's record. */
+ Tk_ItemCreateProc *createProc; /* Procedure to create a new item of
+ * this type. */
+ Tk_ConfigSpec *configSpecs; /* Pointer to array of configuration
+ * specs for this type. Used for
+ * returning configuration info. */
+ Tk_ItemConfigureProc *configProc; /* Procedure to call to change
+ * configuration options. */
+ Tk_ItemCoordProc *coordProc; /* Procedure to call to get and set
+ * the item's coordinates. */
+ Tk_ItemDeleteProc *deleteProc; /* Procedure to delete existing item of
+ * this type. */
+ Tk_ItemDisplayProc *displayProc; /* Procedure to display items of
+ * this type. */
+ int alwaysRedraw; /* Non-zero means displayProc should
+ * be called even when the item has
+ * been moved off-screen. */
+ Tk_ItemPointProc *pointProc; /* Computes distance from item to
+ * a given point. */
+ Tk_ItemAreaProc *areaProc; /* Computes whether item is inside,
+ * outside, or overlapping an area. */
+ Tk_ItemPostscriptProc *postscriptProc;
+ /* Procedure to write a Postscript
+ * description for items of this
+ * type. */
+ Tk_ItemScaleProc *scaleProc; /* Procedure to rescale items of
+ * this type. */
+ Tk_ItemTranslateProc *translateProc;/* Procedure to translate items of
+ * this type. */
+ Tk_ItemIndexProc *indexProc; /* Procedure to determine index of
+ * indicated character. NULL if
+ * item doesn't support indexing. */
+ Tk_ItemCursorProc *icursorProc; /* Procedure to set insert cursor pos.
+ * to just before a given position. */
+ Tk_ItemSelectionProc *selectionProc;/* Procedure to return selection (in
+ * STRING format) when it is in this
+ * item. */
+ Tk_ItemInsertProc *insertProc; /* Procedure to insert something into
+ * an item. */
+ Tk_ItemDCharsProc *dCharsProc; /* Procedure to delete characters
+ * from an item. */
+ struct Tk_ItemType *nextPtr; /* Used to link types together into
+ * a list. */
+} Tk_ItemType;
+
+/*
+ * The following structure provides information about the selection and
+ * the insertion cursor. It is needed by only a few items, such as
+ * those that display text. It is shared by the generic canvas code
+ * and the item-specific code, but most of the fields should be written
+ * only by the canvas generic code.
+ */
+
+typedef struct Tk_CanvasTextInfo {
+ Tk_3DBorder selBorder; /* Border and background for selected
+ * characters. Read-only to items.*/
+ int selBorderWidth; /* Width of border around selection.
+ * Read-only to items. */
+ XColor *selFgColorPtr; /* Foreground color for selected text.
+ * Read-only to items. */
+ Tk_Item *selItemPtr; /* Pointer to selected item. NULL means
+ * selection isn't in this canvas.
+ * Writable by items. */
+ int selectFirst; /* Index of first selected character.
+ * Writable by items. */
+ int selectLast; /* Index of last selected character.
+ * Writable by items. */
+ Tk_Item *anchorItemPtr; /* Item corresponding to "selectAnchor":
+ * not necessarily selItemPtr. Read-only
+ * to items. */
+ int selectAnchor; /* Fixed end of selection (i.e. "select to"
+ * operation will use this as one end of the
+ * selection). Writable by items. */
+ Tk_3DBorder insertBorder; /* Used to draw vertical bar for insertion
+ * cursor. Read-only to items. */
+ int insertWidth; /* Total width of insertion cursor. Read-only
+ * to items. */
+ int insertBorderWidth; /* Width of 3-D border around insert cursor.
+ * Read-only to items. */
+ Tk_Item *focusItemPtr; /* Item that currently has the input focus,
+ * or NULL if no such item. Read-only to
+ * items. */
+ int gotFocus; /* Non-zero means that the canvas widget has
+ * the input focus. Read-only to items.*/
+ int cursorOn; /* Non-zero means that an insertion cursor
+ * should be displayed in focusItemPtr.
+ * Read-only to items.*/
+} Tk_CanvasTextInfo;
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Procedure prototypes and structures used for managing images:
+ *
+ *--------------------------------------------------------------
+ */
+
+typedef struct Tk_ImageType Tk_ImageType;
+typedef int (Tk_ImageCreateProc) _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, int argc, char **argv, Tk_ImageType *typePtr,
+ Tk_ImageMaster master, ClientData *masterDataPtr));
+typedef ClientData (Tk_ImageGetProc) _ANSI_ARGS_((Tk_Window tkwin,
+ ClientData masterData));
+typedef void (Tk_ImageDisplayProc) _ANSI_ARGS_((ClientData instanceData,
+ Display *display, Drawable drawable, int imageX, int imageY,
+ int width, int height, int drawableX, int drawableY));
+typedef void (Tk_ImageFreeProc) _ANSI_ARGS_((ClientData instanceData,
+ Display *display));
+typedef void (Tk_ImageDeleteProc) _ANSI_ARGS_((ClientData masterData));
+typedef void (Tk_ImageChangedProc) _ANSI_ARGS_((ClientData clientData,
+ int x, int y, int width, int height, int imageWidth,
+ int imageHeight));
+
+/*
+ * The following structure represents a particular type of image
+ * (bitmap, xpm image, etc.). It provides information common to
+ * all images of that type, such as the type name and a collection
+ * of procedures in the image manager that respond to various
+ * events. Each image manager is represented by one of these
+ * structures.
+ */
+
+struct Tk_ImageType {
+ char *name; /* Name of image type. */
+ Tk_ImageCreateProc *createProc;
+ /* Procedure to call to create a new image
+ * of this type. */
+ Tk_ImageGetProc *getProc; /* Procedure to call the first time
+ * Tk_GetImage is called in a new way
+ * (new visual or screen). */
+ Tk_ImageDisplayProc *displayProc;
+ /* Call to draw image, in response to
+ * Tk_RedrawImage calls. */
+ Tk_ImageFreeProc *freeProc; /* Procedure to call whenever Tk_FreeImage
+ * is called to release an instance of an
+ * image. */
+ Tk_ImageDeleteProc *deleteProc;
+ /* Procedure to call to delete image. It
+ * will not be called until after freeProc
+ * has been called for each instance of the
+ * image. */
+ struct Tk_ImageType *nextPtr;
+ /* Next in list of all image types currently
+ * known. Filled in by Tk, not by image
+ * manager. */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Additional definitions used to manage images of type "photo".
+ *
+ *--------------------------------------------------------------
+ */
+
+/*
+ * The following type is used to identify a particular photo image
+ * to be manipulated:
+ */
+
+typedef void *Tk_PhotoHandle;
+
+/*
+ * The following structure describes a block of pixels in memory:
+ */
+
+typedef struct Tk_PhotoImageBlock {
+ unsigned char *pixelPtr; /* Pointer to the first pixel. */
+ int width; /* Width of block, in pixels. */
+ int height; /* Height of block, in pixels. */
+ int pitch; /* Address difference between corresponding
+ * pixels in successive lines. */
+ int pixelSize; /* Address difference between successive
+ * pixels in the same line. */
+ int offset[3]; /* Address differences between the red, green
+ * and blue components of the pixel and the
+ * pixel as a whole. */
+} Tk_PhotoImageBlock;
+
+/*
+ * Procedure prototypes and structures used in reading and
+ * writing photo images:
+ */
+
+typedef struct Tk_PhotoImageFormat Tk_PhotoImageFormat;
+typedef int (Tk_ImageFileMatchProc) _ANSI_ARGS_((Tcl_Channel chan,
+ char *fileName, char *formatString, int *widthPtr, int *heightPtr));
+typedef int (Tk_ImageStringMatchProc) _ANSI_ARGS_((char *string,
+ char *formatString, int *widthPtr, int *heightPtr));
+typedef int (Tk_ImageFileReadProc) _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Channel chan, char *fileName, char *formatString,
+ Tk_PhotoHandle imageHandle, int destX, int destY,
+ int width, int height, int srcX, int srcY));
+typedef int (Tk_ImageStringReadProc) _ANSI_ARGS_((Tcl_Interp *interp,
+ char *string, char *formatString, Tk_PhotoHandle imageHandle,
+ int destX, int destY, int width, int height, int srcX, int srcY));
+typedef int (Tk_ImageFileWriteProc) _ANSI_ARGS_((Tcl_Interp *interp,
+ char *fileName, char *formatString, Tk_PhotoImageBlock *blockPtr));
+typedef int (Tk_ImageStringWriteProc) _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_DString *dataPtr, char *formatString,
+ Tk_PhotoImageBlock *blockPtr));
+
+/*
+ * The following structure represents a particular file format for
+ * storing images (e.g., PPM, GIF, JPEG, etc.). It provides information
+ * to allow image files of that format to be recognized and read into
+ * a photo image.
+ */
+
+struct Tk_PhotoImageFormat {
+ char *name; /* Name of image file format */
+ Tk_ImageFileMatchProc *fileMatchProc;
+ /* Procedure to call to determine whether
+ * an image file matches this format. */
+ Tk_ImageStringMatchProc *stringMatchProc;
+ /* Procedure to call to determine whether
+ * the data in a string matches this format. */
+ Tk_ImageFileReadProc *fileReadProc;
+ /* Procedure to call to read data from
+ * an image file into a photo image. */
+ Tk_ImageStringReadProc *stringReadProc;
+ /* Procedure to call to read data from
+ * a string into a photo image. */
+ Tk_ImageFileWriteProc *fileWriteProc;
+ /* Procedure to call to write data from
+ * a photo image to a file. */
+ Tk_ImageStringWriteProc *stringWriteProc;
+ /* Procedure to call to obtain a string
+ * representation of the data in a photo
+ * image.*/
+ struct Tk_PhotoImageFormat *nextPtr;
+ /* Next in list of all photo image formats
+ * currently known. Filled in by Tk, not
+ * by image format handler. */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * The definitions below provide backward compatibility for
+ * functions and types related to event handling that used to
+ * be in Tk but have moved to Tcl.
+ *
+ *--------------------------------------------------------------
+ */
+
+#define TK_READABLE TCL_READABLE
+#define TK_WRITABLE TCL_WRITABLE
+#define TK_EXCEPTION TCL_EXCEPTION
+
+#define TK_DONT_WAIT TCL_DONT_WAIT
+#define TK_X_EVENTS TCL_WINDOW_EVENTS
+#define TK_WINDOW_EVENTS TCL_WINDOW_EVENTS
+#define TK_FILE_EVENTS TCL_FILE_EVENTS
+#define TK_TIMER_EVENTS TCL_TIMER_EVENTS
+#define TK_IDLE_EVENTS TCL_IDLE_EVENTS
+#define TK_ALL_EVENTS TCL_ALL_EVENTS
+
+#define Tk_IdleProc Tcl_IdleProc
+#define Tk_FileProc Tcl_FileProc
+#define Tk_TimerProc Tcl_TimerProc
+#define Tk_TimerToken Tcl_TimerToken
+
+#define Tk_BackgroundError Tcl_BackgroundError
+#define Tk_CancelIdleCall Tcl_CancelIdleCall
+#define Tk_CreateFileHandler Tcl_CreateFileHandler
+#define Tk_CreateTimerHandler Tcl_CreateTimerHandler
+#define Tk_DeleteFileHandler Tcl_DeleteFileHandler
+#define Tk_DeleteTimerHandler Tcl_DeleteTimerHandler
+#define Tk_DoOneEvent Tcl_DoOneEvent
+#define Tk_DoWhenIdle Tcl_DoWhenIdle
+#define Tk_Sleep Tcl_Sleep
+
+/* Additional stuff that has moved to Tcl: */
+
+#define Tk_AfterCmd Tcl_AfterCmd
+#define Tk_EventuallyFree Tcl_EventuallyFree
+#define Tk_FreeProc Tcl_FreeProc
+#define Tk_Preserve Tcl_Preserve
+#define Tk_Release Tcl_Release
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Additional procedure types defined by Tk.
+ *
+ *--------------------------------------------------------------
+ */
+
+typedef int (Tk_ErrorProc) _ANSI_ARGS_((ClientData clientData,
+ XErrorEvent *errEventPtr));
+typedef void (Tk_EventProc) _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+typedef int (Tk_GenericProc) _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+typedef int (Tk_GetSelProc) _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, char *portion));
+typedef void (Tk_LostSelProc) _ANSI_ARGS_((ClientData clientData));
+typedef Tk_RestrictAction (Tk_RestrictProc) _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+typedef int (Tk_SelectionProc) _ANSI_ARGS_((ClientData clientData,
+ int offset, char *buffer, int maxBytes));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Exported procedures and variables.
+ *
+ *--------------------------------------------------------------
+ */
+
+EXTERN XColor * Tk_3DBorderColor _ANSI_ARGS_((Tk_3DBorder border));
+EXTERN GC Tk_3DBorderGC _ANSI_ARGS_((Tk_Window tkwin,
+ Tk_3DBorder border, int which));
+EXTERN void Tk_3DHorizontalBevel _ANSI_ARGS_((Tk_Window tkwin,
+ Drawable drawable, Tk_3DBorder border, int x,
+ int y, int width, int height, int leftIn,
+ int rightIn, int topBevel, int relief));
+EXTERN void Tk_3DVerticalBevel _ANSI_ARGS_((Tk_Window tkwin,
+ Drawable drawable, Tk_3DBorder border, int x,
+ int y, int width, int height, int leftBevel,
+ int relief));
+EXTERN void Tk_AddOption _ANSI_ARGS_((Tk_Window tkwin, char *name,
+ char *value, int priority));
+EXTERN void Tk_BindEvent _ANSI_ARGS_((Tk_BindingTable bindingTable,
+ XEvent *eventPtr, Tk_Window tkwin, int numObjects,
+ ClientData *objectPtr));
+EXTERN void Tk_CanvasDrawableCoords _ANSI_ARGS_((Tk_Canvas canvas,
+ double x, double y, short *drawableXPtr,
+ short *drawableYPtr));
+EXTERN void Tk_CanvasEventuallyRedraw _ANSI_ARGS_((
+ Tk_Canvas canvas, int x1, int y1, int x2,
+ int y2));
+EXTERN int Tk_CanvasGetCoord _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, char *string,
+ double *doublePtr));
+EXTERN Tk_CanvasTextInfo *Tk_CanvasGetTextInfo _ANSI_ARGS_((Tk_Canvas canvas));
+EXTERN int Tk_CanvasPsBitmap _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Pixmap bitmap, int x, int y,
+ int width, int height));
+EXTERN int Tk_CanvasPsColor _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, XColor *colorPtr));
+EXTERN int Tk_CanvasPsFont _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Font font));
+EXTERN void Tk_CanvasPsPath _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, double *coordPtr, int numPoints));
+EXTERN int Tk_CanvasPsStipple _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Pixmap bitmap));
+EXTERN double Tk_CanvasPsY _ANSI_ARGS_((Tk_Canvas canvas, double y));
+EXTERN void Tk_CanvasSetStippleOrigin _ANSI_ARGS_((
+ Tk_Canvas canvas, GC gc));
+EXTERN int Tk_CanvasTagsParseProc _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp,
+ Tk_Window tkwin, char *value, char *widgRec,
+ int offset));
+EXTERN char * Tk_CanvasTagsPrintProc _ANSI_ARGS_((
+ ClientData clientData, Tk_Window tkwin,
+ char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr));
+EXTERN Tk_Window Tk_CanvasTkwin _ANSI_ARGS_((Tk_Canvas canvas));
+EXTERN void Tk_CanvasWindowCoords _ANSI_ARGS_((Tk_Canvas canvas,
+ double x, double y, short *screenXPtr,
+ short *screenYPtr));
+EXTERN void Tk_ChangeWindowAttributes _ANSI_ARGS_((Tk_Window tkwin,
+ unsigned long valueMask,
+ XSetWindowAttributes *attsPtr));
+EXTERN int Tk_CharBbox _ANSI_ARGS_((Tk_TextLayout layout,
+ int index, int *xPtr, int *yPtr, int *widthPtr,
+ int *heightPtr));
+EXTERN void Tk_ClearSelection _ANSI_ARGS_((Tk_Window tkwin,
+ Atom selection));
+EXTERN int Tk_ClipboardAppend _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Atom target, Atom format,
+ char* buffer));
+EXTERN int Tk_ClipboardClear _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin));
+EXTERN int Tk_ConfigureInfo _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_ConfigSpec *specs,
+ char *widgRec, char *argvName, int flags));
+EXTERN int Tk_ConfigureValue _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_ConfigSpec *specs,
+ char *widgRec, char *argvName, int flags));
+EXTERN int Tk_ConfigureWidget _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_ConfigSpec *specs,
+ int argc, char **argv, char *widgRec,
+ int flags));
+EXTERN void Tk_ConfigureWindow _ANSI_ARGS_((Tk_Window tkwin,
+ unsigned int valueMask, XWindowChanges *valuePtr));
+EXTERN Tk_TextLayout Tk_ComputeTextLayout _ANSI_ARGS_((Tk_Font font,
+ CONST char *string, int numChars, int wrapLength,
+ Tk_Justify justify, int flags, int *widthPtr,
+ int *heightPtr));
+EXTERN Tk_Window Tk_CoordsToWindow _ANSI_ARGS_((int rootX, int rootY,
+ Tk_Window tkwin));
+EXTERN unsigned long Tk_CreateBinding _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_BindingTable bindingTable, ClientData object,
+ char *eventString, char *command, int append));
+EXTERN Tk_BindingTable Tk_CreateBindingTable _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN Tk_ErrorHandler Tk_CreateErrorHandler _ANSI_ARGS_((Display *display,
+ int errNum, int request, int minorCode,
+ Tk_ErrorProc *errorProc, ClientData clientData));
+EXTERN void Tk_CreateEventHandler _ANSI_ARGS_((Tk_Window token,
+ unsigned long mask, Tk_EventProc *proc,
+ ClientData clientData));
+EXTERN void Tk_CreateGenericHandler _ANSI_ARGS_((
+ Tk_GenericProc *proc, ClientData clientData));
+EXTERN void Tk_CreateImageType _ANSI_ARGS_((
+ Tk_ImageType *typePtr));
+EXTERN void Tk_CreateItemType _ANSI_ARGS_((Tk_ItemType *typePtr));
+EXTERN void Tk_CreatePhotoImageFormat _ANSI_ARGS_((
+ Tk_PhotoImageFormat *formatPtr));
+EXTERN void Tk_CreateSelHandler _ANSI_ARGS_((Tk_Window tkwin,
+ Atom selection, Atom target,
+ Tk_SelectionProc *proc, ClientData clientData,
+ Atom format));
+EXTERN Tk_Window Tk_CreateWindow _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window parent, char *name, char *screenName));
+EXTERN Tk_Window Tk_CreateWindowFromPath _ANSI_ARGS_((
+ Tcl_Interp *interp, Tk_Window tkwin,
+ char *pathName, char *screenName));
+EXTERN int Tk_DefineBitmap _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Uid name, char *source, int width,
+ int height));
+EXTERN void Tk_DefineCursor _ANSI_ARGS_((Tk_Window window,
+ Tk_Cursor cursor));
+EXTERN void Tk_DeleteAllBindings _ANSI_ARGS_((
+ Tk_BindingTable bindingTable, ClientData object));
+EXTERN int Tk_DeleteBinding _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_BindingTable bindingTable, ClientData object,
+ char *eventString));
+EXTERN void Tk_DeleteBindingTable _ANSI_ARGS_((
+ Tk_BindingTable bindingTable));
+EXTERN void Tk_DeleteErrorHandler _ANSI_ARGS_((
+ Tk_ErrorHandler handler));
+EXTERN void Tk_DeleteEventHandler _ANSI_ARGS_((Tk_Window token,
+ unsigned long mask, Tk_EventProc *proc,
+ ClientData clientData));
+EXTERN void Tk_DeleteGenericHandler _ANSI_ARGS_((
+ Tk_GenericProc *proc, ClientData clientData));
+EXTERN void Tk_DeleteImage _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name));
+EXTERN void Tk_DeleteSelHandler _ANSI_ARGS_((Tk_Window tkwin,
+ Atom selection, Atom target));
+EXTERN void Tk_DestroyWindow _ANSI_ARGS_((Tk_Window tkwin));
+EXTERN char * Tk_DisplayName _ANSI_ARGS_((Tk_Window tkwin));
+EXTERN int Tk_DistanceToTextLayout _ANSI_ARGS_((
+ Tk_TextLayout layout, int x, int y));
+EXTERN void Tk_Draw3DPolygon _ANSI_ARGS_((Tk_Window tkwin,
+ Drawable drawable, Tk_3DBorder border,
+ XPoint *pointPtr, int numPoints, int borderWidth,
+ int leftRelief));
+EXTERN void Tk_Draw3DRectangle _ANSI_ARGS_((Tk_Window tkwin,
+ Drawable drawable, Tk_3DBorder border, int x,
+ int y, int width, int height, int borderWidth,
+ int relief));
+EXTERN void Tk_DrawChars _ANSI_ARGS_((Display *display,
+ Drawable drawable, GC gc, Tk_Font tkfont,
+ CONST char *source, int numChars, int x,
+ int y));
+EXTERN void Tk_DrawFocusHighlight _ANSI_ARGS_((Tk_Window tkwin,
+ GC gc, int width, Drawable drawable));
+EXTERN void Tk_DrawTextLayout _ANSI_ARGS_((Display *display,
+ Drawable drawable, GC gc, Tk_TextLayout layout,
+ int x, int y, int firstChar, int lastChar));
+EXTERN void Tk_Fill3DPolygon _ANSI_ARGS_((Tk_Window tkwin,
+ Drawable drawable, Tk_3DBorder border,
+ XPoint *pointPtr, int numPoints, int borderWidth,
+ int leftRelief));
+EXTERN void Tk_Fill3DRectangle _ANSI_ARGS_((Tk_Window tkwin,
+ Drawable drawable, Tk_3DBorder border, int x,
+ int y, int width, int height, int borderWidth,
+ int relief));
+EXTERN Tk_PhotoHandle Tk_FindPhoto _ANSI_ARGS_((Tcl_Interp *interp,
+ char *imageName));
+EXTERN Font Tk_FontId _ANSI_ARGS_((Tk_Font font));
+EXTERN void Tk_Free3DBorder _ANSI_ARGS_((Tk_3DBorder border));
+EXTERN void Tk_FreeBitmap _ANSI_ARGS_((Display *display,
+ Pixmap bitmap));
+EXTERN void Tk_FreeColor _ANSI_ARGS_((XColor *colorPtr));
+EXTERN void Tk_FreeColormap _ANSI_ARGS_((Display *display,
+ Colormap colormap));
+EXTERN void Tk_FreeCursor _ANSI_ARGS_((Display *display,
+ Tk_Cursor cursor));
+EXTERN void Tk_FreeFont _ANSI_ARGS_((Tk_Font));
+EXTERN void Tk_FreeGC _ANSI_ARGS_((Display *display, GC gc));
+EXTERN void Tk_FreeImage _ANSI_ARGS_((Tk_Image image));
+EXTERN void Tk_FreeOptions _ANSI_ARGS_((Tk_ConfigSpec *specs,
+ char *widgRec, Display *display, int needFlags));
+EXTERN void Tk_FreePixmap _ANSI_ARGS_((Display *display,
+ Pixmap pixmap));
+EXTERN void Tk_FreeTextLayout _ANSI_ARGS_((
+ Tk_TextLayout textLayout));
+EXTERN void Tk_FreeXId _ANSI_ARGS_((Display *display, XID xid));
+EXTERN GC Tk_GCForColor _ANSI_ARGS_((XColor *colorPtr,
+ Drawable drawable));
+EXTERN void Tk_GeometryRequest _ANSI_ARGS_((Tk_Window tkwin,
+ int reqWidth, int reqHeight));
+EXTERN Tk_3DBorder Tk_Get3DBorder _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_Uid colorName));
+EXTERN void Tk_GetAllBindings _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_BindingTable bindingTable, ClientData object));
+EXTERN int Tk_GetAnchor _ANSI_ARGS_((Tcl_Interp *interp,
+ char *string, Tk_Anchor *anchorPtr));
+EXTERN char * Tk_GetAtomName _ANSI_ARGS_((Tk_Window tkwin,
+ Atom atom));
+EXTERN char * Tk_GetBinding _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_BindingTable bindingTable, ClientData object,
+ char *eventString));
+EXTERN Pixmap Tk_GetBitmap _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_Uid string));
+EXTERN Pixmap Tk_GetBitmapFromData _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, char *source,
+ int width, int height));
+EXTERN int Tk_GetCapStyle _ANSI_ARGS_((Tcl_Interp *interp,
+ char *string, int *capPtr));
+EXTERN XColor * Tk_GetColor _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_Uid name));
+EXTERN XColor * Tk_GetColorByValue _ANSI_ARGS_((Tk_Window tkwin,
+ XColor *colorPtr));
+EXTERN Colormap Tk_GetColormap _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, char *string));
+EXTERN Tk_Cursor Tk_GetCursor _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_Uid string));
+EXTERN Tk_Cursor Tk_GetCursorFromData _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, char *source, char *mask,
+ int width, int height, int xHot, int yHot,
+ Tk_Uid fg, Tk_Uid bg));
+EXTERN Tk_Font Tk_GetFont _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *string));
+EXTERN Tk_Font Tk_GetFontFromObj _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Tcl_Obj *objPtr));
+EXTERN void Tk_GetFontMetrics _ANSI_ARGS_((Tk_Font font,
+ Tk_FontMetrics *fmPtr));
+EXTERN GC Tk_GetGC _ANSI_ARGS_((Tk_Window tkwin,
+ unsigned long valueMask, XGCValues *valuePtr));
+EXTERN Tk_Image Tk_GetImage _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, char *name,
+ Tk_ImageChangedProc *changeProc,
+ ClientData clientData));
+EXTERN ClientData Tk_GetImageMasterData _ANSI_ARGS_ ((Tcl_Interp *interp,
+ char *name, Tk_ImageType **typePtrPtr));
+EXTERN Tk_ItemType * Tk_GetItemTypes _ANSI_ARGS_((void));
+EXTERN int Tk_GetJoinStyle _ANSI_ARGS_((Tcl_Interp *interp,
+ char *string, int *joinPtr));
+EXTERN int Tk_GetJustify _ANSI_ARGS_((Tcl_Interp *interp,
+ char *string, Tk_Justify *justifyPtr));
+EXTERN int Tk_GetNumMainWindows _ANSI_ARGS_((void));
+EXTERN Tk_Uid Tk_GetOption _ANSI_ARGS_((Tk_Window tkwin, char *name,
+ char *className));
+EXTERN int Tk_GetPixels _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, char *string, int *intPtr));
+EXTERN Pixmap Tk_GetPixmap _ANSI_ARGS_((Display *display, Drawable d,
+ int width, int height, int depth));
+EXTERN int Tk_GetRelief _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, int *reliefPtr));
+EXTERN void Tk_GetRootCoords _ANSI_ARGS_ ((Tk_Window tkwin,
+ int *xPtr, int *yPtr));
+EXTERN int Tk_GetScrollInfo _ANSI_ARGS_((Tcl_Interp *interp,
+ int argc, char **argv, double *dblPtr,
+ int *intPtr));
+EXTERN int Tk_GetScreenMM _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, char *string, double *doublePtr));
+EXTERN int Tk_GetSelection _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Atom selection, Atom target,
+ Tk_GetSelProc *proc, ClientData clientData));
+EXTERN Tk_Uid Tk_GetUid _ANSI_ARGS_((CONST char *string));
+EXTERN Visual * Tk_GetVisual _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, char *string, int *depthPtr,
+ Colormap *colormapPtr));
+EXTERN void Tk_GetVRootGeometry _ANSI_ARGS_((Tk_Window tkwin,
+ int *xPtr, int *yPtr, int *widthPtr,
+ int *heightPtr));
+EXTERN int Tk_Grab _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, int grabGlobal));
+EXTERN void Tk_HandleEvent _ANSI_ARGS_((XEvent *eventPtr));
+EXTERN Tk_Window Tk_IdToWindow _ANSI_ARGS_((Display *display,
+ Window window));
+EXTERN void Tk_ImageChanged _ANSI_ARGS_((
+ Tk_ImageMaster master, int x, int y,
+ int width, int height, int imageWidth,
+ int imageHeight));
+EXTERN int Tk_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN Atom Tk_InternAtom _ANSI_ARGS_((Tk_Window tkwin,
+ char *name));
+EXTERN int Tk_IntersectTextLayout _ANSI_ARGS_((
+ Tk_TextLayout layout, int x, int y, int width,
+ int height));
+EXTERN void Tk_Main _ANSI_ARGS_((int argc, char **argv,
+ Tcl_AppInitProc *appInitProc));
+EXTERN void Tk_MainLoop _ANSI_ARGS_((void));
+EXTERN void Tk_MaintainGeometry _ANSI_ARGS_((Tk_Window slave,
+ Tk_Window master, int x, int y, int width,
+ int height));
+EXTERN Tk_Window Tk_MainWindow _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void Tk_MakeWindowExist _ANSI_ARGS_((Tk_Window tkwin));
+EXTERN void Tk_ManageGeometry _ANSI_ARGS_((Tk_Window tkwin,
+ Tk_GeomMgr *mgrPtr, ClientData clientData));
+EXTERN void Tk_MapWindow _ANSI_ARGS_((Tk_Window tkwin));
+EXTERN int Tk_MeasureChars _ANSI_ARGS_((Tk_Font tkfont,
+ CONST char *source, int maxChars, int maxPixels,
+ int flags, int *lengthPtr));
+EXTERN void Tk_MoveResizeWindow _ANSI_ARGS_((Tk_Window tkwin,
+ int x, int y, int width, int height));
+EXTERN void Tk_MoveWindow _ANSI_ARGS_((Tk_Window tkwin, int x,
+ int y));
+EXTERN void Tk_MoveToplevelWindow _ANSI_ARGS_((Tk_Window tkwin,
+ int x, int y));
+EXTERN char * Tk_NameOf3DBorder _ANSI_ARGS_((Tk_3DBorder border));
+EXTERN char * Tk_NameOfAnchor _ANSI_ARGS_((Tk_Anchor anchor));
+EXTERN char * Tk_NameOfBitmap _ANSI_ARGS_((Display *display,
+ Pixmap bitmap));
+EXTERN char * Tk_NameOfCapStyle _ANSI_ARGS_((int cap));
+EXTERN char * Tk_NameOfColor _ANSI_ARGS_((XColor *colorPtr));
+EXTERN char * Tk_NameOfCursor _ANSI_ARGS_((Display *display,
+ Tk_Cursor cursor));
+EXTERN char * Tk_NameOfFont _ANSI_ARGS_((Tk_Font font));
+EXTERN char * Tk_NameOfImage _ANSI_ARGS_((
+ Tk_ImageMaster imageMaster));
+EXTERN char * Tk_NameOfJoinStyle _ANSI_ARGS_((int join));
+EXTERN char * Tk_NameOfJustify _ANSI_ARGS_((Tk_Justify justify));
+EXTERN char * Tk_NameOfRelief _ANSI_ARGS_((int relief));
+EXTERN Tk_Window Tk_NameToWindow _ANSI_ARGS_((Tcl_Interp *interp,
+ char *pathName, Tk_Window tkwin));
+EXTERN void Tk_OwnSelection _ANSI_ARGS_((Tk_Window tkwin,
+ Atom selection, Tk_LostSelProc *proc,
+ ClientData clientData));
+EXTERN int Tk_ParseArgv _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, int *argcPtr, char **argv,
+ Tk_ArgvInfo *argTable, int flags));
+EXTERN void Tk_PhotoPutBlock _ANSI_ARGS_((Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock *blockPtr, int x, int y,
+ int width, int height));
+EXTERN void Tk_PhotoPutZoomedBlock _ANSI_ARGS_((
+ Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock *blockPtr, int x, int y,
+ int width, int height, int zoomX, int zoomY,
+ int subsampleX, int subsampleY));
+EXTERN int Tk_PhotoGetImage _ANSI_ARGS_((Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock *blockPtr));
+EXTERN void Tk_PhotoBlank _ANSI_ARGS_((Tk_PhotoHandle handle));
+EXTERN void Tk_PhotoExpand _ANSI_ARGS_((Tk_PhotoHandle handle,
+ int width, int height ));
+EXTERN void Tk_PhotoGetSize _ANSI_ARGS_((Tk_PhotoHandle handle,
+ int *widthPtr, int *heightPtr));
+EXTERN void Tk_PhotoSetSize _ANSI_ARGS_((Tk_PhotoHandle handle,
+ int width, int height));
+EXTERN int Tk_PointToChar _ANSI_ARGS_((Tk_TextLayout layout,
+ int x, int y));
+EXTERN int Tk_PostscriptFontName _ANSI_ARGS_((Tk_Font tkfont,
+ Tcl_DString *dsPtr));
+EXTERN void Tk_PreserveColormap _ANSI_ARGS_((Display *display,
+ Colormap colormap));
+EXTERN void Tk_QueueWindowEvent _ANSI_ARGS_((XEvent *eventPtr,
+ Tcl_QueuePosition position));
+EXTERN void Tk_RedrawImage _ANSI_ARGS_((Tk_Image image, int imageX,
+ int imageY, int width, int height,
+ Drawable drawable, int drawableX, int drawableY));
+EXTERN void Tk_ResizeWindow _ANSI_ARGS_((Tk_Window tkwin,
+ int width, int height));
+EXTERN int Tk_RestackWindow _ANSI_ARGS_((Tk_Window tkwin,
+ int aboveBelow, Tk_Window other));
+EXTERN Tk_RestrictProc *Tk_RestrictEvents _ANSI_ARGS_((Tk_RestrictProc *proc,
+ ClientData arg, ClientData *prevArgPtr));
+EXTERN int Tk_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN char * Tk_SetAppName _ANSI_ARGS_((Tk_Window tkwin,
+ char *name));
+EXTERN void Tk_SetBackgroundFromBorder _ANSI_ARGS_((
+ Tk_Window tkwin, Tk_3DBorder border));
+EXTERN void Tk_SetClass _ANSI_ARGS_((Tk_Window tkwin,
+ char *className));
+EXTERN void Tk_SetGrid _ANSI_ARGS_((Tk_Window tkwin,
+ int reqWidth, int reqHeight, int gridWidth,
+ int gridHeight));
+EXTERN void Tk_SetInternalBorder _ANSI_ARGS_((Tk_Window tkwin,
+ int width));
+EXTERN void Tk_SetWindowBackground _ANSI_ARGS_((Tk_Window tkwin,
+ unsigned long pixel));
+EXTERN void Tk_SetWindowBackgroundPixmap _ANSI_ARGS_((
+ Tk_Window tkwin, Pixmap pixmap));
+EXTERN void Tk_SetWindowBorder _ANSI_ARGS_((Tk_Window tkwin,
+ unsigned long pixel));
+EXTERN void Tk_SetWindowBorderWidth _ANSI_ARGS_((Tk_Window tkwin,
+ int width));
+EXTERN void Tk_SetWindowBorderPixmap _ANSI_ARGS_((Tk_Window tkwin,
+ Pixmap pixmap));
+EXTERN void Tk_SetWindowColormap _ANSI_ARGS_((Tk_Window tkwin,
+ Colormap colormap));
+EXTERN int Tk_SetWindowVisual _ANSI_ARGS_((Tk_Window tkwin,
+ Visual *visual, int depth,
+ Colormap colormap));
+EXTERN void Tk_SizeOfBitmap _ANSI_ARGS_((Display *display,
+ Pixmap bitmap, int *widthPtr,
+ int *heightPtr));
+EXTERN void Tk_SizeOfImage _ANSI_ARGS_((Tk_Image image,
+ int *widthPtr, int *heightPtr));
+EXTERN int Tk_StrictMotif _ANSI_ARGS_((Tk_Window tkwin));
+EXTERN void Tk_TextLayoutToPostscript _ANSI_ARGS_((
+ Tcl_Interp *interp, Tk_TextLayout layout));
+EXTERN int Tk_TextWidth _ANSI_ARGS_((Tk_Font font,
+ CONST char *string, int numChars));
+EXTERN void Tk_UndefineCursor _ANSI_ARGS_((Tk_Window window));
+EXTERN void Tk_UnderlineChars _ANSI_ARGS_((Display *display,
+ Drawable drawable, GC gc, Tk_Font tkfont,
+ CONST char *source, int x, int y, int firstChar,
+ int lastChar));
+EXTERN void Tk_UnderlineTextLayout _ANSI_ARGS_((
+ Display *display, Drawable drawable, GC gc,
+ Tk_TextLayout layout, int x, int y,
+ int underline));
+EXTERN void Tk_Ungrab _ANSI_ARGS_((Tk_Window tkwin));
+EXTERN void Tk_UnmaintainGeometry _ANSI_ARGS_((Tk_Window slave,
+ Tk_Window master));
+EXTERN void Tk_UnmapWindow _ANSI_ARGS_((Tk_Window tkwin));
+EXTERN void Tk_UnsetGrid _ANSI_ARGS_((Tk_Window tkwin));
+EXTERN void Tk_UpdatePointer _ANSI_ARGS_((Tk_Window tkwin,
+ int x, int y, int state));
+
+/*
+ * Tcl commands exported by Tk:
+ */
+
+EXTERN int Tk_AfterCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_BellCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_BindCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_BindtagsCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_ButtonCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_CanvasCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_CheckbuttonCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_ClipboardCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_ChooseColorCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_ChooseFontCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_DestroyCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_EntryCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_EventCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_FileeventCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_FrameCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_FocusCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_FontObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_GetOpenFileCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_GetSaveFileCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_GrabCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_GridCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_ImageCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_LabelCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_ListboxCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_LowerCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_MenuCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_MenubuttonCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_MessageBoxCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_MessageCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_OptionCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_PackCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_PlaceCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_RadiobuttonCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_RaiseCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_ScaleCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_ScrollbarCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_SelectionCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_SendCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_TextCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_TkObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_TkwaitCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_ToplevelCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_UpdateCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_WinfoObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_WmCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+
+#endif /* RESOURCE_INCLUDED */
+#endif /* _TK */
diff --git a/generic/tk3d.c b/generic/tk3d.c
new file mode 100644
index 0000000..53eec8b
--- /dev/null
+++ b/generic/tk3d.c
@@ -0,0 +1,949 @@
+/*
+ * tk3d.c --
+ *
+ * This module provides procedures to draw borders in
+ * the three-dimensional Motif style.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tk3d.c 1.60 97/01/13 17:23:10
+ */
+
+#include <tk3d.h>
+
+/*
+ * Hash table to map from a border's values (color, etc.) to a
+ * Border structure for those values.
+ */
+
+static Tcl_HashTable borderTable;
+typedef struct {
+ Tk_Uid colorName; /* Color for border. */
+ Colormap colormap; /* Colormap used for allocating border
+ * colors. */
+ Screen *screen; /* Screen on which border will be drawn. */
+} BorderKey;
+
+static int initialized = 0; /* 0 means static structures haven't
+ * been initialized yet. */
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void BorderInit _ANSI_ARGS_((void));
+static int Intersect _ANSI_ARGS_((XPoint *a1Ptr, XPoint *a2Ptr,
+ XPoint *b1Ptr, XPoint *b2Ptr, XPoint *iPtr));
+static void ShiftLine _ANSI_ARGS_((XPoint *p1Ptr, XPoint *p2Ptr,
+ int distance, XPoint *p3Ptr));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_Get3DBorder --
+ *
+ * Create a data structure for displaying a 3-D border.
+ *
+ * Results:
+ * The return value is a token for a data structure
+ * describing a 3-D border. This token may be passed
+ * to Tk_Draw3DRectangle and Tk_Free3DBorder. If an
+ * error prevented the border from being created then
+ * NULL is returned and an error message will be left
+ * in interp->result.
+ *
+ * Side effects:
+ * Data structures, graphics contexts, etc. are allocated.
+ * It is the caller's responsibility to eventually call
+ * Tk_Free3DBorder to release the resources.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_3DBorder
+Tk_Get3DBorder(interp, tkwin, colorName)
+ Tcl_Interp *interp; /* Place to store an error message. */
+ Tk_Window tkwin; /* Token for window in which border will
+ * be drawn. */
+ Tk_Uid colorName; /* String giving name of color
+ * for window background. */
+{
+ BorderKey key;
+ Tcl_HashEntry *hashPtr;
+ register TkBorder *borderPtr;
+ int new;
+ XGCValues gcValues;
+
+ if (!initialized) {
+ BorderInit();
+ }
+
+ /*
+ * First, check to see if there's already a border that will work
+ * for this request.
+ */
+
+ key.colorName = colorName;
+ key.colormap = Tk_Colormap(tkwin);
+ key.screen = Tk_Screen(tkwin);
+
+ hashPtr = Tcl_CreateHashEntry(&borderTable, (char *) &key, &new);
+ if (!new) {
+ borderPtr = (TkBorder *) Tcl_GetHashValue(hashPtr);
+ borderPtr->refCount++;
+ } else {
+ XColor *bgColorPtr;
+
+ /*
+ * No satisfactory border exists yet. Initialize a new one.
+ */
+
+ bgColorPtr = Tk_GetColor(interp, tkwin, colorName);
+ if (bgColorPtr == NULL) {
+ Tcl_DeleteHashEntry(hashPtr);
+ return NULL;
+ }
+
+ borderPtr = TkpGetBorder();
+ borderPtr->screen = Tk_Screen(tkwin);
+ borderPtr->visual = Tk_Visual(tkwin);
+ borderPtr->depth = Tk_Depth(tkwin);
+ borderPtr->colormap = key.colormap;
+ borderPtr->refCount = 1;
+ borderPtr->bgColorPtr = bgColorPtr;
+ borderPtr->darkColorPtr = NULL;
+ borderPtr->lightColorPtr = NULL;
+ borderPtr->shadow = None;
+ borderPtr->bgGC = None;
+ borderPtr->darkGC = None;
+ borderPtr->lightGC = None;
+ borderPtr->hashPtr = hashPtr;
+ Tcl_SetHashValue(hashPtr, borderPtr);
+
+ /*
+ * Create the information for displaying the background color,
+ * but delay the allocation of shadows until they are actually
+ * needed for drawing.
+ */
+
+ gcValues.foreground = borderPtr->bgColorPtr->pixel;
+ borderPtr->bgGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ }
+ return (Tk_3DBorder) borderPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_Draw3DRectangle --
+ *
+ * Draw a 3-D border at a given place in a given window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A 3-D border will be drawn in the indicated drawable.
+ * The outside edges of the border will be determined by x,
+ * y, width, and height. The inside edges of the border
+ * will be determined by the borderWidth argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_Draw3DRectangle(tkwin, drawable, border, x, y, width, height,
+ borderWidth, relief)
+ Tk_Window tkwin; /* Window for which border was allocated. */
+ Drawable drawable; /* X window or pixmap in which to draw. */
+ Tk_3DBorder border; /* Token for border to draw. */
+ int x, y, width, height; /* Outside area of region in
+ * which border will be drawn. */
+ int borderWidth; /* Desired width for border, in
+ * pixels. */
+ int relief; /* Type of relief: TK_RELIEF_RAISED,
+ * TK_RELIEF_SUNKEN, TK_RELIEF_GROOVE, etc. */
+{
+ if (width < 2*borderWidth) {
+ borderWidth = width/2;
+ }
+ if (height < 2*borderWidth) {
+ borderWidth = height/2;
+ }
+ Tk_3DVerticalBevel(tkwin, drawable, border, x, y, borderWidth, height,
+ 1, relief);
+ Tk_3DVerticalBevel(tkwin, drawable, border, x+width-borderWidth, y,
+ borderWidth, height, 0, relief);
+ Tk_3DHorizontalBevel(tkwin, drawable, border, x, y, width, borderWidth,
+ 1, 1, 1, relief);
+ Tk_3DHorizontalBevel(tkwin, drawable, border, x, y+height-borderWidth,
+ width, borderWidth, 0, 0, 0, relief);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOf3DBorder --
+ *
+ * Given a border, return a textual string identifying the
+ * border's color.
+ *
+ * Results:
+ * The return value is the string that was used to create
+ * the border.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_NameOf3DBorder(border)
+ Tk_3DBorder border; /* Token for border. */
+{
+ TkBorder *borderPtr = (TkBorder *) border;
+
+ return ((BorderKey *) borderPtr->hashPtr->key.words)->colorName;
+}
+
+/*
+ *--------------------------------------------------------------------
+ *
+ * Tk_3DBorderColor --
+ *
+ * Given a 3D border, return the X color used for the "flat"
+ * surfaces.
+ *
+ * Results:
+ * Returns the color used drawing flat surfaces with the border.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------------
+ */
+XColor *
+Tk_3DBorderColor(border)
+ Tk_3DBorder border; /* Border whose color is wanted. */
+{
+ return(((TkBorder *) border)->bgColorPtr);
+}
+
+/*
+ *--------------------------------------------------------------------
+ *
+ * Tk_3DBorderGC --
+ *
+ * Given a 3D border, returns one of the graphics contexts used to
+ * draw the border.
+ *
+ * Results:
+ * Returns the graphics context given by the "which" argument.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------------
+ */
+GC
+Tk_3DBorderGC(tkwin, border, which)
+ Tk_Window tkwin; /* Window for which border was allocated. */
+ Tk_3DBorder border; /* Border whose GC is wanted. */
+ int which; /* Selects one of the border's 3 GC's:
+ * TK_3D_FLAT_GC, TK_3D_LIGHT_GC, or
+ * TK_3D_DARK_GC. */
+{
+ TkBorder * borderPtr = (TkBorder *) border;
+
+ if ((borderPtr->lightGC == None) && (which != TK_3D_FLAT_GC)) {
+ TkpGetShadows(borderPtr, tkwin);
+ }
+ if (which == TK_3D_FLAT_GC) {
+ return borderPtr->bgGC;
+ } else if (which == TK_3D_LIGHT_GC) {
+ return borderPtr->lightGC;
+ } else if (which == TK_3D_DARK_GC){
+ return borderPtr->darkGC;
+ }
+ panic("bogus \"which\" value in Tk_3DBorderGC");
+
+ /*
+ * The code below will never be executed, but it's needed to
+ * keep compilers happy.
+ */
+
+ return (GC) None;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_Free3DBorder --
+ *
+ * This procedure is called when a 3D border is no longer
+ * needed. It frees the resources associated with the
+ * border. After this call, the caller should never again
+ * use the "border" token.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources are freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_Free3DBorder(border)
+ Tk_3DBorder border; /* Token for border to be released. */
+{
+ register TkBorder *borderPtr = (TkBorder *) border;
+ Display *display = DisplayOfScreen(borderPtr->screen);
+
+ borderPtr->refCount--;
+ if (borderPtr->refCount == 0) {
+ TkpFreeBorder(borderPtr);
+ if (borderPtr->bgColorPtr != NULL) {
+ Tk_FreeColor(borderPtr->bgColorPtr);
+ }
+ if (borderPtr->darkColorPtr != NULL) {
+ Tk_FreeColor(borderPtr->darkColorPtr);
+ }
+ if (borderPtr->lightColorPtr != NULL) {
+ Tk_FreeColor(borderPtr->lightColorPtr);
+ }
+ if (borderPtr->shadow != None) {
+ Tk_FreeBitmap(display, borderPtr->shadow);
+ }
+ if (borderPtr->bgGC != None) {
+ Tk_FreeGC(display, borderPtr->bgGC);
+ }
+ if (borderPtr->darkGC != None) {
+ Tk_FreeGC(display, borderPtr->darkGC);
+ }
+ if (borderPtr->lightGC != None) {
+ Tk_FreeGC(display, borderPtr->lightGC);
+ }
+ Tcl_DeleteHashEntry(borderPtr->hashPtr);
+ ckfree((char *) borderPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetBackgroundFromBorder --
+ *
+ * Change the background of a window to one appropriate for a given
+ * 3-D border.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Tkwin's background gets modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetBackgroundFromBorder(tkwin, border)
+ Tk_Window tkwin; /* Window whose background is to be set. */
+ Tk_3DBorder border; /* Token for border. */
+{
+ register TkBorder *borderPtr = (TkBorder *) border;
+
+ Tk_SetWindowBackground(tkwin, borderPtr->bgColorPtr->pixel);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetRelief --
+ *
+ * Parse a relief description and return the corresponding
+ * relief value, or an error.
+ *
+ * Results:
+ * A standard Tcl return value. If all goes well then
+ * *reliefPtr is filled in with one of the values
+ * TK_RELIEF_RAISED, TK_RELIEF_FLAT, or TK_RELIEF_SUNKEN.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetRelief(interp, name, reliefPtr)
+ Tcl_Interp *interp; /* For error messages. */
+ char *name; /* Name of a relief type. */
+ int *reliefPtr; /* Where to store converted relief. */
+{
+ char c;
+ size_t length;
+
+ c = name[0];
+ length = strlen(name);
+ if ((c == 'f') && (strncmp(name, "flat", length) == 0)) {
+ *reliefPtr = TK_RELIEF_FLAT;
+ } else if ((c == 'g') && (strncmp(name, "groove", length) == 0)
+ && (length >= 2)) {
+ *reliefPtr = TK_RELIEF_GROOVE;
+ } else if ((c == 'r') && (strncmp(name, "raised", length) == 0)
+ && (length >= 2)) {
+ *reliefPtr = TK_RELIEF_RAISED;
+ } else if ((c == 'r') && (strncmp(name, "ridge", length) == 0)) {
+ *reliefPtr = TK_RELIEF_RIDGE;
+ } else if ((c == 's') && (strncmp(name, "solid", length) == 0)) {
+ *reliefPtr = TK_RELIEF_SOLID;
+ } else if ((c == 's') && (strncmp(name, "sunken", length) == 0)) {
+ *reliefPtr = TK_RELIEF_SUNKEN;
+ } else {
+ sprintf(interp->result, "bad relief type \"%.50s\": must be %s",
+ name, "flat, groove, raised, ridge, solid, or sunken");
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfRelief --
+ *
+ * Given a relief value, produce a string describing that
+ * relief value.
+ *
+ * Results:
+ * The return value is a static string that is equivalent
+ * to relief.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_NameOfRelief(relief)
+ int relief; /* One of TK_RELIEF_FLAT, TK_RELIEF_RAISED,
+ * or TK_RELIEF_SUNKEN. */
+{
+ if (relief == TK_RELIEF_FLAT) {
+ return "flat";
+ } else if (relief == TK_RELIEF_SUNKEN) {
+ return "sunken";
+ } else if (relief == TK_RELIEF_RAISED) {
+ return "raised";
+ } else if (relief == TK_RELIEF_GROOVE) {
+ return "groove";
+ } else if (relief == TK_RELIEF_RIDGE) {
+ return "ridge";
+ } else if (relief == TK_RELIEF_SOLID) {
+ return "solid";
+ } else {
+ return "unknown relief";
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_Draw3DPolygon --
+ *
+ * Draw a border with 3-D appearance around the edge of a
+ * given polygon.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information is drawn in "drawable" in the form of a
+ * 3-D border borderWidth units width wide on the left
+ * of the trajectory given by pointPtr and numPoints (or
+ * -borderWidth units wide on the right side, if borderWidth
+ * is negative).
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_Draw3DPolygon(tkwin, drawable, border, pointPtr, numPoints,
+ borderWidth, leftRelief)
+ Tk_Window tkwin; /* Window for which border was allocated. */
+ Drawable drawable; /* X window or pixmap in which to draw. */
+ Tk_3DBorder border; /* Token for border to draw. */
+ XPoint *pointPtr; /* Array of points describing
+ * polygon. All points must be
+ * absolute (CoordModeOrigin). */
+ int numPoints; /* Number of points at *pointPtr. */
+ int borderWidth; /* Width of border, measured in
+ * pixels to the left of the polygon's
+ * trajectory. May be negative. */
+ int leftRelief; /* TK_RELIEF_RAISED or
+ * TK_RELIEF_SUNKEN: indicates how
+ * stuff to left of trajectory looks
+ * relative to stuff on right. */
+{
+ XPoint poly[4], b1, b2, newB1, newB2;
+ XPoint perp, c, shift1, shift2; /* Used for handling parallel lines. */
+ register XPoint *p1Ptr, *p2Ptr;
+ TkBorder *borderPtr = (TkBorder *) border;
+ GC gc;
+ int i, lightOnLeft, dx, dy, parallel, pointsSeen;
+ Display *display = Tk_Display(tkwin);
+
+ if (borderPtr->lightGC == None) {
+ TkpGetShadows(borderPtr, tkwin);
+ }
+
+ /*
+ * Handle grooves and ridges with recursive calls.
+ */
+
+ if ((leftRelief == TK_RELIEF_GROOVE) || (leftRelief == TK_RELIEF_RIDGE)) {
+ int halfWidth;
+
+ halfWidth = borderWidth/2;
+ Tk_Draw3DPolygon(tkwin, drawable, border, pointPtr, numPoints,
+ halfWidth, (leftRelief == TK_RELIEF_GROOVE) ? TK_RELIEF_RAISED
+ : TK_RELIEF_SUNKEN);
+ Tk_Draw3DPolygon(tkwin, drawable, border, pointPtr, numPoints,
+ -halfWidth, (leftRelief == TK_RELIEF_GROOVE) ? TK_RELIEF_SUNKEN
+ : TK_RELIEF_RAISED);
+ return;
+ }
+
+ /*
+ * If the polygon is already closed, drop the last point from it
+ * (we'll close it automatically).
+ */
+
+ p1Ptr = &pointPtr[numPoints-1];
+ p2Ptr = &pointPtr[0];
+ if ((p1Ptr->x == p2Ptr->x) && (p1Ptr->y == p2Ptr->y)) {
+ numPoints--;
+ }
+
+ /*
+ * The loop below is executed once for each vertex in the polgon.
+ * At the beginning of each iteration things look like this:
+ *
+ * poly[1] /
+ * * /
+ * | /
+ * b1 * poly[0] (pointPtr[i-1])
+ * | |
+ * | |
+ * | |
+ * | |
+ * | |
+ * | | *p1Ptr *p2Ptr
+ * b2 *--------------------*
+ * |
+ * |
+ * x-------------------------
+ *
+ * The job of this iteration is to do the following:
+ * (a) Compute x (the border corner corresponding to
+ * pointPtr[i]) and put it in poly[2]. As part of
+ * this, compute a new b1 and b2 value for the next
+ * side of the polygon.
+ * (b) Put pointPtr[i] into poly[3].
+ * (c) Draw the polygon given by poly[0..3].
+ * (d) Advance poly[0], poly[1], b1, and b2 for the
+ * next side of the polygon.
+ */
+
+ /*
+ * The above situation doesn't first come into existence until
+ * two points have been processed; the first two points are
+ * used to "prime the pump", so some parts of the processing
+ * are ommitted for these points. The variable "pointsSeen"
+ * keeps track of the priming process; it has to be separate
+ * from i in order to be able to ignore duplicate points in the
+ * polygon.
+ */
+
+ pointsSeen = 0;
+ for (i = -2, p1Ptr = &pointPtr[numPoints-2], p2Ptr = p1Ptr+1;
+ i < numPoints; i++, p1Ptr = p2Ptr, p2Ptr++) {
+ if ((i == -1) || (i == numPoints-1)) {
+ p2Ptr = pointPtr;
+ }
+ if ((p2Ptr->x == p1Ptr->x) && (p2Ptr->y == p1Ptr->y)) {
+ /*
+ * Ignore duplicate points (they'd cause core dumps in
+ * ShiftLine calls below).
+ */
+ continue;
+ }
+ ShiftLine(p1Ptr, p2Ptr, borderWidth, &newB1);
+ newB2.x = newB1.x + (p2Ptr->x - p1Ptr->x);
+ newB2.y = newB1.y + (p2Ptr->y - p1Ptr->y);
+ poly[3] = *p1Ptr;
+ parallel = 0;
+ if (pointsSeen >= 1) {
+ parallel = Intersect(&newB1, &newB2, &b1, &b2, &poly[2]);
+
+ /*
+ * If two consecutive segments of the polygon are parallel,
+ * then things get more complex. Consider the following
+ * diagram:
+ *
+ * poly[1]
+ * *----b1-----------b2------a
+ * \
+ * \
+ * *---------*----------* b
+ * poly[0] *p2Ptr *p1Ptr /
+ * /
+ * --*--------*----c
+ * newB1 newB2
+ *
+ * Instead of using x and *p1Ptr for poly[2] and poly[3], as
+ * in the original diagram, use a and b as above. Then instead
+ * of using x and *p1Ptr for the new poly[0] and poly[1], use
+ * b and c as above.
+ *
+ * Do the computation in three stages:
+ * 1. Compute a point "perp" such that the line p1Ptr-perp
+ * is perpendicular to p1Ptr-p2Ptr.
+ * 2. Compute the points a and c by intersecting the lines
+ * b1-b2 and newB1-newB2 with p1Ptr-perp.
+ * 3. Compute b by shifting p1Ptr-perp to the right and
+ * intersecting it with p1Ptr-p2Ptr.
+ */
+
+ if (parallel) {
+ perp.x = p1Ptr->x + (p2Ptr->y - p1Ptr->y);
+ perp.y = p1Ptr->y - (p2Ptr->x - p1Ptr->x);
+ (void) Intersect(p1Ptr, &perp, &b1, &b2, &poly[2]);
+ (void) Intersect(p1Ptr, &perp, &newB1, &newB2, &c);
+ ShiftLine(p1Ptr, &perp, borderWidth, &shift1);
+ shift2.x = shift1.x + (perp.x - p1Ptr->x);
+ shift2.y = shift1.y + (perp.y - p1Ptr->y);
+ (void) Intersect(p1Ptr, p2Ptr, &shift1, &shift2, &poly[3]);
+ }
+ }
+ if (pointsSeen >= 2) {
+ dx = poly[3].x - poly[0].x;
+ dy = poly[3].y - poly[0].y;
+ if (dx > 0) {
+ lightOnLeft = (dy <= dx);
+ } else {
+ lightOnLeft = (dy < dx);
+ }
+ if (lightOnLeft ^ (leftRelief == TK_RELIEF_RAISED)) {
+ gc = borderPtr->lightGC;
+ } else {
+ gc = borderPtr->darkGC;
+ }
+ XFillPolygon(display, drawable, gc, poly, 4, Convex,
+ CoordModeOrigin);
+ }
+ b1.x = newB1.x;
+ b1.y = newB1.y;
+ b2.x = newB2.x;
+ b2.y = newB2.y;
+ poly[0].x = poly[3].x;
+ poly[0].y = poly[3].y;
+ if (parallel) {
+ poly[1].x = c.x;
+ poly[1].y = c.y;
+ } else if (pointsSeen >= 1) {
+ poly[1].x = poly[2].x;
+ poly[1].y = poly[2].y;
+ }
+ pointsSeen++;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Fill3DRectangle --
+ *
+ * Fill a rectangular area, supplying a 3D border if desired.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets drawn on the screen.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_Fill3DRectangle(tkwin, drawable, border, x, y, width,
+ height, borderWidth, relief)
+ Tk_Window tkwin; /* Window for which border was allocated. */
+ Drawable drawable; /* X window or pixmap in which to draw. */
+ Tk_3DBorder border; /* Token for border to draw. */
+ int x, y, width, height; /* Outside area of rectangular region. */
+ int borderWidth; /* Desired width for border, in
+ * pixels. Border will be *inside* region. */
+ int relief; /* Indicates 3D effect: TK_RELIEF_FLAT,
+ * TK_RELIEF_RAISED, or TK_RELIEF_SUNKEN. */
+{
+ register TkBorder *borderPtr = (TkBorder *) border;
+ int doubleBorder;
+
+ /*
+ * This code is slightly tricky because it only draws the background
+ * in areas not covered by the 3D border. This avoids flashing
+ * effects on the screen for the border region.
+ */
+
+ if (relief == TK_RELIEF_FLAT) {
+ borderWidth = 0;
+ }
+ doubleBorder = 2*borderWidth;
+
+ if ((width > doubleBorder) && (height > doubleBorder)) {
+ XFillRectangle(Tk_Display(tkwin), drawable, borderPtr->bgGC,
+ x + borderWidth, y + borderWidth,
+ (unsigned int) (width - doubleBorder),
+ (unsigned int) (height - doubleBorder));
+ }
+ if (borderWidth) {
+ Tk_Draw3DRectangle(tkwin, drawable, border, x, y, width,
+ height, borderWidth, relief);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Fill3DPolygon --
+ *
+ * Fill a polygonal area, supplying a 3D border if desired.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets drawn on the screen.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_Fill3DPolygon(tkwin, drawable, border, pointPtr, numPoints,
+ borderWidth, leftRelief)
+ Tk_Window tkwin; /* Window for which border was allocated. */
+ Drawable drawable; /* X window or pixmap in which to draw. */
+ Tk_3DBorder border; /* Token for border to draw. */
+ XPoint *pointPtr; /* Array of points describing
+ * polygon. All points must be
+ * absolute (CoordModeOrigin). */
+ int numPoints; /* Number of points at *pointPtr. */
+ int borderWidth; /* Width of border, measured in
+ * pixels to the left of the polygon's
+ * trajectory. May be negative. */
+ int leftRelief; /* Indicates 3D effect of left side of
+ * trajectory relative to right:
+ * TK_RELIEF_FLAT, TK_RELIEF_RAISED,
+ * or TK_RELIEF_SUNKEN. */
+{
+ register TkBorder *borderPtr = (TkBorder *) border;
+
+ XFillPolygon(Tk_Display(tkwin), drawable, borderPtr->bgGC,
+ pointPtr, numPoints, Complex, CoordModeOrigin);
+ if (leftRelief != TK_RELIEF_FLAT) {
+ Tk_Draw3DPolygon(tkwin, drawable, border, pointPtr, numPoints,
+ borderWidth, leftRelief);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * BorderInit --
+ *
+ * Initialize the structures used for border management.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Read the code.
+ *
+ *-------------------------------------------------------------
+ */
+
+static void
+BorderInit()
+{
+ initialized = 1;
+ Tcl_InitHashTable(&borderTable, sizeof(BorderKey)/sizeof(int));
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ShiftLine --
+ *
+ * Given two points on a line, compute a point on a
+ * new line that is parallel to the given line and
+ * a given distance away from it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ShiftLine(p1Ptr, p2Ptr, distance, p3Ptr)
+ XPoint *p1Ptr; /* First point on line. */
+ XPoint *p2Ptr; /* Second point on line. */
+ int distance; /* New line is to be this many
+ * units to the left of original
+ * line, when looking from p1 to
+ * p2. May be negative. */
+ XPoint *p3Ptr; /* Store coords of point on new
+ * line here. */
+{
+ int dx, dy, dxNeg, dyNeg;
+
+ /*
+ * The table below is used for a quick approximation in
+ * computing the new point. An index into the table
+ * is 128 times the slope of the original line (the slope
+ * must always be between 0 and 1). The value of the table
+ * entry is 128 times the amount to displace the new line
+ * in y for each unit of perpendicular distance. In other
+ * words, the table maps from the tangent of an angle to
+ * the inverse of its cosine. If the slope of the original
+ * line is greater than 1, then the displacement is done in
+ * x rather than in y.
+ */
+
+ static int shiftTable[129];
+
+ /*
+ * Initialize the table if this is the first time it is
+ * used.
+ */
+
+ if (shiftTable[0] == 0) {
+ int i;
+ double tangent, cosine;
+
+ for (i = 0; i <= 128; i++) {
+ tangent = i/128.0;
+ cosine = 128/cos(atan(tangent)) + .5;
+ shiftTable[i] = (int) cosine;
+ }
+ }
+
+ *p3Ptr = *p1Ptr;
+ dx = p2Ptr->x - p1Ptr->x;
+ dy = p2Ptr->y - p1Ptr->y;
+ if (dy < 0) {
+ dyNeg = 1;
+ dy = -dy;
+ } else {
+ dyNeg = 0;
+ }
+ if (dx < 0) {
+ dxNeg = 1;
+ dx = -dx;
+ } else {
+ dxNeg = 0;
+ }
+ if (dy <= dx) {
+ dy = ((distance * shiftTable[(dy<<7)/dx]) + 64) >> 7;
+ if (!dxNeg) {
+ dy = -dy;
+ }
+ p3Ptr->y += dy;
+ } else {
+ dx = ((distance * shiftTable[(dx<<7)/dy]) + 64) >> 7;
+ if (dyNeg) {
+ dx = -dx;
+ }
+ p3Ptr->x += dx;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Intersect --
+ *
+ * Find the intersection point between two lines.
+ *
+ * Results:
+ * Under normal conditions 0 is returned and the point
+ * at *iPtr is filled in with the intersection between
+ * the two lines. If the two lines are parallel, then
+ * -1 is returned and *iPtr isn't modified.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+Intersect(a1Ptr, a2Ptr, b1Ptr, b2Ptr, iPtr)
+ XPoint *a1Ptr; /* First point of first line. */
+ XPoint *a2Ptr; /* Second point of first line. */
+ XPoint *b1Ptr; /* First point of second line. */
+ XPoint *b2Ptr; /* Second point of second line. */
+ XPoint *iPtr; /* Filled in with intersection point. */
+{
+ int dxadyb, dxbdya, dxadxb, dyadyb, p, q;
+
+ /*
+ * The code below is just a straightforward manipulation of two
+ * equations of the form y = (x-x1)*(y2-y1)/(x2-x1) + y1 to solve
+ * for the x-coordinate of intersection, then the y-coordinate.
+ */
+
+ dxadyb = (a2Ptr->x - a1Ptr->x)*(b2Ptr->y - b1Ptr->y);
+ dxbdya = (b2Ptr->x - b1Ptr->x)*(a2Ptr->y - a1Ptr->y);
+ dxadxb = (a2Ptr->x - a1Ptr->x)*(b2Ptr->x - b1Ptr->x);
+ dyadyb = (a2Ptr->y - a1Ptr->y)*(b2Ptr->y - b1Ptr->y);
+
+ if (dxadyb == dxbdya) {
+ return -1;
+ }
+ p = (a1Ptr->x*dxbdya - b1Ptr->x*dxadyb + (b1Ptr->y - a1Ptr->y)*dxadxb);
+ q = dxbdya - dxadyb;
+ if (q < 0) {
+ p = -p;
+ q = -q;
+ }
+ if (p < 0) {
+ iPtr->x = - ((-p + q/2)/q);
+ } else {
+ iPtr->x = (p + q/2)/q;
+ }
+ p = (a1Ptr->y*dxadyb - b1Ptr->y*dxbdya + (b1Ptr->x - a1Ptr->x)*dyadyb);
+ q = dxadyb - dxbdya;
+ if (q < 0) {
+ p = -p;
+ q = -q;
+ }
+ if (p < 0) {
+ iPtr->y = - ((-p + q/2)/q);
+ } else {
+ iPtr->y = (p + q/2)/q;
+ }
+ return 0;
+}
diff --git a/generic/tk3d.h b/generic/tk3d.h
new file mode 100644
index 0000000..cd9ecd5
--- /dev/null
+++ b/generic/tk3d.h
@@ -0,0 +1,79 @@
+/*
+ * tk3d.h --
+ *
+ * Declarations of types and functions shared by the 3d border
+ * module.
+ *
+ * Copyright (c) 1996 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tk3d.h 1.1 96/11/04 13:52:59
+ */
+
+#ifndef _TK3D
+#define _TK3D
+
+#include <tkInt.h>
+
+/*
+ * One of the following data structures is allocated for
+ * each 3-D border currently in use. Structures of this
+ * type are indexed by borderTable, so that a single
+ * structure can be shared for several uses.
+ */
+
+typedef struct {
+ Screen *screen; /* Screen on which the border will be used. */
+ Visual *visual; /* Visual for all windows and pixmaps using
+ * the border. */
+ int depth; /* Number of bits per pixel of drawables where
+ * the border will be used. */
+ Colormap colormap; /* Colormap out of which pixels are
+ * allocated. */
+ int refCount; /* Number of different users of
+ * this border. */
+ XColor *bgColorPtr; /* Background color (intensity
+ * between lightColorPtr and
+ * darkColorPtr). */
+ XColor *darkColorPtr; /* Color for darker areas (must free when
+ * deleting structure). NULL means shadows
+ * haven't been allocated yet.*/
+ XColor *lightColorPtr; /* Color used for lighter areas of border
+ * (must free this when deleting structure).
+ * NULL means shadows haven't been allocated
+ * yet. */
+ Pixmap shadow; /* Stipple pattern to use for drawing
+ * shadows areas. Used for displays with
+ * <= 64 colors or where colormap has filled
+ * up. */
+ GC bgGC; /* Used (if necessary) to draw areas in
+ * the background color. */
+ GC darkGC; /* Used to draw darker parts of the
+ * border. None means the shadow colors
+ * haven't been allocated yet.*/
+ GC lightGC; /* Used to draw lighter parts of
+ * the border. None means the shadow colors
+ * haven't been allocated yet. */
+ Tcl_HashEntry *hashPtr; /* Entry in borderTable (needed in
+ * order to delete structure). */
+} TkBorder;
+
+
+/*
+ * Maximum intensity for a color:
+ */
+
+#define MAX_INTENSITY 65535
+
+/*
+ * Declarations for platform specific interfaces used by this module.
+ */
+
+EXTERN TkBorder * TkpGetBorder _ANSI_ARGS_((void));
+EXTERN void TkpGetShadows _ANSI_ARGS_((TkBorder *borderPtr,
+ Tk_Window tkwin));
+EXTERN void TkpFreeBorder _ANSI_ARGS_((TkBorder *borderPtr));
+
+#endif /* _TK3D */
diff --git a/generic/tkArgv.c b/generic/tkArgv.c
new file mode 100644
index 0000000..5842687
--- /dev/null
+++ b/generic/tkArgv.c
@@ -0,0 +1,433 @@
+/*
+ * tkArgv.c --
+ *
+ * This file contains a procedure that handles table-based
+ * argv-argc parsing.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkArgv.c 1.21 97/04/25 16:50:27
+ */
+
+#include "tkPort.h"
+#include "tk.h"
+
+/*
+ * Default table of argument descriptors. These are normally available
+ * in every application.
+ */
+
+static Tk_ArgvInfo defaultTable[] = {
+ {"-help", TK_ARGV_HELP, (char *) NULL, (char *) NULL,
+ "Print summary of command-line options and abort"},
+ {NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
+ (char *) NULL}
+};
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void PrintUsage _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_ArgvInfo *argTable, int flags));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ParseArgv --
+ *
+ * Process an argv array according to a table of expected
+ * command-line options. See the manual page for more details.
+ *
+ * Results:
+ * The return value is a standard Tcl return value. If an
+ * error occurs then an error message is left in interp->result.
+ * Under normal conditions, both *argcPtr and *argv are modified
+ * to return the arguments that couldn't be processed here (they
+ * didn't match the option table, or followed an TK_ARGV_REST
+ * argument).
+ *
+ * Side effects:
+ * Variables may be modified, resources may be entered for tkwin,
+ * or procedures may be called. It all depends on the arguments
+ * and their entries in argTable. See the user documentation
+ * for details.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ParseArgv(interp, tkwin, argcPtr, argv, argTable, flags)
+ Tcl_Interp *interp; /* Place to store error message. */
+ Tk_Window tkwin; /* Window to use for setting Tk options.
+ * NULL means ignore Tk option specs. */
+ int *argcPtr; /* Number of arguments in argv. Modified
+ * to hold # args left in argv at end. */
+ char **argv; /* Array of arguments. Modified to hold
+ * those that couldn't be processed here. */
+ Tk_ArgvInfo *argTable; /* Array of option descriptions */
+ int flags; /* Or'ed combination of various flag bits,
+ * such as TK_ARGV_NO_DEFAULTS. */
+{
+ register Tk_ArgvInfo *infoPtr;
+ /* Pointer to the current entry in the
+ * table of argument descriptions. */
+ Tk_ArgvInfo *matchPtr; /* Descriptor that matches current argument. */
+ char *curArg; /* Current argument */
+ register char c; /* Second character of current arg (used for
+ * quick check for matching; use 2nd char.
+ * because first char. will almost always
+ * be '-'). */
+ int srcIndex; /* Location from which to read next argument
+ * from argv. */
+ int dstIndex; /* Index into argv to which next unused
+ * argument should be copied (never greater
+ * than srcIndex). */
+ int argc; /* # arguments in argv still to process. */
+ size_t length; /* Number of characters in current argument. */
+ int i;
+
+ if (flags & TK_ARGV_DONT_SKIP_FIRST_ARG) {
+ srcIndex = dstIndex = 0;
+ argc = *argcPtr;
+ } else {
+ srcIndex = dstIndex = 1;
+ argc = *argcPtr-1;
+ }
+
+ while (argc > 0) {
+ curArg = argv[srcIndex];
+ srcIndex++;
+ argc--;
+ length = strlen(curArg);
+ if (length > 0) {
+ c = curArg[1];
+ } else {
+ c = 0;
+ }
+
+ /*
+ * Loop throught the argument descriptors searching for one with
+ * the matching key string. If found, leave a pointer to it in
+ * matchPtr.
+ */
+
+ matchPtr = NULL;
+ for (i = 0; i < 2; i++) {
+ if (i == 0) {
+ infoPtr = argTable;
+ } else {
+ infoPtr = defaultTable;
+ }
+ for (; (infoPtr != NULL) && (infoPtr->type != TK_ARGV_END);
+ infoPtr++) {
+ if (infoPtr->key == NULL) {
+ continue;
+ }
+ if ((infoPtr->key[1] != c)
+ || (strncmp(infoPtr->key, curArg, length) != 0)) {
+ continue;
+ }
+ if ((tkwin == NULL)
+ && ((infoPtr->type == TK_ARGV_CONST_OPTION)
+ || (infoPtr->type == TK_ARGV_OPTION_VALUE)
+ || (infoPtr->type == TK_ARGV_OPTION_NAME_VALUE))) {
+ continue;
+ }
+ if (infoPtr->key[length] == 0) {
+ matchPtr = infoPtr;
+ goto gotMatch;
+ }
+ if (flags & TK_ARGV_NO_ABBREV) {
+ continue;
+ }
+ if (matchPtr != NULL) {
+ Tcl_AppendResult(interp, "ambiguous option \"", curArg,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ matchPtr = infoPtr;
+ }
+ }
+ if (matchPtr == NULL) {
+
+ /*
+ * Unrecognized argument. Just copy it down, unless the caller
+ * prefers an error to be registered.
+ */
+
+ if (flags & TK_ARGV_NO_LEFTOVERS) {
+ Tcl_AppendResult(interp, "unrecognized argument \"",
+ curArg, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ argv[dstIndex] = curArg;
+ dstIndex++;
+ continue;
+ }
+
+ /*
+ * Take the appropriate action based on the option type
+ */
+
+ gotMatch:
+ infoPtr = matchPtr;
+ switch (infoPtr->type) {
+ case TK_ARGV_CONSTANT:
+ *((int *) infoPtr->dst) = (int) infoPtr->src;
+ break;
+ case TK_ARGV_INT:
+ if (argc == 0) {
+ goto missingArg;
+ } else {
+ char *endPtr;
+
+ *((int *) infoPtr->dst) =
+ strtol(argv[srcIndex], &endPtr, 0);
+ if ((endPtr == argv[srcIndex]) || (*endPtr != 0)) {
+ Tcl_AppendResult(interp, "expected integer argument ",
+ "for \"", infoPtr->key, "\" but got \"",
+ argv[srcIndex], "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ srcIndex++;
+ argc--;
+ }
+ break;
+ case TK_ARGV_STRING:
+ if (argc == 0) {
+ goto missingArg;
+ } else {
+ *((char **)infoPtr->dst) = argv[srcIndex];
+ srcIndex++;
+ argc--;
+ }
+ break;
+ case TK_ARGV_UID:
+ if (argc == 0) {
+ goto missingArg;
+ } else {
+ *((Tk_Uid *)infoPtr->dst) = Tk_GetUid(argv[srcIndex]);
+ srcIndex++;
+ argc--;
+ }
+ break;
+ case TK_ARGV_REST:
+ *((int *) infoPtr->dst) = dstIndex;
+ goto argsDone;
+ case TK_ARGV_FLOAT:
+ if (argc == 0) {
+ goto missingArg;
+ } else {
+ char *endPtr;
+
+ *((double *) infoPtr->dst) =
+ strtod(argv[srcIndex], &endPtr);
+ if ((endPtr == argv[srcIndex]) || (*endPtr != 0)) {
+ Tcl_AppendResult(interp, "expected floating-point ",
+ "argument for \"", infoPtr->key,
+ "\" but got \"", argv[srcIndex], "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ srcIndex++;
+ argc--;
+ }
+ break;
+ case TK_ARGV_FUNC: {
+ typedef int (ArgvFunc)_ANSI_ARGS_((char *, char *, char *));
+ ArgvFunc *handlerProc;
+
+ handlerProc = (ArgvFunc *) infoPtr->src;
+ if ((*handlerProc)(infoPtr->dst, infoPtr->key,
+ argv[srcIndex])) {
+ srcIndex += 1;
+ argc -= 1;
+ }
+ break;
+ }
+ case TK_ARGV_GENFUNC: {
+ typedef int (ArgvGenFunc)_ANSI_ARGS_((char *, Tcl_Interp *,
+ char *, int, char **));
+ ArgvGenFunc *handlerProc;
+
+ handlerProc = (ArgvGenFunc *) infoPtr->src;
+ argc = (*handlerProc)(infoPtr->dst, interp, infoPtr->key,
+ argc, argv+srcIndex);
+ if (argc < 0) {
+ return TCL_ERROR;
+ }
+ break;
+ }
+ case TK_ARGV_HELP:
+ PrintUsage (interp, argTable, flags);
+ return TCL_ERROR;
+ case TK_ARGV_CONST_OPTION:
+ Tk_AddOption(tkwin, infoPtr->dst, infoPtr->src,
+ TK_INTERACTIVE_PRIO);
+ break;
+ case TK_ARGV_OPTION_VALUE:
+ if (argc < 1) {
+ goto missingArg;
+ }
+ Tk_AddOption(tkwin, infoPtr->dst, argv[srcIndex],
+ TK_INTERACTIVE_PRIO);
+ srcIndex++;
+ argc--;
+ break;
+ case TK_ARGV_OPTION_NAME_VALUE:
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "\"", curArg,
+ "\" option requires two following arguments",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tk_AddOption(tkwin, argv[srcIndex], argv[srcIndex+1],
+ TK_INTERACTIVE_PRIO);
+ srcIndex += 2;
+ argc -= 2;
+ break;
+ default:
+ sprintf(interp->result, "bad argument type %d in Tk_ArgvInfo",
+ infoPtr->type);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * If we broke out of the loop because of an OPT_REST argument,
+ * copy the remaining arguments down.
+ */
+
+ argsDone:
+ while (argc) {
+ argv[dstIndex] = argv[srcIndex];
+ srcIndex++;
+ dstIndex++;
+ argc--;
+ }
+ argv[dstIndex] = (char *) NULL;
+ *argcPtr = dstIndex;
+ return TCL_OK;
+
+ missingArg:
+ Tcl_AppendResult(interp, "\"", curArg,
+ "\" option requires an additional argument", (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PrintUsage --
+ *
+ * Generate a help string describing command-line options.
+ *
+ * Results:
+ * Interp->result will be modified to hold a help string
+ * describing all the options in argTable, plus all those
+ * in the default table unless TK_ARGV_NO_DEFAULTS is
+ * specified in flags.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PrintUsage(interp, argTable, flags)
+ Tcl_Interp *interp; /* Place information in this interp's
+ * result area. */
+ Tk_ArgvInfo *argTable; /* Array of command-specific argument
+ * descriptions. */
+ int flags; /* If the TK_ARGV_NO_DEFAULTS bit is set
+ * in this word, then don't generate
+ * information for default options. */
+{
+ register Tk_ArgvInfo *infoPtr;
+ int width, i, numSpaces;
+#define NUM_SPACES 20
+ static char spaces[] = " ";
+ char tmp[30];
+
+ /*
+ * First, compute the width of the widest option key, so that we
+ * can make everything line up.
+ */
+
+ width = 4;
+ for (i = 0; i < 2; i++) {
+ for (infoPtr = i ? defaultTable : argTable;
+ infoPtr->type != TK_ARGV_END; infoPtr++) {
+ int length;
+ if (infoPtr->key == NULL) {
+ continue;
+ }
+ length = strlen(infoPtr->key);
+ if (length > width) {
+ width = length;
+ }
+ }
+ }
+
+ Tcl_AppendResult(interp, "Command-specific options:", (char *) NULL);
+ for (i = 0; ; i++) {
+ for (infoPtr = i ? defaultTable : argTable;
+ infoPtr->type != TK_ARGV_END; infoPtr++) {
+ if ((infoPtr->type == TK_ARGV_HELP) && (infoPtr->key == NULL)) {
+ Tcl_AppendResult(interp, "\n", infoPtr->help, (char *) NULL);
+ continue;
+ }
+ Tcl_AppendResult(interp, "\n ", infoPtr->key, ":", (char *) NULL);
+ numSpaces = width + 1 - strlen(infoPtr->key);
+ while (numSpaces > 0) {
+ if (numSpaces >= NUM_SPACES) {
+ Tcl_AppendResult(interp, spaces, (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, spaces+NUM_SPACES-numSpaces,
+ (char *) NULL);
+ }
+ numSpaces -= NUM_SPACES;
+ }
+ Tcl_AppendResult(interp, infoPtr->help, (char *) NULL);
+ switch (infoPtr->type) {
+ case TK_ARGV_INT: {
+ sprintf(tmp, "%d", *((int *) infoPtr->dst));
+ Tcl_AppendResult(interp, "\n\t\tDefault value: ",
+ tmp, (char *) NULL);
+ break;
+ }
+ case TK_ARGV_FLOAT: {
+ sprintf(tmp, "%g", *((double *) infoPtr->dst));
+ Tcl_AppendResult(interp, "\n\t\tDefault value: ",
+ tmp, (char *) NULL);
+ break;
+ }
+ case TK_ARGV_STRING: {
+ char *string;
+
+ string = *((char **) infoPtr->dst);
+ if (string != NULL) {
+ Tcl_AppendResult(interp, "\n\t\tDefault value: \"",
+ string, "\"", (char *) NULL);
+ }
+ break;
+ }
+ default: {
+ break;
+ }
+ }
+ }
+
+ if ((flags & TK_ARGV_NO_DEFAULTS) || (i > 0)) {
+ break;
+ }
+ Tcl_AppendResult(interp, "\nGeneric options for all commands:",
+ (char *) NULL);
+ }
+}
diff --git a/generic/tkAtom.c b/generic/tkAtom.c
new file mode 100644
index 0000000..9d35f6b
--- /dev/null
+++ b/generic/tkAtom.c
@@ -0,0 +1,217 @@
+/*
+ * tkAtom.c --
+ *
+ * This file manages a cache of X Atoms in order to avoid
+ * interactions with the X server. It's much like the Xmu
+ * routines, except it has a cleaner interface (caller
+ * doesn't have to provide permanent storage for atom names,
+ * for example).
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkAtom.c 1.13 96/02/15 18:51:34
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * The following are a list of the predefined atom strings.
+ * They should match those found in xatom.h
+ */
+
+static char * atomNameArray[] = {
+ "PRIMARY", "SECONDARY", "ARC",
+ "ATOM", "BITMAP", "CARDINAL",
+ "COLORMAP", "CURSOR", "CUT_BUFFER0",
+ "CUT_BUFFER1", "CUT_BUFFER2", "CUT_BUFFER3",
+ "CUT_BUFFER4", "CUT_BUFFER5", "CUT_BUFFER6",
+ "CUT_BUFFER7", "DRAWABLE", "FONT",
+ "INTEGER", "PIXMAP", "POINT",
+ "RECTANGLE", "RESOURCE_MANAGER", "RGB_COLOR_MAP",
+ "RGB_BEST_MAP", "RGB_BLUE_MAP", "RGB_DEFAULT_MAP",
+ "RGB_GRAY_MAP", "RGB_GREEN_MAP", "RGB_RED_MAP",
+ "STRING", "VISUALID", "WINDOW",
+ "WM_COMMAND", "WM_HINTS", "WM_CLIENT_MACHINE",
+ "WM_ICON_NAME", "WM_ICON_SIZE", "WM_NAME",
+ "WM_NORMAL_HINTS", "WM_SIZE_HINTS", "WM_ZOOM_HINTS",
+ "MIN_SPACE", "NORM_SPACE", "MAX_SPACE",
+ "END_SPACE", "SUPERSCRIPT_X", "SUPERSCRIPT_Y",
+ "SUBSCRIPT_X", "SUBSCRIPT_Y", "UNDERLINE_POSITION",
+ "UNDERLINE_THICKNESS", "STRIKEOUT_ASCENT", "STRIKEOUT_DESCENT",
+ "ITALIC_ANGLE", "X_HEIGHT", "QUAD_WIDTH",
+ "WEIGHT", "POINT_SIZE", "RESOLUTION",
+ "COPYRIGHT", "NOTICE", "FONT_NAME",
+ "FAMILY_NAME", "FULL_NAME", "CAP_HEIGHT",
+ "WM_CLASS", "WM_TRANSIENT_FOR",
+ (char *) NULL
+};
+
+/*
+ * Forward references to procedures defined in this file:
+ */
+
+static void AtomInit _ANSI_ARGS_((TkDisplay *dispPtr));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_InternAtom --
+ *
+ * Given a string, produce the equivalent X atom. This
+ * procedure is equivalent to XInternAtom, except that it
+ * keeps a local cache of atoms. Once a name is known,
+ * the server need not be contacted again for that name.
+ *
+ * Results:
+ * The return value is the Atom corresponding to name.
+ *
+ * Side effects:
+ * A new entry may be added to the local atom cache.
+ *
+ *--------------------------------------------------------------
+ */
+
+Atom
+Tk_InternAtom(tkwin, name)
+ Tk_Window tkwin; /* Window token; map name to atom
+ * for this window's display. */
+ char *name; /* Name to turn into atom. */
+{
+ register TkDisplay *dispPtr;
+ register Tcl_HashEntry *hPtr;
+ int new;
+
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ if (!dispPtr->atomInit) {
+ AtomInit(dispPtr);
+ }
+
+ hPtr = Tcl_CreateHashEntry(&dispPtr->nameTable, name, &new);
+ if (new) {
+ Tcl_HashEntry *hPtr2;
+ Atom atom;
+
+ atom = XInternAtom(dispPtr->display, name, False);
+ Tcl_SetHashValue(hPtr, atom);
+ hPtr2 = Tcl_CreateHashEntry(&dispPtr->atomTable, (char *) atom,
+ &new);
+ Tcl_SetHashValue(hPtr2, Tcl_GetHashKey(&dispPtr->nameTable, hPtr));
+ }
+ return (Atom) Tcl_GetHashValue(hPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetAtomName --
+ *
+ * This procedure is equivalent to XGetAtomName except that
+ * it uses the local atom cache to avoid contacting the
+ * server.
+ *
+ * Results:
+ * The return value is a character string corresponding to
+ * the atom given by "atom". This string's storage space
+ * is static: it need not be freed by the caller, and should
+ * not be modified by the caller. If "atom" doesn't exist
+ * on tkwin's display, then the string "?bad atom?" is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_GetAtomName(tkwin, atom)
+ Tk_Window tkwin; /* Window token; map atom to name
+ * relative to this window's
+ * display. */
+ Atom atom; /* Atom whose name is wanted. */
+{
+ register TkDisplay *dispPtr;
+ register Tcl_HashEntry *hPtr;
+
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ if (!dispPtr->atomInit) {
+ AtomInit(dispPtr);
+ }
+
+ hPtr = Tcl_FindHashEntry(&dispPtr->atomTable, (char *) atom);
+ if (hPtr == NULL) {
+ char *name;
+ Tk_ErrorHandler handler;
+ int new, mustFree;
+
+ handler= Tk_CreateErrorHandler(dispPtr->display, BadAtom,
+ -1, -1, (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ name = XGetAtomName(dispPtr->display, atom);
+ mustFree = 1;
+ if (name == NULL) {
+ name = "?bad atom?";
+ mustFree = 0;
+ }
+ Tk_DeleteErrorHandler(handler);
+ hPtr = Tcl_CreateHashEntry(&dispPtr->nameTable, (char *) name,
+ &new);
+ Tcl_SetHashValue(hPtr, atom);
+ if (mustFree) {
+ XFree(name);
+ }
+ name = Tcl_GetHashKey(&dispPtr->nameTable, hPtr);
+ hPtr = Tcl_CreateHashEntry(&dispPtr->atomTable, (char *) atom,
+ &new);
+ Tcl_SetHashValue(hPtr, name);
+ }
+ return (char *) Tcl_GetHashValue(hPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * AtomInit --
+ *
+ * Initialize atom-related information for a display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Tables get initialized, etc. etc..
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+AtomInit(dispPtr)
+ register TkDisplay *dispPtr; /* Display to initialize. */
+{
+ Tcl_HashEntry *hPtr;
+ Atom atom;
+
+ dispPtr->atomInit = 1;
+ Tcl_InitHashTable(&dispPtr->nameTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&dispPtr->atomTable, TCL_ONE_WORD_KEYS);
+
+ for (atom = 1; atom <= XA_LAST_PREDEFINED; atom++) {
+ hPtr = Tcl_FindHashEntry(&dispPtr->atomTable, (char *) atom);
+ if (hPtr == NULL) {
+ char *name;
+ int new;
+
+ name = atomNameArray[atom - 1];
+ hPtr = Tcl_CreateHashEntry(&dispPtr->nameTable, (char *) name,
+ &new);
+ Tcl_SetHashValue(hPtr, atom);
+ name = Tcl_GetHashKey(&dispPtr->nameTable, hPtr);
+ hPtr = Tcl_CreateHashEntry(&dispPtr->atomTable, (char *) atom,
+ &new);
+ Tcl_SetHashValue(hPtr, name);
+ }
+ }
+}
diff --git a/generic/tkBind.c b/generic/tkBind.c
new file mode 100644
index 0000000..bb37b00
--- /dev/null
+++ b/generic/tkBind.c
@@ -0,0 +1,4533 @@
+/*
+ * tkBind.c --
+ *
+ * This file provides procedures that associate Tcl commands
+ * with X events or sequences of X events.
+ *
+ * Copyright (c) 1989-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkBind.c 1.133 97/07/01 17:59:53
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * File structure:
+ *
+ * Structure definitions and static variables.
+ *
+ * Init/Free this package.
+ *
+ * Tcl "bind" command (actually located in tkCmds.c).
+ * "bind" command implementation.
+ * "bind" implementation helpers.
+ *
+ * Tcl "event" command.
+ * "event" command implementation.
+ * "event" implementation helpers.
+ *
+ * Package-specific common helpers.
+ *
+ * Non-package-specific helpers.
+ */
+
+
+/*
+ * The following union is used to hold the detail information from an
+ * XEvent (including Tk's XVirtualEvent extension).
+ */
+typedef union {
+ KeySym keySym; /* KeySym that corresponds to xkey.keycode. */
+ int button; /* Button that was pressed (xbutton.button). */
+ Tk_Uid name; /* Tk_Uid of virtual event. */
+ ClientData clientData; /* Used when type of Detail is unknown, and to
+ * ensure that all bytes of Detail are initialized
+ * when this structure is used in a hash key. */
+} Detail;
+
+/*
+ * The structure below represents a binding table. A binding table
+ * represents a domain in which event bindings may occur. It includes
+ * a space of objects relative to which events occur (usually windows,
+ * but not always), a history of recent events in the domain, and
+ * a set of mappings that associate particular Tcl commands with sequences
+ * of events in the domain. Multiple binding tables may exist at once,
+ * either because there are multiple applications open, or because there
+ * are multiple domains within an application with separate event
+ * bindings for each (for example, each canvas widget has a separate
+ * binding table for associating events with the items in the canvas).
+ *
+ * Note: it is probably a bad idea to reduce EVENT_BUFFER_SIZE much
+ * below 30. To see this, consider a triple mouse button click while
+ * the Shift key is down (and auto-repeating). There may be as many
+ * as 3 auto-repeat events after each mouse button press or release
+ * (see the first large comment block within Tk_BindEvent for more on
+ * this), for a total of 20 events to cover the three button presses
+ * and two intervening releases. If you reduce EVENT_BUFFER_SIZE too
+ * much, shift multi-clicks will be lost.
+ *
+ */
+
+#define EVENT_BUFFER_SIZE 30
+typedef struct BindingTable {
+ XEvent eventRing[EVENT_BUFFER_SIZE];/* Circular queue of recent events
+ * (higher indices are for more recent
+ * events). */
+ Detail detailRing[EVENT_BUFFER_SIZE];/* "Detail" information (keySym,
+ * button, Tk_Uid, or 0) for each
+ * entry in eventRing. */
+ int curEvent; /* Index in eventRing of most recent
+ * event. Newer events have higher
+ * indices. */
+ Tcl_HashTable patternTable; /* Used to map from an event to a
+ * list of patterns that may match that
+ * event. Keys are PatternTableKey
+ * structs, values are (PatSeq *). */
+ Tcl_HashTable objectTable; /* Used to map from an object to a
+ * list of patterns associated with
+ * that object. Keys are ClientData,
+ * values are (PatSeq *). */
+ Tcl_Interp *interp; /* Interpreter in which commands are
+ * executed. */
+} BindingTable;
+
+/*
+ * The following structure represents virtual event table. A virtual event
+ * table provides a way to map from platform-specific physical events such
+ * as button clicks or key presses to virtual events such as <<Paste>>,
+ * <<Close>>, or <<ScrollWindow>>.
+ *
+ * A virtual event is usually never part of the event stream, but instead is
+ * synthesized inline by matching low-level events. However, a virtual
+ * event may be generated by platform-specific code or by Tcl scripts. In
+ * that case, no lookup of the virtual event will need to be done using
+ * this table, because the virtual event is actually in the event stream.
+ */
+
+typedef struct VirtualEventTable {
+ Tcl_HashTable patternTable; /* Used to map from a physical event to
+ * a list of patterns that may match that
+ * event. Keys are PatternTableKey
+ * structs, values are (PatSeq *). */
+ Tcl_HashTable nameTable; /* Used to map a virtual event name to
+ * the array of physical events that can
+ * trigger it. Keys are the Tk_Uid names
+ * of the virtual events, values are
+ * PhysicalsOwned structs. */
+} VirtualEventTable;
+
+/*
+ * The following structure is used as a key in a patternTable for both
+ * binding tables and a virtual event tables.
+ *
+ * In a binding table, the object field corresponds to the binding tag
+ * for the widget whose bindings are being accessed.
+ *
+ * In a virtual event table, the object field is always NULL. Virtual
+ * events are a global definiton and are not tied to a particular
+ * binding tag.
+ *
+ * The same key is used for both types of pattern tables so that the
+ * helper functions that traverse and match patterns will work for both
+ * binding tables and virtual event tables.
+ */
+typedef struct PatternTableKey {
+ ClientData object; /* For binding table, identifies the binding
+ * tag of the object (or class of objects)
+ * relative to which the event occurred.
+ * For virtual event table, always NULL. */
+ int type; /* Type of event (from X). */
+ Detail detail; /* Additional information, such as keysym,
+ * button, Tk_Uid, or 0 if nothing
+ * additional. */
+} PatternTableKey;
+
+/*
+ * The following structure defines a pattern, which is matched against X
+ * events as part of the process of converting X events into Tcl commands.
+ */
+
+typedef struct Pattern {
+ int eventType; /* Type of X event, e.g. ButtonPress. */
+ int needMods; /* Mask of modifiers that must be
+ * present (0 means no modifiers are
+ * required). */
+ Detail detail; /* Additional information that must
+ * match event. Normally this is 0,
+ * meaning no additional information
+ * must match. For KeyPress and
+ * KeyRelease events, a keySym may
+ * be specified to select a
+ * particular keystroke (0 means any
+ * keystrokes). For button events,
+ * specifies a particular button (0
+ * means any buttons are OK). For virtual
+ * events, specifies the Tk_Uid of the
+ * virtual event name (never 0). */
+} Pattern;
+
+/*
+ * The following structure defines a pattern sequence, which consists of one
+ * or more patterns. In order to trigger, a pattern sequence must match
+ * the most recent X events (first pattern to most recent event, next
+ * pattern to next event, and so on). It is used as the hash value in a
+ * patternTable for both binding tables and virtual event tables.
+ *
+ * In a binding table, it is the sequence of physical events that make up
+ * a binding for an object.
+ *
+ * In a virtual event table, it is the sequence of physical events that
+ * define a virtual event.
+ *
+ * The same structure is used for both types of pattern tables so that the
+ * helper functions that traverse and match patterns will work for both
+ * binding tables and virtual event tables.
+ */
+
+typedef struct PatSeq {
+ int numPats; /* Number of patterns in sequence (usually
+ * 1). */
+ TkBindEvalProc *eventProc; /* The procedure that will be invoked on
+ * the clientData when this pattern sequence
+ * matches. */
+ TkBindFreeProc *freeProc; /* The procedure that will be invoked to
+ * release the clientData when this pattern
+ * sequence is freed. */
+ ClientData clientData; /* Arbitray data passed to eventProc and
+ * freeProc when sequence matches. */
+ int flags; /* Miscellaneous flag values; see below for
+ * definitions. */
+ int refCount; /* Number of times that this binding is in
+ * the midst of executing. If greater than 1,
+ * then a recursive invocation is happening.
+ * Only when this is zero can the binding
+ * actually be freed. */
+ struct PatSeq *nextSeqPtr; /* Next in list of all pattern sequences
+ * that have the same initial pattern. NULL
+ * means end of list. */
+ Tcl_HashEntry *hPtr; /* Pointer to hash table entry for the
+ * initial pattern. This is the head of the
+ * list of which nextSeqPtr forms a part. */
+ struct VirtualOwners *voPtr;/* In a binding table, always NULL. In a
+ * virtual event table, identifies the array
+ * of virtual events that can be triggered by
+ * this event. */
+ struct PatSeq *nextObjPtr; /* In a binding table, next in list of all
+ * pattern sequences for the same object (NULL
+ * for end of list). Needed to implement
+ * Tk_DeleteAllBindings. In a virtual event
+ * table, always NULL. */
+ Pattern pats[1]; /* Array of "numPats" patterns. Only one
+ * element is declared here but in actuality
+ * enough space will be allocated for "numPats"
+ * patterns. To match, pats[0] must match
+ * event n, pats[1] must match event n-1, etc.
+ */
+} PatSeq;
+
+/*
+ * Flag values for PatSeq structures:
+ *
+ * PAT_NEARBY 1 means that all of the events matching
+ * this sequence must occur with nearby X
+ * and Y mouse coordinates and close in time.
+ * This is typically used to restrict multiple
+ * button presses.
+ * MARKED_DELETED 1 means that this binding has been marked as deleted
+ * and removed from the binding table, but its memory
+ * could not be released because it was already queued for
+ * execution. When the binding is actually about to be
+ * executed, this flag will be checked and the binding
+ * skipped if set.
+ */
+
+#define PAT_NEARBY 0x1
+#define MARKED_DELETED 0x2
+
+/*
+ * Constants that define how close together two events must be
+ * in milliseconds or pixels to meet the PAT_NEARBY constraint:
+ */
+
+#define NEARBY_PIXELS 5
+#define NEARBY_MS 500
+
+
+/*
+ * The following structure keeps track of all the virtual events that are
+ * associated with a particular physical event. It is pointed to by the
+ * voPtr field in a PatSeq in the patternTable of a virtual event table.
+ */
+
+typedef struct VirtualOwners {
+ int numOwners; /* Number of virtual events to trigger. */
+ Tcl_HashEntry *owners[1]; /* Array of pointers to entries in
+ * nameTable. Enough space will
+ * actually be allocated for numOwners
+ * hash entries. */
+} VirtualOwners;
+
+/*
+ * The following structure is used in the nameTable of a virtual event
+ * table to associate a virtual event with all the physical events that can
+ * trigger it.
+ */
+typedef struct PhysicalsOwned {
+ int numOwned; /* Number of physical events owned. */
+ PatSeq *patSeqs[1]; /* Array of pointers to physical event
+ * patterns. Enough space will actually
+ * be allocated to hold numOwned. */
+} PhysicalsOwned;
+
+/*
+ * One of the following structures exists for each interpreter. This
+ * structure keeps track of the current display and screen in the
+ * interpreter, so that a script can be invoked whenever the display/screen
+ * changes (the script does things like point tkPriv at a display-specific
+ * structure).
+ */
+
+typedef struct {
+ TkDisplay *curDispPtr; /* Display for last binding command invoked
+ * in this application. */
+ int curScreenIndex; /* Index of screen for last binding command. */
+ int bindingDepth; /* Number of active instances of Tk_BindEvent
+ * in this application. */
+} ScreenInfo;
+
+/*
+ * The following structure is used to keep track of all the C bindings that
+ * are awaiting invocation and whether the window they refer to has been
+ * destroyed. If the window is destroyed, then all pending callbacks for
+ * that window will be cancelled. The Tcl bindings will still all be
+ * invoked, however.
+ */
+
+typedef struct PendingBinding {
+ struct PendingBinding *nextPtr;
+ /* Next in chain of pending bindings, in
+ * case a recursive binding evaluation is in
+ * progress. */
+ Tk_Window tkwin; /* The window that the following bindings
+ * depend upon. */
+ int deleted; /* Set to non-zero by window cleanup code
+ * if tkwin is deleted. */
+ PatSeq *matchArray[5]; /* Array of pending C bindings. The actual
+ * size of this depends on how many C bindings
+ * matched the event passed to Tk_BindEvent.
+ * THIS FIELD MUST BE THE LAST IN THE
+ * STRUCTURE. */
+} PendingBinding;
+
+/*
+ * The following structure keeps track of all the information local to
+ * the binding package on a per interpreter basis.
+ */
+
+typedef struct BindInfo {
+ VirtualEventTable virtualEventTable;
+ /* The virtual events that exist in this
+ * interpreter. */
+ ScreenInfo screenInfo; /* Keeps track of the current display and
+ * screen, so it can be restored after
+ * a binding has executed. */
+ PendingBinding *pendingList;/* The list of pending C bindings, kept in
+ * case a C or Tcl binding causes the target
+ * window to be deleted. */
+} BindInfo;
+
+/*
+ * In X11R4 and earlier versions, XStringToKeysym is ridiculously
+ * slow. The data structure and hash table below, along with the
+ * code that uses them, implement a fast mapping from strings to
+ * keysyms. In X11R5 and later releases XStringToKeysym is plenty
+ * fast so this stuff isn't needed. The #define REDO_KEYSYM_LOOKUP
+ * is normally undefined, so that XStringToKeysym gets used. It
+ * can be set in the Makefile to enable the use of the hash table
+ * below.
+ */
+
+#ifdef REDO_KEYSYM_LOOKUP
+typedef struct {
+ char *name; /* Name of keysym. */
+ KeySym value; /* Numeric identifier for keysym. */
+} KeySymInfo;
+static KeySymInfo keyArray[] = {
+#ifndef lint
+#include "ks_names.h"
+#endif
+ {(char *) NULL, 0}
+};
+static Tcl_HashTable keySymTable; /* keyArray hashed by keysym value. */
+static Tcl_HashTable nameTable; /* keyArray hashed by keysym name. */
+#endif /* REDO_KEYSYM_LOOKUP */
+
+/*
+ * Set to non-zero when the package-wide static variables have been
+ * initialized.
+ */
+
+static int initialized = 0;
+
+/*
+ * A hash table is kept to map from the string names of event
+ * modifiers to information about those modifiers. The structure
+ * for storing this information, and the hash table built at
+ * initialization time, are defined below.
+ */
+
+typedef struct {
+ char *name; /* Name of modifier. */
+ int mask; /* Button/modifier mask value, * such as Button1Mask. */
+ int flags; /* Various flags; see below for
+ * definitions. */
+} ModInfo;
+
+/*
+ * Flags for ModInfo structures:
+ *
+ * DOUBLE - Non-zero means duplicate this event,
+ * e.g. for double-clicks.
+ * TRIPLE - Non-zero means triplicate this event,
+ * e.g. for triple-clicks.
+ */
+
+#define DOUBLE 1
+#define TRIPLE 2
+
+/*
+ * The following special modifier mask bits are defined, to indicate
+ * logical modifiers such as Meta and Alt that may float among the
+ * actual modifier bits.
+ */
+
+#define META_MASK (AnyModifier<<1)
+#define ALT_MASK (AnyModifier<<2)
+
+static ModInfo modArray[] = {
+ {"Control", ControlMask, 0},
+ {"Shift", ShiftMask, 0},
+ {"Lock", LockMask, 0},
+ {"Meta", META_MASK, 0},
+ {"M", META_MASK, 0},
+ {"Alt", ALT_MASK, 0},
+ {"B1", Button1Mask, 0},
+ {"Button1", Button1Mask, 0},
+ {"B2", Button2Mask, 0},
+ {"Button2", Button2Mask, 0},
+ {"B3", Button3Mask, 0},
+ {"Button3", Button3Mask, 0},
+ {"B4", Button4Mask, 0},
+ {"Button4", Button4Mask, 0},
+ {"B5", Button5Mask, 0},
+ {"Button5", Button5Mask, 0},
+ {"Mod1", Mod1Mask, 0},
+ {"M1", Mod1Mask, 0},
+ {"Command", Mod1Mask, 0},
+ {"Mod2", Mod2Mask, 0},
+ {"M2", Mod2Mask, 0},
+ {"Option", Mod2Mask, 0},
+ {"Mod3", Mod3Mask, 0},
+ {"M3", Mod3Mask, 0},
+ {"Mod4", Mod4Mask, 0},
+ {"M4", Mod4Mask, 0},
+ {"Mod5", Mod5Mask, 0},
+ {"M5", Mod5Mask, 0},
+ {"Double", 0, DOUBLE},
+ {"Triple", 0, TRIPLE},
+ {"Any", 0, 0}, /* Ignored: historical relic. */
+ {NULL, 0, 0}
+};
+static Tcl_HashTable modTable;
+
+/*
+ * This module also keeps a hash table mapping from event names
+ * to information about those events. The structure, an array
+ * to use to initialize the hash table, and the hash table are
+ * all defined below.
+ */
+
+typedef struct {
+ char *name; /* Name of event. */
+ int type; /* Event type for X, such as
+ * ButtonPress. */
+ int eventMask; /* Mask bits (for XSelectInput)
+ * for this event type. */
+} EventInfo;
+
+/*
+ * Note: some of the masks below are an OR-ed combination of
+ * several masks. This is necessary because X doesn't report
+ * up events unless you also ask for down events. Also, X
+ * doesn't report button state in motion events unless you've
+ * asked about button events.
+ */
+
+static EventInfo eventArray[] = {
+ {"Key", KeyPress, KeyPressMask},
+ {"KeyPress", KeyPress, KeyPressMask},
+ {"KeyRelease", KeyRelease, KeyPressMask|KeyReleaseMask},
+ {"Button", ButtonPress, ButtonPressMask},
+ {"ButtonPress", ButtonPress, ButtonPressMask},
+ {"ButtonRelease", ButtonRelease,
+ ButtonPressMask|ButtonReleaseMask},
+ {"Motion", MotionNotify,
+ ButtonPressMask|PointerMotionMask},
+ {"Enter", EnterNotify, EnterWindowMask},
+ {"Leave", LeaveNotify, LeaveWindowMask},
+ {"FocusIn", FocusIn, FocusChangeMask},
+ {"FocusOut", FocusOut, FocusChangeMask},
+ {"Expose", Expose, ExposureMask},
+ {"Visibility", VisibilityNotify, VisibilityChangeMask},
+ {"Destroy", DestroyNotify, StructureNotifyMask},
+ {"Unmap", UnmapNotify, StructureNotifyMask},
+ {"Map", MapNotify, StructureNotifyMask},
+ {"Reparent", ReparentNotify, StructureNotifyMask},
+ {"Configure", ConfigureNotify, StructureNotifyMask},
+ {"Gravity", GravityNotify, StructureNotifyMask},
+ {"Circulate", CirculateNotify, StructureNotifyMask},
+ {"Property", PropertyNotify, PropertyChangeMask},
+ {"Colormap", ColormapNotify, ColormapChangeMask},
+ {"Activate", ActivateNotify, ActivateMask},
+ {"Deactivate", DeactivateNotify, ActivateMask},
+ {(char *) NULL, 0, 0}
+};
+static Tcl_HashTable eventTable;
+
+/*
+ * The defines and table below are used to classify events into
+ * various groups. The reason for this is that logically identical
+ * fields (e.g. "state") appear at different places in different
+ * types of events. The classification masks can be used to figure
+ * out quickly where to extract information from events.
+ */
+
+#define KEY 0x1
+#define BUTTON 0x2
+#define MOTION 0x4
+#define CROSSING 0x8
+#define FOCUS 0x10
+#define EXPOSE 0x20
+#define VISIBILITY 0x40
+#define CREATE 0x80
+#define DESTROY 0x100
+#define UNMAP 0x200
+#define MAP 0x400
+#define REPARENT 0x800
+#define CONFIG 0x1000
+#define GRAVITY 0x2000
+#define CIRC 0x4000
+#define PROP 0x8000
+#define COLORMAP 0x10000
+#define VIRTUAL 0x20000
+#define ACTIVATE 0x40000
+
+#define KEY_BUTTON_MOTION_VIRTUAL (KEY|BUTTON|MOTION|VIRTUAL)
+
+static int flagArray[TK_LASTEVENT] = {
+ /* Not used */ 0,
+ /* Not used */ 0,
+ /* KeyPress */ KEY,
+ /* KeyRelease */ KEY,
+ /* ButtonPress */ BUTTON,
+ /* ButtonRelease */ BUTTON,
+ /* MotionNotify */ MOTION,
+ /* EnterNotify */ CROSSING,
+ /* LeaveNotify */ CROSSING,
+ /* FocusIn */ FOCUS,
+ /* FocusOut */ FOCUS,
+ /* KeymapNotify */ 0,
+ /* Expose */ EXPOSE,
+ /* GraphicsExpose */ EXPOSE,
+ /* NoExpose */ 0,
+ /* VisibilityNotify */ VISIBILITY,
+ /* CreateNotify */ CREATE,
+ /* DestroyNotify */ DESTROY,
+ /* UnmapNotify */ UNMAP,
+ /* MapNotify */ MAP,
+ /* MapRequest */ 0,
+ /* ReparentNotify */ REPARENT,
+ /* ConfigureNotify */ CONFIG,
+ /* ConfigureRequest */ 0,
+ /* GravityNotify */ GRAVITY,
+ /* ResizeRequest */ 0,
+ /* CirculateNotify */ CIRC,
+ /* CirculateRequest */ 0,
+ /* PropertyNotify */ PROP,
+ /* SelectionClear */ 0,
+ /* SelectionRequest */ 0,
+ /* SelectionNotify */ 0,
+ /* ColormapNotify */ COLORMAP,
+ /* ClientMessage */ 0,
+ /* MappingNotify */ 0,
+ /* VirtualEvent */ VIRTUAL,
+ /* Activate */ ACTIVATE,
+ /* Deactivate */ ACTIVATE
+};
+
+/*
+ * The following tables are used as a two-way map between X's internal
+ * numeric values for fields in an XEvent and the strings used in Tcl. The
+ * tables are used both when constructing an XEvent from user input and
+ * when providing data from an XEvent to the user.
+ */
+
+static TkStateMap notifyMode[] = {
+ {NotifyNormal, "NotifyNormal"},
+ {NotifyGrab, "NotifyGrab"},
+ {NotifyUngrab, "NotifyUngrab"},
+ {NotifyWhileGrabbed, "NotifyWhileGrabbed"},
+ {-1, NULL}
+};
+
+static TkStateMap notifyDetail[] = {
+ {NotifyAncestor, "NotifyAncestor"},
+ {NotifyVirtual, "NotifyVirtual"},
+ {NotifyInferior, "NotifyInferior"},
+ {NotifyNonlinear, "NotifyNonlinear"},
+ {NotifyNonlinearVirtual, "NotifyNonlinearVirtual"},
+ {NotifyPointer, "NotifyPointer"},
+ {NotifyPointerRoot, "NotifyPointerRoot"},
+ {NotifyDetailNone, "NotifyDetailNone"},
+ {-1, NULL}
+};
+
+static TkStateMap circPlace[] = {
+ {PlaceOnTop, "PlaceOnTop"},
+ {PlaceOnBottom, "PlaceOnBottom"},
+ {-1, NULL}
+};
+
+static TkStateMap visNotify[] = {
+ {VisibilityUnobscured, "VisibilityUnobscured"},
+ {VisibilityPartiallyObscured, "VisibilityPartiallyObscured"},
+ {VisibilityFullyObscured, "VisibilityFullyObscured"},
+ {-1, NULL}
+};
+
+/*
+ * Prototypes for local procedures defined in this file:
+ */
+
+static void ChangeScreen _ANSI_ARGS_((Tcl_Interp *interp,
+ char *dispName, int screenIndex));
+static int CreateVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
+ VirtualEventTable *vetPtr, char *virtString,
+ char *eventString));
+static int DeleteVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
+ VirtualEventTable *vetPtr, char *virtString,
+ char *eventString));
+static void DeleteVirtualEventTable _ANSI_ARGS_((
+ VirtualEventTable *vetPtr));
+static void ExpandPercents _ANSI_ARGS_((TkWindow *winPtr,
+ char *before, XEvent *eventPtr, KeySym keySym,
+ Tcl_DString *dsPtr));
+static void FreeTclBinding _ANSI_ARGS_((ClientData clientData));
+static PatSeq * FindSequence _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_HashTable *patternTablePtr, ClientData object,
+ char *eventString, int create, int allowVirtual,
+ unsigned long *maskPtr));
+static void GetAllVirtualEvents _ANSI_ARGS_((Tcl_Interp *interp,
+ VirtualEventTable *vetPtr));
+static char * GetField _ANSI_ARGS_((char *p, char *copy, int size));
+static KeySym GetKeySym _ANSI_ARGS_((TkDisplay *dispPtr,
+ XEvent *eventPtr));
+static void GetPatternString _ANSI_ARGS_((PatSeq *psPtr,
+ Tcl_DString *dsPtr));
+static int GetVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
+ VirtualEventTable *vetPtr, char *virtString));
+static Tk_Uid GetVirtualEventUid _ANSI_ARGS_((Tcl_Interp *interp,
+ char *virtString));
+static int HandleEventGenerate _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window main, int argc, char **argv));
+static void InitKeymapInfo _ANSI_ARGS_((TkDisplay *dispPtr));
+static void InitVirtualEventTable _ANSI_ARGS_((
+ VirtualEventTable *vetPtr));
+static PatSeq * MatchPatterns _ANSI_ARGS_((TkDisplay *dispPtr,
+ BindingTable *bindPtr, PatSeq *psPtr,
+ PatSeq *bestPtr, ClientData *objectPtr,
+ PatSeq **sourcePtrPtr));
+static int ParseEventDescription _ANSI_ARGS_((Tcl_Interp *interp,
+ char **eventStringPtr, Pattern *patPtr,
+ unsigned long *eventMaskPtr));
+
+/*
+ * The following define is used as a short circuit for the callback
+ * procedure to evaluate a TclBinding. The actual evaluation of the
+ * binding is handled inline, because special things have to be done
+ * with a Tcl binding before evaluation time.
+ */
+
+#define EvalTclBinding ((TkBindEvalProc *) 1)
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkBindInit --
+ *
+ * This procedure is called when an application is created. It
+ * initializes all the structures used by bindings and virtual
+ * events. It must be called before any other functions in this
+ * file are called.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkBindInit(mainPtr)
+ TkMainInfo *mainPtr; /* The newly created application. */
+{
+ BindInfo *bindInfoPtr;
+
+ if (sizeof(XEvent) < sizeof(XVirtualEvent)) {
+ panic("TkBindInit: virtual events can't be supported");
+ }
+
+ /*
+ * Initialize the static data structures used by the binding package.
+ * They are only initialized once, no matter how many interps are
+ * created.
+ */
+
+ if (!initialized) {
+ Tcl_HashEntry *hPtr;
+ ModInfo *modPtr;
+ EventInfo *eiPtr;
+ int dummy;
+
+#ifdef REDO_KEYSYM_LOOKUP
+ KeySymInfo *kPtr;
+
+ Tcl_InitHashTable(&keySymTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&nameTable, TCL_ONE_WORD_KEYS);
+ for (kPtr = keyArray; kPtr->name != NULL; kPtr++) {
+ hPtr = Tcl_CreateHashEntry(&keySymTable, kPtr->name, &dummy);
+ Tcl_SetHashValue(hPtr, kPtr->value);
+ hPtr = Tcl_CreateHashEntry(&nameTable, (char *) kPtr->value,
+ &dummy);
+ Tcl_SetHashValue(hPtr, kPtr->name);
+ }
+#endif /* REDO_KEYSYM_LOOKUP */
+
+ Tcl_InitHashTable(&modTable, TCL_STRING_KEYS);
+ for (modPtr = modArray; modPtr->name != NULL; modPtr++) {
+ hPtr = Tcl_CreateHashEntry(&modTable, modPtr->name, &dummy);
+ Tcl_SetHashValue(hPtr, modPtr);
+ }
+
+ Tcl_InitHashTable(&eventTable, TCL_STRING_KEYS);
+ for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
+ hPtr = Tcl_CreateHashEntry(&eventTable, eiPtr->name, &dummy);
+ Tcl_SetHashValue(hPtr, eiPtr);
+ }
+ initialized = 1;
+ }
+
+ mainPtr->bindingTable = Tk_CreateBindingTable(mainPtr->interp);
+
+ bindInfoPtr = (BindInfo *) ckalloc(sizeof(BindInfo));
+ InitVirtualEventTable(&bindInfoPtr->virtualEventTable);
+ bindInfoPtr->screenInfo.curDispPtr = NULL;
+ bindInfoPtr->screenInfo.curScreenIndex = -1;
+ bindInfoPtr->screenInfo.bindingDepth = 0;
+ bindInfoPtr->pendingList = NULL;
+ mainPtr->bindInfo = (TkBindInfo) bindInfoPtr;
+
+ TkpInitializeMenuBindings(mainPtr->interp, mainPtr->bindingTable);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkBindFree --
+ *
+ * This procedure is called when an application is deleted. It
+ * deletes all the structures used by bindings and virtual events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkBindFree(mainPtr)
+ TkMainInfo *mainPtr; /* The newly created application. */
+{
+ BindInfo *bindInfoPtr;
+
+ Tk_DeleteBindingTable(mainPtr->bindingTable);
+ mainPtr->bindingTable = NULL;
+
+ bindInfoPtr = (BindInfo *) mainPtr->bindInfo;
+ DeleteVirtualEventTable(&bindInfoPtr->virtualEventTable);
+ mainPtr->bindInfo = NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateBindingTable --
+ *
+ * Set up a new domain in which event bindings may be created.
+ *
+ * Results:
+ * The return value is a token for the new table, which must
+ * be passed to procedures like Tk_CreatBinding.
+ *
+ * Side effects:
+ * Memory is allocated for the new table.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_BindingTable
+Tk_CreateBindingTable(interp)
+ Tcl_Interp *interp; /* Interpreter to associate with the binding
+ * table: commands are executed in this
+ * interpreter. */
+{
+ BindingTable *bindPtr;
+ int i;
+
+ /*
+ * Create and initialize a new binding table.
+ */
+
+ bindPtr = (BindingTable *) ckalloc(sizeof(BindingTable));
+ for (i = 0; i < EVENT_BUFFER_SIZE; i++) {
+ bindPtr->eventRing[i].type = -1;
+ }
+ bindPtr->curEvent = 0;
+ Tcl_InitHashTable(&bindPtr->patternTable,
+ sizeof(PatternTableKey)/sizeof(int));
+ Tcl_InitHashTable(&bindPtr->objectTable, TCL_ONE_WORD_KEYS);
+ bindPtr->interp = interp;
+ return (Tk_BindingTable) bindPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteBindingTable --
+ *
+ * Destroy a binding table and free up all its memory.
+ * The caller should not use bindingTable again after
+ * this procedure returns.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_DeleteBindingTable(bindingTable)
+ Tk_BindingTable bindingTable; /* Token for the binding table to
+ * destroy. */
+{
+ BindingTable *bindPtr = (BindingTable *) bindingTable;
+ PatSeq *psPtr, *nextPtr;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+
+ /*
+ * Find and delete all of the patterns associated with the binding
+ * table.
+ */
+
+ for (hPtr = Tcl_FirstHashEntry(&bindPtr->patternTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ psPtr != NULL; psPtr = nextPtr) {
+ nextPtr = psPtr->nextSeqPtr;
+ psPtr->flags |= MARKED_DELETED;
+ if (psPtr->refCount == 0) {
+ if (psPtr->freeProc != NULL) {
+ (*psPtr->freeProc)(psPtr->clientData);
+ }
+ ckfree((char *) psPtr);
+ }
+ }
+ }
+
+ /*
+ * Clean up the rest of the information associated with the
+ * binding table.
+ */
+
+ Tcl_DeleteHashTable(&bindPtr->patternTable);
+ Tcl_DeleteHashTable(&bindPtr->objectTable);
+ ckfree((char *) bindPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateBinding --
+ *
+ * Add a binding to a binding table, so that future calls to
+ * Tk_BindEvent may execute the command in the binding.
+ *
+ * Results:
+ * The return value is 0 if an error occurred while setting
+ * up the binding. In this case, an error message will be
+ * left in interp->result. If all went well then the return
+ * value is a mask of the event types that must be made
+ * available to Tk_BindEvent in order to properly detect when
+ * this binding triggers. This value can be used to determine
+ * what events to select for in a window, for example.
+ *
+ * Side effects:
+ * An existing binding on the same event sequence may be
+ * replaced.
+ * The new binding may cause future calls to Tk_BindEvent to
+ * behave differently than they did previously.
+ *
+ *--------------------------------------------------------------
+ */
+
+unsigned long
+Tk_CreateBinding(interp, bindingTable, object, eventString, command, append)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_BindingTable bindingTable;
+ /* Table in which to create binding. */
+ ClientData object; /* Token for object with which binding is
+ * associated. */
+ char *eventString; /* String describing event sequence that
+ * triggers binding. */
+ char *command; /* Contains Tcl command to execute when
+ * binding triggers. */
+ int append; /* 0 means replace any existing binding for
+ * eventString; 1 means append to that
+ * binding. If the existing binding is for a
+ * callback function and not a Tcl command
+ * string, the existing binding will always be
+ * replaced. */
+{
+ BindingTable *bindPtr = (BindingTable *) bindingTable;
+ PatSeq *psPtr;
+ unsigned long eventMask;
+ char *new, *old;
+
+ psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
+ 1, 1, &eventMask);
+ if (psPtr == NULL) {
+ return 0;
+ }
+ if (psPtr->eventProc == NULL) {
+ int new;
+ Tcl_HashEntry *hPtr;
+
+ /*
+ * This pattern sequence was just created.
+ * Link the pattern into the list associated with the object, so
+ * that if the object goes away, these bindings will all
+ * automatically be deleted.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object,
+ &new);
+ if (new) {
+ psPtr->nextObjPtr = NULL;
+ } else {
+ psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ }
+ Tcl_SetHashValue(hPtr, psPtr);
+ } else if (psPtr->eventProc != EvalTclBinding) {
+ /*
+ * Free existing procedural binding.
+ */
+
+ if (psPtr->freeProc != NULL) {
+ (*psPtr->freeProc)(psPtr->clientData);
+ }
+ psPtr->clientData = NULL;
+ append = 0;
+ }
+
+ old = (char *) psPtr->clientData;
+ if ((append != 0) && (old != NULL)) {
+ int length;
+
+ length = strlen(old) + strlen(command) + 2;
+ new = (char *) ckalloc((unsigned) length);
+ sprintf(new, "%s\n%s", old, command);
+ } else {
+ new = (char *) ckalloc((unsigned) strlen(command) + 1);
+ strcpy(new, command);
+ }
+ if (old != NULL) {
+ ckfree(old);
+ }
+ psPtr->eventProc = EvalTclBinding;
+ psPtr->freeProc = FreeTclBinding;
+ psPtr->clientData = (ClientData) new;
+ return eventMask;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkCreateBindingProcedure --
+ *
+ * Add a C binding to a binding table, so that future calls to
+ * Tk_BindEvent may callback the procedure in the binding.
+ *
+ * Results:
+ * The return value is 0 if an error occurred while setting
+ * up the binding. In this case, an error message will be
+ * left in interp->result. If all went well then the return
+ * value is a mask of the event types that must be made
+ * available to Tk_BindEvent in order to properly detect when
+ * this binding triggers. This value can be used to determine
+ * what events to select for in a window, for example.
+ *
+ * Side effects:
+ * Any existing binding on the same event sequence will be
+ * replaced.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+unsigned long
+TkCreateBindingProcedure(interp, bindingTable, object, eventString,
+ eventProc, freeProc, clientData)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_BindingTable bindingTable;
+ /* Table in which to create binding. */
+ ClientData object; /* Token for object with which binding is
+ * associated. */
+ char *eventString; /* String describing event sequence that
+ * triggers binding. */
+ TkBindEvalProc *eventProc; /* Procedure to invoke when binding
+ * triggers. Must not be NULL. */
+ TkBindFreeProc *freeProc; /* Procedure to invoke when binding is
+ * freed. May be NULL for no procedure. */
+ ClientData clientData; /* Arbitrary ClientData to pass to eventProc
+ * and freeProc. */
+{
+ BindingTable *bindPtr = (BindingTable *) bindingTable;
+ PatSeq *psPtr;
+ unsigned long eventMask;
+
+ psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
+ 1, 1, &eventMask);
+ if (psPtr == NULL) {
+ return 0;
+ }
+ if (psPtr->eventProc == NULL) {
+ int new;
+ Tcl_HashEntry *hPtr;
+
+ /*
+ * This pattern sequence was just created.
+ * Link the pattern into the list associated with the object, so
+ * that if the object goes away, these bindings will all
+ * automatically be deleted.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object,
+ &new);
+ if (new) {
+ psPtr->nextObjPtr = NULL;
+ } else {
+ psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ }
+ Tcl_SetHashValue(hPtr, psPtr);
+ } else {
+
+ /*
+ * Free existing callback.
+ */
+
+ if (psPtr->freeProc != NULL) {
+ (*psPtr->freeProc)(psPtr->clientData);
+ }
+ }
+
+ psPtr->eventProc = eventProc;
+ psPtr->freeProc = freeProc;
+ psPtr->clientData = clientData;
+ return eventMask;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteBinding --
+ *
+ * Remove an event binding from a binding table.
+ *
+ * Results:
+ * The result is a standard Tcl return value. If an error
+ * occurs then interp->result will contain an error message.
+ *
+ * Side effects:
+ * The binding given by object and eventString is removed
+ * from bindingTable.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_DeleteBinding(interp, bindingTable, object, eventString)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_BindingTable bindingTable; /* Table in which to delete binding. */
+ ClientData object; /* Token for object with which binding
+ * is associated. */
+ char *eventString; /* String describing event sequence
+ * that triggers binding. */
+{
+ BindingTable *bindPtr = (BindingTable *) bindingTable;
+ PatSeq *psPtr, *prevPtr;
+ unsigned long eventMask;
+ Tcl_HashEntry *hPtr;
+
+ psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
+ 0, 1, &eventMask);
+ if (psPtr == NULL) {
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+ }
+
+ /*
+ * Unlink the binding from the list for its object, then from the
+ * list for its pattern.
+ */
+
+ hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
+ if (hPtr == NULL) {
+ panic("Tk_DeleteBinding couldn't find object table entry");
+ }
+ prevPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ if (prevPtr == psPtr) {
+ Tcl_SetHashValue(hPtr, psPtr->nextObjPtr);
+ } else {
+ for ( ; ; prevPtr = prevPtr->nextObjPtr) {
+ if (prevPtr == NULL) {
+ panic("Tk_DeleteBinding couldn't find on object list");
+ }
+ if (prevPtr->nextObjPtr == psPtr) {
+ prevPtr->nextObjPtr = psPtr->nextObjPtr;
+ break;
+ }
+ }
+ }
+ prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
+ if (prevPtr == psPtr) {
+ if (psPtr->nextSeqPtr == NULL) {
+ Tcl_DeleteHashEntry(psPtr->hPtr);
+ } else {
+ Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr);
+ }
+ } else {
+ for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
+ if (prevPtr == NULL) {
+ panic("Tk_DeleteBinding couldn't find on hash chain");
+ }
+ if (prevPtr->nextSeqPtr == psPtr) {
+ prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
+ break;
+ }
+ }
+ }
+
+ psPtr->flags |= MARKED_DELETED;
+ if (psPtr->refCount == 0) {
+ if (psPtr->freeProc != NULL) {
+ (*psPtr->freeProc)(psPtr->clientData);
+ }
+ ckfree((char *) psPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetBinding --
+ *
+ * Return the command associated with a given event string.
+ *
+ * Results:
+ * The return value is a pointer to the command string
+ * associated with eventString for object in the domain
+ * given by bindingTable. If there is no binding for
+ * eventString, or if eventString is improperly formed,
+ * then NULL is returned and an error message is left in
+ * interp->result. The return value is semi-static: it
+ * will persist until the binding is changed or deleted.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_GetBinding(interp, bindingTable, object, eventString)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_BindingTable bindingTable; /* Table in which to look for
+ * binding. */
+ ClientData object; /* Token for object with which binding
+ * is associated. */
+ char *eventString; /* String describing event sequence
+ * that triggers binding. */
+{
+ BindingTable *bindPtr = (BindingTable *) bindingTable;
+ PatSeq *psPtr;
+ unsigned long eventMask;
+
+ psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
+ 0, 1, &eventMask);
+ if (psPtr == NULL) {
+ return NULL;
+ }
+ if (psPtr->eventProc == EvalTclBinding) {
+ return (char *) psPtr->clientData;
+ }
+ return "";
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetAllBindings --
+ *
+ * Return a list of event strings for all the bindings
+ * associated with a given object.
+ *
+ * Results:
+ * There is no return value. Interp->result is modified to
+ * hold a Tcl list with one entry for each binding associated
+ * with object in bindingTable. Each entry in the list
+ * contains the event string associated with one binding.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_GetAllBindings(interp, bindingTable, object)
+ Tcl_Interp *interp; /* Interpreter returning result or
+ * error. */
+ Tk_BindingTable bindingTable; /* Table in which to look for
+ * bindings. */
+ ClientData object; /* Token for object. */
+
+{
+ BindingTable *bindPtr = (BindingTable *) bindingTable;
+ PatSeq *psPtr;
+ Tcl_HashEntry *hPtr;
+ Tcl_DString ds;
+
+ hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
+ if (hPtr == NULL) {
+ return;
+ }
+ Tcl_DStringInit(&ds);
+ for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
+ psPtr = psPtr->nextObjPtr) {
+ /*
+ * For each binding, output information about each of the
+ * patterns in its sequence.
+ */
+
+ Tcl_DStringSetLength(&ds, 0);
+ GetPatternString(psPtr, &ds);
+ Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
+ }
+ Tcl_DStringFree(&ds);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteAllBindings --
+ *
+ * Remove all bindings associated with a given object in a
+ * given binding table.
+ *
+ * Results:
+ * All bindings associated with object are removed from
+ * bindingTable.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_DeleteAllBindings(bindingTable, object)
+ Tk_BindingTable bindingTable; /* Table in which to delete
+ * bindings. */
+ ClientData object; /* Token for object. */
+{
+ BindingTable *bindPtr = (BindingTable *) bindingTable;
+ PatSeq *psPtr, *prevPtr;
+ PatSeq *nextPtr;
+ Tcl_HashEntry *hPtr;
+
+ hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
+ if (hPtr == NULL) {
+ return;
+ }
+ for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
+ psPtr = nextPtr) {
+ nextPtr = psPtr->nextObjPtr;
+
+ /*
+ * Be sure to remove each binding from its hash chain in the
+ * pattern table. If this is the last pattern in the chain,
+ * then delete the hash entry too.
+ */
+
+ prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
+ if (prevPtr == psPtr) {
+ if (psPtr->nextSeqPtr == NULL) {
+ Tcl_DeleteHashEntry(psPtr->hPtr);
+ } else {
+ Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr);
+ }
+ } else {
+ for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
+ if (prevPtr == NULL) {
+ panic("Tk_DeleteAllBindings couldn't find on hash chain");
+ }
+ if (prevPtr->nextSeqPtr == psPtr) {
+ prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
+ break;
+ }
+ }
+ }
+ psPtr->flags |= MARKED_DELETED;
+
+ if (psPtr->refCount == 0) {
+ if (psPtr->freeProc != NULL) {
+ (*psPtr->freeProc)(psPtr->clientData);
+ }
+ ckfree((char *) psPtr);
+ }
+ }
+ Tcl_DeleteHashEntry(hPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_BindEvent --
+ *
+ * This procedure is invoked to process an X event. The
+ * event is added to those recorded for the binding table.
+ * Then each of the objects at *objectPtr is checked in
+ * order to see if it has a binding that matches the recent
+ * events. If so, the most specific binding is invoked for
+ * each object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the command associated with the matching binding.
+ *
+ * All Tcl bindings scripts for each object are accumulated before
+ * the first binding is evaluated. If the action of a Tcl binding
+ * is to change or delete a binding, or delete the window associated
+ * with the binding, all the original Tcl binding scripts will still
+ * fire. Contrast this with C binding procedures. If a pending C
+ * binding (one that hasn't fired yet, but is queued to be fired for
+ * this window) is deleted, it will not be called, and if it is
+ * changed, then the new binding procedure will be called. If the
+ * window itself is deleted, no further C binding procedures will be
+ * called for this window. When both Tcl binding scripts and C binding
+ * procedures are interleaved, the above rules still apply.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
+ Tk_BindingTable bindingTable; /* Table in which to look for
+ * bindings. */
+ XEvent *eventPtr; /* What actually happened. */
+ Tk_Window tkwin; /* Window on display where event
+ * occurred (needed in order to
+ * locate display information). */
+ int numObjects; /* Number of objects at *objectPtr. */
+ ClientData *objectPtr; /* Array of one or more objects
+ * to check for a matching binding. */
+{
+ BindingTable *bindPtr;
+ TkDisplay *dispPtr;
+ BindInfo *bindInfoPtr;
+ TkDisplay *oldDispPtr;
+ ScreenInfo *screenPtr;
+ XEvent *ringPtr;
+ PatSeq *vMatchDetailList, *vMatchNoDetailList;
+ int flags, oldScreen, i, deferModal;
+ unsigned int matchCount, matchSpace;
+ Tcl_Interp *interp;
+ Tcl_DString scripts, savedResult;
+ Detail detail;
+ char *p, *end;
+ PendingBinding *pendingPtr;
+ PendingBinding staticPending;
+ TkWindow *winPtr = (TkWindow *)tkwin;
+ PatternTableKey key;
+
+ /*
+ * Ignore events on windows that don't have names: these are windows
+ * like wrapper windows that shouldn't be visible to the
+ * application.
+ */
+
+ if (winPtr->pathName == NULL) {
+ return;
+ }
+
+ /*
+ * Ignore the event completely if it is an Enter, Leave, FocusIn,
+ * or FocusOut event with detail NotifyInferior. The reason for
+ * ignoring these events is that we don't want transitions between
+ * a window and its children to visible to bindings on the parent:
+ * this would cause problems for mega-widgets, since the internal
+ * structure of a mega-widget isn't supposed to be visible to
+ * people watching the parent.
+ */
+
+ if ((eventPtr->type == EnterNotify) || (eventPtr->type == LeaveNotify)) {
+ if (eventPtr->xcrossing.detail == NotifyInferior) {
+ return;
+ }
+ }
+ if ((eventPtr->type == FocusIn) || (eventPtr->type == FocusOut)) {
+ if (eventPtr->xfocus.detail == NotifyInferior) {
+ return;
+ }
+ }
+
+ bindPtr = (BindingTable *) bindingTable;
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ bindInfoPtr = (BindInfo *) winPtr->mainPtr->bindInfo;
+
+ /*
+ * Add the new event to the ring of saved events for the
+ * binding table. Two tricky points:
+ *
+ * 1. Combine consecutive MotionNotify events. Do this by putting
+ * the new event *on top* of the previous event.
+ * 2. If a modifier key is held down, it auto-repeats to generate
+ * continuous KeyPress and KeyRelease events. These can flush
+ * the event ring so that valuable information is lost (such
+ * as repeated button clicks). To handle this, check for the
+ * special case of a modifier KeyPress arriving when the previous
+ * two events are a KeyRelease and KeyPress of the same key.
+ * If this happens, mark the most recent event (the KeyRelease)
+ * invalid and put the new event on top of the event before that
+ * (the KeyPress).
+ */
+
+ if ((eventPtr->type == MotionNotify)
+ && (bindPtr->eventRing[bindPtr->curEvent].type == MotionNotify)) {
+ /*
+ * Don't advance the ring pointer.
+ */
+ } else if (eventPtr->type == KeyPress) {
+ int i;
+ for (i = 0; ; i++) {
+ if (i >= dispPtr->numModKeyCodes) {
+ goto advanceRingPointer;
+ }
+ if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) {
+ break;
+ }
+ }
+ ringPtr = &bindPtr->eventRing[bindPtr->curEvent];
+ if ((ringPtr->type != KeyRelease)
+ || (ringPtr->xkey.keycode != eventPtr->xkey.keycode)) {
+ goto advanceRingPointer;
+ }
+ if (bindPtr->curEvent <= 0) {
+ i = EVENT_BUFFER_SIZE - 1;
+ } else {
+ i = bindPtr->curEvent - 1;
+ }
+ ringPtr = &bindPtr->eventRing[i];
+ if ((ringPtr->type != KeyPress)
+ || (ringPtr->xkey.keycode != eventPtr->xkey.keycode)) {
+ goto advanceRingPointer;
+ }
+ bindPtr->eventRing[bindPtr->curEvent].type = -1;
+ bindPtr->curEvent = i;
+ } else {
+ advanceRingPointer:
+ bindPtr->curEvent++;
+ if (bindPtr->curEvent >= EVENT_BUFFER_SIZE) {
+ bindPtr->curEvent = 0;
+ }
+ }
+ ringPtr = &bindPtr->eventRing[bindPtr->curEvent];
+ memcpy((VOID *) ringPtr, (VOID *) eventPtr, sizeof(XEvent));
+ detail.clientData = 0;
+ flags = flagArray[ringPtr->type];
+ if (flags & KEY) {
+ detail.keySym = GetKeySym(dispPtr, ringPtr);
+ if (detail.keySym == NoSymbol) {
+ detail.keySym = 0;
+ }
+ } else if (flags & BUTTON) {
+ detail.button = ringPtr->xbutton.button;
+ } else if (flags & VIRTUAL) {
+ detail.name = ((XVirtualEvent *) ringPtr)->name;
+ }
+ bindPtr->detailRing[bindPtr->curEvent] = detail;
+
+ /*
+ * Find out if there are any virtual events that correspond to this
+ * physical event (or sequence of physical events).
+ */
+
+ vMatchDetailList = NULL;
+ vMatchNoDetailList = NULL;
+ memset(&key, 0, sizeof(key));
+
+ if (ringPtr->type != VirtualEvent) {
+ Tcl_HashTable *veptPtr;
+ Tcl_HashEntry *hPtr;
+
+ veptPtr = &bindInfoPtr->virtualEventTable.patternTable;
+
+ key.object = NULL;
+ key.type = ringPtr->type;
+ key.detail = detail;
+
+ hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key);
+ if (hPtr != NULL) {
+ vMatchDetailList = (PatSeq *) Tcl_GetHashValue(hPtr);
+ }
+
+ if (key.detail.clientData != 0) {
+ key.detail.clientData = 0;
+ hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key);
+ if (hPtr != NULL) {
+ vMatchNoDetailList = (PatSeq *) Tcl_GetHashValue(hPtr);
+ }
+ }
+ }
+
+ /*
+ * Loop over all the binding tags, finding the binding script or
+ * callback for each one. Append all of the binding scripts, with
+ * %-sequences expanded, to "scripts", with null characters separating
+ * the scripts for each object. Append all the callbacks to the array
+ * of pending callbacks.
+ */
+
+ pendingPtr = &staticPending;
+ matchCount = 0;
+ matchSpace = sizeof(staticPending.matchArray) / sizeof(PatSeq *);
+ Tcl_DStringInit(&scripts);
+
+ for ( ; numObjects > 0; numObjects--, objectPtr++) {
+ PatSeq *matchPtr, *sourcePtr;
+ Tcl_HashEntry *hPtr;
+
+ matchPtr = NULL;
+ sourcePtr = NULL;
+
+ /*
+ * Match the new event against those recorded in the pattern table,
+ * saving the longest matching pattern. For events with details
+ * (button and key events), look for a binding for the specific
+ * key or button. First see if the event matches a physical event
+ * that the object is interested in, then look for a virtual event.
+ */
+
+ key.object = *objectPtr;
+ key.type = ringPtr->type;
+ key.detail = detail;
+ hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
+ if (hPtr != NULL) {
+ matchPtr = MatchPatterns(dispPtr, bindPtr,
+ (PatSeq *) Tcl_GetHashValue(hPtr), matchPtr, NULL,
+ &sourcePtr);
+ }
+
+ if (vMatchDetailList != NULL) {
+ matchPtr = MatchPatterns(dispPtr, bindPtr, vMatchDetailList,
+ matchPtr, objectPtr, &sourcePtr);
+ }
+
+ /*
+ * If no match was found, look for a binding for all keys or buttons
+ * (detail of 0). Again, first match on a virtual event.
+ */
+
+ if ((detail.clientData != 0) && (matchPtr == NULL)) {
+ key.detail.clientData = 0;
+ hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
+ if (hPtr != NULL) {
+ matchPtr = MatchPatterns(dispPtr, bindPtr,
+ (PatSeq *) Tcl_GetHashValue(hPtr), matchPtr, NULL,
+ &sourcePtr);
+ }
+
+ if (vMatchNoDetailList != NULL) {
+ matchPtr = MatchPatterns(dispPtr, bindPtr, vMatchNoDetailList,
+ matchPtr, objectPtr, &sourcePtr);
+ }
+
+ }
+
+ if (matchPtr != NULL) {
+ if (sourcePtr->eventProc == NULL) {
+ panic("Tk_BindEvent: missing command");
+ }
+ if (sourcePtr->eventProc == EvalTclBinding) {
+ ExpandPercents(winPtr, (char *) sourcePtr->clientData,
+ eventPtr, detail.keySym, &scripts);
+ } else {
+ if (matchCount >= matchSpace) {
+ PendingBinding *new;
+ unsigned int oldSize, newSize;
+
+ oldSize = sizeof(staticPending)
+ - sizeof(staticPending.matchArray)
+ + matchSpace * sizeof(PatSeq*);
+ matchSpace *= 2;
+ newSize = sizeof(staticPending)
+ - sizeof(staticPending.matchArray)
+ + matchSpace * sizeof(PatSeq*);
+ new = (PendingBinding *) ckalloc(newSize);
+ memcpy((VOID *) new, (VOID *) pendingPtr, oldSize);
+ if (pendingPtr != &staticPending) {
+ ckfree((char *) pendingPtr);
+ }
+ pendingPtr = new;
+ }
+ sourcePtr->refCount++;
+ pendingPtr->matchArray[matchCount] = sourcePtr;
+ matchCount++;
+ }
+ /*
+ * A "" is added to the scripts string to separate the
+ * various scripts that should be invoked.
+ */
+
+ Tcl_DStringAppend(&scripts, "", 1);
+ }
+ }
+ if (Tcl_DStringLength(&scripts) == 0) {
+ return;
+ }
+
+ /*
+ * Now go back through and evaluate the binding for each object,
+ * in order, dealing with "break" and "continue" exceptions
+ * appropriately.
+ *
+ * There are two tricks here:
+ * 1. Bindings can be invoked from in the middle of Tcl commands,
+ * where interp->result is significant (for example, a widget
+ * might be deleted because of an error in creating it, so the
+ * result contains an error message that is eventually going to
+ * be returned by the creating command). To preserve the result,
+ * we save it in a dynamic string.
+ * 2. The binding's action can potentially delete the binding,
+ * so bindPtr may not point to anything valid once the action
+ * completes. Thus we have to save bindPtr->interp in a
+ * local variable in order to restore the result.
+ */
+
+ interp = bindPtr->interp;
+ Tcl_DStringInit(&savedResult);
+
+ /*
+ * Save information about the current screen, then invoke a script
+ * if the screen has changed.
+ */
+
+ Tcl_DStringGetResult(interp, &savedResult);
+ screenPtr = &bindInfoPtr->screenInfo;
+ oldDispPtr = screenPtr->curDispPtr;
+ oldScreen = screenPtr->curScreenIndex;
+ if ((dispPtr != screenPtr->curDispPtr)
+ || (Tk_ScreenNumber(tkwin) != screenPtr->curScreenIndex)) {
+ screenPtr->curDispPtr = dispPtr;
+ screenPtr->curScreenIndex = Tk_ScreenNumber(tkwin);
+ ChangeScreen(interp, dispPtr->name, screenPtr->curScreenIndex);
+ }
+
+ if (matchCount > 0) {
+ pendingPtr->nextPtr = bindInfoPtr->pendingList;
+ pendingPtr->tkwin = tkwin;
+ pendingPtr->deleted = 0;
+ bindInfoPtr->pendingList = pendingPtr;
+ }
+
+ /*
+ * Save the current value of the TK_DEFER_MODAL flag so we can
+ * restore it at the end of the loop. Clear the flag so we can
+ * detect any recursive requests for a modal loop.
+ */
+
+ flags = winPtr->flags;
+ winPtr->flags &= ~TK_DEFER_MODAL;
+
+ p = Tcl_DStringValue(&scripts);
+ end = p + Tcl_DStringLength(&scripts);
+ i = 0;
+
+ while (p < end) {
+ int code;
+
+ screenPtr->bindingDepth++;
+ Tcl_AllowExceptions(interp);
+
+ if (*p == '\0') {
+ PatSeq *psPtr;
+
+ psPtr = pendingPtr->matchArray[i];
+ i++;
+ code = TCL_OK;
+ if ((pendingPtr->deleted == 0)
+ && ((psPtr->flags & MARKED_DELETED) == 0)) {
+ code = (*psPtr->eventProc)(psPtr->clientData, interp, eventPtr,
+ tkwin, detail.keySym);
+ }
+ psPtr->refCount--;
+ if ((psPtr->refCount == 0) && (psPtr->flags & MARKED_DELETED)) {
+ if (psPtr->freeProc != NULL) {
+ (*psPtr->freeProc)(psPtr->clientData);
+ }
+ ckfree((char *) psPtr);
+ }
+ } else {
+ code = Tcl_GlobalEval(interp, p);
+ p += strlen(p);
+ }
+ p++;
+ screenPtr->bindingDepth--;
+ if (code != TCL_OK) {
+ if (code == TCL_CONTINUE) {
+ /*
+ * Do nothing: just go on to the next command.
+ */
+ } else if (code == TCL_BREAK) {
+ break;
+ } else {
+ Tcl_AddErrorInfo(interp, "\n (command bound to event)");
+ Tcl_BackgroundError(interp);
+ break;
+ }
+ }
+ }
+
+ if (matchCount > 0 && !pendingPtr->deleted) {
+ /*
+ * Restore the original modal flag value and invoke the modal loop
+ * if needed.
+ */
+
+ deferModal = winPtr->flags & TK_DEFER_MODAL;
+ winPtr->flags = (winPtr->flags & (unsigned int) ~TK_DEFER_MODAL)
+ | (flags & TK_DEFER_MODAL);
+ if (deferModal) {
+ (*winPtr->classProcsPtr->modalProc)(tkwin, eventPtr);
+ }
+ }
+
+ if ((screenPtr->bindingDepth != 0) &&
+ ((oldDispPtr != screenPtr->curDispPtr)
+ || (oldScreen != screenPtr->curScreenIndex))) {
+
+ /*
+ * Some other binding script is currently executing, but its
+ * screen is no longer current. Change the current display
+ * back again.
+ */
+
+ screenPtr->curDispPtr = oldDispPtr;
+ screenPtr->curScreenIndex = oldScreen;
+ ChangeScreen(interp, oldDispPtr->name, oldScreen);
+ }
+ Tcl_DStringResult(interp, &savedResult);
+ Tcl_DStringFree(&scripts);
+
+ if (matchCount > 0) {
+ PendingBinding **curPtrPtr;
+
+ for (curPtrPtr = &bindInfoPtr->pendingList; ; ) {
+ if (*curPtrPtr == pendingPtr) {
+ *curPtrPtr = pendingPtr->nextPtr;
+ break;
+ }
+ curPtrPtr = &(*curPtrPtr)->nextPtr;
+ }
+ if (pendingPtr != &staticPending) {
+ ckfree((char *) pendingPtr);
+ }
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkBindDeadWindow --
+ *
+ * This procedure is invoked when it is determined that a window is
+ * dead. It cleans up bind-related information about the window
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Any pending C bindings for this window are cancelled.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkBindDeadWindow(winPtr)
+ TkWindow *winPtr; /* The window that is being deleted. */
+{
+ BindInfo *bindInfoPtr;
+ PendingBinding *curPtr;
+
+ bindInfoPtr = (BindInfo *) winPtr->mainPtr->bindInfo;
+ curPtr = bindInfoPtr->pendingList;
+ while (curPtr != NULL) {
+ if (curPtr->tkwin == (Tk_Window) winPtr) {
+ curPtr->deleted = 1;
+ }
+ curPtr = curPtr->nextPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MatchPatterns --
+ *
+ * Given a list of pattern sequences and a list of recent events,
+ * return the pattern sequence that best matches the event list,
+ * if there is one.
+ *
+ * This procedure is used in two different ways. In the simplest
+ * use, "object" is NULL and psPtr is a list of pattern sequences,
+ * each of which corresponds to a binding. In this case, the
+ * procedure finds the pattern sequences that match the event list
+ * and returns the most specific of those, if there is more than one.
+ *
+ * In the second case, psPtr is a list of pattern sequences, each
+ * of which corresponds to a definition for a virtual binding.
+ * In order for one of these sequences to "match", it must match
+ * the events (as above) but in addition there must be a binding
+ * for its associated virtual event on the current object. The
+ * "object" argument indicates which object the binding must be for.
+ *
+ * Results:
+ * The return value is NULL if bestPtr is NULL and no pattern matches
+ * the recent events from bindPtr. Otherwise the return value is
+ * the most specific pattern sequence among bestPtr and all those
+ * at psPtr that match the event list and object. If a pattern
+ * sequence other than bestPtr is returned, then *bestCommandPtr
+ * is filled in with a pointer to the command from the best sequence.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static PatSeq *
+MatchPatterns(dispPtr, bindPtr, psPtr, bestPtr, objectPtr, sourcePtrPtr)
+ TkDisplay *dispPtr; /* Display from which the event came. */
+ BindingTable *bindPtr; /* Information about binding table, such as
+ * ring of recent events. */
+ PatSeq *psPtr; /* List of pattern sequences. */
+ PatSeq *bestPtr; /* The best match seen so far, from a
+ * previous call to this procedure. NULL
+ * means no prior best match. */
+ ClientData *objectPtr; /* If NULL, the sequences at psPtr
+ * correspond to "normal" bindings. If
+ * non-NULL, the sequences at psPtr correspond
+ * to virtual bindings; in order to match each
+ * sequence must correspond to a virtual
+ * binding for which a binding exists for
+ * object in bindPtr. */
+ PatSeq **sourcePtrPtr; /* Filled with the pattern sequence that
+ * contains the eventProc and clientData
+ * associated with the best match. If this
+ * differs from the return value, it is the
+ * virtual event that most closely matched the
+ * return value (a physical event). Not
+ * modified unless a result other than bestPtr
+ * is returned. */
+{
+ PatSeq *matchPtr, *bestSourcePtr, *sourcePtr;
+
+ bestSourcePtr = *sourcePtrPtr;
+
+ /*
+ * Iterate over all the pattern sequences.
+ */
+
+ for ( ; psPtr != NULL; psPtr = psPtr->nextSeqPtr) {
+ XEvent *eventPtr;
+ Pattern *patPtr;
+ Window window;
+ Detail *detailPtr;
+ int patCount, ringCount, flags, state;
+ int modMask;
+
+ /*
+ * Iterate over all the patterns in a sequence to be
+ * sure that they all match.
+ */
+
+ eventPtr = &bindPtr->eventRing[bindPtr->curEvent];
+ detailPtr = &bindPtr->detailRing[bindPtr->curEvent];
+ window = eventPtr->xany.window;
+ patPtr = psPtr->pats;
+ patCount = psPtr->numPats;
+ ringCount = EVENT_BUFFER_SIZE;
+ while (patCount > 0) {
+ if (ringCount <= 0) {
+ goto nextSequence;
+ }
+ if (eventPtr->xany.type != patPtr->eventType) {
+ /*
+ * Most of the event types are considered superfluous
+ * in that they are ignored if they occur in the middle
+ * of a pattern sequence and have mismatching types. The
+ * only ones that cannot be ignored are ButtonPress and
+ * ButtonRelease events (if the next event in the pattern
+ * is a KeyPress or KeyRelease) and KeyPress and KeyRelease
+ * events (if the next pattern event is a ButtonPress or
+ * ButtonRelease). Here are some tricky cases to consider:
+ * 1. Double-Button or Double-Key events.
+ * 2. Double-ButtonRelease or Double-KeyRelease events.
+ * 3. The arrival of various events like Enter and Leave
+ * and FocusIn and GraphicsExpose between two button
+ * presses or key presses.
+ * 4. Modifier keys like Shift and Control shouldn't
+ * generate conflicts with button events.
+ */
+
+ if ((patPtr->eventType == KeyPress)
+ || (patPtr->eventType == KeyRelease)) {
+ if ((eventPtr->xany.type == ButtonPress)
+ || (eventPtr->xany.type == ButtonRelease)) {
+ goto nextSequence;
+ }
+ } else if ((patPtr->eventType == ButtonPress)
+ || (patPtr->eventType == ButtonRelease)) {
+ if ((eventPtr->xany.type == KeyPress)
+ || (eventPtr->xany.type == KeyRelease)) {
+ int i;
+
+ /*
+ * Ignore key events if they are modifier keys.
+ */
+
+ for (i = 0; i < dispPtr->numModKeyCodes; i++) {
+ if (dispPtr->modKeyCodes[i]
+ == eventPtr->xkey.keycode) {
+ /*
+ * This key is a modifier key, so ignore it.
+ */
+ goto nextEvent;
+ }
+ }
+ goto nextSequence;
+ }
+ }
+ goto nextEvent;
+ }
+ if (eventPtr->xany.window != window) {
+ goto nextSequence;
+ }
+
+ /*
+ * Note: it's important for the keysym check to go before
+ * the modifier check, so we can ignore unwanted modifier
+ * keys before choking on the modifier check.
+ */
+
+ if ((patPtr->detail.clientData != 0)
+ && (patPtr->detail.clientData != detailPtr->clientData)) {
+ /*
+ * The detail appears not to match. However, if the event
+ * is a KeyPress for a modifier key then just ignore the
+ * event. Otherwise event sequences like "aD" never match
+ * because the shift key goes down between the "a" and the
+ * "D".
+ */
+
+ if (eventPtr->xany.type == KeyPress) {
+ int i;
+
+ for (i = 0; i < dispPtr->numModKeyCodes; i++) {
+ if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) {
+ goto nextEvent;
+ }
+ }
+ }
+ goto nextSequence;
+ }
+ flags = flagArray[eventPtr->type];
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+ state = eventPtr->xkey.state;
+ } else if (flags & CROSSING) {
+ state = eventPtr->xcrossing.state;
+ } else {
+ state = 0;
+ }
+ if (patPtr->needMods != 0) {
+ modMask = patPtr->needMods;
+ if ((modMask & META_MASK) && (dispPtr->metaModMask != 0)) {
+ modMask = (modMask & ~META_MASK) | dispPtr->metaModMask;
+ }
+ if ((modMask & ALT_MASK) && (dispPtr->altModMask != 0)) {
+ modMask = (modMask & ~ALT_MASK) | dispPtr->altModMask;
+ }
+ if ((state & modMask) != modMask) {
+ goto nextSequence;
+ }
+ }
+ if (psPtr->flags & PAT_NEARBY) {
+ XEvent *firstPtr;
+ int timeDiff;
+
+ firstPtr = &bindPtr->eventRing[bindPtr->curEvent];
+ timeDiff = (Time) firstPtr->xkey.time - eventPtr->xkey.time;
+ if ((firstPtr->xkey.x_root
+ < (eventPtr->xkey.x_root - NEARBY_PIXELS))
+ || (firstPtr->xkey.x_root
+ > (eventPtr->xkey.x_root + NEARBY_PIXELS))
+ || (firstPtr->xkey.y_root
+ < (eventPtr->xkey.y_root - NEARBY_PIXELS))
+ || (firstPtr->xkey.y_root
+ > (eventPtr->xkey.y_root + NEARBY_PIXELS))
+ || (timeDiff > NEARBY_MS)) {
+ goto nextSequence;
+ }
+ }
+ patPtr++;
+ patCount--;
+ nextEvent:
+ if (eventPtr == bindPtr->eventRing) {
+ eventPtr = &bindPtr->eventRing[EVENT_BUFFER_SIZE-1];
+ detailPtr = &bindPtr->detailRing[EVENT_BUFFER_SIZE-1];
+ } else {
+ eventPtr--;
+ detailPtr--;
+ }
+ ringCount--;
+ }
+
+ matchPtr = psPtr;
+ sourcePtr = psPtr;
+
+ if (objectPtr != NULL) {
+ int iVirt;
+ VirtualOwners *voPtr;
+ PatternTableKey key;
+
+ /*
+ * The sequence matches the physical constraints.
+ * Is this object interested in any of the virtual events
+ * that correspond to this sequence?
+ */
+
+ voPtr = psPtr->voPtr;
+
+ memset(&key, 0, sizeof(key));
+ key.object = *objectPtr;
+ key.type = VirtualEvent;
+ key.detail.clientData = 0;
+
+ for (iVirt = 0; iVirt < voPtr->numOwners; iVirt++) {
+ Tcl_HashEntry *hPtr = voPtr->owners[iVirt];
+
+ key.detail.name = (Tk_Uid) Tcl_GetHashKey(hPtr->tablePtr,
+ hPtr);
+ hPtr = Tcl_FindHashEntry(&bindPtr->patternTable,
+ (char *) &key);
+ if (hPtr != NULL) {
+
+ /*
+ * This tag is interested in this virtual event and its
+ * corresponding physical event is a good match with the
+ * virtual event's definition.
+ */
+
+ PatSeq *virtMatchPtr;
+
+ virtMatchPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ if ((virtMatchPtr->numPats != 1)
+ || (virtMatchPtr->nextSeqPtr != NULL)) {
+ panic("MatchPattern: badly constructed virtual event");
+ }
+ sourcePtr = virtMatchPtr;
+ goto match;
+ }
+ }
+
+ /*
+ * The physical event matches a virtual event's definition, but
+ * the tag isn't interested in it.
+ */
+ goto nextSequence;
+ }
+ match:
+
+ /*
+ * This sequence matches. If we've already got another match,
+ * pick whichever is most specific. Detail is most important,
+ * then needMods.
+ */
+
+ if (bestPtr != NULL) {
+ Pattern *patPtr2;
+ int i;
+
+ if (matchPtr->numPats != bestPtr->numPats) {
+ if (bestPtr->numPats > matchPtr->numPats) {
+ goto nextSequence;
+ } else {
+ goto newBest;
+ }
+ }
+ for (i = 0, patPtr = matchPtr->pats, patPtr2 = bestPtr->pats;
+ i < matchPtr->numPats; i++, patPtr++, patPtr2++) {
+ if (patPtr->detail.clientData != patPtr2->detail.clientData) {
+ if (patPtr->detail.clientData == 0) {
+ goto nextSequence;
+ } else {
+ goto newBest;
+ }
+ }
+ if (patPtr->needMods != patPtr2->needMods) {
+ if ((patPtr->needMods & patPtr2->needMods)
+ == patPtr->needMods) {
+ goto nextSequence;
+ } else if ((patPtr->needMods & patPtr2->needMods)
+ == patPtr2->needMods) {
+ goto newBest;
+ }
+ }
+ }
+ /*
+ * Tie goes to current best pattern.
+ *
+ * (1) For virtual vs. virtual, the least recently defined
+ * virtual wins, because virtuals are examined in order of
+ * definition. This order is _not_ guaranteed in the
+ * documentation.
+ *
+ * (2) For virtual vs. physical, the physical wins because all
+ * the physicals are examined before the virtuals. This order
+ * is guaranteed in the documentation.
+ *
+ * (3) For physical vs. physical pattern, the most recently
+ * defined physical wins, because physicals are examined in
+ * reverse order of definition. This order is guaranteed in
+ * the documentation.
+ */
+
+ goto nextSequence;
+ }
+ newBest:
+ bestPtr = matchPtr;
+ bestSourcePtr = sourcePtr;
+
+ nextSequence: continue;
+ }
+
+ *sourcePtrPtr = bestSourcePtr;
+ return bestPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ExpandPercents --
+ *
+ * Given a command and an event, produce a new command
+ * by replacing % constructs in the original command
+ * with information from the X event.
+ *
+ * Results:
+ * The new expanded command is appended to the dynamic string
+ * given by dsPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr)
+ TkWindow *winPtr; /* Window where event occurred: needed to
+ * get input context. */
+ char *before; /* Command containing percent expressions
+ * to be replaced. */
+ XEvent *eventPtr; /* X event containing information to be
+ * used in % replacements. */
+ KeySym keySym; /* KeySym: only relevant for KeyPress and
+ * KeyRelease events). */
+ Tcl_DString *dsPtr; /* Dynamic string in which to append new
+ * command. */
+{
+ int spaceNeeded, cvtFlags; /* Used to substitute string as proper Tcl
+ * list element. */
+ int number, flags, length;
+#define NUM_SIZE 40
+ char *string;
+ char numStorage[NUM_SIZE+1];
+
+ if (eventPtr->type < TK_LASTEVENT) {
+ flags = flagArray[eventPtr->type];
+ } else {
+ flags = 0;
+ }
+ while (1) {
+ /*
+ * Find everything up to the next % character and append it
+ * to the result string.
+ */
+
+ for (string = before; (*string != 0) && (*string != '%'); string++) {
+ /* Empty loop body. */
+ }
+ if (string != before) {
+ Tcl_DStringAppend(dsPtr, before, string-before);
+ before = string;
+ }
+ if (*before == 0) {
+ break;
+ }
+
+ /*
+ * There's a percent sequence here. Process it.
+ */
+
+ number = 0;
+ string = "??";
+ switch (before[1]) {
+ case '#':
+ number = eventPtr->xany.serial;
+ goto doNumber;
+ case 'a':
+ TkpPrintWindowId(numStorage, eventPtr->xconfigure.above);
+ string = numStorage;
+ goto doString;
+ case 'b':
+ number = eventPtr->xbutton.button;
+ goto doNumber;
+ case 'c':
+ if (flags & EXPOSE) {
+ number = eventPtr->xexpose.count;
+ }
+ goto doNumber;
+ case 'd':
+ if (flags & (CROSSING|FOCUS)) {
+ if (flags & FOCUS) {
+ number = eventPtr->xfocus.detail;
+ } else {
+ number = eventPtr->xcrossing.detail;
+ }
+ string = TkFindStateString(notifyDetail, number);
+ }
+ goto doString;
+ case 'f':
+ number = eventPtr->xcrossing.focus;
+ goto doNumber;
+ case 'h':
+ if (flags & EXPOSE) {
+ number = eventPtr->xexpose.height;
+ } else if (flags & (CONFIG)) {
+ number = eventPtr->xconfigure.height;
+ }
+ goto doNumber;
+ case 'k':
+ number = eventPtr->xkey.keycode;
+ goto doNumber;
+ case 'm':
+ if (flags & CROSSING) {
+ number = eventPtr->xcrossing.mode;
+ } else if (flags & FOCUS) {
+ number = eventPtr->xfocus.mode;
+ }
+ string = TkFindStateString(notifyMode, number);
+ goto doString;
+ case 'o':
+ if (flags & CREATE) {
+ number = eventPtr->xcreatewindow.override_redirect;
+ } else if (flags & MAP) {
+ number = eventPtr->xmap.override_redirect;
+ } else if (flags & REPARENT) {
+ number = eventPtr->xreparent.override_redirect;
+ } else if (flags & CONFIG) {
+ number = eventPtr->xconfigure.override_redirect;
+ }
+ goto doNumber;
+ case 'p':
+ string = TkFindStateString(circPlace, eventPtr->xcirculate.place);
+ goto doString;
+ case 's':
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+ number = eventPtr->xkey.state;
+ } else if (flags & CROSSING) {
+ number = eventPtr->xcrossing.state;
+ } else if (flags & VISIBILITY) {
+ string = TkFindStateString(visNotify,
+ eventPtr->xvisibility.state);
+ goto doString;
+ }
+ goto doNumber;
+ case 't':
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+ number = (int) eventPtr->xkey.time;
+ } else if (flags & CROSSING) {
+ number = (int) eventPtr->xcrossing.time;
+ } else if (flags & PROP) {
+ number = (int) eventPtr->xproperty.time;
+ }
+ goto doNumber;
+ case 'v':
+ number = eventPtr->xconfigurerequest.value_mask;
+ goto doNumber;
+ case 'w':
+ if (flags & EXPOSE) {
+ number = eventPtr->xexpose.width;
+ } else if (flags & CONFIG) {
+ number = eventPtr->xconfigure.width;
+ }
+ goto doNumber;
+ case 'x':
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+ number = eventPtr->xkey.x;
+ } else if (flags & CROSSING) {
+ number = eventPtr->xcrossing.x;
+ } else if (flags & EXPOSE) {
+ number = eventPtr->xexpose.x;
+ } else if (flags & (CREATE|CONFIG|GRAVITY)) {
+ number = eventPtr->xcreatewindow.x;
+ } else if (flags & REPARENT) {
+ number = eventPtr->xreparent.x;
+ }
+ goto doNumber;
+ case 'y':
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+ number = eventPtr->xkey.y;
+ } else if (flags & EXPOSE) {
+ number = eventPtr->xexpose.y;
+ } else if (flags & (CREATE|CONFIG|GRAVITY)) {
+ number = eventPtr->xcreatewindow.y;
+ } else if (flags & REPARENT) {
+ number = eventPtr->xreparent.y;
+ } else if (flags & CROSSING) {
+ number = eventPtr->xcrossing.y;
+
+ }
+ goto doNumber;
+ case 'A':
+ if (flags & KEY) {
+ int numChars;
+
+ /*
+ * If we're using input methods and this is a keypress
+ * event, invoke XmbTkFindStateString. Otherwise just use
+ * the older XTkFindStateString.
+ */
+
+#ifdef TK_USE_INPUT_METHODS
+ Status status;
+ if ((winPtr->inputContext != NULL)
+ && (eventPtr->type == KeyPress)) {
+ numChars = XmbLookupString(winPtr->inputContext,
+ &eventPtr->xkey, numStorage, NUM_SIZE,
+ (KeySym *) NULL, &status);
+ if ((status != XLookupChars)
+ && (status != XLookupBoth)) {
+ numChars = 0;
+ }
+ } else {
+ numChars = XLookupString(&eventPtr->xkey, numStorage,
+ NUM_SIZE, (KeySym *) NULL,
+ (XComposeStatus *) NULL);
+ }
+#else /* TK_USE_INPUT_METHODS */
+ numChars = XLookupString(&eventPtr->xkey, numStorage,
+ NUM_SIZE, (KeySym *) NULL,
+ (XComposeStatus *) NULL);
+#endif /* TK_USE_INPUT_METHODS */
+ numStorage[numChars] = '\0';
+ string = numStorage;
+ }
+ goto doString;
+ case 'B':
+ number = eventPtr->xcreatewindow.border_width;
+ goto doNumber;
+ case 'E':
+ number = (int) eventPtr->xany.send_event;
+ goto doNumber;
+ case 'K':
+ if (flags & KEY) {
+ char *name;
+
+ name = TkKeysymToString(keySym);
+ if (name != NULL) {
+ string = name;
+ }
+ }
+ goto doString;
+ case 'N':
+ number = (int) keySym;
+ goto doNumber;
+ case 'R':
+ TkpPrintWindowId(numStorage, eventPtr->xkey.root);
+ string = numStorage;
+ goto doString;
+ case 'S':
+ TkpPrintWindowId(numStorage, eventPtr->xkey.subwindow);
+ string = numStorage;
+ goto doString;
+ case 'T':
+ number = eventPtr->type;
+ goto doNumber;
+ case 'W': {
+ Tk_Window tkwin;
+
+ tkwin = Tk_IdToWindow(eventPtr->xany.display,
+ eventPtr->xany.window);
+ if (tkwin != NULL) {
+ string = Tk_PathName(tkwin);
+ } else {
+ string = "??";
+ }
+ goto doString;
+ }
+ case 'X': {
+ Tk_Window tkwin;
+ int x, y;
+ int width, height;
+
+ number = eventPtr->xkey.x_root;
+ tkwin = Tk_IdToWindow(eventPtr->xany.display,
+ eventPtr->xany.window);
+ if (tkwin != NULL) {
+ Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+ number -= x;
+ }
+ goto doNumber;
+ }
+ case 'Y': {
+ Tk_Window tkwin;
+ int x, y;
+ int width, height;
+
+ number = eventPtr->xkey.y_root;
+ tkwin = Tk_IdToWindow(eventPtr->xany.display,
+ eventPtr->xany.window);
+ if (tkwin != NULL) {
+ Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+ number -= y;
+ }
+ goto doNumber;
+ }
+ default:
+ numStorage[0] = before[1];
+ numStorage[1] = '\0';
+ string = numStorage;
+ goto doString;
+ }
+
+ doNumber:
+ sprintf(numStorage, "%d", number);
+ string = numStorage;
+
+ doString:
+ spaceNeeded = Tcl_ScanElement(string, &cvtFlags);
+ length = Tcl_DStringLength(dsPtr);
+ Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
+ spaceNeeded = Tcl_ConvertElement(string,
+ Tcl_DStringValue(dsPtr) + length,
+ cvtFlags | TCL_DONT_USE_BRACES);
+ Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
+ before += 2;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChangeScreen --
+ *
+ * This procedure is invoked whenever the current screen changes
+ * in an application. It invokes a Tcl procedure named
+ * "tkScreenChanged", passing it the screen name as argument.
+ * tkScreenChanged does things like making the tkPriv variable
+ * point to an array for the current display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on what tkScreenChanged does. If an error occurs
+ * them tkError will be invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ChangeScreen(interp, dispName, screenIndex)
+ Tcl_Interp *interp; /* Interpreter in which to invoke
+ * command. */
+ char *dispName; /* Name of new display. */
+ int screenIndex; /* Index of new screen. */
+{
+ Tcl_DString cmd;
+ int code;
+ char screen[30];
+
+ Tcl_DStringInit(&cmd);
+ Tcl_DStringAppend(&cmd, "tkScreenChanged ", 16);
+ Tcl_DStringAppend(&cmd, dispName, -1);
+ sprintf(screen, ".%d", screenIndex);
+ Tcl_DStringAppend(&cmd, screen, -1);
+ code = Tcl_GlobalEval(interp, Tcl_DStringValue(&cmd));
+ if (code != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (changing screen in event binding)");
+ Tcl_BackgroundError(interp);
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_EventCmd --
+ *
+ * This procedure is invoked to process the "event" Tcl command.
+ * It is used to define and generate events.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_EventCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ int i;
+ size_t length;
+ char *option;
+ Tk_Window tkwin;
+ VirtualEventTable *vetPtr;
+ TkBindInfo bindInfo;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " option ?arg1?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ option = argv[1];
+ length = strlen(option);
+ if (length == 0) {
+ goto badopt;
+ }
+
+ tkwin = (Tk_Window) clientData;
+ bindInfo = ((TkWindow *) tkwin)->mainPtr->bindInfo;
+ vetPtr = &((BindInfo *) bindInfo)->virtualEventTable;
+
+ if (strncmp(option, "add", length) == 0) {
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " add virtual sequence ?sequence ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (i = 3; i < argc; i++) {
+ if (CreateVirtualEvent(interp, vetPtr, argv[2], argv[i])
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ } else if (strncmp(option, "delete", length) == 0) {
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " delete virtual ?sequence sequence ...?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc == 3) {
+ return DeleteVirtualEvent(interp, vetPtr, argv[2], NULL);
+ }
+ for (i = 3; i < argc; i++) {
+ if (DeleteVirtualEvent(interp, vetPtr, argv[2], argv[i])
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ } else if (strncmp(option, "generate", length) == 0) {
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " generate window event ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return HandleEventGenerate(interp, tkwin, argc - 2, argv + 2);
+ } else if (strncmp(option, "info", length) == 0) {
+ if (argc == 2) {
+ GetAllVirtualEvents(interp, vetPtr);
+ return TCL_OK;
+ } else if (argc == 3) {
+ return GetVirtualEvent(interp, vetPtr, argv[2]);
+ } else {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " info ?virtual?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ badopt:
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": should be add, delete, generate, info", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitVirtualEventTable --
+ *
+ * Given storage for a virtual event table, set up the fields to
+ * prepare a new domain in which virtual events may be defined.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * *vetPtr is now initialized.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitVirtualEventTable(vetPtr)
+ VirtualEventTable *vetPtr; /* Pointer to virtual event table. Memory
+ * is supplied by the caller. */
+{
+ Tcl_InitHashTable(&vetPtr->patternTable,
+ sizeof(PatternTableKey) / sizeof(int));
+ Tcl_InitHashTable(&vetPtr->nameTable, TCL_ONE_WORD_KEYS);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * DeleteVirtualEventTable --
+ *
+ * Delete the contents of a virtual event table. The caller is
+ * responsible for freeing any memory used by the table itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+DeleteVirtualEventTable(vetPtr)
+ VirtualEventTable *vetPtr; /* The virtual event table to delete. */
+{
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ PatSeq *psPtr, *nextPtr;
+
+ hPtr = Tcl_FirstHashEntry(&vetPtr->patternTable, &search);
+ for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ psPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ for ( ; psPtr != NULL; psPtr = nextPtr) {
+ nextPtr = psPtr->nextSeqPtr;
+ ckfree((char *) psPtr->voPtr);
+ ckfree((char *) psPtr);
+ }
+ }
+ Tcl_DeleteHashTable(&vetPtr->patternTable);
+
+ hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search);
+ for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ ckfree((char *) Tcl_GetHashValue(hPtr));
+ }
+ Tcl_DeleteHashTable(&vetPtr->nameTable);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateVirtualEvent --
+ *
+ * Add a new definition for a virtual event. If the virtual event
+ * is already defined, the new definition augments those that
+ * already exist.
+ *
+ * Results:
+ * The return value is TCL_ERROR if an error occured while
+ * creating the virtual binding. In this case, an error message
+ * will be left in interp->result. If all went well then the return
+ * value is TCL_OK.
+ *
+ * Side effects:
+ * The virtual event may cause future calls to Tk_BindEvent to
+ * behave differently than they did previously.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CreateVirtualEvent(interp, vetPtr, virtString, eventString)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ VirtualEventTable *vetPtr;/* Table in which to augment virtual event. */
+ char *virtString; /* Name of new virtual event. */
+ char *eventString; /* String describing physical event that
+ * triggers virtual event. */
+{
+ PatSeq *psPtr;
+ int dummy;
+ Tcl_HashEntry *vhPtr;
+ unsigned long eventMask;
+ PhysicalsOwned *poPtr;
+ VirtualOwners *voPtr;
+ Tk_Uid virtUid;
+
+ virtUid = GetVirtualEventUid(interp, virtString);
+ if (virtUid == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Find/create physical event
+ */
+
+ psPtr = FindSequence(interp, &vetPtr->patternTable, NULL, eventString,
+ 1, 0, &eventMask);
+ if (psPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Find/create virtual event.
+ */
+
+ vhPtr = Tcl_CreateHashEntry(&vetPtr->nameTable, virtUid, &dummy);
+
+ /*
+ * Make virtual event own the physical event.
+ */
+
+ poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr);
+ if (poPtr == NULL) {
+ poPtr = (PhysicalsOwned *) ckalloc(sizeof(PhysicalsOwned));
+ poPtr->numOwned = 0;
+ } else {
+ /*
+ * See if this virtual event is already defined for this physical
+ * event and just return if it is.
+ */
+
+ int i;
+ for (i = 0; i < poPtr->numOwned; i++) {
+ if (poPtr->patSeqs[i] == psPtr) {
+ return TCL_OK;
+ }
+ }
+ poPtr = (PhysicalsOwned *) ckrealloc((char *) poPtr,
+ sizeof(PhysicalsOwned) + poPtr->numOwned * sizeof(PatSeq *));
+ }
+ Tcl_SetHashValue(vhPtr, (ClientData) poPtr);
+ poPtr->patSeqs[poPtr->numOwned] = psPtr;
+ poPtr->numOwned++;
+
+ /*
+ * Make physical event so it can trigger the virtual event.
+ */
+
+ voPtr = psPtr->voPtr;
+ if (voPtr == NULL) {
+ voPtr = (VirtualOwners *) ckalloc(sizeof(VirtualOwners));
+ voPtr->numOwners = 0;
+ } else {
+ voPtr = (VirtualOwners *) ckrealloc((char *) voPtr,
+ sizeof(VirtualOwners)
+ + voPtr->numOwners * sizeof(Tcl_HashEntry *));
+ }
+ psPtr->voPtr = voPtr;
+ voPtr->owners[voPtr->numOwners] = vhPtr;
+ voPtr->numOwners++;
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteVirtualEvent --
+ *
+ * Remove the definition of a given virtual event. If the
+ * event string is NULL, all definitions of the virtual event
+ * will be removed. Otherwise, just the specified definition
+ * of the virtual event will be removed.
+ *
+ * Results:
+ * The result is a standard Tcl return value. If an error
+ * occurs then interp->result will contain an error message.
+ * It is not an error to attempt to delete a virtual event that
+ * does not exist or a definition that does not exist.
+ *
+ * Side effects:
+ * The virtual event given by virtString may be removed from the
+ * virtual event table.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+DeleteVirtualEvent(interp, vetPtr, virtString, eventString)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ VirtualEventTable *vetPtr;/* Table in which to delete event. */
+ char *virtString; /* String describing event sequence that
+ * triggers binding. */
+ char *eventString; /* The event sequence that should be deleted,
+ * or NULL to delete all event sequences for
+ * the entire virtual event. */
+{
+ int iPhys;
+ Tk_Uid virtUid;
+ Tcl_HashEntry *vhPtr;
+ PhysicalsOwned *poPtr;
+ PatSeq *eventPSPtr;
+
+ virtUid = GetVirtualEventUid(interp, virtString);
+ if (virtUid == NULL) {
+ return TCL_ERROR;
+ }
+
+ vhPtr = Tcl_FindHashEntry(&vetPtr->nameTable, virtUid);
+ if (vhPtr == NULL) {
+ return TCL_OK;
+ }
+ poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr);
+
+ eventPSPtr = NULL;
+ if (eventString != NULL) {
+ unsigned long eventMask;
+
+ /*
+ * Delete only the specific physical event associated with the
+ * virtual event. If the physical event doesn't already exist, or
+ * the virtual event doesn't own that physical event, return w/o
+ * doing anything.
+ */
+
+ eventPSPtr = FindSequence(interp, &vetPtr->patternTable, NULL,
+ eventString, 0, 0, &eventMask);
+ if (eventPSPtr == NULL) {
+ return (interp->result[0] != '\0') ? TCL_ERROR : TCL_OK;
+ }
+ }
+
+ for (iPhys = poPtr->numOwned; --iPhys >= 0; ) {
+ PatSeq *psPtr = poPtr->patSeqs[iPhys];
+ if ((eventPSPtr == NULL) || (psPtr == eventPSPtr)) {
+ int iVirt;
+ VirtualOwners *voPtr;
+
+ /*
+ * Remove association between this physical event and the given
+ * virtual event that it triggers.
+ */
+
+ voPtr = psPtr->voPtr;
+ for (iVirt = 0; iVirt < voPtr->numOwners; iVirt++) {
+ if (voPtr->owners[iVirt] == vhPtr) {
+ break;
+ }
+ }
+ if (iVirt == voPtr->numOwners) {
+ panic("DeleteVirtualEvent: couldn't find owner");
+ }
+ voPtr->numOwners--;
+ if (voPtr->numOwners == 0) {
+ /*
+ * Removed last reference to this physical event, so
+ * remove it from physical->virtual map.
+ */
+ PatSeq *prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
+ if (prevPtr == psPtr) {
+ if (psPtr->nextSeqPtr == NULL) {
+ Tcl_DeleteHashEntry(psPtr->hPtr);
+ } else {
+ Tcl_SetHashValue(psPtr->hPtr,
+ psPtr->nextSeqPtr);
+ }
+ } else {
+ for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
+ if (prevPtr == NULL) {
+ panic("Tk_DeleteVirtualEvent couldn't find on hash chain");
+ }
+ if (prevPtr->nextSeqPtr == psPtr) {
+ prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
+ break;
+ }
+ }
+ }
+ ckfree((char *) psPtr->voPtr);
+ ckfree((char *) psPtr);
+ } else {
+ /*
+ * This physical event still triggers some other virtual
+ * event(s). Consolidate the list of virtual owners for
+ * this physical event so it no longer triggers the
+ * given virtual event.
+ */
+ voPtr->owners[iVirt] = voPtr->owners[voPtr->numOwners];
+ }
+
+ /*
+ * Now delete the virtual event's reference to the physical
+ * event.
+ */
+
+ poPtr->numOwned--;
+ if (eventPSPtr != NULL && poPtr->numOwned != 0) {
+ /*
+ * Just deleting this one physical event. Consolidate list
+ * of owned physical events and return.
+ */
+
+ poPtr->patSeqs[iPhys] = poPtr->patSeqs[poPtr->numOwned];
+ return TCL_OK;
+ }
+ }
+ }
+
+ if (poPtr->numOwned == 0) {
+ /*
+ * All the physical events for this virtual event were deleted,
+ * either because there was only one associated physical event or
+ * because the caller was deleting the entire virtual event. Now
+ * the virtual event itself should be deleted.
+ */
+
+ ckfree((char *) poPtr);
+ Tcl_DeleteHashEntry(vhPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetVirtualEvent --
+ *
+ * Return the list of physical events that can invoke the
+ * given virtual event.
+ *
+ * Results:
+ * The return value is TCL_OK and interp->result is filled with the
+ * string representation of the physical events associated with the
+ * virtual event; if there are no physical events for the given virtual
+ * event, interp->result is filled with and empty string. If the
+ * virtual event string is improperly formed, then TCL_ERROR is
+ * returned and an error message is left in interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+GetVirtualEvent(interp, vetPtr, virtString)
+ Tcl_Interp *interp; /* Interpreter for reporting. */
+ VirtualEventTable *vetPtr;/* Table in which to look for event. */
+ char *virtString; /* String describing virtual event. */
+{
+ Tcl_HashEntry *vhPtr;
+ Tcl_DString ds;
+ int iPhys;
+ PhysicalsOwned *poPtr;
+ Tk_Uid virtUid;
+
+ virtUid = GetVirtualEventUid(interp, virtString);
+ if (virtUid == NULL) {
+ return TCL_ERROR;
+ }
+
+ vhPtr = Tcl_FindHashEntry(&vetPtr->nameTable, virtUid);
+ if (vhPtr == NULL) {
+ return TCL_OK;
+ }
+
+ Tcl_DStringInit(&ds);
+
+ poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr);
+ for (iPhys = 0; iPhys < poPtr->numOwned; iPhys++) {
+ Tcl_DStringSetLength(&ds, 0);
+ GetPatternString(poPtr->patSeqs[iPhys], &ds);
+ Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
+ }
+ Tcl_DStringFree(&ds);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetAllVirtualEvents --
+ *
+ * Return a list that contains the names of all the virtual
+ * event defined.
+ *
+ * Results:
+ * There is no return value. Interp->result is modified to
+ * hold a Tcl list with one entry for each virtual event in
+ * nameTable.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+GetAllVirtualEvents(interp, vetPtr)
+ Tcl_Interp *interp; /* Interpreter returning result. */
+ VirtualEventTable *vetPtr;/* Table containing events. */
+{
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ Tcl_DString ds;
+
+ Tcl_DStringInit(&ds);
+
+ hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search);
+ for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_DStringSetLength(&ds, 0);
+ Tcl_DStringAppend(&ds, "<<", 2);
+ Tcl_DStringAppend(&ds, Tcl_GetHashKey(hPtr->tablePtr, hPtr), -1);
+ Tcl_DStringAppend(&ds, ">>", 2);
+ Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
+ }
+
+ Tcl_DStringFree(&ds);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * HandleEventGenerate --
+ *
+ * Helper function for the "event generate" command. Generate and
+ * process an XEvent, constructed from information parsed from the
+ * event description string and its optional arguments.
+ *
+ * argv[0] contains name of the target window.
+ * argv[1] contains pattern string for one event (e.g, <Control-v>).
+ * argv[2..argc-1] contains -field/option pairs for specifying
+ * additional detail in the generated event.
+ *
+ * Either virtual or physical events can be generated this way.
+ * The event description string must contain the specification
+ * for only one event.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When constructing the event,
+ * event.xany.serial is filled with the current X serial number.
+ * event.xany.window is filled with the target window.
+ * event.xany.display is filled with the target window's display.
+ * Any other fields in eventPtr which are not specified by the pattern
+ * string or the optional arguments, are set to 0.
+ *
+ * The event may be handled sychronously or asynchronously, depending
+ * on the value specified by the optional "-when" option. The
+ * default setting is synchronous.
+ *
+ *---------------------------------------------------------------------------
+ */
+static int
+HandleEventGenerate(interp, main, argc, argv)
+ Tcl_Interp *interp; /* Interp for error messages and name lookup. */
+ Tk_Window main; /* Main window associated with interp. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Pattern pat;
+ Tk_Window tkwin;
+ char *p;
+ unsigned long eventMask;
+ int count, i, state, flags, synch;
+ Tcl_QueuePosition pos;
+ XEvent event;
+
+ if (argv[0][0] == '.') {
+ tkwin = Tk_NameToWindow(interp, argv[0], main);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ if (TkpScanWindowId(NULL, argv[0], &i) != TCL_OK) {
+ Tcl_AppendResult(interp, "bad window name/identifier \"",
+ argv[0], "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ tkwin = Tk_IdToWindow(Tk_Display(main), (Window) i);
+ if ((tkwin == NULL) || (((TkWindow *) main)->mainPtr
+ != ((TkWindow *) tkwin)->mainPtr)) {
+ Tcl_AppendResult(interp, "window id \"", argv[0],
+ "\" doesn't exist in this application", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ p = argv[1];
+ count = ParseEventDescription(interp, &p, &pat, &eventMask);
+ if (count == 0) {
+ return TCL_ERROR;
+ }
+ if (count != 1) {
+ interp->result = "Double or Triple modifier not allowed";
+ return TCL_ERROR;
+ }
+ if (*p != '\0') {
+ interp->result = "only one event specification allowed";
+ return TCL_ERROR;
+ }
+ if (argc & 1) {
+ Tcl_AppendResult(interp, "value for \"", argv[argc - 1],
+ "\" missing", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ memset((VOID *) &event, 0, sizeof(event));
+ event.xany.type = pat.eventType;
+ event.xany.serial = NextRequest(Tk_Display(tkwin));
+ event.xany.send_event = False;
+ event.xany.window = Tk_WindowId(tkwin);
+ event.xany.display = Tk_Display(tkwin);
+
+ flags = flagArray[event.xany.type];
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+ event.xkey.state = pat.needMods;
+ if (flags & KEY) {
+ /*
+ * When mapping from a keysym to a keycode, need information about
+ * the modifier state that should be used so that when they call
+ * XKeycodeToKeysym taking into account the xkey.state, they will
+ * get back the original keysym.
+ */
+
+ if (pat.detail.keySym == NoSymbol) {
+ event.xkey.keycode = 0;
+ } else {
+ event.xkey.keycode = XKeysymToKeycode(event.xany.display,
+ pat.detail.keySym);
+ }
+ if (event.xkey.keycode != 0) {
+ for (state = 0; state < 4; state++) {
+ if (XKeycodeToKeysym(event.xany.display,
+ event.xkey.keycode, state) == pat.detail.keySym) {
+ if (state & 1) {
+ event.xkey.state |= ShiftMask;
+ }
+ if (state & 2) {
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ event.xkey.state |= dispPtr->modeModMask;
+ }
+ break;
+ }
+ }
+ }
+ } else if (flags & BUTTON) {
+ event.xbutton.button = pat.detail.button;
+ } else if (flags & VIRTUAL) {
+ ((XVirtualEvent *) &event)->name = pat.detail.name;
+ }
+ }
+ if (flags & (CREATE|DESTROY|UNMAP|MAP|REPARENT|CONFIG|GRAVITY|CIRC)) {
+ event.xcreatewindow.window = event.xany.window;
+ }
+
+ /*
+ * Process the remaining arguments to fill in additional fields
+ * of the event.
+ */
+
+ synch = 1;
+ pos = TCL_QUEUE_TAIL;
+ for (i = 2; i < argc; i += 2) {
+ char *field, *value;
+ Tk_Window tkwin2;
+ int number;
+ KeySym keysym;
+
+ field = argv[i];
+ value = argv[i+1];
+
+ if (strcmp(field, "-when") == 0) {
+ if (strcmp(value, "now") == 0) {
+ synch = 1;
+ } else if (strcmp(value, "head") == 0) {
+ pos = TCL_QUEUE_HEAD;
+ synch = 0;
+ } else if (strcmp(value, "mark") == 0) {
+ pos = TCL_QUEUE_MARK;
+ synch = 0;
+ } else if (strcmp(value, "tail") == 0) {
+ pos = TCL_QUEUE_TAIL;
+ synch = 0;
+ } else {
+ Tcl_AppendResult(interp, "bad position \"", value,
+ "\": should be now, head, mark, tail", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if (strcmp(field, "-above") == 0) {
+ if (value[0] == '.') {
+ tkwin2 = Tk_NameToWindow(interp, value, main);
+ if (tkwin2 == NULL) {
+ return TCL_ERROR;
+ }
+ number = Tk_WindowId(tkwin2);
+ } else if (TkpScanWindowId(interp, value, &number)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & CONFIG) {
+ event.xconfigure.above = number;
+ } else {
+ goto badopt;
+ }
+ } else if (strcmp(field, "-borderwidth") == 0) {
+ if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (CREATE|CONFIG)) {
+ event.xcreatewindow.border_width = number;
+ } else {
+ goto badopt;
+ }
+ } else if (strcmp(field, "-button") == 0) {
+ if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & BUTTON) {
+ event.xbutton.button = number;
+ } else {
+ goto badopt;
+ }
+ } else if (strcmp(field, "-count") == 0) {
+ if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & EXPOSE) {
+ event.xexpose.count = number;
+ } else {
+ goto badopt;
+ }
+ } else if (strcmp(field, "-detail") == 0) {
+ number = TkFindStateNum(interp, field, notifyDetail, value);
+ if (number < 0) {
+ return TCL_ERROR;
+ }
+ if (flags & FOCUS) {
+ event.xfocus.detail = number;
+ } else if (flags & CROSSING) {
+ event.xcrossing.detail = number;
+ } else {
+ goto badopt;
+ }
+ } else if (strcmp(field, "-focus") == 0) {
+ if (Tcl_GetBoolean(interp, value, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & CROSSING) {
+ event.xcrossing.focus = number;
+ } else {
+ goto badopt;
+ }
+ } else if (strcmp(field, "-height") == 0) {
+ if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & EXPOSE) {
+ event.xexpose.height = number;
+ } else if (flags & CONFIG) {
+ event.xconfigure.height = number;
+ } else {
+ goto badopt;
+ }
+ } else if (strcmp(field, "-keycode") == 0) {
+ if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & KEY) {
+ event.xkey.keycode = number;
+ } else {
+ goto badopt;
+ }
+ } else if (strcmp(field, "-keysym") == 0) {
+ keysym = TkStringToKeysym(value);
+ if (keysym == NoSymbol) {
+ Tcl_AppendResult(interp, "unknown keysym \"", value,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ /*
+ * When mapping from a keysym to a keycode, need information about
+ * the modifier state that should be used so that when they call
+ * XKeycodeToKeysym taking into account the xkey.state, they will
+ * get back the original keysym.
+ */
+
+ number = XKeysymToKeycode(event.xany.display, keysym);
+ if (number == 0) {
+ Tcl_AppendResult(interp, "no keycode for keysym \"", value,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (state = 0; state < 4; state++) {
+ if (XKeycodeToKeysym(event.xany.display, (unsigned) number,
+ state) == keysym) {
+ if (state & 1) {
+ event.xkey.state |= ShiftMask;
+ }
+ if (state & 2) {
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ event.xkey.state |= dispPtr->modeModMask;
+ }
+ break;
+ }
+ }
+ if (flags & KEY) {
+ event.xkey.keycode = number;
+ } else {
+ goto badopt;
+ }
+ } else if (strcmp(field, "-mode") == 0) {
+ number = TkFindStateNum(interp, field, notifyMode, value);
+ if (number < 0) {
+ return TCL_ERROR;
+ }
+ if (flags & CROSSING) {
+ event.xcrossing.mode = number;
+ } else if (flags & FOCUS) {
+ event.xfocus.mode = number;
+ } else {
+ goto badopt;
+ }
+ } else if (strcmp(field, "-override") == 0) {
+ if (Tcl_GetBoolean(interp, value, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & CREATE) {
+ event.xcreatewindow.override_redirect = number;
+ } else if (flags & MAP) {
+ event.xmap.override_redirect = number;
+ } else if (flags & REPARENT) {
+ event.xreparent.override_redirect = number;
+ } else if (flags & CONFIG) {
+ event.xconfigure.override_redirect = number;
+ } else {
+ goto badopt;
+ }
+ } else if (strcmp(field, "-place") == 0) {
+ number = TkFindStateNum(interp, field, circPlace, value);
+ if (number < 0) {
+ return TCL_ERROR;
+ }
+ if (flags & CIRC) {
+ event.xcirculate.place = number;
+ } else {
+ goto badopt;
+ }
+ } else if (strcmp(field, "-root") == 0) {
+ if (value[0] == '.') {
+ tkwin2 = Tk_NameToWindow(interp, value, main);
+ if (tkwin2 == NULL) {
+ return TCL_ERROR;
+ }
+ number = Tk_WindowId(tkwin2);
+ } else if (TkpScanWindowId(interp, value, &number)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.root = number;
+ } else {
+ goto badopt;
+ }
+ } else if (strcmp(field, "-rootx") == 0) {
+ if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.x_root = number;
+ } else {
+ goto badopt;
+ }
+ } else if (strcmp(field, "-rooty") == 0) {
+ if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.y_root = number;
+ } else {
+ goto badopt;
+ }
+ } else if (strcmp(field, "-sendevent") == 0) {
+ if (isdigit(UCHAR(value[0]))) {
+ /*
+ * Allow arbitrary integer values for the field; they
+ * are needed by a few of the tests in the Tk test suite.
+ */
+
+ if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ if (Tcl_GetBoolean(interp, value, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ event.xany.send_event = number;
+ } else if (strcmp(field, "-serial") == 0) {
+ if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ event.xany.serial = number;
+ } else if (strcmp(field, "-state") == 0) {
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+ event.xkey.state = number;
+ } else {
+ event.xcrossing.state = number;
+ }
+ } else if (flags & VISIBILITY) {
+ number = TkFindStateNum(interp, field, visNotify, value);
+ if (number < 0) {
+ return TCL_ERROR;
+ }
+ event.xvisibility.state = number;
+ } else {
+ goto badopt;
+ }
+ } else if (strcmp(field, "-subwindow") == 0) {
+ if (value[0] == '.') {
+ tkwin2 = Tk_NameToWindow(interp, value, main);
+ if (tkwin2 == NULL) {
+ return TCL_ERROR;
+ }
+ number = Tk_WindowId(tkwin2);
+ } else if (TkpScanWindowId(interp, value, &number)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.subwindow = number;
+ } else {
+ goto badopt;
+ }
+ } else if (strcmp(field, "-time") == 0) {
+ if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.time = (Time) number;
+ } else if (flags & PROP) {
+ event.xproperty.time = (Time) number;
+ } else {
+ goto badopt;
+ }
+ } else if (strcmp(field, "-width") == 0) {
+ if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & EXPOSE) {
+ event.xexpose.width = number;
+ } else if (flags & (CREATE|CONFIG)) {
+ event.xcreatewindow.width = number;
+ } else {
+ goto badopt;
+ }
+ } else if (strcmp(field, "-window") == 0) {
+ if (value[0] == '.') {
+ tkwin2 = Tk_NameToWindow(interp, value, main);
+ if (tkwin2 == NULL) {
+ return TCL_ERROR;
+ }
+ number = Tk_WindowId(tkwin2);
+ } else if (TkpScanWindowId(interp, value, &number)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (CREATE|DESTROY|UNMAP|MAP|REPARENT|CONFIG
+ |GRAVITY|CIRC)) {
+ event.xcreatewindow.window = number;
+ } else {
+ goto badopt;
+ }
+ } else if (strcmp(field, "-x") == 0) {
+ int rootX, rootY;
+ if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tk_GetRootCoords(tkwin, &rootX, &rootY);
+ rootX += number;
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.x = number;
+ event.xkey.x_root = rootX;
+ } else if (flags & EXPOSE) {
+ event.xexpose.x = number;
+ } else if (flags & (CREATE|CONFIG|GRAVITY)) {
+ event.xcreatewindow.x = number;
+ } else if (flags & REPARENT) {
+ event.xreparent.x = number;
+ } else {
+ goto badopt;
+ }
+ } else if (strcmp(field, "-y") == 0) {
+ int rootX, rootY;
+ if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tk_GetRootCoords(tkwin, &rootX, &rootY);
+ rootY += number;
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.y = number;
+ event.xkey.y_root = rootY;
+ } else if (flags & EXPOSE) {
+ event.xexpose.y = number;
+ } else if (flags & (CREATE|CONFIG|GRAVITY)) {
+ event.xcreatewindow.y = number;
+ } else if (flags & REPARENT) {
+ event.xreparent.y = number;
+ } else {
+ goto badopt;
+ }
+ } else {
+ badopt:
+ Tcl_AppendResult(interp, "bad option to ", argv[1],
+ " event: \"", field, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if (synch != 0) {
+ Tk_HandleEvent(&event);
+ } else {
+ Tk_QueueWindowEvent(&event, pos);
+ }
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * GetVirtualEventUid --
+ *
+ * Determine if the given string is in the proper format for a
+ * virtual event.
+ *
+ * Results:
+ * The return value is NULL if the virtual event string was
+ * not in the proper format. In this case, an error message
+ * will be left in interp->result. Otherwise the return
+ * value is a Tk_Uid that represents the virtual event.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+static Tk_Uid
+GetVirtualEventUid(interp, virtString)
+ Tcl_Interp *interp;
+ char *virtString;
+{
+ Tk_Uid uid;
+ int length;
+
+ length = strlen(virtString);
+
+ if (length < 5 || virtString[0] != '<' || virtString[1] != '<' ||
+ virtString[length - 2] != '>' || virtString[length - 1] != '>') {
+ Tcl_AppendResult(interp, "virtual event \"", virtString,
+ "\" is badly formed", (char *) NULL);
+ return NULL;
+ }
+ virtString[length - 2] = '\0';
+ uid = Tk_GetUid(virtString + 2);
+ virtString[length - 2] = '>';
+
+ return uid;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindSequence --
+ *
+ * Find the entry in the pattern table that corresponds to a
+ * particular pattern string, and return a pointer to that
+ * entry.
+ *
+ * Results:
+ * The return value is normally a pointer to the PatSeq
+ * in patternTable that corresponds to eventString. If an error
+ * was found while parsing eventString, or if "create" is 0 and
+ * no pattern sequence previously existed, then NULL is returned
+ * and interp->result contains a message describing the problem.
+ * If no pattern sequence previously existed for eventString, then
+ * a new one is created with a NULL command field. In a successful
+ * return, *maskPtr is filled in with a mask of the event types
+ * on which the pattern sequence depends.
+ *
+ * Side effects:
+ * A new pattern sequence may be allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static PatSeq *
+FindSequence(interp, patternTablePtr, object, eventString, create,
+ allowVirtual, maskPtr)
+ Tcl_Interp *interp; /* Interpreter to use for error
+ * reporting. */
+ Tcl_HashTable *patternTablePtr; /* Table to use for lookup. */
+ ClientData object; /* For binding table, token for object with
+ * which binding is associated.
+ * For virtual event table, NULL. */
+ char *eventString; /* String description of pattern to
+ * match on. See user documentation
+ * for details. */
+ int create; /* 0 means don't create the entry if
+ * it doesn't already exist. Non-zero
+ * means create. */
+ int allowVirtual; /* 0 means that virtual events are not
+ * allowed in the sequence. Non-zero
+ * otherwise. */
+ unsigned long *maskPtr; /* *maskPtr is filled in with the event
+ * types on which this pattern sequence
+ * depends. */
+{
+
+ Pattern pats[EVENT_BUFFER_SIZE];
+ int numPats, virtualFound;
+ char *p;
+ Pattern *patPtr;
+ PatSeq *psPtr;
+ Tcl_HashEntry *hPtr;
+ int flags, count, new;
+ size_t sequenceSize;
+ unsigned long eventMask;
+ PatternTableKey key;
+
+ /*
+ *-------------------------------------------------------------
+ * Step 1: parse the pattern string to produce an array
+ * of Patterns. The array is generated backwards, so
+ * that the lowest-indexed pattern corresponds to the last
+ * event that must occur.
+ *-------------------------------------------------------------
+ */
+
+ p = eventString;
+ flags = 0;
+ eventMask = 0;
+ virtualFound = 0;
+
+ patPtr = &pats[EVENT_BUFFER_SIZE-1];
+ for (numPats = 0; numPats < EVENT_BUFFER_SIZE; numPats++, patPtr--) {
+ while (isspace(UCHAR(*p))) {
+ p++;
+ }
+ if (*p == '\0') {
+ break;
+ }
+
+ count = ParseEventDescription(interp, &p, patPtr, &eventMask);
+ if (count == 0) {
+ return NULL;
+ }
+
+ if (eventMask & VirtualEventMask) {
+ if (allowVirtual == 0) {
+ interp->result =
+ "virtual event not allowed in definition of another virtual event";
+ return NULL;
+ }
+ virtualFound = 1;
+ }
+
+ /*
+ * Replicate events for DOUBLE and TRIPLE.
+ */
+
+ if ((count > 1) && (numPats < EVENT_BUFFER_SIZE-1)) {
+ flags |= PAT_NEARBY;
+ patPtr[-1] = patPtr[0];
+ patPtr--;
+ numPats++;
+ if ((count == 3) && (numPats < EVENT_BUFFER_SIZE-1)) {
+ patPtr[-1] = patPtr[0];
+ patPtr--;
+ numPats++;
+ }
+ }
+ }
+
+ /*
+ *-------------------------------------------------------------
+ * Step 2: find the sequence in the binding table if it exists,
+ * and add a new sequence to the table if it doesn't.
+ *-------------------------------------------------------------
+ */
+
+ if (numPats == 0) {
+ interp->result = "no events specified in binding";
+ return NULL;
+ }
+ if ((numPats > 1) && (virtualFound != 0)) {
+ interp->result = "virtual events may not be composed";
+ return NULL;
+ }
+
+ patPtr = &pats[EVENT_BUFFER_SIZE-numPats];
+ memset(&key, 0, sizeof(key));
+ key.object = object;
+ key.type = patPtr->eventType;
+ key.detail = patPtr->detail;
+ hPtr = Tcl_CreateHashEntry(patternTablePtr, (char *) &key, &new);
+ sequenceSize = numPats*sizeof(Pattern);
+ if (!new) {
+ for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
+ psPtr = psPtr->nextSeqPtr) {
+ if ((numPats == psPtr->numPats)
+ && ((flags & PAT_NEARBY) == (psPtr->flags & PAT_NEARBY))
+ && (memcmp((char *) patPtr, (char *) psPtr->pats,
+ sequenceSize) == 0)) {
+ goto done;
+ }
+ }
+ }
+ if (!create) {
+ if (new) {
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ return NULL;
+ }
+ psPtr = (PatSeq *) ckalloc((unsigned) (sizeof(PatSeq)
+ + (numPats-1)*sizeof(Pattern)));
+ psPtr->numPats = numPats;
+ psPtr->eventProc = NULL;
+ psPtr->freeProc = NULL;
+ psPtr->clientData = NULL;
+ psPtr->flags = flags;
+ psPtr->refCount = 0;
+ psPtr->nextSeqPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ psPtr->hPtr = hPtr;
+ psPtr->voPtr = NULL;
+ psPtr->nextObjPtr = NULL;
+ Tcl_SetHashValue(hPtr, psPtr);
+
+ memcpy((VOID *) psPtr->pats, (VOID *) patPtr, sequenceSize);
+
+ done:
+ *maskPtr = eventMask;
+ return psPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ParseEventDescription --
+ *
+ * Fill Pattern buffer with information about event from
+ * event string.
+ *
+ * Results:
+ * Leaves error message in interp and returns 0 if there was an
+ * error due to a badly formed event string. Returns 1 if proper
+ * event was specified, 2 if Double modifier was used in event
+ * string, or 3 if Triple was used.
+ *
+ * Side effects:
+ * On exit, eventStringPtr points to rest of event string (after the
+ * closing '>', so that this procedure can be called repeatedly to
+ * parse all the events in the entire sequence.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+ParseEventDescription(interp, eventStringPtr, patPtr,
+ eventMaskPtr)
+ Tcl_Interp *interp; /* For error messages. */
+ char **eventStringPtr; /* On input, holds a pointer to start of
+ * event string. On exit, gets pointer to
+ * rest of string after parsed event. */
+ Pattern *patPtr; /* Filled with the pattern parsed from the
+ * event string. */
+ unsigned long *eventMaskPtr;/* Filled with event mask of matched event. */
+
+{
+ char *p;
+ unsigned long eventMask;
+ int count, eventFlags;
+#define FIELD_SIZE 48
+ char field[FIELD_SIZE];
+ Tcl_HashEntry *hPtr;
+
+ p = *eventStringPtr;
+
+ patPtr->eventType = -1;
+ patPtr->needMods = 0;
+ patPtr->detail.clientData = 0;
+
+ eventMask = 0;
+ count = 1;
+
+ /*
+ * Handle simple ASCII characters.
+ */
+
+ if (*p != '<') {
+ char string[2];
+
+ patPtr->eventType = KeyPress;
+ eventMask = KeyPressMask;
+ string[0] = *p;
+ string[1] = 0;
+ patPtr->detail.keySym = TkStringToKeysym(string);
+ if (patPtr->detail.keySym == NoSymbol) {
+ if (isprint(UCHAR(*p))) {
+ patPtr->detail.keySym = *p;
+ } else {
+ sprintf(interp->result,
+ "bad ASCII character 0x%x", (unsigned char) *p);
+ return 0;
+ }
+ }
+ p++;
+ goto end;
+ }
+
+ /*
+ * A fancier event description. This can be either a virtual event
+ * or a physical event.
+ *
+ * A virtual event description consists of:
+ *
+ * 1. double open angle brackets.
+ * 2. virtual event name.
+ * 3. double close angle brackets.
+ *
+ * A physical event description consists of:
+ *
+ * 1. open angle bracket.
+ * 2. any number of modifiers, each followed by spaces
+ * or dashes.
+ * 3. an optional event name.
+ * 4. an option button or keysym name. Either this or
+ * item 3 *must* be present; if both are present
+ * then they are separated by spaces or dashes.
+ * 5. a close angle bracket.
+ */
+
+ p++;
+ if (*p == '<') {
+ /*
+ * This is a virtual event: soak up all the characters up to
+ * the next '>'.
+ */
+
+ char *field = p + 1;
+ p = strchr(field, '>');
+ if (p == field) {
+ interp->result = "virtual event \"<<>>\" is badly formed";
+ return 0;
+ }
+ if ((p == NULL) || (p[1] != '>')) {
+ interp->result = "missing \">\" in virtual binding";
+ return 0;
+ }
+ *p = '\0';
+ patPtr->eventType = VirtualEvent;
+ eventMask = VirtualEventMask;
+ patPtr->detail.name = Tk_GetUid(field);
+ *p = '>';
+
+ p += 2;
+ goto end;
+ }
+
+ while (1) {
+ ModInfo *modPtr;
+ p = GetField(p, field, FIELD_SIZE);
+ if (*p == '>') {
+ /*
+ * This solves the problem of, e.g., <Control-M> being
+ * misinterpreted as Control + Meta + missing keysym
+ * instead of Control + KeyPress + M.
+ */
+ break;
+ }
+ hPtr = Tcl_FindHashEntry(&modTable, field);
+ if (hPtr == NULL) {
+ break;
+ }
+ modPtr = (ModInfo *) Tcl_GetHashValue(hPtr);
+ patPtr->needMods |= modPtr->mask;
+ if (modPtr->flags & (DOUBLE|TRIPLE)) {
+ if (modPtr->flags & DOUBLE) {
+ count = 2;
+ } else {
+ count = 3;
+ }
+ }
+ while ((*p == '-') || isspace(UCHAR(*p))) {
+ p++;
+ }
+ }
+
+ eventFlags = 0;
+ hPtr = Tcl_FindHashEntry(&eventTable, field);
+ if (hPtr != NULL) {
+ EventInfo *eiPtr;
+ eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr);
+
+ patPtr->eventType = eiPtr->type;
+ eventFlags = flagArray[eiPtr->type];
+ eventMask = eiPtr->eventMask;
+ while ((*p == '-') || isspace(UCHAR(*p))) {
+ p++;
+ }
+ p = GetField(p, field, FIELD_SIZE);
+ }
+ if (*field != '\0') {
+ if ((*field >= '1') && (*field <= '5') && (field[1] == '\0')) {
+ if (eventFlags == 0) {
+ patPtr->eventType = ButtonPress;
+ eventMask = ButtonPressMask;
+ } else if (eventFlags & KEY) {
+ goto getKeysym;
+ } else if ((eventFlags & BUTTON) == 0) {
+ Tcl_AppendResult(interp, "specified button \"", field,
+ "\" for non-button event", (char *) NULL);
+ return 0;
+ }
+ patPtr->detail.button = (*field - '0');
+ } else {
+ getKeysym:
+ patPtr->detail.keySym = TkStringToKeysym(field);
+ if (patPtr->detail.keySym == NoSymbol) {
+ Tcl_AppendResult(interp, "bad event type or keysym \"",
+ field, "\"", (char *) NULL);
+ return 0;
+ }
+ if (eventFlags == 0) {
+ patPtr->eventType = KeyPress;
+ eventMask = KeyPressMask;
+ } else if ((eventFlags & KEY) == 0) {
+ Tcl_AppendResult(interp, "specified keysym \"", field,
+ "\" for non-key event", (char *) NULL);
+ return 0;
+ }
+ }
+ } else if (eventFlags == 0) {
+ interp->result = "no event type or button # or keysym";
+ return 0;
+ }
+
+ while ((*p == '-') || isspace(UCHAR(*p))) {
+ p++;
+ }
+ if (*p != '>') {
+ while (*p != '\0') {
+ p++;
+ if (*p == '>') {
+ interp->result = "extra characters after detail in binding";
+ return 0;
+ }
+ }
+ interp->result = "missing \">\" in binding";
+ return 0;
+ }
+ p++;
+
+end:
+ *eventStringPtr = p;
+ *eventMaskPtr |= eventMask;
+ return count;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetField --
+ *
+ * Used to parse pattern descriptions. Copies up to
+ * size characters from p to copy, stopping at end of
+ * string, space, "-", ">", or whenever size is
+ * exceeded.
+ *
+ * Results:
+ * The return value is a pointer to the character just
+ * after the last one copied (usually "-" or space or
+ * ">", but could be anything if size was exceeded).
+ * Also places NULL-terminated string (up to size
+ * character, including NULL), at copy.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+GetField(p, copy, size)
+ char *p; /* Pointer to part of pattern. */
+ char *copy; /* Place to copy field. */
+ int size; /* Maximum number of characters to
+ * copy. */
+{
+ while ((*p != '\0') && !isspace(UCHAR(*p)) && (*p != '>')
+ && (*p != '-') && (size > 1)) {
+ *copy = *p;
+ p++;
+ copy++;
+ size--;
+ }
+ *copy = '\0';
+ return p;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetPatternString --
+ *
+ * Produce a string version of the given event, for displaying to
+ * the user.
+ *
+ * Results:
+ * The string is left in dsPtr.
+ *
+ * Side effects:
+ * It is the caller's responsibility to initialize the DString before
+ * and to free it after calling this procedure.
+ *
+ *---------------------------------------------------------------------------
+ */
+static void
+GetPatternString(psPtr, dsPtr)
+ PatSeq *psPtr;
+ Tcl_DString *dsPtr;
+{
+ Pattern *patPtr;
+ char c, buffer[10];
+ int patsLeft, needMods;
+ ModInfo *modPtr;
+ EventInfo *eiPtr;
+
+ /*
+ * The order of the patterns in the sequence is backwards from the order
+ * in which they must be output.
+ */
+
+ for (patsLeft = psPtr->numPats, patPtr = &psPtr->pats[psPtr->numPats - 1];
+ patsLeft > 0; patsLeft--, patPtr--) {
+
+ /*
+ * Check for simple case of an ASCII character.
+ */
+
+ if ((patPtr->eventType == KeyPress)
+ && ((psPtr->flags & PAT_NEARBY) == 0)
+ && (patPtr->needMods == 0)
+ && (patPtr->detail.keySym < 128)
+ && isprint(UCHAR(patPtr->detail.keySym))
+ && (patPtr->detail.keySym != '<')
+ && (patPtr->detail.keySym != ' ')) {
+
+ c = (char) patPtr->detail.keySym;
+ Tcl_DStringAppend(dsPtr, &c, 1);
+ continue;
+ }
+
+ /*
+ * Check for virtual event.
+ */
+
+ if (patPtr->eventType == VirtualEvent) {
+ Tcl_DStringAppend(dsPtr, "<<", 2);
+ Tcl_DStringAppend(dsPtr, patPtr->detail.name, -1);
+ Tcl_DStringAppend(dsPtr, ">>", 2);
+ continue;
+ }
+
+ /*
+ * It's a more general event specification. First check
+ * for "Double" or "Triple", then modifiers, then event type,
+ * then keysym or button detail.
+ */
+
+ Tcl_DStringAppend(dsPtr, "<", 1);
+ if ((psPtr->flags & PAT_NEARBY) && (patsLeft > 1)
+ && (memcmp((char *) patPtr, (char *) (patPtr-1),
+ sizeof(Pattern)) == 0)) {
+ patsLeft--;
+ patPtr--;
+ if ((patsLeft > 1) && (memcmp((char *) patPtr,
+ (char *) (patPtr-1), sizeof(Pattern)) == 0)) {
+ patsLeft--;
+ patPtr--;
+ Tcl_DStringAppend(dsPtr, "Triple-", 7);
+ } else {
+ Tcl_DStringAppend(dsPtr, "Double-", 7);
+ }
+ }
+ for (needMods = patPtr->needMods, modPtr = modArray;
+ needMods != 0; modPtr++) {
+ if (modPtr->mask & needMods) {
+ needMods &= ~modPtr->mask;
+ Tcl_DStringAppend(dsPtr, modPtr->name, -1);
+ Tcl_DStringAppend(dsPtr, "-", 1);
+ }
+ }
+ for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
+ if (eiPtr->type == patPtr->eventType) {
+ Tcl_DStringAppend(dsPtr, eiPtr->name, -1);
+ if (patPtr->detail.clientData != 0) {
+ Tcl_DStringAppend(dsPtr, "-", 1);
+ }
+ break;
+ }
+ }
+
+ if (patPtr->detail.clientData != 0) {
+ if ((patPtr->eventType == KeyPress)
+ || (patPtr->eventType == KeyRelease)) {
+ char *string;
+
+ string = TkKeysymToString(patPtr->detail.keySym);
+ if (string != NULL) {
+ Tcl_DStringAppend(dsPtr, string, -1);
+ }
+ } else {
+ sprintf(buffer, "%d", patPtr->detail.button);
+ Tcl_DStringAppend(dsPtr, buffer, -1);
+ }
+ }
+ Tcl_DStringAppend(dsPtr, ">", 1);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetKeySym --
+ *
+ * Given an X KeyPress or KeyRelease event, map the
+ * keycode in the event into a KeySym.
+ *
+ * Results:
+ * The return value is the KeySym corresponding to
+ * eventPtr, or NoSymbol if no matching Keysym could be
+ * found.
+ *
+ * Side effects:
+ * In the first call for a given display, keycode-to-
+ * KeySym maps get loaded.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static KeySym
+GetKeySym(dispPtr, eventPtr)
+ TkDisplay *dispPtr; /* Display in which to
+ * map keycode. */
+ XEvent *eventPtr; /* Description of X event. */
+{
+ KeySym sym;
+ int index;
+
+ /*
+ * Refresh the mapping information if it's stale
+ */
+
+ if (dispPtr->bindInfoStale) {
+ InitKeymapInfo(dispPtr);
+ }
+
+ /*
+ * Figure out which of the four slots in the keymap vector to
+ * use for this key. Refer to Xlib documentation for more info
+ * on how this computation works.
+ */
+
+ index = 0;
+ if (eventPtr->xkey.state & dispPtr->modeModMask) {
+ index = 2;
+ }
+ if ((eventPtr->xkey.state & ShiftMask)
+ || ((dispPtr->lockUsage != LU_IGNORE)
+ && (eventPtr->xkey.state & LockMask))) {
+ index += 1;
+ }
+ sym = XKeycodeToKeysym(dispPtr->display, eventPtr->xkey.keycode, index);
+
+ /*
+ * Special handling: if the key was shifted because of Lock, but
+ * lock is only caps lock, not shift lock, and the shifted keysym
+ * isn't upper-case alphabetic, then switch back to the unshifted
+ * keysym.
+ */
+
+ if ((index & 1) && !(eventPtr->xkey.state & ShiftMask)
+ && (dispPtr->lockUsage == LU_CAPS)) {
+ if (!(((sym >= XK_A) && (sym <= XK_Z))
+ || ((sym >= XK_Agrave) && (sym <= XK_Odiaeresis))
+ || ((sym >= XK_Ooblique) && (sym <= XK_Thorn)))) {
+ index &= ~1;
+ sym = XKeycodeToKeysym(dispPtr->display, eventPtr->xkey.keycode,
+ index);
+ }
+ }
+
+ /*
+ * Another bit of special handling: if this is a shifted key and there
+ * is no keysym defined, then use the keysym for the unshifted key.
+ */
+
+ if ((index & 1) && (sym == NoSymbol)) {
+ sym = XKeycodeToKeysym(dispPtr->display, eventPtr->xkey.keycode,
+ index & ~1);
+ }
+ return sym;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * InitKeymapInfo --
+ *
+ * This procedure is invoked to scan keymap information
+ * to recompute stuff that's important for binding, such
+ * as the modifier key (if any) that corresponds to "mode
+ * switch".
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Keymap-related information in dispPtr is updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+InitKeymapInfo(dispPtr)
+ TkDisplay *dispPtr; /* Display for which to recompute keymap
+ * information. */
+{
+ XModifierKeymap *modMapPtr;
+ KeyCode *codePtr;
+ KeySym keysym;
+ int count, i, j, max, arraySize;
+#define KEYCODE_ARRAY_SIZE 20
+
+ dispPtr->bindInfoStale = 0;
+ modMapPtr = XGetModifierMapping(dispPtr->display);
+
+ /*
+ * Check the keycodes associated with the Lock modifier. If
+ * any of them is associated with the XK_Shift_Lock modifier,
+ * then Lock has to be interpreted as Shift Lock, not Caps Lock.
+ */
+
+ dispPtr->lockUsage = LU_IGNORE;
+ codePtr = modMapPtr->modifiermap + modMapPtr->max_keypermod*LockMapIndex;
+ for (count = modMapPtr->max_keypermod; count > 0; count--, codePtr++) {
+ if (*codePtr == 0) {
+ continue;
+ }
+ keysym = XKeycodeToKeysym(dispPtr->display, *codePtr, 0);
+ if (keysym == XK_Shift_Lock) {
+ dispPtr->lockUsage = LU_SHIFT;
+ break;
+ }
+ if (keysym == XK_Caps_Lock) {
+ dispPtr->lockUsage = LU_CAPS;
+ break;
+ }
+ }
+
+ /*
+ * Look through the keycodes associated with modifiers to see if
+ * the the "mode switch", "meta", or "alt" keysyms are associated
+ * with any modifiers. If so, remember their modifier mask bits.
+ */
+
+ dispPtr->modeModMask = 0;
+ dispPtr->metaModMask = 0;
+ dispPtr->altModMask = 0;
+ codePtr = modMapPtr->modifiermap;
+ max = 8*modMapPtr->max_keypermod;
+ for (i = 0; i < max; i++, codePtr++) {
+ if (*codePtr == 0) {
+ continue;
+ }
+ keysym = XKeycodeToKeysym(dispPtr->display, *codePtr, 0);
+ if (keysym == XK_Mode_switch) {
+ dispPtr->modeModMask |= ShiftMask << (i/modMapPtr->max_keypermod);
+ }
+ if ((keysym == XK_Meta_L) || (keysym == XK_Meta_R)) {
+ dispPtr->metaModMask |= ShiftMask << (i/modMapPtr->max_keypermod);
+ }
+ if ((keysym == XK_Alt_L) || (keysym == XK_Alt_R)) {
+ dispPtr->altModMask |= ShiftMask << (i/modMapPtr->max_keypermod);
+ }
+ }
+
+ /*
+ * Create an array of the keycodes for all modifier keys.
+ */
+
+ if (dispPtr->modKeyCodes != NULL) {
+ ckfree((char *) dispPtr->modKeyCodes);
+ }
+ dispPtr->numModKeyCodes = 0;
+ arraySize = KEYCODE_ARRAY_SIZE;
+ dispPtr->modKeyCodes = (KeyCode *) ckalloc((unsigned)
+ (KEYCODE_ARRAY_SIZE * sizeof(KeyCode)));
+ for (i = 0, codePtr = modMapPtr->modifiermap; i < max; i++, codePtr++) {
+ if (*codePtr == 0) {
+ continue;
+ }
+
+ /*
+ * Make sure that the keycode isn't already in the array.
+ */
+
+ for (j = 0; j < dispPtr->numModKeyCodes; j++) {
+ if (dispPtr->modKeyCodes[j] == *codePtr) {
+ goto nextModCode;
+ }
+ }
+ if (dispPtr->numModKeyCodes >= arraySize) {
+ KeyCode *new;
+
+ /*
+ * Ran out of space in the array; grow it.
+ */
+
+ arraySize *= 2;
+ new = (KeyCode *) ckalloc((unsigned)
+ (arraySize * sizeof(KeyCode)));
+ memcpy((VOID *) new, (VOID *) dispPtr->modKeyCodes,
+ (dispPtr->numModKeyCodes * sizeof(KeyCode)));
+ ckfree((char *) dispPtr->modKeyCodes);
+ dispPtr->modKeyCodes = new;
+ }
+ dispPtr->modKeyCodes[dispPtr->numModKeyCodes] = *codePtr;
+ dispPtr->numModKeyCodes++;
+ nextModCode: continue;
+ }
+ XFreeModifiermap(modMapPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * EvalTclBinding --
+ *
+ * The procedure that is invoked by Tk_BindEvent when a Tcl binding
+ * is fired.
+ *
+ * Results:
+ * A standard Tcl result code, the result of globally evaluating the
+ * percent-substitued binding string.
+ *
+ * Side effects:
+ * Normal side effects due to eval.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeTclBinding(clientData)
+ ClientData clientData;
+{
+ ckfree((char *) clientData);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkStringToKeysym --
+ *
+ * This procedure finds the keysym associated with a given keysym
+ * name.
+ *
+ * Results:
+ * The return value is the keysym that corresponds to name, or
+ * NoSymbol if there is no such keysym.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+KeySym
+TkStringToKeysym(name)
+ char *name; /* Name of a keysym. */
+{
+#ifdef REDO_KEYSYM_LOOKUP
+ Tcl_HashEntry *hPtr;
+ KeySym keysym;
+
+ hPtr = Tcl_FindHashEntry(&keySymTable, name);
+ if (hPtr != NULL) {
+ return (KeySym) Tcl_GetHashValue(hPtr);
+ }
+ if (strlen(name) == 1) {
+ keysym = (KeySym) (unsigned char) name[0];
+ if (TkKeysymToString(keysym) != NULL) {
+ return keysym;
+ }
+ }
+#endif /* REDO_KEYSYM_LOOKUP */
+ return XStringToKeysym(name);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkKeysymToString --
+ *
+ * This procedure finds the keysym name associated with a given
+ * keysym.
+ *
+ * Results:
+ * The return value is a pointer to a static string containing
+ * the name of the given keysym, or NULL if there is no known name.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkKeysymToString(keysym)
+ KeySym keysym;
+{
+#ifdef REDO_KEYSYM_LOOKUP
+ Tcl_HashEntry *hPtr;
+
+ hPtr = Tcl_FindHashEntry(&nameTable, (char *)keysym);
+ if (hPtr != NULL) {
+ return (char *) Tcl_GetHashValue(hPtr);
+ }
+#endif /* REDO_KEYSYM_LOOKUP */
+ return XKeysymToString(keysym);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCopyAndGlobalEval --
+ *
+ * This procedure makes a copy of a script then calls Tcl_GlobalEval
+ * to evaluate it. It's used in situations where the execution of
+ * a command may cause the original command string to be reallocated.
+ *
+ * Results:
+ * Returns the result of evaluating script, including both a standard
+ * Tcl completion code and a string in interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkCopyAndGlobalEval(interp, script)
+ Tcl_Interp *interp; /* Interpreter in which to evaluate
+ * script. */
+ char *script; /* Script to evaluate. */
+{
+ Tcl_DString buffer;
+ int code;
+
+ Tcl_DStringInit(&buffer);
+ Tcl_DStringAppend(&buffer, script, -1);
+ code = Tcl_GlobalEval(interp, Tcl_DStringValue(&buffer));
+ Tcl_DStringFree(&buffer);
+ return code;
+}
+
+
diff --git a/generic/tkBitmap.c b/generic/tkBitmap.c
new file mode 100644
index 0000000..fe46b35
--- /dev/null
+++ b/generic/tkBitmap.c
@@ -0,0 +1,585 @@
+/*
+ * tkBitmap.c --
+ *
+ * This file maintains a database of read-only bitmaps for the Tk
+ * toolkit. This allows bitmaps to be shared between widgets and
+ * also avoids interactions with the X server.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkBitmap.c 1.45 97/07/24 17:27:38
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * The includes below are for pre-defined bitmaps.
+ *
+ * Platform-specific issue: Windows complains when the bitmaps are
+ * included, because an array of characters is being initialized with
+ * integers as elements. For lint purposes, the following pragmas
+ * temporarily turn off that warning message.
+ */
+
+#if defined(__WIN32__) || defined(_WIN32)
+#pragma warning (disable : 4305)
+#endif
+
+#include "error.bmp"
+#include "gray12.bmp"
+#include "gray25.bmp"
+#include "gray50.bmp"
+#include "gray75.bmp"
+#include "hourglass.bmp"
+#include "info.bmp"
+#include "questhead.bmp"
+#include "question.bmp"
+#include "warning.bmp"
+
+#if defined(__WIN32__) || defined(_WIN32)
+#pragma warning (default : 4305)
+#endif
+
+/*
+ * One of the following data structures exists for each bitmap that is
+ * currently in use. Each structure is indexed with both "idTable" and
+ * "nameTable".
+ */
+
+typedef struct {
+ Pixmap bitmap; /* X identifier for bitmap. None means this
+ * bitmap was created by Tk_DefineBitmap
+ * and it isn't currently in use. */
+ int width, height; /* Dimensions of bitmap. */
+ Display *display; /* Display for which bitmap is valid. */
+ int refCount; /* Number of active uses of bitmap. */
+ Tcl_HashEntry *hashPtr; /* Entry in nameTable for this structure
+ * (needed when deleting). */
+} TkBitmap;
+
+/*
+ * Hash table to map from a textual description of a bitmap to the
+ * TkBitmap record for the bitmap, and key structure used in that
+ * hash table:
+ */
+
+static Tcl_HashTable nameTable;
+typedef struct {
+ Tk_Uid name; /* Textual name for desired bitmap. */
+ Screen *screen; /* Screen on which bitmap will be used. */
+} NameKey;
+
+/*
+ * Hash table that maps from <display + bitmap id> to the TkBitmap structure
+ * for the bitmap. This table is used by Tk_FreeBitmap.
+ */
+
+static Tcl_HashTable idTable;
+typedef struct {
+ Display *display; /* Display for which bitmap was allocated. */
+ Pixmap pixmap; /* X identifier for pixmap. */
+} IdKey;
+
+/*
+ * Hash table create by Tk_DefineBitmap to map from a name to a
+ * collection of in-core data about a bitmap. The table is
+ * indexed by the address of the data for the bitmap, and the entries
+ * contain pointers to TkPredefBitmap structures.
+ */
+
+Tcl_HashTable tkPredefBitmapTable;
+
+/*
+ * Hash table used by Tk_GetBitmapFromData to map from a collection
+ * of in-core data about a bitmap to a Tk_Uid giving an automatically-
+ * generated name for the bitmap:
+ */
+
+static Tcl_HashTable dataTable;
+typedef struct {
+ char *source; /* Bitmap bits. */
+ int width, height; /* Dimensions of bitmap. */
+} DataKey;
+
+static int initialized = 0; /* 0 means static structures haven't been
+ * initialized yet. */
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void BitmapInit _ANSI_ARGS_((void));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetBitmap --
+ *
+ * Given a string describing a bitmap, locate (or create if necessary)
+ * a bitmap that fits the description.
+ *
+ * Results:
+ * The return value is the X identifer for the desired bitmap
+ * (i.e. a Pixmap with a single plane), unless string couldn't be
+ * parsed correctly. In this case, None is returned and an error
+ * message is left in interp->result. The caller should never
+ * modify the bitmap that is returned, and should eventually call
+ * Tk_FreeBitmap when the bitmap is no longer needed.
+ *
+ * Side effects:
+ * The bitmap is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeBitmap, so that the database can be cleaned up when bitmaps
+ * aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Pixmap
+Tk_GetBitmap(interp, tkwin, string)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting,
+ * this may be NULL. */
+ Tk_Window tkwin; /* Window in which bitmap will be used. */
+ Tk_Uid string; /* Description of bitmap. See manual entry
+ * for details on legal syntax. */
+{
+ NameKey nameKey;
+ IdKey idKey;
+ Tcl_HashEntry *nameHashPtr, *idHashPtr, *predefHashPtr;
+ register TkBitmap *bitmapPtr;
+ TkPredefBitmap *predefPtr;
+ int new;
+ Pixmap bitmap;
+ int width, height;
+ int dummy2;
+
+ if (!initialized) {
+ BitmapInit();
+ }
+
+ nameKey.name = string;
+ nameKey.screen = Tk_Screen(tkwin);
+ nameHashPtr = Tcl_CreateHashEntry(&nameTable, (char *) &nameKey, &new);
+ if (!new) {
+ bitmapPtr = (TkBitmap *) Tcl_GetHashValue(nameHashPtr);
+ bitmapPtr->refCount++;
+ return bitmapPtr->bitmap;
+ }
+
+ /*
+ * No suitable bitmap exists. Create a new bitmap from the
+ * information contained in the string. If the string starts
+ * with "@" then the rest of the string is a file name containing
+ * the bitmap. Otherwise the string must refer to a bitmap
+ * defined by a call to Tk_DefineBitmap.
+ */
+
+ if (*string == '@') {
+ Tcl_DString buffer;
+ int result;
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_AppendResult(interp, "can't specify bitmap with '@' in a",
+ " safe interpreter", (char *) NULL);
+ goto error;
+ }
+
+ string = Tcl_TranslateFileName(interp, string + 1, &buffer);
+ if (string == NULL) {
+ goto error;
+ }
+ result = XReadBitmapFile(Tk_Display(tkwin),
+ RootWindowOfScreen(nameKey.screen), string,
+ (unsigned int *) &width, (unsigned int *) &height,
+ &bitmap, &dummy2, &dummy2);
+ if (result != BitmapSuccess) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "error reading bitmap file \"", string,
+ "\"", (char *) NULL);
+ }
+ Tcl_DStringFree(&buffer);
+ goto error;
+ }
+ Tcl_DStringFree(&buffer);
+ } else {
+ predefHashPtr = Tcl_FindHashEntry(&tkPredefBitmapTable, string);
+ if (predefHashPtr == NULL) {
+ /*
+ * The following platform specific call allows the user to
+ * define bitmaps that may only exist during run time. If
+ * it returns None nothing was found and we return the error.
+ */
+ bitmap = TkpGetNativeAppBitmap(Tk_Display(tkwin), string,
+ &width, &height);
+
+ if (bitmap == None) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "bitmap \"", string,
+ "\" not defined", (char *) NULL);
+ }
+ goto error;
+ }
+ } else {
+ predefPtr = (TkPredefBitmap *) Tcl_GetHashValue(predefHashPtr);
+ width = predefPtr->width;
+ height = predefPtr->height;
+ if (predefPtr->native) {
+ bitmap = TkpCreateNativeBitmap(Tk_Display(tkwin),
+ predefPtr->source);
+ if (bitmap == None) {
+ panic("native bitmap creation failed");
+ }
+ } else {
+ bitmap = XCreateBitmapFromData(Tk_Display(tkwin),
+ RootWindowOfScreen(nameKey.screen), predefPtr->source,
+ (unsigned) width, (unsigned) height);
+ }
+ }
+ }
+
+ /*
+ * Add information about this bitmap to our database.
+ */
+
+ bitmapPtr = (TkBitmap *) ckalloc(sizeof(TkBitmap));
+ bitmapPtr->bitmap = bitmap;
+ bitmapPtr->width = width;
+ bitmapPtr->height = height;
+ bitmapPtr->display = Tk_Display(tkwin);
+ bitmapPtr->refCount = 1;
+ bitmapPtr->hashPtr = nameHashPtr;
+ idKey.display = bitmapPtr->display;
+ idKey.pixmap = bitmap;
+ idHashPtr = Tcl_CreateHashEntry(&idTable, (char *) &idKey,
+ &new);
+ if (!new) {
+ panic("bitmap already registered in Tk_GetBitmap");
+ }
+ Tcl_SetHashValue(nameHashPtr, bitmapPtr);
+ Tcl_SetHashValue(idHashPtr, bitmapPtr);
+ return bitmapPtr->bitmap;
+
+ error:
+ Tcl_DeleteHashEntry(nameHashPtr);
+ return None;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DefineBitmap --
+ *
+ * This procedure associates a textual name with a binary bitmap
+ * description, so that the name may be used to refer to the
+ * bitmap in future calls to Tk_GetBitmap.
+ *
+ * Results:
+ * A standard Tcl result. If an error occurs then TCL_ERROR is
+ * returned and a message is left in interp->result.
+ *
+ * Side effects:
+ * "Name" is entered into the bitmap table and may be used from
+ * here on to refer to the given bitmap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_DefineBitmap(interp, name, source, width, height)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ Tk_Uid name; /* Name to use for bitmap. Must not already
+ * be defined as a bitmap. */
+ char *source; /* Address of bits for bitmap. */
+ int width; /* Width of bitmap. */
+ int height; /* Height of bitmap. */
+{
+ int new;
+ Tcl_HashEntry *predefHashPtr;
+ TkPredefBitmap *predefPtr;
+
+ if (!initialized) {
+ BitmapInit();
+ }
+
+ predefHashPtr = Tcl_CreateHashEntry(&tkPredefBitmapTable, name, &new);
+ if (!new) {
+ Tcl_AppendResult(interp, "bitmap \"", name,
+ "\" is already defined", (char *) NULL);
+ return TCL_ERROR;
+ }
+ predefPtr = (TkPredefBitmap *) ckalloc(sizeof(TkPredefBitmap));
+ predefPtr->source = source;
+ predefPtr->width = width;
+ predefPtr->height = height;
+ predefPtr->native = 0;
+ Tcl_SetHashValue(predefHashPtr, predefPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfBitmap --
+ *
+ * Given a bitmap, return a textual string identifying the
+ * bitmap.
+ *
+ * Results:
+ * The return value is the string name associated with bitmap.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_Uid
+Tk_NameOfBitmap(display, bitmap)
+ Display *display; /* Display for which bitmap was
+ * allocated. */
+ Pixmap bitmap; /* Bitmap whose name is wanted. */
+{
+ IdKey idKey;
+ Tcl_HashEntry *idHashPtr;
+ TkBitmap *bitmapPtr;
+
+ if (!initialized) {
+ unknown:
+ panic("Tk_NameOfBitmap received unknown bitmap argument");
+ }
+
+ idKey.display = display;
+ idKey.pixmap = bitmap;
+ idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey);
+ if (idHashPtr == NULL) {
+ goto unknown;
+ }
+ bitmapPtr = (TkBitmap *) Tcl_GetHashValue(idHashPtr);
+ return ((NameKey *) bitmapPtr->hashPtr->key.words)->name;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SizeOfBitmap --
+ *
+ * Given a bitmap managed by this module, returns the width
+ * and height of the bitmap.
+ *
+ * Results:
+ * The words at *widthPtr and *heightPtr are filled in with
+ * the dimenstions of bitmap.
+ *
+ * Side effects:
+ * If bitmap isn't managed by this module then the procedure
+ * panics..
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_SizeOfBitmap(display, bitmap, widthPtr, heightPtr)
+ Display *display; /* Display for which bitmap was
+ * allocated. */
+ Pixmap bitmap; /* Bitmap whose size is wanted. */
+ int *widthPtr; /* Store bitmap width here. */
+ int *heightPtr; /* Store bitmap height here. */
+{
+ IdKey idKey;
+ Tcl_HashEntry *idHashPtr;
+ TkBitmap *bitmapPtr;
+
+ if (!initialized) {
+ unknownBitmap:
+ panic("Tk_SizeOfBitmap received unknown bitmap argument");
+ }
+
+ idKey.display = display;
+ idKey.pixmap = bitmap;
+ idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey);
+ if (idHashPtr == NULL) {
+ goto unknownBitmap;
+ }
+ bitmapPtr = (TkBitmap *) Tcl_GetHashValue(idHashPtr);
+ *widthPtr = bitmapPtr->width;
+ *heightPtr = bitmapPtr->height;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeBitmap --
+ *
+ * This procedure is called to release a bitmap allocated by
+ * Tk_GetBitmap or TkGetBitmapFromData.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with bitmap is decremented, and
+ * it is officially deallocated if no-one is using it anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeBitmap(display, bitmap)
+ Display *display; /* Display for which bitmap was
+ * allocated. */
+ Pixmap bitmap; /* Bitmap to be released. */
+{
+ Tcl_HashEntry *idHashPtr;
+ register TkBitmap *bitmapPtr;
+ IdKey idKey;
+
+ if (!initialized) {
+ panic("Tk_FreeBitmap called before Tk_GetBitmap");
+ }
+
+ idKey.display = display;
+ idKey.pixmap = bitmap;
+ idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey);
+ if (idHashPtr == NULL) {
+ panic("Tk_FreeBitmap received unknown bitmap argument");
+ }
+ bitmapPtr = (TkBitmap *) Tcl_GetHashValue(idHashPtr);
+ bitmapPtr->refCount--;
+ if (bitmapPtr->refCount == 0) {
+ Tk_FreePixmap(bitmapPtr->display, bitmapPtr->bitmap);
+ Tcl_DeleteHashEntry(idHashPtr);
+ Tcl_DeleteHashEntry(bitmapPtr->hashPtr);
+ ckfree((char *) bitmapPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetBitmapFromData --
+ *
+ * Given a description of the bits for a bitmap, make a bitmap that
+ * has the given properties. *** NOTE: this procedure is obsolete
+ * and really shouldn't be used anymore. ***
+ *
+ * Results:
+ * The return value is the X identifer for the desired bitmap
+ * (a one-plane Pixmap), unless it couldn't be created properly.
+ * In this case, None is returned and an error message is left in
+ * interp->result. The caller should never modify the bitmap that
+ * is returned, and should eventually call Tk_FreeBitmap when the
+ * bitmap is no longer needed.
+ *
+ * Side effects:
+ * The bitmap is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeBitmap, so that the database can be cleaned up when bitmaps
+ * aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+Pixmap
+Tk_GetBitmapFromData(interp, tkwin, source, width, height)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ Tk_Window tkwin; /* Window in which bitmap will be used. */
+ char *source; /* Bitmap data for bitmap shape. */
+ int width, height; /* Dimensions of bitmap. */
+{
+ DataKey nameKey;
+ Tcl_HashEntry *dataHashPtr;
+ Tk_Uid name;
+ int new;
+ char string[20];
+ static int autoNumber = 0;
+
+ if (!initialized) {
+ BitmapInit();
+ }
+
+ nameKey.source = source;
+ nameKey.width = width;
+ nameKey.height = height;
+ dataHashPtr = Tcl_CreateHashEntry(&dataTable, (char *) &nameKey, &new);
+ if (!new) {
+ name = (Tk_Uid) Tcl_GetHashValue(dataHashPtr);
+ } else {
+ autoNumber++;
+ sprintf(string, "_tk%d", autoNumber);
+ name = Tk_GetUid(string);
+ Tcl_SetHashValue(dataHashPtr, name);
+ if (Tk_DefineBitmap(interp, name, source, width, height) != TCL_OK) {
+ Tcl_DeleteHashEntry(dataHashPtr);
+ return TCL_ERROR;
+ }
+ }
+ return Tk_GetBitmap(interp, tkwin, name);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BitmapInit --
+ *
+ * Initialize the structures used for bitmap management.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Read the code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+BitmapInit()
+{
+ Tcl_Interp *dummy;
+
+ dummy = Tcl_CreateInterp();
+ initialized = 1;
+ Tcl_InitHashTable(&nameTable, sizeof(NameKey)/sizeof(int));
+ Tcl_InitHashTable(&dataTable, sizeof(DataKey)/sizeof(int));
+ Tcl_InitHashTable(&tkPredefBitmapTable, TCL_ONE_WORD_KEYS);
+
+ /*
+ * The call below is tricky: can't use sizeof(IdKey) because it
+ * gets padded with extra unpredictable bytes on some 64-bit
+ * machines.
+ */
+
+ Tcl_InitHashTable(&idTable, (sizeof(Display *) + sizeof(Pixmap))
+ /sizeof(int));
+
+ Tk_DefineBitmap(dummy, Tk_GetUid("error"), (char *) error_bits,
+ error_width, error_height);
+ Tk_DefineBitmap(dummy, Tk_GetUid("gray75"), (char *) gray75_bits,
+ gray75_width, gray75_height);
+ Tk_DefineBitmap(dummy, Tk_GetUid("gray50"), (char *) gray50_bits,
+ gray50_width, gray50_height);
+ Tk_DefineBitmap(dummy, Tk_GetUid("gray25"), (char *) gray25_bits,
+ gray25_width, gray25_height);
+ Tk_DefineBitmap(dummy, Tk_GetUid("gray12"), (char *) gray12_bits,
+ gray12_width, gray12_height);
+ Tk_DefineBitmap(dummy, Tk_GetUid("hourglass"), (char *) hourglass_bits,
+ hourglass_width, hourglass_height);
+ Tk_DefineBitmap(dummy, Tk_GetUid("info"), (char *) info_bits,
+ info_width, info_height);
+ Tk_DefineBitmap(dummy, Tk_GetUid("questhead"), (char *) questhead_bits,
+ questhead_width, questhead_height);
+ Tk_DefineBitmap(dummy, Tk_GetUid("question"), (char *) question_bits,
+ question_width, question_height);
+ Tk_DefineBitmap(dummy, Tk_GetUid("warning"), (char *) warning_bits,
+ warning_width, warning_height);
+
+ TkpDefineNativeBitmaps();
+
+ Tcl_DeleteInterp(dummy);
+}
diff --git a/generic/tkButton.c b/generic/tkButton.c
new file mode 100644
index 0000000..c9c25c2
--- /dev/null
+++ b/generic/tkButton.c
@@ -0,0 +1,1347 @@
+/*
+ * tkButton.c --
+ *
+ * This module implements a collection of button-like
+ * widgets for the Tk toolkit. The widgets implemented
+ * include labels, buttons, check buttons, and radio
+ * buttons.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkButton.c 1.144 97/07/31 09:04:57
+ */
+
+#include "tkButton.h"
+#include "default.h"
+
+/*
+ * Class names for buttons, indexed by one of the type values above.
+ */
+
+static char *classNames[] = {"Label", "Button", "Checkbutton", "Radiobutton"};
+
+/*
+ * The class procedure table for the button widget.
+ */
+
+static int configFlags[] = {LABEL_MASK, BUTTON_MASK,
+ CHECK_BUTTON_MASK, RADIO_BUTTON_MASK};
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+Tk_ConfigSpec tkpButtonConfigSpecs[] = {
+ {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_BUTTON_ACTIVE_BG_COLOR, Tk_Offset(TkButton, activeBorder),
+ BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK
+ |TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_BUTTON_ACTIVE_BG_MONO, Tk_Offset(TkButton, activeBorder),
+ BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK
+ |TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",
+ DEF_BUTTON_ACTIVE_FG_COLOR, Tk_Offset(TkButton, activeFg),
+ BUTTON_MASK|TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",
+ DEF_CHKRAD_ACTIVE_FG_COLOR, Tk_Offset(TkButton, activeFg),
+ CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",
+ DEF_BUTTON_ACTIVE_FG_MONO, Tk_Offset(TkButton, activeFg),
+ BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK
+ |TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor",
+ DEF_BUTTON_ANCHOR, Tk_Offset(TkButton, anchor), ALL_MASK},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_BUTTON_BG_COLOR, Tk_Offset(TkButton, normalBorder),
+ ALL_MASK | TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_BUTTON_BG_MONO, Tk_Offset(TkButton, normalBorder),
+ ALL_MASK | TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
+ (char *) NULL, 0, ALL_MASK},
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
+ (char *) NULL, 0, ALL_MASK},
+ {TK_CONFIG_BITMAP, "-bitmap", "bitmap", "Bitmap",
+ DEF_BUTTON_BITMAP, Tk_Offset(TkButton, bitmap),
+ ALL_MASK|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_BUTTON_BORDER_WIDTH, Tk_Offset(TkButton, borderWidth), ALL_MASK},
+ {TK_CONFIG_STRING, "-command", "command", "Command",
+ DEF_BUTTON_COMMAND, Tk_Offset(TkButton, command),
+ BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_BUTTON_CURSOR, Tk_Offset(TkButton, cursor),
+ ALL_MASK|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_UID, "-default", "default", "Default",
+ DEF_BUTTON_DEFAULT, Tk_Offset(TkButton, defaultState), BUTTON_MASK},
+ {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_BUTTON_DISABLED_FG_COLOR,
+ Tk_Offset(TkButton, disabledFg), BUTTON_MASK|CHECK_BUTTON_MASK
+ |RADIO_BUTTON_MASK|TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_BUTTON_DISABLED_FG_MONO,
+ Tk_Offset(TkButton, disabledFg), BUTTON_MASK|CHECK_BUTTON_MASK
+ |RADIO_BUTTON_MASK|TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, ALL_MASK},
+ {TK_CONFIG_FONT, "-font", "font", "Font",
+ DEF_BUTTON_FONT, Tk_Offset(TkButton, tkfont),
+ ALL_MASK},
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_BUTTON_FG, Tk_Offset(TkButton, normalFg), LABEL_MASK|BUTTON_MASK},
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_CHKRAD_FG, Tk_Offset(TkButton, normalFg), CHECK_BUTTON_MASK
+ |RADIO_BUTTON_MASK},
+ {TK_CONFIG_STRING, "-height", "height", "Height",
+ DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightString), ALL_MASK},
+ {TK_CONFIG_BORDER, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_BUTTON_HIGHLIGHT_BG,
+ Tk_Offset(TkButton, highlightBorder), ALL_MASK},
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_BUTTON_HIGHLIGHT, Tk_Offset(TkButton, highlightColorPtr),
+ ALL_MASK},
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_LABEL_HIGHLIGHT_WIDTH, Tk_Offset(TkButton, highlightWidth),
+ LABEL_MASK},
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_BUTTON_HIGHLIGHT_WIDTH, Tk_Offset(TkButton, highlightWidth),
+ BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK},
+ {TK_CONFIG_STRING, "-image", "image", "Image",
+ DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imageString),
+ ALL_MASK|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn",
+ DEF_BUTTON_INDICATOR, Tk_Offset(TkButton, indicatorOn),
+ CHECK_BUTTON_MASK|RADIO_BUTTON_MASK},
+ {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_BUTTON_JUSTIFY, Tk_Offset(TkButton, justify), ALL_MASK},
+ {TK_CONFIG_STRING, "-offvalue", "offValue", "Value",
+ DEF_BUTTON_OFF_VALUE, Tk_Offset(TkButton, offValue),
+ CHECK_BUTTON_MASK},
+ {TK_CONFIG_STRING, "-onvalue", "onValue", "Value",
+ DEF_BUTTON_ON_VALUE, Tk_Offset(TkButton, onValue),
+ CHECK_BUTTON_MASK},
+ {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
+ DEF_BUTTON_PADX, Tk_Offset(TkButton, padX), BUTTON_MASK},
+ {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
+ DEF_LABCHKRAD_PADX, Tk_Offset(TkButton, padX),
+ LABEL_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK},
+ {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
+ DEF_BUTTON_PADY, Tk_Offset(TkButton, padY), BUTTON_MASK},
+ {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
+ DEF_LABCHKRAD_PADY, Tk_Offset(TkButton, padY),
+ LABEL_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_BUTTON_RELIEF, Tk_Offset(TkButton, relief), BUTTON_MASK},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_LABCHKRAD_RELIEF, Tk_Offset(TkButton, relief),
+ LABEL_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK},
+ {TK_CONFIG_BORDER, "-selectcolor", "selectColor", "Background",
+ DEF_BUTTON_SELECT_COLOR, Tk_Offset(TkButton, selectBorder),
+ CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_COLOR_ONLY
+ |TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BORDER, "-selectcolor", "selectColor", "Background",
+ DEF_BUTTON_SELECT_MONO, Tk_Offset(TkButton, selectBorder),
+ CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_MONO_ONLY
+ |TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-selectimage", "selectImage", "SelectImage",
+ DEF_BUTTON_SELECT_IMAGE, Tk_Offset(TkButton, selectImageString),
+ CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_UID, "-state", "state", "State",
+ DEF_BUTTON_STATE, Tk_Offset(TkButton, state),
+ BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_LABEL_TAKE_FOCUS, Tk_Offset(TkButton, takeFocus),
+ LABEL_MASK|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_BUTTON_TAKE_FOCUS, Tk_Offset(TkButton, takeFocus),
+ BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-text", "text", "Text",
+ DEF_BUTTON_TEXT, Tk_Offset(TkButton, text), ALL_MASK},
+ {TK_CONFIG_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(TkButton, textVarName),
+ ALL_MASK|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_INT, "-underline", "underline", "Underline",
+ DEF_BUTTON_UNDERLINE, Tk_Offset(TkButton, underline), ALL_MASK},
+ {TK_CONFIG_STRING, "-value", "value", "Value",
+ DEF_BUTTON_VALUE, Tk_Offset(TkButton, onValue),
+ RADIO_BUTTON_MASK},
+ {TK_CONFIG_STRING, "-variable", "variable", "Variable",
+ DEF_RADIOBUTTON_VARIABLE, Tk_Offset(TkButton, selVarName),
+ RADIO_BUTTON_MASK},
+ {TK_CONFIG_STRING, "-variable", "variable", "Variable",
+ DEF_CHECKBUTTON_VARIABLE, Tk_Offset(TkButton, selVarName),
+ CHECK_BUTTON_MASK|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-width", "width", "Width",
+ DEF_BUTTON_WIDTH, Tk_Offset(TkButton, widthString), ALL_MASK},
+ {TK_CONFIG_PIXELS, "-wraplength", "wrapLength", "WrapLength",
+ DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLength), ALL_MASK},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * String to print out in error messages, identifying options for
+ * widget commands for different types of labels or buttons:
+ */
+
+static char *optionStrings[] = {
+ "cget or configure",
+ "cget, configure, flash, or invoke",
+ "cget, configure, deselect, flash, invoke, select, or toggle",
+ "cget, configure, deselect, flash, invoke, or select"
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void ButtonCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static int ButtonCreate _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv,
+ int type));
+static void ButtonEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void ButtonImageProc _ANSI_ARGS_((ClientData clientData,
+ int x, int y, int width, int height,
+ int imgWidth, int imgHeight));
+static void ButtonSelectImageProc _ANSI_ARGS_((
+ ClientData clientData, int x, int y, int width,
+ int height, int imgWidth, int imgHeight));
+static char * ButtonTextVarProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, char *name1, char *name2,
+ int flags));
+static char * ButtonVarProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, char *name1, char *name2,
+ int flags));
+static int ButtonWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static int ConfigureButton _ANSI_ARGS_((Tcl_Interp *interp,
+ TkButton *butPtr, int argc, char **argv,
+ int flags));
+static void DestroyButton _ANSI_ARGS_((TkButton *butPtr));
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ButtonCmd, Tk_CheckbuttonCmd, Tk_LabelCmd, Tk_RadiobuttonCmd --
+ *
+ * These procedures are invoked to process the "button", "label",
+ * "radiobutton", and "checkbutton" Tcl commands. See the
+ * user documentation for details on what they do.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation. These procedures are just wrappers;
+ * they call ButtonCreate to do all of the real work.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_ButtonCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ return ButtonCreate(clientData, interp, argc, argv, TYPE_BUTTON);
+}
+
+int
+Tk_CheckbuttonCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ return ButtonCreate(clientData, interp, argc, argv, TYPE_CHECK_BUTTON);
+}
+
+int
+Tk_LabelCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ return ButtonCreate(clientData, interp, argc, argv, TYPE_LABEL);
+}
+
+int
+Tk_RadiobuttonCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ return ButtonCreate(clientData, interp, argc, argv, TYPE_RADIO_BUTTON);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ButtonCreate --
+ *
+ * This procedure does all the real work of implementing the
+ * "button", "label", "radiobutton", and "checkbutton" Tcl
+ * commands. See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ButtonCreate(clientData, interp, argc, argv, type)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+ int type; /* Type of button to create: TYPE_LABEL,
+ * TYPE_BUTTON, TYPE_CHECK_BUTTON, or
+ * TYPE_RADIO_BUTTON. */
+{
+ register TkButton *butPtr;
+ Tk_Window tkwin = (Tk_Window) clientData;
+ Tk_Window new;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " pathName ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the new window.
+ */
+
+ new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+
+ Tk_SetClass(new, classNames[type]);
+ butPtr = TkpCreateButton(new);
+
+ TkSetClassProcs(new, &tkpButtonProcs, (ClientData) butPtr);
+
+ /*
+ * Initialize the data structure for the button.
+ */
+
+ butPtr->tkwin = new;
+ butPtr->display = Tk_Display(new);
+ butPtr->widgetCmd = Tcl_CreateCommand(interp, Tk_PathName(butPtr->tkwin),
+ ButtonWidgetCmd, (ClientData) butPtr, ButtonCmdDeletedProc);
+ butPtr->interp = interp;
+ butPtr->type = type;
+ butPtr->text = NULL;
+ butPtr->underline = -1;
+ butPtr->textVarName = NULL;
+ butPtr->bitmap = None;
+ butPtr->imageString = NULL;
+ butPtr->image = NULL;
+ butPtr->selectImageString = NULL;
+ butPtr->selectImage = NULL;
+ butPtr->state = tkNormalUid;
+ butPtr->normalBorder = NULL;
+ butPtr->activeBorder = NULL;
+ butPtr->borderWidth = 0;
+ butPtr->relief = TK_RELIEF_FLAT;
+ butPtr->highlightWidth = 0;
+ butPtr->highlightBorder = NULL;
+ butPtr->highlightColorPtr = NULL;
+ butPtr->inset = 0;
+ butPtr->tkfont = NULL;
+ butPtr->normalFg = NULL;
+ butPtr->activeFg = NULL;
+ butPtr->disabledFg = NULL;
+ butPtr->normalTextGC = None;
+ butPtr->activeTextGC = None;
+ butPtr->gray = None;
+ butPtr->disabledGC = None;
+ butPtr->copyGC = None;
+ butPtr->widthString = NULL;
+ butPtr->heightString = NULL;
+ butPtr->width = 0;
+ butPtr->height = 0;
+ butPtr->wrapLength = 0;
+ butPtr->padX = 0;
+ butPtr->padY = 0;
+ butPtr->anchor = TK_ANCHOR_CENTER;
+ butPtr->justify = TK_JUSTIFY_CENTER;
+ butPtr->textLayout = NULL;
+ butPtr->indicatorOn = 0;
+ butPtr->selectBorder = NULL;
+ butPtr->indicatorSpace = 0;
+ butPtr->indicatorDiameter = 0;
+ butPtr->defaultState = tkDisabledUid;
+ butPtr->selVarName = NULL;
+ butPtr->onValue = NULL;
+ butPtr->offValue = NULL;
+ butPtr->cursor = None;
+ butPtr->command = NULL;
+ butPtr->takeFocus = NULL;
+ butPtr->flags = 0;
+
+ Tk_CreateEventHandler(butPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ ButtonEventProc, (ClientData) butPtr);
+
+ if (ConfigureButton(interp, butPtr, argc - 2, argv + 2,
+ configFlags[type]) != TCL_OK) {
+ Tk_DestroyWindow(butPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ interp->result = Tk_PathName(butPtr->tkwin);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ButtonWidgetCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to a widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ButtonWidgetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about button widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ register TkButton *butPtr = (TkButton *) clientData;
+ int result = TCL_OK;
+ size_t length;
+ int c;
+
+ if (argc < 2) {
+ sprintf(interp->result,
+ "wrong # args: should be \"%.50s option ?arg arg ...?\"",
+ argv[0]);
+ return TCL_ERROR;
+ }
+ Tcl_Preserve((ClientData) butPtr);
+ c = argv[1][0];
+ length = strlen(argv[1]);
+
+ if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
+ && (length >= 2)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " cget option\"",
+ (char *) NULL);
+ goto error;
+ }
+ result = Tk_ConfigureValue(interp, butPtr->tkwin, tkpButtonConfigSpecs,
+ (char *) butPtr, argv[2], configFlags[butPtr->type]);
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
+ && (length >= 2)) {
+ if (argc == 2) {
+ result = Tk_ConfigureInfo(interp, butPtr->tkwin,
+ tkpButtonConfigSpecs, (char *) butPtr, (char *) NULL,
+ configFlags[butPtr->type]);
+ } else if (argc == 3) {
+ result = Tk_ConfigureInfo(interp, butPtr->tkwin,
+ tkpButtonConfigSpecs, (char *) butPtr, argv[2],
+ configFlags[butPtr->type]);
+ } else {
+ result = ConfigureButton(interp, butPtr, argc-2, argv+2,
+ configFlags[butPtr->type] | TK_CONFIG_ARGV_ONLY);
+ }
+ } else if ((c == 'd') && (strncmp(argv[1], "deselect", length) == 0)
+ && (butPtr->type >= TYPE_CHECK_BUTTON)) {
+ if (argc > 2) {
+ sprintf(interp->result,
+ "wrong # args: should be \"%.50s deselect\"",
+ argv[0]);
+ goto error;
+ }
+ if (butPtr->type == TYPE_CHECK_BUTTON) {
+ if (Tcl_SetVar(interp, butPtr->selVarName, butPtr->offValue,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
+ }
+ } else if (butPtr->flags & SELECTED) {
+ if (Tcl_SetVar(interp, butPtr->selVarName, "",
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
+ };
+ }
+ } else if ((c == 'f') && (strncmp(argv[1], "flash", length) == 0)
+ && (butPtr->type != TYPE_LABEL)) {
+ int i;
+
+ if (argc > 2) {
+ sprintf(interp->result,
+ "wrong # args: should be \"%.50s flash\"",
+ argv[0]);
+ goto error;
+ }
+ if (butPtr->state != tkDisabledUid) {
+ for (i = 0; i < 4; i++) {
+ butPtr->state = (butPtr->state == tkNormalUid)
+ ? tkActiveUid : tkNormalUid;
+ Tk_SetBackgroundFromBorder(butPtr->tkwin,
+ (butPtr->state == tkActiveUid) ? butPtr->activeBorder
+ : butPtr->normalBorder);
+ TkpDisplayButton((ClientData) butPtr);
+
+ /*
+ * Special note: must cancel any existing idle handler
+ * for TkpDisplayButton; it's no longer needed, and TkpDisplayButton
+ * cleared the REDRAW_PENDING flag.
+ */
+
+ Tcl_CancelIdleCall(TkpDisplayButton, (ClientData) butPtr);
+ XFlush(butPtr->display);
+ Tcl_Sleep(50);
+ }
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "invoke", length) == 0)
+ && (butPtr->type > TYPE_LABEL)) {
+ if (argc > 2) {
+ sprintf(interp->result,
+ "wrong # args: should be \"%.50s invoke\"",
+ argv[0]);
+ goto error;
+ }
+ if (butPtr->state != tkDisabledUid) {
+ result = TkInvokeButton(butPtr);
+ }
+ } else if ((c == 's') && (strncmp(argv[1], "select", length) == 0)
+ && (butPtr->type >= TYPE_CHECK_BUTTON)) {
+ if (argc > 2) {
+ sprintf(interp->result,
+ "wrong # args: should be \"%.50s select\"",
+ argv[0]);
+ goto error;
+ }
+ if (Tcl_SetVar(interp, butPtr->selVarName, butPtr->onValue,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
+ }
+ } else if ((c == 't') && (strncmp(argv[1], "toggle", length) == 0)
+ && (length >= 2) && (butPtr->type == TYPE_CHECK_BUTTON)) {
+ if (argc > 2) {
+ sprintf(interp->result,
+ "wrong # args: should be \"%.50s toggle\"",
+ argv[0]);
+ goto error;
+ }
+ if (butPtr->flags & SELECTED) {
+ if (Tcl_SetVar(interp, butPtr->selVarName, butPtr->offValue,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
+ }
+ } else {
+ if (Tcl_SetVar(interp, butPtr->selVarName, butPtr->onValue,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
+ }
+ }
+ } else {
+ sprintf(interp->result,
+ "bad option \"%.50s\": must be %s", argv[1],
+ optionStrings[butPtr->type]);
+ goto error;
+ }
+ Tcl_Release((ClientData) butPtr);
+ return result;
+
+ error:
+ Tcl_Release((ClientData) butPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyButton --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a button at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the widget is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyButton(butPtr)
+ TkButton *butPtr; /* Info about button widget. */
+{
+ /*
+ * Free up all the stuff that requires special handling, then
+ * let Tk_FreeOptions handle all the standard option-related
+ * stuff.
+ */
+
+ if (butPtr->textVarName != NULL) {
+ Tcl_UntraceVar(butPtr->interp, butPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonTextVarProc, (ClientData) butPtr);
+ }
+ if (butPtr->image != NULL) {
+ Tk_FreeImage(butPtr->image);
+ }
+ if (butPtr->selectImage != NULL) {
+ Tk_FreeImage(butPtr->selectImage);
+ }
+ if (butPtr->normalTextGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->normalTextGC);
+ }
+ if (butPtr->activeTextGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->activeTextGC);
+ }
+ if (butPtr->gray != None) {
+ Tk_FreeBitmap(butPtr->display, butPtr->gray);
+ }
+ if (butPtr->disabledGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->disabledGC);
+ }
+ if (butPtr->copyGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->copyGC);
+ }
+ if (butPtr->selVarName != NULL) {
+ Tcl_UntraceVar(butPtr->interp, butPtr->selVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonVarProc, (ClientData) butPtr);
+ }
+ Tk_FreeTextLayout(butPtr->textLayout);
+ Tk_FreeOptions(tkpButtonConfigSpecs, (char *) butPtr, butPtr->display,
+ configFlags[butPtr->type]);
+ Tcl_EventuallyFree((ClientData)butPtr, TCL_DYNAMIC);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureButton --
+ *
+ * This procedure is called to process an argv/argc list, plus
+ * the Tk option database, in order to configure (or
+ * reconfigure) a button widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then interp->result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as text string, colors, font,
+ * etc. get set for butPtr; old resources get freed, if there
+ * were any. The button is redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureButton(interp, butPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register TkButton *butPtr; /* Information about widget; may or may
+ * not already have values for some fields. */
+ int argc; /* Number of valid entries in argv. */
+ char **argv; /* Arguments. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ Tk_Image image;
+
+ /*
+ * Eliminate any existing trace on variables monitored by the button.
+ */
+
+ if (butPtr->textVarName != NULL) {
+ Tcl_UntraceVar(interp, butPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonTextVarProc, (ClientData) butPtr);
+ }
+ if (butPtr->selVarName != NULL) {
+ Tcl_UntraceVar(interp, butPtr->selVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonVarProc, (ClientData) butPtr);
+ }
+
+
+
+ if (Tk_ConfigureWidget(interp, butPtr->tkwin, tkpButtonConfigSpecs,
+ argc, argv, (char *) butPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few options need special processing, such as setting the
+ * background from a 3-D border, or filling in complicated
+ * defaults that couldn't be specified to Tk_ConfigureWidget.
+ */
+
+ if ((butPtr->state == tkActiveUid) && !Tk_StrictMotif(butPtr->tkwin)) {
+ Tk_SetBackgroundFromBorder(butPtr->tkwin, butPtr->activeBorder);
+ } else {
+ Tk_SetBackgroundFromBorder(butPtr->tkwin, butPtr->normalBorder);
+ if ((butPtr->state != tkNormalUid) && (butPtr->state != tkActiveUid)
+ && (butPtr->state != tkDisabledUid)) {
+ Tcl_AppendResult(interp, "bad state value \"", butPtr->state,
+ "\": must be normal, active, or disabled", (char *) NULL);
+ butPtr->state = tkNormalUid;
+ return TCL_ERROR;
+ }
+ }
+
+ if ((butPtr->defaultState != tkActiveUid)
+ && (butPtr->defaultState != tkDisabledUid)
+ && (butPtr->defaultState != tkNormalUid)) {
+ Tcl_AppendResult(interp, "bad -default value \"", butPtr->defaultState,
+ "\": must be normal, active, or disabled", (char *) NULL);
+ butPtr->defaultState = tkDisabledUid;
+ return TCL_ERROR;
+ }
+
+ if (butPtr->highlightWidth < 0) {
+ butPtr->highlightWidth = 0;
+ }
+
+ if (butPtr->padX < 0) {
+ butPtr->padX = 0;
+ }
+ if (butPtr->padY < 0) {
+ butPtr->padY = 0;
+ }
+
+ if (butPtr->type >= TYPE_CHECK_BUTTON) {
+ char *value;
+
+ if (butPtr->selVarName == NULL) {
+ butPtr->selVarName = (char *) ckalloc((unsigned)
+ (strlen(Tk_Name(butPtr->tkwin)) + 1));
+ strcpy(butPtr->selVarName, Tk_Name(butPtr->tkwin));
+ }
+
+ /*
+ * Select the button if the associated variable has the
+ * appropriate value, initialize the variable if it doesn't
+ * exist, then set a trace on the variable to monitor future
+ * changes to its value.
+ */
+
+ value = Tcl_GetVar(interp, butPtr->selVarName, TCL_GLOBAL_ONLY);
+ butPtr->flags &= ~SELECTED;
+ if (value != NULL) {
+ if (strcmp(value, butPtr->onValue) == 0) {
+ butPtr->flags |= SELECTED;
+ }
+ } else {
+ if (Tcl_SetVar(interp, butPtr->selVarName,
+ (butPtr->type == TYPE_CHECK_BUTTON) ? butPtr->offValue : "",
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ Tcl_TraceVar(interp, butPtr->selVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonVarProc, (ClientData) butPtr);
+ }
+
+ /*
+ * Get the images for the widget, if there are any. Allocate the
+ * new images before freeing the old ones, so that the reference
+ * counts don't go to zero and cause image data to be discarded.
+ */
+
+ if (butPtr->imageString != NULL) {
+ image = Tk_GetImage(butPtr->interp, butPtr->tkwin,
+ butPtr->imageString, ButtonImageProc, (ClientData) butPtr);
+ if (image == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (butPtr->image != NULL) {
+ Tk_FreeImage(butPtr->image);
+ }
+ butPtr->image = image;
+ if (butPtr->selectImageString != NULL) {
+ image = Tk_GetImage(butPtr->interp, butPtr->tkwin,
+ butPtr->selectImageString, ButtonSelectImageProc,
+ (ClientData) butPtr);
+ if (image == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (butPtr->selectImage != NULL) {
+ Tk_FreeImage(butPtr->selectImage);
+ }
+ butPtr->selectImage = image;
+
+ if ((butPtr->image == NULL) && (butPtr->bitmap == None)
+ && (butPtr->textVarName != NULL)) {
+ /*
+ * The button must display the value of a variable: set up a trace
+ * on the variable's value, create the variable if it doesn't
+ * exist, and fetch its current value.
+ */
+
+ char *value;
+
+ value = Tcl_GetVar(interp, butPtr->textVarName, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ if (Tcl_SetVar(interp, butPtr->textVarName, butPtr->text,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ if (butPtr->text != NULL) {
+ ckfree(butPtr->text);
+ }
+ butPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1));
+ strcpy(butPtr->text, value);
+ }
+ Tcl_TraceVar(interp, butPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonTextVarProc, (ClientData) butPtr);
+ }
+
+ if ((butPtr->bitmap != None) || (butPtr->image != NULL)) {
+ if (Tk_GetPixels(interp, butPtr->tkwin, butPtr->widthString,
+ &butPtr->width) != TCL_OK) {
+ widthError:
+ Tcl_AddErrorInfo(interp, "\n (processing -width option)");
+ return TCL_ERROR;
+ }
+ if (Tk_GetPixels(interp, butPtr->tkwin, butPtr->heightString,
+ &butPtr->height) != TCL_OK) {
+ heightError:
+ Tcl_AddErrorInfo(interp, "\n (processing -height option)");
+ return TCL_ERROR;
+ }
+ } else {
+ if (Tcl_GetInt(interp, butPtr->widthString, &butPtr->width)
+ != TCL_OK) {
+ goto widthError;
+ }
+ if (Tcl_GetInt(interp, butPtr->heightString, &butPtr->height)
+ != TCL_OK) {
+ goto heightError;
+ }
+ }
+
+ TkButtonWorldChanged((ClientData) butPtr);
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkButtonWorldChanged --
+ *
+ * This procedure is called when the world has changed in some
+ * way and the widget needs to recompute all its graphics contexts
+ * and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Button will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkButtonWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ XGCValues gcValues;
+ GC newGC;
+ unsigned long mask;
+ TkButton *butPtr;
+
+ butPtr = (TkButton *) instanceData;
+
+ /*
+ * Recompute GCs.
+ */
+
+ gcValues.font = Tk_FontId(butPtr->tkfont);
+ gcValues.foreground = butPtr->normalFg->pixel;
+ gcValues.background = Tk_3DBorderColor(butPtr->normalBorder)->pixel;
+
+ /*
+ * Note: GraphicsExpose events are disabled in normalTextGC because it's
+ * used to copy stuff from an off-screen pixmap onto the screen (we know
+ * that there's no problem with obscured areas).
+ */
+
+ gcValues.graphics_exposures = False;
+ mask = GCForeground | GCBackground | GCFont | GCGraphicsExposures;
+ newGC = Tk_GetGC(butPtr->tkwin, mask, &gcValues);
+ if (butPtr->normalTextGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->normalTextGC);
+ }
+ butPtr->normalTextGC = newGC;
+
+ if (butPtr->activeFg != NULL) {
+ gcValues.font = Tk_FontId(butPtr->tkfont);
+ gcValues.foreground = butPtr->activeFg->pixel;
+ gcValues.background = Tk_3DBorderColor(butPtr->activeBorder)->pixel;
+ mask = GCForeground | GCBackground | GCFont;
+ newGC = Tk_GetGC(butPtr->tkwin, mask, &gcValues);
+ if (butPtr->activeTextGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->activeTextGC);
+ }
+ butPtr->activeTextGC = newGC;
+ }
+
+ if (butPtr->type != TYPE_LABEL) {
+ gcValues.font = Tk_FontId(butPtr->tkfont);
+ gcValues.background = Tk_3DBorderColor(butPtr->normalBorder)->pixel;
+ if ((butPtr->disabledFg != NULL) && (butPtr->imageString == NULL)) {
+ gcValues.foreground = butPtr->disabledFg->pixel;
+ mask = GCForeground | GCBackground | GCFont;
+ } else {
+ gcValues.foreground = gcValues.background;
+ mask = GCForeground;
+ if (butPtr->gray == None) {
+ butPtr->gray = Tk_GetBitmap(NULL, butPtr->tkwin,
+ Tk_GetUid("gray50"));
+ }
+ if (butPtr->gray != None) {
+ gcValues.fill_style = FillStippled;
+ gcValues.stipple = butPtr->gray;
+ mask |= GCFillStyle | GCStipple;
+ }
+ }
+ newGC = Tk_GetGC(butPtr->tkwin, mask, &gcValues);
+ if (butPtr->disabledGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->disabledGC);
+ }
+ butPtr->disabledGC = newGC;
+ }
+
+ if (butPtr->copyGC == None) {
+ butPtr->copyGC = Tk_GetGC(butPtr->tkwin, 0, &gcValues);
+ }
+
+ TkpComputeButtonGeometry(butPtr);
+
+ /*
+ * Lastly, arrange for the button to be redisplayed.
+ */
+
+ if (Tk_IsMapped(butPtr->tkwin) && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ButtonEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on buttons.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ButtonEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TkButton *butPtr = (TkButton *) clientData;
+ if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
+ goto redraw;
+ } else if (eventPtr->type == ConfigureNotify) {
+ /*
+ * Must redraw after size changes, since layout could have changed
+ * and borders will need to be redrawn.
+ */
+
+ goto redraw;
+ } else if (eventPtr->type == DestroyNotify) {
+ TkpDestroyButton(butPtr);
+ if (butPtr->tkwin != NULL) {
+ butPtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(butPtr->interp, butPtr->widgetCmd);
+ }
+ if (butPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(TkpDisplayButton, (ClientData) butPtr);
+ }
+ DestroyButton(butPtr);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ butPtr->flags |= GOT_FOCUS;
+ if (butPtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ butPtr->flags &= ~GOT_FOCUS;
+ if (butPtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ }
+ return;
+
+ redraw:
+ if ((butPtr->tkwin != NULL) && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ButtonCmdDeletedProc --
+ *
+ * This procedure is invoked when a widget command is deleted. If
+ * the widget isn't already in the process of being destroyed,
+ * this command destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ButtonCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ TkButton *butPtr = (TkButton *) clientData;
+ Tk_Window tkwin = butPtr->tkwin;
+
+ /*
+ * This procedure could be invoked either because the window was
+ * destroyed and the command was then deleted (in which case tkwin
+ * is NULL) or because the command was deleted, and then this procedure
+ * destroys the widget.
+ */
+
+ if (tkwin != NULL) {
+ butPtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkInvokeButton --
+ *
+ * This procedure is called to carry out the actions associated
+ * with a button, such as invoking a Tcl command or setting a
+ * variable. This procedure is invoked, for example, when the
+ * button is invoked via the mouse.
+ *
+ * Results:
+ * A standard Tcl return value. Information is also left in
+ * interp->result.
+ *
+ * Side effects:
+ * Depends on the button and its associated command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkInvokeButton(butPtr)
+ register TkButton *butPtr; /* Information about button. */
+{
+ if (butPtr->type == TYPE_CHECK_BUTTON) {
+ if (butPtr->flags & SELECTED) {
+ if (Tcl_SetVar(butPtr->interp, butPtr->selVarName, butPtr->offValue,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ if (Tcl_SetVar(butPtr->interp, butPtr->selVarName, butPtr->onValue,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ } else if (butPtr->type == TYPE_RADIO_BUTTON) {
+ if (Tcl_SetVar(butPtr->interp, butPtr->selVarName, butPtr->onValue,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if ((butPtr->type != TYPE_LABEL) && (butPtr->command != NULL)) {
+ return TkCopyAndGlobalEval(butPtr->interp, butPtr->command);
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ButtonVarProc --
+ *
+ * This procedure is invoked when someone changes the
+ * state variable associated with a radio button. Depending
+ * on the new value of the button's variable, the button
+ * may be selected or deselected.
+ *
+ * Results:
+ * NULL is always returned.
+ *
+ * Side effects:
+ * The button may become selected or deselected.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+ButtonVarProc(clientData, interp, name1, name2, flags)
+ ClientData clientData; /* Information about button. */
+ Tcl_Interp *interp; /* Interpreter containing variable. */
+ char *name1; /* Name of variable. */
+ char *name2; /* Second part of variable name. */
+ int flags; /* Information about what happened. */
+{
+ register TkButton *butPtr = (TkButton *) clientData;
+ char *value;
+
+ /*
+ * If the variable is being unset, then just re-establish the
+ * trace unless the whole interpreter is going away.
+ */
+
+ if (flags & TCL_TRACE_UNSETS) {
+ butPtr->flags &= ~SELECTED;
+ if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+ Tcl_TraceVar(interp, butPtr->selVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonVarProc, clientData);
+ }
+ goto redisplay;
+ }
+
+ /*
+ * Use the value of the variable to update the selected status of
+ * the button.
+ */
+
+ value = Tcl_GetVar(interp, butPtr->selVarName, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ value = "";
+ }
+ if (strcmp(value, butPtr->onValue) == 0) {
+ if (butPtr->flags & SELECTED) {
+ return (char *) NULL;
+ }
+ butPtr->flags |= SELECTED;
+ } else if (butPtr->flags & SELECTED) {
+ butPtr->flags &= ~SELECTED;
+ } else {
+ return (char *) NULL;
+ }
+
+ redisplay:
+ if ((butPtr->tkwin != NULL) && Tk_IsMapped(butPtr->tkwin)
+ && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+ return (char *) NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ButtonTextVarProc --
+ *
+ * This procedure is invoked when someone changes the variable
+ * whose contents are to be displayed in a button.
+ *
+ * Results:
+ * NULL is always returned.
+ *
+ * Side effects:
+ * The text displayed in the button will change to match the
+ * variable.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+ButtonTextVarProc(clientData, interp, name1, name2, flags)
+ ClientData clientData; /* Information about button. */
+ Tcl_Interp *interp; /* Interpreter containing variable. */
+ char *name1; /* Not used. */
+ char *name2; /* Not used. */
+ int flags; /* Information about what happened. */
+{
+ register TkButton *butPtr = (TkButton *) clientData;
+ char *value;
+
+ /*
+ * If the variable is unset, then immediately recreate it unless
+ * the whole interpreter is going away.
+ */
+
+ if (flags & TCL_TRACE_UNSETS) {
+ if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+ Tcl_SetVar(interp, butPtr->textVarName, butPtr->text,
+ TCL_GLOBAL_ONLY);
+ Tcl_TraceVar(interp, butPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonTextVarProc, clientData);
+ }
+ return (char *) NULL;
+ }
+
+ value = Tcl_GetVar(interp, butPtr->textVarName, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ value = "";
+ }
+ if (butPtr->text != NULL) {
+ ckfree(butPtr->text);
+ }
+ butPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1));
+ strcpy(butPtr->text, value);
+ TkpComputeButtonGeometry(butPtr);
+
+ if ((butPtr->tkwin != NULL) && Tk_IsMapped(butPtr->tkwin)
+ && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+ return (char *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ButtonImageProc --
+ *
+ * This procedure is invoked by the image code whenever the manager
+ * for an image does something that affects the size of contents
+ * of an image displayed in a button.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for the button to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ButtonImageProc(clientData, x, y, width, height, imgWidth, imgHeight)
+ ClientData clientData; /* Pointer to widget record. */
+ int x, y; /* Upper left pixel (within image)
+ * that must be redisplayed. */
+ int width, height; /* Dimensions of area to redisplay
+ * (may be <= 0). */
+ int imgWidth, imgHeight; /* New dimensions of image. */
+{
+ register TkButton *butPtr = (TkButton *) clientData;
+
+ if (butPtr->tkwin != NULL) {
+ TkpComputeButtonGeometry(butPtr);
+ if (Tk_IsMapped(butPtr->tkwin) && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ButtonSelectImageProc --
+ *
+ * This procedure is invoked by the image code whenever the manager
+ * for an image does something that affects the size of contents
+ * of the image displayed in a button when it is selected.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May arrange for the button to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ButtonSelectImageProc(clientData, x, y, width, height, imgWidth, imgHeight)
+ ClientData clientData; /* Pointer to widget record. */
+ int x, y; /* Upper left pixel (within image)
+ * that must be redisplayed. */
+ int width, height; /* Dimensions of area to redisplay
+ * (may be <= 0). */
+ int imgWidth, imgHeight; /* New dimensions of image. */
+{
+ register TkButton *butPtr = (TkButton *) clientData;
+
+ /*
+ * Don't recompute geometry: it's controlled by the primary image.
+ */
+
+ if ((butPtr->flags & SELECTED) && (butPtr->tkwin != NULL)
+ && Tk_IsMapped(butPtr->tkwin)
+ && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+}
diff --git a/generic/tkButton.h b/generic/tkButton.h
new file mode 100644
index 0000000..0d5b928
--- /dev/null
+++ b/generic/tkButton.h
@@ -0,0 +1,241 @@
+/*
+ * tkButton.h --
+ *
+ * Declarations of types and functions used to implement
+ * button-like widgets.
+ *
+ * Copyright (c) 1996 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkButton.h 1.5 97/06/06 11:19:24
+ */
+
+#ifndef _TKBUTTON
+#define _TKBUTTON
+
+#ifndef _TKINT
+#include "tkInt.h"
+#endif
+
+/*
+ * A data structure of the following type is kept for each
+ * widget managed by this file:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the button. NULL
+ * means that the window has been destroyed. */
+ Display *display; /* Display containing widget. Needed to
+ * free up resources after tkwin is gone. */
+ Tcl_Interp *interp; /* Interpreter associated with button. */
+ Tcl_Command widgetCmd; /* Token for button's widget command. */
+ int type; /* Type of widget: restricts operations
+ * that may be performed on widget. See
+ * below for possible values. */
+
+ /*
+ * Information about what's in the button.
+ */
+
+ char *text; /* Text to display in button (malloc'ed)
+ * or NULL. */
+ int underline; /* Index of character to underline. < 0 means
+ * don't underline anything. */
+ char *textVarName; /* Name of variable (malloc'ed) or NULL.
+ * If non-NULL, button displays the contents
+ * of this variable. */
+ Pixmap bitmap; /* Bitmap to display or None. If not None
+ * then text and textVar are ignored. */
+ char *imageString; /* Name of image to display (malloc'ed), or
+ * NULL. If non-NULL, bitmap, text, and
+ * textVarName are ignored. */
+ Tk_Image image; /* Image to display in window, or NULL if
+ * none. */
+ char *selectImageString; /* Name of image to display when selected
+ * (malloc'ed), or NULL. */
+ Tk_Image selectImage; /* Image to display in window when selected,
+ * or NULL if none. Ignored if image is
+ * NULL. */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ Tk_Uid state; /* State of button for display purposes:
+ * normal, active, or disabled. */
+ Tk_3DBorder normalBorder; /* Structure used to draw 3-D
+ * border and background when window
+ * isn't active. NULL means no such
+ * border exists. */
+ Tk_3DBorder activeBorder; /* Structure used to draw 3-D
+ * border and background when window
+ * is active. NULL means no such
+ * border exists. */
+ int borderWidth; /* Width of border. */
+ int relief; /* 3-d effect: TK_RELIEF_RAISED, etc. */
+ int highlightWidth; /* Width in pixels of highlight to draw
+ * around widget when it has the focus.
+ * <= 0 means don't draw a highlight. */
+ Tk_3DBorder highlightBorder;
+ /* Structure used to draw 3-D default ring
+ * and focus highlight area when highlight
+ * is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+
+ int inset; /* Total width of all borders, including
+ * traversal highlight and 3-D border.
+ * Indicates how much interior stuff must
+ * be offset from outside edges to leave
+ * room for borders. */
+ Tk_Font tkfont; /* Information about text font, or NULL. */
+ XColor *normalFg; /* Foreground color in normal mode. */
+ XColor *activeFg; /* Foreground color in active mode. NULL
+ * means use normalFg instead. */
+ XColor *disabledFg; /* Foreground color when disabled. NULL
+ * means use normalFg with a 50% stipple
+ * instead. */
+ GC normalTextGC; /* GC for drawing text in normal mode. Also
+ * used to copy from off-screen pixmap onto
+ * screen. */
+ GC activeTextGC; /* GC for drawing text in active mode (NULL
+ * means use normalTextGC). */
+ Pixmap gray; /* Pixmap for displaying disabled text if
+ * disabledFg is NULL. */
+ GC disabledGC; /* Used to produce disabled effect. If
+ * disabledFg isn't NULL, this GC is used to
+ * draw button text or icon. Otherwise
+ * text or icon is drawn with normalGC and
+ * this GC is used to stipple background
+ * across it. For labels this is None. */
+ GC copyGC; /* Used for copying information from an
+ * off-screen pixmap to the screen. */
+ char *widthString; /* Value of -width option. Malloc'ed. */
+ char *heightString; /* Value of -height option. Malloc'ed. */
+ int width, height; /* If > 0, these specify dimensions to request
+ * for window, in characters for text and in
+ * pixels for bitmaps. In this case the actual
+ * size of the text string or bitmap is
+ * ignored in computing desired window size. */
+ int wrapLength; /* Line length (in pixels) at which to wrap
+ * onto next line. <= 0 means don't wrap
+ * except at newlines. */
+ int padX, padY; /* Extra space around text (pixels to leave
+ * on each side). Ignored for bitmaps and
+ * images. */
+ Tk_Anchor anchor; /* Where text/bitmap should be displayed
+ * inside button region. */
+ Tk_Justify justify; /* Justification to use for multi-line text. */
+ int indicatorOn; /* True means draw indicator, false means
+ * don't draw it. */
+ Tk_3DBorder selectBorder; /* For drawing indicator background, or perhaps
+ * widget background, when selected. */
+ int textWidth; /* Width needed to display text as requested,
+ * in pixels. */
+ int textHeight; /* Height needed to display text as requested,
+ * in pixels. */
+ Tk_TextLayout textLayout; /* Saved text layout information. */
+ int indicatorSpace; /* Horizontal space (in pixels) allocated for
+ * display of indicator. */
+ int indicatorDiameter; /* Diameter of indicator, in pixels. */
+ Tk_Uid defaultState; /* State of default ring: normal, active, or
+ * disabled. */
+
+ /*
+ * For check and radio buttons, the fields below are used
+ * to manage the variable indicating the button's state.
+ */
+
+ char *selVarName; /* Name of variable used to control selected
+ * state of button. Malloc'ed (if
+ * not NULL). */
+ char *onValue; /* Value to store in variable when
+ * this button is selected. Malloc'ed (if
+ * not NULL). */
+ char *offValue; /* Value to store in variable when this
+ * button isn't selected. Malloc'ed
+ * (if not NULL). Valid only for check
+ * buttons. */
+
+ /*
+ * Miscellaneous information:
+ */
+
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ char *takeFocus; /* Value of -takefocus option; not used in
+ * the C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+ char *command; /* Command to execute when button is
+ * invoked; valid for buttons only.
+ * If not NULL, it's malloc-ed. */
+ int flags; /* Various flags; see below for
+ * definitions. */
+} TkButton;
+
+/*
+ * Possible "type" values for buttons. These are the kinds of
+ * widgets supported by this file. The ordering of the type
+ * numbers is significant: greater means more features and is
+ * used in the code.
+ */
+
+#define TYPE_LABEL 0
+#define TYPE_BUTTON 1
+#define TYPE_CHECK_BUTTON 2
+#define TYPE_RADIO_BUTTON 3
+
+/*
+ * Flag bits for buttons:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler
+ * has already been queued to redraw
+ * this window.
+ * SELECTED: Non-zero means this button is selected,
+ * so special highlight should be drawn.
+ * GOT_FOCUS: Non-zero means this button currently
+ * has the input focus.
+ */
+
+#define REDRAW_PENDING 1
+#define SELECTED 2
+#define GOT_FOCUS 4
+
+/*
+ * Mask values used to selectively enable entries in the
+ * configuration specs:
+ */
+
+#define LABEL_MASK TK_CONFIG_USER_BIT
+#define BUTTON_MASK TK_CONFIG_USER_BIT << 1
+#define CHECK_BUTTON_MASK TK_CONFIG_USER_BIT << 2
+#define RADIO_BUTTON_MASK TK_CONFIG_USER_BIT << 3
+#define ALL_MASK (LABEL_MASK | BUTTON_MASK \
+ | CHECK_BUTTON_MASK | RADIO_BUTTON_MASK)
+
+/*
+ * Declaration of variables shared between the files in the button module.
+ */
+
+extern TkClassProcs tkpButtonProcs;
+extern Tk_ConfigSpec tkpButtonConfigSpecs[];
+
+/*
+ * Declaration of procedures used in the implementation of the button
+ * widget.
+ */
+
+EXTERN void TkButtonWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+EXTERN void TkpComputeButtonGeometry _ANSI_ARGS_((
+ TkButton *butPtr));
+EXTERN TkButton * TkpCreateButton _ANSI_ARGS_((Tk_Window tkwin));
+#ifndef TkpDestroyButton
+EXTERN void TkpDestroyButton _ANSI_ARGS_((TkButton *butPtr));
+#endif
+#ifndef TkpDisplayButton
+EXTERN void TkpDisplayButton _ANSI_ARGS_((ClientData clientData));
+#endif
+EXTERN int TkInvokeButton _ANSI_ARGS_((TkButton *butPtr));
+
+#endif /* _TKBUTTON */
diff --git a/generic/tkCanvArc.c b/generic/tkCanvArc.c
new file mode 100644
index 0000000..26b62e7
--- /dev/null
+++ b/generic/tkCanvArc.c
@@ -0,0 +1,1716 @@
+/*
+ * tkCanvArc.c --
+ *
+ * This file implements arc items for canvas widgets.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkCanvArc.c 1.34 97/04/25 16:50:56
+ */
+
+#include <stdio.h>
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * The structure below defines the record for each arc item.
+ */
+
+typedef struct ArcItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ double bbox[4]; /* Coordinates (x1, y1, x2, y2) of bounding
+ * box for oval of which arc is a piece. */
+ double start; /* Angle at which arc begins, in degrees
+ * between 0 and 360. */
+ double extent; /* Extent of arc (angular distance from
+ * start to end of arc) in degrees between
+ * -360 and 360. */
+ double *outlinePtr; /* Points to (x,y) coordinates for points
+ * that define one or two closed polygons
+ * representing the portion of the outline
+ * that isn't part of the arc (the V-shape
+ * for a pie slice or a line-like segment
+ * for a chord). Malloc'ed. */
+ int numOutlinePoints; /* Number of points at outlinePtr. Zero
+ * means no space allocated. */
+ int width; /* Width of outline (in pixels). */
+ XColor *outlineColor; /* Color for outline. NULL means don't
+ * draw outline. */
+ XColor *fillColor; /* Color for filling arc (used for drawing
+ * outline too when style is "arc"). NULL
+ * means don't fill arc. */
+ Pixmap fillStipple; /* Stipple bitmap for filling item. */
+ Pixmap outlineStipple; /* Stipple bitmap for outline. */
+ Tk_Uid style; /* How to draw arc: arc, chord, or pieslice. */
+ GC outlineGC; /* Graphics context for outline. */
+ GC fillGC; /* Graphics context for filling item. */
+ double center1[2]; /* Coordinates of center of arc outline at
+ * start (see ComputeArcOutline). */
+ double center2[2]; /* Coordinates of center of arc outline at
+ * start+extent (see ComputeArcOutline). */
+} ArcItem;
+
+/*
+ * The definitions below define the sizes of the polygons used to
+ * display outline information for various styles of arcs:
+ */
+
+#define CHORD_OUTLINE_PTS 7
+#define PIE_OUTLINE1_PTS 6
+#define PIE_OUTLINE2_PTS 7
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_DOUBLE, "-extent", (char *) NULL, (char *) NULL,
+ "90", Tk_Offset(ArcItem, extent), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, fillColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-outline", (char *) NULL, (char *) NULL,
+ "black", Tk_Offset(ArcItem, outlineColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-outlinestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, outlineStipple), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_DOUBLE, "-start", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(ArcItem, start), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, fillStipple), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_UID, "-style", (char *) NULL, (char *) NULL,
+ "pieslice", Tk_Offset(ArcItem, style), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
+ "1", Tk_Offset(ArcItem, width), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static void ComputeArcBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ ArcItem *arcPtr));
+static int ConfigureArc _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv, int flags));
+static int CreateArc _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int argc, char **argv));
+static void DeleteArc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayArc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static int ArcCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv));
+static int ArcToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+static double ArcToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *coordPtr));
+static int ArcToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+static void ScaleArc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void TranslateArc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+static int AngleInRange _ANSI_ARGS_((double x, double y,
+ double start, double extent));
+static void ComputeArcOutline _ANSI_ARGS_((ArcItem *arcPtr));
+static int HorizLineToArc _ANSI_ARGS_((double x1, double x2,
+ double y, double rx, double ry,
+ double start, double extent));
+static int VertLineToArc _ANSI_ARGS_((double x, double y1,
+ double y2, double rx, double ry,
+ double start, double extent));
+
+/*
+ * The structures below defines the arc item types by means of procedures
+ * that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkArcType = {
+ "arc", /* name */
+ sizeof(ArcItem), /* itemSize */
+ CreateArc, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureArc, /* configureProc */
+ ArcCoords, /* coordProc */
+ DeleteArc, /* deleteProc */
+ DisplayArc, /* displayProc */
+ 0, /* alwaysRedraw */
+ ArcToPoint, /* pointProc */
+ ArcToArea, /* areaProc */
+ ArcToPostscript, /* postscriptProc */
+ ScaleArc, /* scaleProc */
+ TranslateArc, /* translateProc */
+ (Tk_ItemIndexProc *) NULL, /* indexProc */
+ (Tk_ItemCursorProc *) NULL, /* icursorProc */
+ (Tk_ItemSelectionProc *) NULL, /* selectionProc */
+ (Tk_ItemInsertProc *) NULL, /* insertProc */
+ (Tk_ItemDCharsProc *) NULL, /* dTextProc */
+ (Tk_ItemType *) NULL /* nextPtr */
+};
+
+#ifndef PI
+# define PI 3.14159265358979323846
+#endif
+
+/*
+ * The uid's below comprise the legal values for the "-style"
+ * option for arcs.
+ */
+
+static Tk_Uid arcUid = NULL;
+static Tk_Uid chordUid = NULL;
+static Tk_Uid pieSliceUid = NULL;
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateArc --
+ *
+ * This procedure is invoked to create a new arc item in
+ * a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in
+ * creating the item, then an error message is left in
+ * interp->result; in this case itemPtr is
+ * left uninitialized, so it can be safely freed by the
+ * caller.
+ *
+ * Side effects:
+ * A new arc item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateArc(interp, canvas, itemPtr, argc, argv)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas to hold new item. */
+ Tk_Item *itemPtr; /* Record to hold new item; header
+ * has been initialized by caller. */
+ int argc; /* Number of arguments in argv. */
+ char **argv; /* Arguments describing arc. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
+ itemPtr->typePtr->name, " x1 y1 x2 y2 ?options?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Carry out once-only initialization.
+ */
+
+ if (arcUid == NULL) {
+ arcUid = Tk_GetUid("arc");
+ chordUid = Tk_GetUid("chord");
+ pieSliceUid = Tk_GetUid("pieslice");
+ }
+
+ /*
+ * Carry out initialization that is needed in order to clean
+ * up after errors during the the remainder of this procedure.
+ */
+
+ arcPtr->start = 0;
+ arcPtr->extent = 90;
+ arcPtr->outlinePtr = NULL;
+ arcPtr->numOutlinePoints = 0;
+ arcPtr->width = 1;
+ arcPtr->outlineColor = NULL;
+ arcPtr->fillColor = NULL;
+ arcPtr->fillStipple = None;
+ arcPtr->outlineStipple = None;
+ arcPtr->style = pieSliceUid;
+ arcPtr->outlineGC = None;
+ arcPtr->fillGC = None;
+
+ /*
+ * Process the arguments to fill in the item record.
+ */
+
+ if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &arcPtr->bbox[0]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[1],
+ &arcPtr->bbox[1]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[2],
+ &arcPtr->bbox[2]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[3],
+ &arcPtr->bbox[3]) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+
+ if (ConfigureArc(interp, canvas, itemPtr, argc-4, argv+4, 0) != TCL_OK) {
+ DeleteArc(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArcCoords --
+ *
+ * This procedure is invoked to process the "coords" widget
+ * command on arcs. See the user documentation for details
+ * on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets interp->result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ArcCoords(interp, canvas, itemPtr, argc, argv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item whose coordinates are to be
+ * read or modified. */
+ int argc; /* Number of coordinates supplied in
+ * argv. */
+ char **argv; /* Array of coordinates: x1, y1,
+ * x2, y2, ... */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ char c0[TCL_DOUBLE_SPACE], c1[TCL_DOUBLE_SPACE];
+ char c2[TCL_DOUBLE_SPACE], c3[TCL_DOUBLE_SPACE];
+
+ if (argc == 0) {
+ Tcl_PrintDouble(interp, arcPtr->bbox[0], c0);
+ Tcl_PrintDouble(interp, arcPtr->bbox[1], c1);
+ Tcl_PrintDouble(interp, arcPtr->bbox[2], c2);
+ Tcl_PrintDouble(interp, arcPtr->bbox[3], c3);
+ Tcl_AppendResult(interp, c0, " ", c1, " ", c2, " ", c3,
+ (char *) NULL);
+ } else if (argc == 4) {
+ if ((Tk_CanvasGetCoord(interp, canvas, argv[0],
+ &arcPtr->bbox[0]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[1],
+ &arcPtr->bbox[1]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[2],
+ &arcPtr->bbox[2]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[3],
+ &arcPtr->bbox[3]) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComputeArcBbox(canvas, arcPtr);
+ } else {
+ sprintf(interp->result,
+ "wrong # coordinates: expected 0 or 4, got %d",
+ argc);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureArc --
+ *
+ * This procedure is invoked to configure various aspects
+ * of a arc item, such as its outline and fill colors.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then
+ * an error message is left in interp->result.
+ *
+ * Side effects:
+ * Configuration information, such as colors and stipple
+ * patterns, may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureArc(interp, canvas, itemPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Arc item to reconfigure. */
+ int argc; /* Number of elements in argv. */
+ char **argv; /* Arguments describing things to configure. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ XGCValues gcValues;
+ GC newGC;
+ unsigned long mask;
+ int i;
+ Tk_Window tkwin;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv,
+ (char *) arcPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as
+ * style and graphics contexts.
+ */
+
+ i = (int) (arcPtr->start/360.0);
+ arcPtr->start -= i*360.0;
+ if (arcPtr->start < 0) {
+ arcPtr->start += 360.0;
+ }
+ i = (int) (arcPtr->extent/360.0);
+ arcPtr->extent -= i*360.0;
+
+ if ((arcPtr->style != arcUid) && (arcPtr->style != chordUid)
+ && (arcPtr->style != pieSliceUid)) {
+ Tcl_AppendResult(interp, "bad -style option \"",
+ arcPtr->style, "\": must be arc, chord, or pieslice",
+ (char *) NULL);
+ arcPtr->style = pieSliceUid;
+ return TCL_ERROR;
+ }
+
+ if (arcPtr->width < 0) {
+ arcPtr->width = 1;
+ }
+ if (arcPtr->outlineColor == NULL) {
+ newGC = None;
+ } else {
+ gcValues.foreground = arcPtr->outlineColor->pixel;
+ gcValues.cap_style = CapButt;
+ gcValues.line_width = arcPtr->width;
+ mask = GCForeground|GCCapStyle|GCLineWidth;
+ if (arcPtr->outlineStipple != None) {
+ gcValues.stipple = arcPtr->outlineStipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ }
+ if (arcPtr->outlineGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), arcPtr->outlineGC);
+ }
+ arcPtr->outlineGC = newGC;
+
+ if ((arcPtr->fillColor == NULL) || (arcPtr->style == arcUid)) {
+ newGC = None;
+ } else {
+ gcValues.foreground = arcPtr->fillColor->pixel;
+ if (arcPtr->style == chordUid) {
+ gcValues.arc_mode = ArcChord;
+ } else {
+ gcValues.arc_mode = ArcPieSlice;
+ }
+ mask = GCForeground|GCArcMode;
+ if (arcPtr->fillStipple != None) {
+ gcValues.stipple = arcPtr->fillStipple;
+ 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;
+
+ ComputeArcBbox(canvas, arcPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteArc --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a arc item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteArc(canvas, itemPtr, display)
+ Tk_Canvas canvas; /* Info about overall canvas. */
+ Tk_Item *itemPtr; /* Item that is being deleted. */
+ Display *display; /* Display containing window for
+ * canvas. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+
+ if (arcPtr->numOutlinePoints != 0) {
+ ckfree((char *) arcPtr->outlinePtr);
+ }
+ if (arcPtr->outlineColor != NULL) {
+ Tk_FreeColor(arcPtr->outlineColor);
+ }
+ if (arcPtr->fillColor != NULL) {
+ Tk_FreeColor(arcPtr->fillColor);
+ }
+ if (arcPtr->fillStipple != None) {
+ Tk_FreeBitmap(display, arcPtr->fillStipple);
+ }
+ if (arcPtr->outlineStipple != None) {
+ Tk_FreeBitmap(display, arcPtr->outlineStipple);
+ }
+ if (arcPtr->outlineGC != None) {
+ Tk_FreeGC(display, arcPtr->outlineGC);
+ }
+ if (arcPtr->fillGC != None) {
+ Tk_FreeGC(display, arcPtr->fillGC);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeArcBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of an arc.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ComputeArcBbox(canvas, arcPtr)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ ArcItem *arcPtr; /* Item whose bbox is to be
+ * recomputed. */
+{
+ double tmp, center[2], point[2];
+
+ /*
+ * Make sure that the first coordinates are the lowest ones.
+ */
+
+ if (arcPtr->bbox[1] > arcPtr->bbox[3]) {
+ double tmp;
+ tmp = arcPtr->bbox[3];
+ arcPtr->bbox[3] = arcPtr->bbox[1];
+ arcPtr->bbox[1] = tmp;
+ }
+ if (arcPtr->bbox[0] > arcPtr->bbox[2]) {
+ double tmp;
+ tmp = arcPtr->bbox[2];
+ arcPtr->bbox[2] = arcPtr->bbox[0];
+ arcPtr->bbox[0] = tmp;
+ }
+
+ ComputeArcOutline(arcPtr);
+
+ /*
+ * To compute the bounding box, start with the the bbox formed
+ * by the two endpoints of the arc. Then add in the center of
+ * the arc's oval (if relevant) and the 3-o'clock, 6-o'clock,
+ * 9-o'clock, and 12-o'clock positions, if they are relevant.
+ */
+
+ arcPtr->header.x1 = arcPtr->header.x2 = (int) arcPtr->center1[0];
+ arcPtr->header.y1 = arcPtr->header.y2 = (int) arcPtr->center1[1];
+ TkIncludePoint((Tk_Item *) arcPtr, arcPtr->center2);
+ center[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2;
+ center[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2;
+ if (arcPtr->style != arcUid) {
+ TkIncludePoint((Tk_Item *) arcPtr, center);
+ }
+
+ tmp = -arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ point[0] = arcPtr->bbox[2];
+ point[1] = center[1];
+ TkIncludePoint((Tk_Item *) arcPtr, point);
+ }
+ tmp = 90.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ point[0] = center[0];
+ point[1] = arcPtr->bbox[1];
+ TkIncludePoint((Tk_Item *) arcPtr, point);
+ }
+ tmp = 180.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ point[0] = arcPtr->bbox[0];
+ point[1] = center[1];
+ TkIncludePoint((Tk_Item *) arcPtr, point);
+ }
+ tmp = 270.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ point[0] = center[0];
+ point[1] = arcPtr->bbox[3];
+ TkIncludePoint((Tk_Item *) arcPtr, point);
+ }
+
+ /*
+ * Lastly, expand by the width of the arc (if the arc's outline is
+ * being drawn) and add one extra pixel just for safety.
+ */
+
+ if (arcPtr->outlineColor == NULL) {
+ tmp = 1;
+ } else {
+ tmp = (arcPtr->width + 1)/2 + 1;
+ }
+ arcPtr->header.x1 -= (int) tmp;
+ arcPtr->header.y1 -= (int) tmp;
+ arcPtr->header.x2 += (int) tmp;
+ arcPtr->header.y2 += (int) tmp;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayArc --
+ *
+ * This procedure is invoked to draw an arc item in a given
+ * drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * information in canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayArc(canvas, itemPtr, display, drawable, x, y, width, height)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ Tk_Item *itemPtr; /* Item to be displayed. */
+ Display *display; /* Display on which to draw item. */
+ Drawable drawable; /* Pixmap or window in which to draw
+ * item. */
+ int x, y, width, height; /* Describes region of canvas that
+ * must be redisplayed (not used). */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ short x1, y1, x2, y2;
+ int start, extent;
+
+ /*
+ * Compute the screen coordinates of the bounding box for the item,
+ * plus integer values for the angles.
+ */
+
+ Tk_CanvasDrawableCoords(canvas, arcPtr->bbox[0], arcPtr->bbox[1],
+ &x1, &y1);
+ Tk_CanvasDrawableCoords(canvas, arcPtr->bbox[2], arcPtr->bbox[3],
+ &x2, &y2);
+ if (x2 <= x1) {
+ x2 = x1+1;
+ }
+ if (y2 <= y1) {
+ y2 = y1+1;
+ }
+ start = (int) ((64*arcPtr->start) + 0.5);
+ extent = (int) ((64*arcPtr->extent) + 0.5);
+
+ /*
+ * Display filled arc first (if wanted), then outline. If the extent
+ * is zero then don't invoke XFillArc or XDrawArc, since this causes
+ * some window servers to crash and should be a no-op anyway.
+ */
+
+ if ((arcPtr->fillGC != None) && (extent != 0)) {
+ if (arcPtr->fillStipple != None) {
+ Tk_CanvasSetStippleOrigin(canvas, arcPtr->fillGC);
+ }
+ XFillArc(display, drawable, arcPtr->fillGC, x1, y1, (unsigned) (x2-x1),
+ (unsigned) (y2-y1), start, extent);
+ if (arcPtr->fillStipple != None) {
+ XSetTSOrigin(display, arcPtr->fillGC, 0, 0);
+ }
+ }
+ if (arcPtr->outlineGC != None) {
+ if (arcPtr->outlineStipple != None) {
+ Tk_CanvasSetStippleOrigin(canvas, arcPtr->outlineGC);
+ }
+ if (extent != 0) {
+ XDrawArc(display, drawable, arcPtr->outlineGC, x1, y1,
+ (unsigned) (x2-x1), (unsigned) (y2-y1), start, extent);
+ }
+
+ /*
+ * If the outline width is very thin, don't use polygons to draw
+ * the linear parts of the outline (this often results in nothing
+ * being displayed); just draw lines instead.
+ */
+
+ if (arcPtr->width <= 2) {
+ Tk_CanvasDrawableCoords(canvas, arcPtr->center1[0],
+ arcPtr->center1[1], &x1, &y1);
+ Tk_CanvasDrawableCoords(canvas, arcPtr->center2[0],
+ arcPtr->center2[1], &x2, &y2);
+
+ if (arcPtr->style == chordUid) {
+ XDrawLine(display, drawable, arcPtr->outlineGC,
+ x1, y1, x2, y2);
+ } else if (arcPtr->style == pieSliceUid) {
+ short cx, cy;
+
+ Tk_CanvasDrawableCoords(canvas,
+ (arcPtr->bbox[0] + arcPtr->bbox[2])/2.0,
+ (arcPtr->bbox[1] + arcPtr->bbox[3])/2.0, &cx, &cy);
+ XDrawLine(display, drawable, arcPtr->outlineGC,
+ cx, cy, x1, y1);
+ XDrawLine(display, drawable, arcPtr->outlineGC,
+ cx, cy, x2, y2);
+ }
+ } else {
+ if (arcPtr->style == chordUid) {
+ TkFillPolygon(canvas, arcPtr->outlinePtr, CHORD_OUTLINE_PTS,
+ display, drawable, arcPtr->outlineGC, None);
+ } else if (arcPtr->style == pieSliceUid) {
+ TkFillPolygon(canvas, arcPtr->outlinePtr, PIE_OUTLINE1_PTS,
+ display, drawable, arcPtr->outlineGC, None);
+ TkFillPolygon(canvas, arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS,
+ PIE_OUTLINE2_PTS, display, drawable, arcPtr->outlineGC,
+ None);
+ }
+ }
+ if (arcPtr->outlineStipple != None) {
+ XSetTSOrigin(display, arcPtr->outlineGC, 0, 0);
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArcToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * arc, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are coordPtr[0] and coordPtr[1] is inside the arc. If the
+ * point isn't inside the arc then the return value is the
+ * distance from the point to the arc. If itemPtr is filled,
+ * then anywhere in the interior is considered "inside"; if
+ * itemPtr isn't filled, then "inside" means only the area
+ * occupied by the outline.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static double
+ArcToPoint(canvas, itemPtr, pointPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *pointPtr; /* Pointer to x and y coordinates. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ double vertex[2], pointAngle, diff, dist, newDist;
+ double poly[8], polyDist, width, t1, t2;
+ int filled, angleInRange;
+
+ /*
+ * See if the point is within the angular range of the arc.
+ * Remember, X angles are backwards from the way we'd normally
+ * think of them. Also, compensate for any eccentricity of
+ * the oval.
+ */
+
+ vertex[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2.0;
+ vertex[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2.0;
+ t1 = (pointPtr[1] - vertex[1])/(arcPtr->bbox[3] - arcPtr->bbox[1]);
+ t2 = (pointPtr[0] - vertex[0])/(arcPtr->bbox[2] - arcPtr->bbox[0]);
+ if ((t1 == 0.0) && (t2 == 0.0)) {
+ pointAngle = 0;
+ } else {
+ pointAngle = -atan2(t1, t2)*180/PI;
+ }
+ diff = pointAngle - arcPtr->start;
+ diff -= ((int) (diff/360.0) * 360.0);
+ if (diff < 0) {
+ diff += 360.0;
+ }
+ angleInRange = (diff <= arcPtr->extent) ||
+ ((arcPtr->extent < 0) && ((diff - 360.0) >= arcPtr->extent));
+
+ /*
+ * Now perform different tests depending on what kind of arc
+ * we're dealing with.
+ */
+
+ if (arcPtr->style == arcUid) {
+ if (angleInRange) {
+ return TkOvalToPoint(arcPtr->bbox, (double) arcPtr->width,
+ 0, pointPtr);
+ }
+ dist = hypot(pointPtr[0] - arcPtr->center1[0],
+ pointPtr[1] - arcPtr->center1[1]);
+ newDist = hypot(pointPtr[0] - arcPtr->center2[0],
+ pointPtr[1] - arcPtr->center2[1]);
+ if (newDist < dist) {
+ return newDist;
+ }
+ return dist;
+ }
+
+ if ((arcPtr->fillGC != None) || (arcPtr->outlineGC == None)) {
+ filled = 1;
+ } else {
+ filled = 0;
+ }
+ if (arcPtr->outlineGC == None) {
+ width = 0.0;
+ } else {
+ width = arcPtr->width;
+ }
+
+ if (arcPtr->style == pieSliceUid) {
+ if (width > 1.0) {
+ dist = TkPolygonToPoint(arcPtr->outlinePtr, PIE_OUTLINE1_PTS,
+ pointPtr);
+ newDist = TkPolygonToPoint(arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS,
+ PIE_OUTLINE2_PTS, pointPtr);
+ } else {
+ dist = TkLineToPoint(vertex, arcPtr->center1, pointPtr);
+ newDist = TkLineToPoint(vertex, arcPtr->center2, pointPtr);
+ }
+ if (newDist < dist) {
+ dist = newDist;
+ }
+ if (angleInRange) {
+ newDist = TkOvalToPoint(arcPtr->bbox, width, filled, pointPtr);
+ if (newDist < dist) {
+ dist = newDist;
+ }
+ }
+ return dist;
+ }
+
+ /*
+ * This is a chord-style arc. We have to deal specially with the
+ * triangular piece that represents the difference between a
+ * chord-style arc and a pie-slice arc (for small angles this piece
+ * is excluded here where it would be included for pie slices;
+ * for large angles the piece is included here but would be
+ * excluded for pie slices).
+ */
+
+ if (width > 1.0) {
+ dist = TkPolygonToPoint(arcPtr->outlinePtr, CHORD_OUTLINE_PTS,
+ pointPtr);
+ } else {
+ dist = TkLineToPoint(arcPtr->center1, arcPtr->center2, pointPtr);
+ }
+ poly[0] = poly[6] = vertex[0];
+ poly[1] = poly[7] = vertex[1];
+ poly[2] = arcPtr->center1[0];
+ poly[3] = arcPtr->center1[1];
+ poly[4] = arcPtr->center2[0];
+ poly[5] = arcPtr->center2[1];
+ polyDist = TkPolygonToPoint(poly, 4, pointPtr);
+ if (angleInRange) {
+ if ((arcPtr->extent < -180.0) || (arcPtr->extent > 180.0)
+ || (polyDist > 0.0)) {
+ newDist = TkOvalToPoint(arcPtr->bbox, width, filled, pointPtr);
+ if (newDist < dist) {
+ dist = newDist;
+ }
+ }
+ } else {
+ if ((arcPtr->extent < -180.0) || (arcPtr->extent > 180.0)) {
+ if (filled && (polyDist < dist)) {
+ dist = polyDist;
+ }
+ }
+ }
+ return dist;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArcToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given area.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area
+ * given by rectPtr, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ArcToArea(canvas, itemPtr, rectPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against arc. */
+ double *rectPtr; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) describing rectangular
+ * area. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ double rx, ry; /* Radii for transformed oval: these define
+ * an oval centered at the origin. */
+ double tRect[4]; /* Transformed version of x1, y1, x2, y2,
+ * for coord. system where arc is centered
+ * on the origin. */
+ double center[2], width, angle, tmp;
+ double points[20], *pointPtr;
+ int numPoints, filled;
+ int inside; /* Non-zero means every test so far suggests
+ * that arc is inside rectangle. 0 means
+ * every test so far shows arc to be outside
+ * of rectangle. */
+ int newInside;
+
+ if ((arcPtr->fillGC != None) || (arcPtr->outlineGC == None)) {
+ filled = 1;
+ } else {
+ filled = 0;
+ }
+ if (arcPtr->outlineGC == None) {
+ width = 0.0;
+ } else {
+ width = arcPtr->width;
+ }
+
+ /*
+ * Transform both the arc and the rectangle so that the arc's oval
+ * is centered on the origin.
+ */
+
+ center[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2.0;
+ center[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2.0;
+ tRect[0] = rectPtr[0] - center[0];
+ tRect[1] = rectPtr[1] - center[1];
+ tRect[2] = rectPtr[2] - center[0];
+ tRect[3] = rectPtr[3] - center[1];
+ rx = arcPtr->bbox[2] - center[0] + width/2.0;
+ ry = arcPtr->bbox[3] - center[1] + width/2.0;
+
+ /*
+ * Find the extreme points of the arc and see whether these are all
+ * inside the rectangle (in which case we're done), partly in and
+ * partly out (in which case we're done), or all outside (in which
+ * case we have more work to do). The extreme points include the
+ * following, which are checked in order:
+ *
+ * 1. The outside points of the arc, corresponding to start and
+ * extent.
+ * 2. The center of the arc (but only in pie-slice mode).
+ * 3. The 12, 3, 6, and 9-o'clock positions (but only if the arc
+ * includes those angles).
+ */
+
+ pointPtr = points;
+ angle = -arcPtr->start*(PI/180.0);
+ pointPtr[0] = rx*cos(angle);
+ pointPtr[1] = ry*sin(angle);
+ angle += -arcPtr->extent*(PI/180.0);
+ pointPtr[2] = rx*cos(angle);
+ pointPtr[3] = ry*sin(angle);
+ numPoints = 2;
+ pointPtr += 4;
+
+ if ((arcPtr->style == pieSliceUid) && (arcPtr->extent < 180.0)) {
+ pointPtr[0] = 0.0;
+ pointPtr[1] = 0.0;
+ numPoints++;
+ pointPtr += 2;
+ }
+
+ tmp = -arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ pointPtr[0] = rx;
+ pointPtr[1] = 0.0;
+ numPoints++;
+ pointPtr += 2;
+ }
+ tmp = 90.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ pointPtr[0] = 0.0;
+ pointPtr[1] = -ry;
+ numPoints++;
+ pointPtr += 2;
+ }
+ tmp = 180.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ pointPtr[0] = -rx;
+ pointPtr[1] = 0.0;
+ numPoints++;
+ pointPtr += 2;
+ }
+ tmp = 270.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ pointPtr[0] = 0.0;
+ pointPtr[1] = ry;
+ numPoints++;
+ }
+
+ /*
+ * Now that we've located the extreme points, loop through them all
+ * to see which are inside the rectangle.
+ */
+
+ inside = (points[0] > tRect[0]) && (points[0] < tRect[2])
+ && (points[1] > tRect[1]) && (points[1] < tRect[3]);
+ for (pointPtr = points+2; numPoints > 1; pointPtr += 2, numPoints--) {
+ newInside = (pointPtr[0] > tRect[0]) && (pointPtr[0] < tRect[2])
+ && (pointPtr[1] > tRect[1]) && (pointPtr[1] < tRect[3]);
+ if (newInside != inside) {
+ return 0;
+ }
+ }
+
+ if (inside) {
+ return 1;
+ }
+
+ /*
+ * So far, oval appears to be outside rectangle, but can't yet tell
+ * for sure. Next, test each of the four sides of the rectangle
+ * against the bounding region for the arc. If any intersections
+ * are found, then return "overlapping". First, test against the
+ * polygon(s) forming the sides of a chord or pie-slice.
+ */
+
+ if (arcPtr->style == pieSliceUid) {
+ if (width >= 1.0) {
+ if (TkPolygonToArea(arcPtr->outlinePtr, PIE_OUTLINE1_PTS,
+ rectPtr) != -1) {
+ return 0;
+ }
+ if (TkPolygonToArea(arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS,
+ PIE_OUTLINE2_PTS, rectPtr) != -1) {
+ return 0;
+ }
+ } else {
+ if ((TkLineToArea(center, arcPtr->center1, rectPtr) != -1) ||
+ (TkLineToArea(center, arcPtr->center2, rectPtr) != -1)) {
+ return 0;
+ }
+ }
+ } else if (arcPtr->style == chordUid) {
+ if (width >= 1.0) {
+ if (TkPolygonToArea(arcPtr->outlinePtr, CHORD_OUTLINE_PTS,
+ rectPtr) != -1) {
+ return 0;
+ }
+ } else {
+ if (TkLineToArea(arcPtr->center1, arcPtr->center2,
+ rectPtr) != -1) {
+ return 0;
+ }
+ }
+ }
+
+ /*
+ * Next check for overlap between each of the four sides and the
+ * outer perimiter of the arc. If the arc isn't filled, then also
+ * check the inner perimeter of the arc.
+ */
+
+ if (HorizLineToArc(tRect[0], tRect[2], tRect[1], rx, ry, arcPtr->start,
+ arcPtr->extent)
+ || HorizLineToArc(tRect[0], tRect[2], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)
+ || VertLineToArc(tRect[0], tRect[1], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)
+ || VertLineToArc(tRect[2], tRect[1], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)) {
+ return 0;
+ }
+ if ((width > 1.0) && !filled) {
+ rx -= width;
+ ry -= width;
+ if (HorizLineToArc(tRect[0], tRect[2], tRect[1], rx, ry, arcPtr->start,
+ arcPtr->extent)
+ || HorizLineToArc(tRect[0], tRect[2], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)
+ || VertLineToArc(tRect[0], tRect[1], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)
+ || VertLineToArc(tRect[2], tRect[1], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)) {
+ return 0;
+ }
+ }
+
+ /*
+ * The arc still appears to be totally disjoint from the rectangle,
+ * but it's also possible that the rectangle is totally inside the arc.
+ * Do one last check, which is to check one point of the rectangle
+ * to see if it's inside the arc. If it is, we've got overlap. If
+ * it isn't, the arc's really outside the rectangle.
+ */
+
+ if (ArcToPoint(canvas, itemPtr, rectPtr) == 0.0) {
+ return 0;
+ }
+ return -1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleArc --
+ *
+ * This procedure is invoked to rescale an arc item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The arc referred to by itemPtr is rescaled so that the
+ * following transformation is applied to all point
+ * coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleArc(canvas, itemPtr, originX, originY, scaleX, scaleY)
+ Tk_Canvas canvas; /* Canvas containing arc. */
+ Tk_Item *itemPtr; /* Arc to be scaled. */
+ double originX, originY; /* Origin about which to scale rect. */
+ double scaleX; /* Amount to scale in X direction. */
+ double scaleY; /* Amount to scale in Y direction. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+
+ arcPtr->bbox[0] = originX + scaleX*(arcPtr->bbox[0] - originX);
+ arcPtr->bbox[1] = originY + scaleY*(arcPtr->bbox[1] - originY);
+ arcPtr->bbox[2] = originX + scaleX*(arcPtr->bbox[2] - originX);
+ arcPtr->bbox[3] = originY + scaleY*(arcPtr->bbox[3] - originY);
+ ComputeArcBbox(canvas, arcPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateArc --
+ *
+ * This procedure is called to move an arc by a given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the arc is offset by (xDelta, yDelta), and
+ * the bounding box is updated in the generic part of the item
+ * structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateArc(canvas, itemPtr, deltaX, deltaY)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item that is being moved. */
+ double deltaX, deltaY; /* Amount by which item is to be
+ * moved. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+
+ arcPtr->bbox[0] += deltaX;
+ arcPtr->bbox[1] += deltaY;
+ arcPtr->bbox[2] += deltaX;
+ arcPtr->bbox[3] += deltaY;
+ ComputeArcBbox(canvas, arcPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeArcOutline --
+ *
+ * This procedure creates a polygon describing everything in
+ * the outline for an arc except what's in the curved part.
+ * For a "pie slice" arc this is a V-shaped chunk, and for
+ * a "chord" arc this is a linear chunk (with cutaway corners).
+ * For "arc" arcs, this stuff isn't relevant.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The information at arcPtr->outlinePtr gets modified, and
+ * storage for arcPtr->outlinePtr may be allocated or freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputeArcOutline(arcPtr)
+ ArcItem *arcPtr; /* Information about arc. */
+{
+ double sin1, cos1, sin2, cos2, angle, halfWidth;
+ double boxWidth, boxHeight;
+ double vertex[2], corner1[2], corner2[2];
+ double *outlinePtr;
+
+ /*
+ * Make sure that the outlinePtr array is large enough to hold
+ * either a chord or pie-slice outline.
+ */
+
+ if (arcPtr->numOutlinePoints == 0) {
+ arcPtr->outlinePtr = (double *) ckalloc((unsigned)
+ (26 * sizeof(double)));
+ arcPtr->numOutlinePoints = 22;
+ }
+ outlinePtr = arcPtr->outlinePtr;
+
+ /*
+ * First compute the two points that lie at the centers of
+ * the ends of the curved arc segment, which are marked with
+ * X's in the figure below:
+ *
+ *
+ * * * *
+ * * *
+ * * * * *
+ * * * * *
+ * * * * *
+ * X * * X
+ *
+ * The code is tricky because the arc can be ovular in shape.
+ * It computes the position for a unit circle, and then
+ * scales to fit the shape of the arc's bounding box.
+ *
+ * Also, watch out because angles go counter-clockwise like you
+ * might expect, but the y-coordinate system is inverted. To
+ * handle this, just negate the angles in all the computations.
+ */
+
+ boxWidth = arcPtr->bbox[2] - arcPtr->bbox[0];
+ boxHeight = arcPtr->bbox[3] - arcPtr->bbox[1];
+ angle = -arcPtr->start*PI/180.0;
+ sin1 = sin(angle);
+ cos1 = cos(angle);
+ angle -= arcPtr->extent*PI/180.0;
+ sin2 = sin(angle);
+ cos2 = cos(angle);
+ vertex[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2.0;
+ vertex[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2.0;
+ arcPtr->center1[0] = vertex[0] + cos1*boxWidth/2.0;
+ arcPtr->center1[1] = vertex[1] + sin1*boxHeight/2.0;
+ arcPtr->center2[0] = vertex[0] + cos2*boxWidth/2.0;
+ arcPtr->center2[1] = vertex[1] + sin2*boxHeight/2.0;
+
+ /*
+ * Next compute the "outermost corners" of the arc, which are
+ * marked with X's in the figure below:
+ *
+ * * * *
+ * * *
+ * * * * *
+ * * * * *
+ * X * * X
+ * * *
+ *
+ * The code below is tricky because it has to handle eccentricity
+ * in the shape of the oval. The key in the code below is to
+ * realize that the slope of the line from arcPtr->center1 to corner1
+ * is (boxWidth*sin1)/(boxHeight*cos1), and similarly for arcPtr->center2
+ * and corner2. These formulas can be computed from the formula for
+ * the oval.
+ */
+
+ halfWidth = arcPtr->width/2.0;
+ if (((boxWidth*sin1) == 0.0) && ((boxHeight*cos1) == 0.0)) {
+ angle = 0.0;
+ } else {
+ angle = atan2(boxWidth*sin1, boxHeight*cos1);
+ }
+ corner1[0] = arcPtr->center1[0] + cos(angle)*halfWidth;
+ corner1[1] = arcPtr->center1[1] + sin(angle)*halfWidth;
+ if (((boxWidth*sin2) == 0.0) && ((boxHeight*cos2) == 0.0)) {
+ angle = 0.0;
+ } else {
+ angle = atan2(boxWidth*sin2, boxHeight*cos2);
+ }
+ corner2[0] = arcPtr->center2[0] + cos(angle)*halfWidth;
+ corner2[1] = arcPtr->center2[1] + sin(angle)*halfWidth;
+
+ /*
+ * For a chord outline, generate a six-sided polygon with three
+ * points for each end of the chord. The first and third points
+ * for each end are butt points generated on either side of the
+ * center point. The second point is the corner point.
+ */
+
+ if (arcPtr->style == chordUid) {
+ outlinePtr[0] = outlinePtr[12] = corner1[0];
+ outlinePtr[1] = outlinePtr[13] = corner1[1];
+ TkGetButtPoints(arcPtr->center2, arcPtr->center1,
+ (double) arcPtr->width, 0, outlinePtr+10, outlinePtr+2);
+ outlinePtr[4] = arcPtr->center2[0] + outlinePtr[2]
+ - arcPtr->center1[0];
+ outlinePtr[5] = arcPtr->center2[1] + outlinePtr[3]
+ - arcPtr->center1[1];
+ outlinePtr[6] = corner2[0];
+ outlinePtr[7] = corner2[1];
+ outlinePtr[8] = arcPtr->center2[0] + outlinePtr[10]
+ - arcPtr->center1[0];
+ outlinePtr[9] = arcPtr->center2[1] + outlinePtr[11]
+ - arcPtr->center1[1];
+ } else if (arcPtr->style == pieSliceUid) {
+ /*
+ * For pie slices, generate two polygons, one for each side
+ * of the pie slice. The first arm has a shape like this,
+ * where the center of the oval is X, arcPtr->center1 is at Y, and
+ * corner1 is at Z:
+ *
+ * _____________________
+ * | \
+ * | \
+ * X Y Z
+ * | /
+ * |_____________________/
+ *
+ */
+
+ TkGetButtPoints(arcPtr->center1, vertex, (double) arcPtr->width, 0,
+ outlinePtr, outlinePtr+2);
+ outlinePtr[4] = arcPtr->center1[0] + outlinePtr[2] - vertex[0];
+ outlinePtr[5] = arcPtr->center1[1] + outlinePtr[3] - vertex[1];
+ outlinePtr[6] = corner1[0];
+ outlinePtr[7] = corner1[1];
+ outlinePtr[8] = arcPtr->center1[0] + outlinePtr[0] - vertex[0];
+ outlinePtr[9] = arcPtr->center1[1] + outlinePtr[1] - vertex[1];
+ outlinePtr[10] = outlinePtr[0];
+ outlinePtr[11] = outlinePtr[1];
+
+ /*
+ * The second arm has a shape like this:
+ *
+ *
+ * ______________________
+ * / \
+ * / \
+ * Z Y X /
+ * \ /
+ * \______________________/
+ *
+ * Similar to above X is the center of the oval/circle, Y is
+ * arcPtr->center2, and Z is corner2. The extra jog out to the left
+ * of X is needed in or to produce a butted joint with the
+ * first arm; the corner to the right of X is one of the
+ * first two points of the first arm, depending on extent.
+ */
+
+ TkGetButtPoints(arcPtr->center2, vertex, (double) arcPtr->width, 0,
+ outlinePtr+12, outlinePtr+16);
+ if ((arcPtr->extent > 180) ||
+ ((arcPtr->extent < 0) && (arcPtr->extent > -180))) {
+ outlinePtr[14] = outlinePtr[0];
+ outlinePtr[15] = outlinePtr[1];
+ } else {
+ outlinePtr[14] = outlinePtr[2];
+ outlinePtr[15] = outlinePtr[3];
+ }
+ outlinePtr[18] = arcPtr->center2[0] + outlinePtr[16] - vertex[0];
+ outlinePtr[19] = arcPtr->center2[1] + outlinePtr[17] - vertex[1];
+ outlinePtr[20] = corner2[0];
+ outlinePtr[21] = corner2[1];
+ outlinePtr[22] = arcPtr->center2[0] + outlinePtr[12] - vertex[0];
+ outlinePtr[23] = arcPtr->center2[1] + outlinePtr[13] - vertex[1];
+ outlinePtr[24] = outlinePtr[12];
+ outlinePtr[25] = outlinePtr[13];
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * HorizLineToArc --
+ *
+ * Determines whether a horizontal line segment intersects
+ * a given arc.
+ *
+ * Results:
+ * The return value is 1 if the given line intersects the
+ * infinitely-thin arc section defined by rx, ry, start,
+ * and extent, and 0 otherwise. Only the perimeter of the
+ * arc is checked: interior areas (e.g. pie-slice or chord)
+ * are not checked.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+HorizLineToArc(x1, x2, y, rx, ry, start, extent)
+ double x1, x2; /* X-coords of endpoints of line segment.
+ * X1 must be <= x2. */
+ double y; /* Y-coordinate of line segment. */
+ double rx, ry; /* These x- and y-radii define an oval
+ * centered at the origin. */
+ double start, extent; /* Angles that define extent of arc, in
+ * the standard fashion for this module. */
+{
+ double tmp;
+ double tx, ty; /* Coordinates of intersection point in
+ * transformed coordinate system. */
+ double x;
+
+ /*
+ * Compute the x-coordinate of one possible intersection point
+ * between the arc and the line. Use a transformed coordinate
+ * system where the oval is a unit circle centered at the origin.
+ * Then scale back to get actual x-coordinate.
+ */
+
+ ty = y/ry;
+ tmp = 1 - ty*ty;
+ if (tmp < 0) {
+ return 0;
+ }
+ tx = sqrt(tmp);
+ x = tx*rx;
+
+ /*
+ * Test both intersection points.
+ */
+
+ if ((x >= x1) && (x <= x2) && AngleInRange(tx, ty, start, extent)) {
+ return 1;
+ }
+ if ((-x >= x1) && (-x <= x2) && AngleInRange(-tx, ty, start, extent)) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * VertLineToArc --
+ *
+ * Determines whether a vertical line segment intersects
+ * a given arc.
+ *
+ * Results:
+ * The return value is 1 if the given line intersects the
+ * infinitely-thin arc section defined by rx, ry, start,
+ * and extent, and 0 otherwise. Only the perimeter of the
+ * arc is checked: interior areas (e.g. pie-slice or chord)
+ * are not checked.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+VertLineToArc(x, y1, y2, rx, ry, start, extent)
+ double x; /* X-coordinate of line segment. */
+ double y1, y2; /* Y-coords of endpoints of line segment.
+ * Y1 must be <= y2. */
+ double rx, ry; /* These x- and y-radii define an oval
+ * centered at the origin. */
+ double start, extent; /* Angles that define extent of arc, in
+ * the standard fashion for this module. */
+{
+ double tmp;
+ double tx, ty; /* Coordinates of intersection point in
+ * transformed coordinate system. */
+ double y;
+
+ /*
+ * Compute the y-coordinate of one possible intersection point
+ * between the arc and the line. Use a transformed coordinate
+ * system where the oval is a unit circle centered at the origin.
+ * Then scale back to get actual y-coordinate.
+ */
+
+ tx = x/rx;
+ tmp = 1 - tx*tx;
+ if (tmp < 0) {
+ return 0;
+ }
+ ty = sqrt(tmp);
+ y = ty*ry;
+
+ /*
+ * Test both intersection points.
+ */
+
+ if ((y > y1) && (y < y2) && AngleInRange(tx, ty, start, extent)) {
+ return 1;
+ }
+ if ((-y > y1) && (-y < y2) && AngleInRange(tx, -ty, start, extent)) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * AngleInRange --
+ *
+ * Determine whether the angle from the origin to a given
+ * point is within a given range.
+ *
+ * Results:
+ * The return value is 1 if the angle from (0,0) to (x,y)
+ * is in the range given by start and extent, where angles
+ * are interpreted in the standard way for ovals (meaning
+ * backwards from normal interpretation). Otherwise the
+ * return value is 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+AngleInRange(x, y, start, extent)
+ double x, y; /* Coordinate of point; angle measured
+ * from origin to here, relative to x-axis. */
+ double start; /* First angle, degrees, >=0, <=360. */
+ double extent; /* Size of arc in degrees >=-360, <=360. */
+{
+ double diff;
+
+ if ((x == 0.0) && (y == 0.0)) {
+ return 1;
+ }
+ diff = -atan2(y, x);
+ diff = diff*(180.0/PI) - start;
+ while (diff > 360.0) {
+ diff -= 360.0;
+ }
+ while (diff < 0.0) {
+ diff += 360.0;
+ }
+ if (extent >= 0) {
+ return diff <= extent;
+ }
+ return (diff-360.0) >= extent;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArcToPostscript --
+ *
+ * This procedure is called to generate Postscript for
+ * arc items.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error
+ * occurs in generating Postscript then an error message is
+ * left in interp->result, replacing whatever used
+ * to be there. If no error occurs, then Postscript for the
+ * item is appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ArcToPostscript(interp, canvas, itemPtr, prepass)
+ Tcl_Interp *interp; /* Leave Postscript or error message
+ * here. */
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ Tk_Item *itemPtr; /* Item for which Postscript is
+ * wanted. */
+ int prepass; /* 1 means this is a prepass to
+ * collect font information; 0 means
+ * final Postscript is being created. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ char buffer[400];
+ double y1, y2, ang1, ang2;
+
+ y1 = Tk_CanvasPsY(canvas, arcPtr->bbox[1]);
+ y2 = Tk_CanvasPsY(canvas, arcPtr->bbox[3]);
+ ang1 = arcPtr->start;
+ ang2 = ang1 + arcPtr->extent;
+ if (ang2 < ang1) {
+ ang1 = ang2;
+ ang2 = arcPtr->start;
+ }
+
+ /*
+ * If the arc is filled, output Postscript for the interior region
+ * of the arc.
+ */
+
+ if (arcPtr->fillGC != None) {
+ sprintf(buffer, "matrix currentmatrix\n%.15g %.15g translate %.15g %.15g scale\n",
+ (arcPtr->bbox[0] + arcPtr->bbox[2])/2, (y1 + y2)/2,
+ (arcPtr->bbox[2] - arcPtr->bbox[0])/2, (y1 - y2)/2);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ if (arcPtr->style == chordUid) {
+ sprintf(buffer, "0 0 1 %.15g %.15g arc closepath\nsetmatrix\n",
+ ang1, ang2);
+ } else {
+ sprintf(buffer,
+ "0 0 moveto 0 0 1 %.15g %.15g arc closepath\nsetmatrix\n",
+ ang1, ang2);
+ }
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ if (Tk_CanvasPsColor(interp, canvas, arcPtr->fillColor) != TCL_OK) {
+ return TCL_ERROR;
+ };
+ if (arcPtr->fillStipple != None) {
+ Tcl_AppendResult(interp, "clip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas, arcPtr->fillStipple)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (arcPtr->outlineGC != None) {
+ Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
+ }
+ } else {
+ Tcl_AppendResult(interp, "fill\n", (char *) NULL);
+ }
+ }
+
+ /*
+ * If there's an outline for the arc, draw it.
+ */
+
+ if (arcPtr->outlineGC != None) {
+ sprintf(buffer, "matrix currentmatrix\n%.15g %.15g translate %.15g %.15g scale\n",
+ (arcPtr->bbox[0] + arcPtr->bbox[2])/2, (y1 + y2)/2,
+ (arcPtr->bbox[2] - arcPtr->bbox[0])/2, (y1 - y2)/2);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ sprintf(buffer, "0 0 1 %.15g %.15g arc\nsetmatrix\n", ang1, ang2);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ sprintf(buffer, "%d setlinewidth\n0 setlinecap\n", arcPtr->width);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ if (Tk_CanvasPsColor(interp, canvas, arcPtr->outlineColor)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (arcPtr->outlineStipple != None) {
+ Tcl_AppendResult(interp, "StrokeClip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas,
+ arcPtr->outlineStipple) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "stroke\n", (char *) NULL);
+ }
+ if (arcPtr->style != arcUid) {
+ Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
+ if (arcPtr->style == chordUid) {
+ Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr,
+ CHORD_OUTLINE_PTS);
+ } else {
+ Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr,
+ PIE_OUTLINE1_PTS);
+ if (Tk_CanvasPsColor(interp, canvas, arcPtr->outlineColor)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (arcPtr->outlineStipple != None) {
+ Tcl_AppendResult(interp, "clip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas,
+ arcPtr->outlineStipple) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "fill\n", (char *) NULL);
+ }
+ Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
+ Tk_CanvasPsPath(interp, canvas,
+ arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS,
+ PIE_OUTLINE2_PTS);
+ }
+ if (Tk_CanvasPsColor(interp, canvas, arcPtr->outlineColor)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (arcPtr->outlineStipple != None) {
+ Tcl_AppendResult(interp, "clip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas,
+ arcPtr->outlineStipple) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "fill\n", (char *) NULL);
+ }
+ }
+ }
+
+ return TCL_OK;
+}
diff --git a/generic/tkCanvBmap.c b/generic/tkCanvBmap.c
new file mode 100644
index 0000000..fff0638
--- /dev/null
+++ b/generic/tkCanvBmap.c
@@ -0,0 +1,800 @@
+/*
+ * tkCanvBmap.c --
+ *
+ * This file implements bitmap items for canvas widgets.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkCanvBmap.c 1.30 96/05/03 10:49:00
+ */
+
+#include <stdio.h>
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkCanvas.h"
+
+/*
+ * The structure below defines the record for each bitmap item.
+ */
+
+typedef struct BitmapItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ double x, y; /* Coordinates of positioning point for
+ * bitmap. */
+ Tk_Anchor anchor; /* Where to anchor bitmap relative to
+ * (x,y). */
+ Pixmap bitmap; /* Bitmap to display in window. */
+ XColor *fgColor; /* Foreground color to use for bitmap. */
+ XColor *bgColor; /* Background color to use for bitmap. */
+ GC gc; /* Graphics context to use for drawing
+ * bitmap on screen. */
+} BitmapItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", (char *) NULL, (char *) NULL,
+ "center", Tk_Offset(BitmapItem, anchor), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_COLOR, "-background", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapItem, bgColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-bitmap", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapItem, bitmap), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-foreground", (char *) NULL, (char *) NULL,
+ "black", Tk_Offset(BitmapItem, fgColor), 0},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static int BitmapCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv));
+static int BitmapToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+static double BitmapToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *coordPtr));
+static int BitmapToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+static void ComputeBitmapBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ BitmapItem *bmapPtr));
+static int ConfigureBitmap _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv, int flags));
+static int CreateBitmap _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int argc, char **argv));
+static void DeleteBitmap _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayBitmap _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static void ScaleBitmap _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void TranslateBitmap _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+
+/*
+ * The structures below defines the bitmap item type in terms of
+ * procedures that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkBitmapType = {
+ "bitmap", /* name */
+ sizeof(BitmapItem), /* itemSize */
+ CreateBitmap, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureBitmap, /* configureProc */
+ BitmapCoords, /* coordProc */
+ DeleteBitmap, /* deleteProc */
+ DisplayBitmap, /* displayProc */
+ 0, /* alwaysRedraw */
+ BitmapToPoint, /* pointProc */
+ BitmapToArea, /* areaProc */
+ BitmapToPostscript, /* postscriptProc */
+ ScaleBitmap, /* scaleProc */
+ TranslateBitmap, /* translateProc */
+ (Tk_ItemIndexProc *) NULL, /* indexProc */
+ (Tk_ItemCursorProc *) NULL, /* icursorProc */
+ (Tk_ItemSelectionProc *) NULL, /* selectionProc */
+ (Tk_ItemInsertProc *) NULL, /* insertProc */
+ (Tk_ItemDCharsProc *) NULL, /* dTextProc */
+ (Tk_ItemType *) NULL /* nextPtr */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateBitmap --
+ *
+ * This procedure is invoked to create a new bitmap
+ * item in a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in
+ * creating the item, then an error message is left in
+ * interp->result; in this case itemPtr is left uninitialized,
+ * so it can be safely freed by the caller.
+ *
+ * Side effects:
+ * A new bitmap item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateBitmap(interp, canvas, itemPtr, argc, argv)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas to hold new item. */
+ Tk_Item *itemPtr; /* Record to hold new item; header
+ * has been initialized by caller. */
+ int argc; /* Number of arguments in argv. */
+ char **argv; /* Arguments describing rectangle. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
+ itemPtr->typePtr->name, " x y ?options?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Initialize item's record.
+ */
+
+ bmapPtr->anchor = TK_ANCHOR_CENTER;
+ bmapPtr->bitmap = None;
+ bmapPtr->fgColor = NULL;
+ bmapPtr->bgColor = NULL;
+ bmapPtr->gc = None;
+
+ /*
+ * Process the arguments to fill in the item record.
+ */
+
+ if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &bmapPtr->x) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[1], &bmapPtr->y)
+ != TCL_OK)) {
+ return TCL_ERROR;
+ }
+
+ if (ConfigureBitmap(interp, canvas, itemPtr, argc-2, argv+2, 0) != TCL_OK) {
+ DeleteBitmap(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * BitmapCoords --
+ *
+ * This procedure is invoked to process the "coords" widget
+ * command on bitmap items. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets interp->result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+BitmapCoords(interp, canvas, itemPtr, argc, argv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item whose coordinates are to be
+ * read or modified. */
+ int argc; /* Number of coordinates supplied in
+ * argv. */
+ char **argv; /* Array of coordinates: x1, y1,
+ * x2, y2, ... */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+ char x[TCL_DOUBLE_SPACE], y[TCL_DOUBLE_SPACE];
+
+ if (argc == 0) {
+ Tcl_PrintDouble(interp, bmapPtr->x, x);
+ Tcl_PrintDouble(interp, bmapPtr->y, y);
+ Tcl_AppendResult(interp, x, " ", y, (char *) NULL);
+ } else if (argc == 2) {
+ if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &bmapPtr->x) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[1], &bmapPtr->y)
+ != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComputeBitmapBbox(canvas, bmapPtr);
+ } else {
+ sprintf(interp->result,
+ "wrong # coordinates: expected 0 or 2, got %d", argc);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureBitmap --
+ *
+ * This procedure is invoked to configure various aspects
+ * of a bitmap item, such as its anchor position.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then
+ * an error message is left in interp->result.
+ *
+ * Side effects:
+ * Configuration information may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureBitmap(interp, canvas, itemPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Bitmap item to reconfigure. */
+ int argc; /* Number of elements in argv. */
+ char **argv; /* Arguments describing things to configure. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+ XGCValues gcValues;
+ GC newGC;
+ Tk_Window tkwin;
+ unsigned long mask;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv,
+ (char *) bmapPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as those
+ * that determine the graphics context.
+ */
+
+ gcValues.foreground = bmapPtr->fgColor->pixel;
+ mask = GCForeground;
+ if (bmapPtr->bgColor != NULL) {
+ gcValues.background = bmapPtr->bgColor->pixel;
+ mask |= GCBackground;
+ } else {
+ gcValues.clip_mask = bmapPtr->bitmap;
+ mask |= GCClipMask;
+ }
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ if (bmapPtr->gc != None) {
+ Tk_FreeGC(Tk_Display(tkwin), bmapPtr->gc);
+ }
+ bmapPtr->gc = newGC;
+
+ ComputeBitmapBbox(canvas, bmapPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteBitmap --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a bitmap item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteBitmap(canvas, itemPtr, display)
+ Tk_Canvas canvas; /* Info about overall canvas widget. */
+ Tk_Item *itemPtr; /* Item that is being deleted. */
+ Display *display; /* Display containing window for
+ * canvas. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+
+ if (bmapPtr->bitmap != None) {
+ Tk_FreeBitmap(display, bmapPtr->bitmap);
+ }
+ if (bmapPtr->fgColor != NULL) {
+ Tk_FreeColor(bmapPtr->fgColor);
+ }
+ if (bmapPtr->bgColor != NULL) {
+ Tk_FreeColor(bmapPtr->bgColor);
+ }
+ if (bmapPtr->gc != NULL) {
+ Tk_FreeGC(display, bmapPtr->gc);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeBitmapBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of a bitmap item.
+ * This procedure is where the child bitmap's placement is
+ * computed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ComputeBitmapBbox(canvas, bmapPtr)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ BitmapItem *bmapPtr; /* Item whose bbox is to be
+ * recomputed. */
+{
+ int width, height;
+ int x, y;
+
+ x = (int) (bmapPtr->x + ((bmapPtr->x >= 0) ? 0.5 : - 0.5));
+ y = (int) (bmapPtr->y + ((bmapPtr->y >= 0) ? 0.5 : - 0.5));
+
+ if (bmapPtr->bitmap == None) {
+ bmapPtr->header.x1 = bmapPtr->header.x2 = x;
+ bmapPtr->header.y1 = bmapPtr->header.y2 = y;
+ return;
+ }
+
+ /*
+ * Compute location and size of bitmap, using anchor information.
+ */
+
+ Tk_SizeOfBitmap(Tk_Display(Tk_CanvasTkwin(canvas)), bmapPtr->bitmap,
+ &width, &height);
+ switch (bmapPtr->anchor) {
+ case TK_ANCHOR_N:
+ x -= width/2;
+ break;
+ case TK_ANCHOR_NE:
+ x -= width;
+ break;
+ case TK_ANCHOR_E:
+ x -= width;
+ y -= height/2;
+ break;
+ case TK_ANCHOR_SE:
+ x -= width;
+ y -= height;
+ break;
+ case TK_ANCHOR_S:
+ x -= width/2;
+ y -= height;
+ break;
+ case TK_ANCHOR_SW:
+ y -= height;
+ break;
+ case TK_ANCHOR_W:
+ y -= height/2;
+ break;
+ case TK_ANCHOR_NW:
+ break;
+ case TK_ANCHOR_CENTER:
+ x -= width/2;
+ y -= height/2;
+ break;
+ }
+
+ /*
+ * Store the information in the item header.
+ */
+
+ bmapPtr->header.x1 = x;
+ bmapPtr->header.y1 = y;
+ bmapPtr->header.x2 = x + width;
+ bmapPtr->header.y2 = y + height;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayBitmap --
+ *
+ * This procedure is invoked to draw a bitmap item in a given
+ * drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * information in canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayBitmap(canvas, itemPtr, display, drawable, x, y, width, height)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ Tk_Item *itemPtr; /* Item to be displayed. */
+ Display *display; /* Display on which to draw item. */
+ Drawable drawable; /* Pixmap or window in which to draw
+ * item. */
+ int x, y, width, height; /* Describes region of canvas that
+ * must be redisplayed (not used). */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+ int bmapX, bmapY, bmapWidth, bmapHeight;
+ short drawableX, drawableY;
+
+ /*
+ * If the area being displayed doesn't cover the whole bitmap,
+ * then only redisplay the part of the bitmap that needs
+ * redisplay.
+ */
+
+ if (bmapPtr->bitmap != None) {
+ if (x > bmapPtr->header.x1) {
+ bmapX = x - bmapPtr->header.x1;
+ bmapWidth = bmapPtr->header.x2 - x;
+ } else {
+ bmapX = 0;
+ if ((x+width) < bmapPtr->header.x2) {
+ bmapWidth = x + width - bmapPtr->header.x1;
+ } else {
+ bmapWidth = bmapPtr->header.x2 - bmapPtr->header.x1;
+ }
+ }
+ if (y > bmapPtr->header.y1) {
+ bmapY = y - bmapPtr->header.y1;
+ bmapHeight = bmapPtr->header.y2 - y;
+ } else {
+ bmapY = 0;
+ if ((y+height) < bmapPtr->header.y2) {
+ bmapHeight = y + height - bmapPtr->header.y1;
+ } else {
+ bmapHeight = bmapPtr->header.y2 - bmapPtr->header.y1;
+ }
+ }
+ Tk_CanvasDrawableCoords(canvas,
+ (double) (bmapPtr->header.x1 + bmapX),
+ (double) (bmapPtr->header.y1 + bmapY),
+ &drawableX, &drawableY);
+
+ /*
+ * Must modify the mask origin within the graphics context
+ * to line up with the bitmap's origin (in order to make
+ * bitmaps with "-background {}" work right).
+ */
+
+ XSetClipOrigin(display, bmapPtr->gc, drawableX - bmapX,
+ drawableY - bmapY);
+ XCopyPlane(display, bmapPtr->bitmap, drawable,
+ bmapPtr->gc, bmapX, bmapY, (unsigned int) bmapWidth,
+ (unsigned int) bmapHeight, drawableX, drawableY, 1);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * BitmapToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * rectangle, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are coordPtr[0] and coordPtr[1] is inside the bitmap. If the
+ * point isn't inside the bitmap then the return value is the
+ * distance from the point to the bitmap.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static double
+BitmapToPoint(canvas, itemPtr, coordPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *coordPtr; /* Pointer to x and y coordinates. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+ double x1, x2, y1, y2, xDiff, yDiff;
+
+ x1 = bmapPtr->header.x1;
+ y1 = bmapPtr->header.y1;
+ x2 = bmapPtr->header.x2;
+ y2 = bmapPtr->header.y2;
+
+ /*
+ * Point is outside rectangle.
+ */
+
+ if (coordPtr[0] < x1) {
+ xDiff = x1 - coordPtr[0];
+ } else if (coordPtr[0] > x2) {
+ xDiff = coordPtr[0] - x2;
+ } else {
+ xDiff = 0;
+ }
+
+ if (coordPtr[1] < y1) {
+ yDiff = y1 - coordPtr[1];
+ } else if (coordPtr[1] > y2) {
+ yDiff = coordPtr[1] - y2;
+ } else {
+ yDiff = 0;
+ }
+
+ return hypot(xDiff, yDiff);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * BitmapToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given rectangle.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area
+ * given by rectPtr, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+BitmapToArea(canvas, itemPtr, rectPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against rectangle. */
+ double *rectPtr; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) describing rectangular
+ * area. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+
+ if ((rectPtr[2] <= bmapPtr->header.x1)
+ || (rectPtr[0] >= bmapPtr->header.x2)
+ || (rectPtr[3] <= bmapPtr->header.y1)
+ || (rectPtr[1] >= bmapPtr->header.y2)) {
+ return -1;
+ }
+ if ((rectPtr[0] <= bmapPtr->header.x1)
+ && (rectPtr[1] <= bmapPtr->header.y1)
+ && (rectPtr[2] >= bmapPtr->header.x2)
+ && (rectPtr[3] >= bmapPtr->header.y2)) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleBitmap --
+ *
+ * This procedure is invoked to rescale a bitmap item in a
+ * canvas. It is one of the standard item procedures for
+ * bitmap items, and is invoked by the generic canvas code.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The item referred to by itemPtr is rescaled so that the
+ * following transformation is applied to all point coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleBitmap(canvas, itemPtr, originX, originY, scaleX, scaleY)
+ Tk_Canvas canvas; /* Canvas containing rectangle. */
+ Tk_Item *itemPtr; /* Rectangle to be scaled. */
+ double originX, originY; /* Origin about which to scale item. */
+ double scaleX; /* Amount to scale in X direction. */
+ double scaleY; /* Amount to scale in Y direction. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+
+ bmapPtr->x = originX + scaleX*(bmapPtr->x - originX);
+ bmapPtr->y = originY + scaleY*(bmapPtr->y - originY);
+ ComputeBitmapBbox(canvas, bmapPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateBitmap --
+ *
+ * This procedure is called to move an item by a given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the item is offset by (xDelta, yDelta), and
+ * the bounding box is updated in the generic part of the item
+ * structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateBitmap(canvas, itemPtr, deltaX, deltaY)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item that is being moved. */
+ double deltaX, deltaY; /* Amount by which item is to be
+ * moved. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+
+ bmapPtr->x += deltaX;
+ bmapPtr->y += deltaY;
+ ComputeBitmapBbox(canvas, bmapPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * BitmapToPostscript --
+ *
+ * This procedure is called to generate Postscript for
+ * bitmap items.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error
+ * occurs in generating Postscript then an error message is
+ * left in interp->result, replacing whatever used to be there.
+ * If no error occurs, then Postscript for the item is appended
+ * to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+BitmapToPostscript(interp, canvas, itemPtr, prepass)
+ Tcl_Interp *interp; /* Leave Postscript or error message
+ * here. */
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ Tk_Item *itemPtr; /* Item for which Postscript is
+ * wanted. */
+ int prepass; /* 1 means this is a prepass to
+ * collect font information; 0 means
+ * final Postscript is being created. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+ double x, y;
+ int width, height, rowsAtOnce, rowsThisTime;
+ int curRow;
+ char buffer[200];
+
+ if (bmapPtr->bitmap == None) {
+ return TCL_OK;
+ }
+
+ /*
+ * Compute the coordinates of the lower-left corner of the bitmap,
+ * taking into account the anchor position for the bitmp.
+ */
+
+ x = bmapPtr->x;
+ y = Tk_CanvasPsY(canvas, bmapPtr->y);
+ Tk_SizeOfBitmap(Tk_Display(Tk_CanvasTkwin(canvas)), bmapPtr->bitmap,
+ &width, &height);
+ switch (bmapPtr->anchor) {
+ case TK_ANCHOR_NW: y -= height; break;
+ case TK_ANCHOR_N: x -= width/2.0; y -= height; break;
+ case TK_ANCHOR_NE: x -= width; y -= height; break;
+ case TK_ANCHOR_E: x -= width; y -= height/2.0; break;
+ case TK_ANCHOR_SE: x -= width; break;
+ case TK_ANCHOR_S: x -= width/2.0; break;
+ case TK_ANCHOR_SW: break;
+ case TK_ANCHOR_W: y -= height/2.0; break;
+ case TK_ANCHOR_CENTER: x -= width/2.0; y -= height/2.0; break;
+ }
+
+ /*
+ * Color the background, if there is one.
+ */
+
+ if (bmapPtr->bgColor != NULL) {
+ sprintf(buffer,
+ "%.15g %.15g moveto %d 0 rlineto 0 %d rlineto %d %s\n",
+ x, y, width, height, -width,"0 rlineto closepath");
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ if (Tk_CanvasPsColor(interp, canvas, bmapPtr->bgColor) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_AppendResult(interp, "fill\n", (char *) NULL);
+ }
+
+ /*
+ * Draw the bitmap, if there is a foreground color. If the bitmap
+ * is very large, then chop it up into multiple bitmaps, each
+ * consisting of one or more rows. This is needed because Postscript
+ * can't handle single strings longer than 64 KBytes long.
+ */
+
+ if (bmapPtr->fgColor != NULL) {
+ if (Tk_CanvasPsColor(interp, canvas, bmapPtr->fgColor) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (width > 60000) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "can't generate Postscript",
+ " for bitmaps more than 60000 pixels wide",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ rowsAtOnce = 60000/width;
+ if (rowsAtOnce < 1) {
+ rowsAtOnce = 1;
+ }
+ sprintf(buffer, "%.15g %.15g translate\n", x, y+height);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ for (curRow = 0; curRow < height; curRow += rowsAtOnce) {
+ rowsThisTime = rowsAtOnce;
+ if (rowsThisTime > (height - curRow)) {
+ rowsThisTime = height - curRow;
+ }
+ sprintf(buffer, "0 -%.15g translate\n%d %d true matrix {\n",
+ (double) rowsThisTime, width, rowsThisTime);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ if (Tk_CanvasPsBitmap(interp, canvas, bmapPtr->bitmap,
+ 0, curRow, width, rowsThisTime) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_AppendResult(interp, "\n} imagemask\n", (char *) NULL);
+ }
+ }
+ return TCL_OK;
+}
diff --git a/generic/tkCanvImg.c b/generic/tkCanvImg.c
new file mode 100644
index 0000000..55169f7
--- /dev/null
+++ b/generic/tkCanvImg.c
@@ -0,0 +1,677 @@
+/*
+ * tkCanvImg.c --
+ *
+ * This file implements image items for canvas widgets.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkCanvImg.c 1.18 96/05/03 10:49:09
+ */
+
+#include <stdio.h>
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkCanvas.h"
+
+/*
+ * The structure below defines the record for each image item.
+ */
+
+typedef struct ImageItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ Tk_Canvas canvas; /* Canvas containing the image. */
+ double x, y; /* Coordinates of positioning point for
+ * image. */
+ Tk_Anchor anchor; /* Where to anchor image relative to
+ * (x,y). */
+ char *imageString; /* String describing -image option (malloc-ed).
+ * NULL means no image right now. */
+ Tk_Image image; /* Image to display in window, or NULL if
+ * no image at present. */
+} ImageItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", (char *) NULL, (char *) NULL,
+ "center", Tk_Offset(ImageItem, anchor), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_STRING, "-image", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ImageItem, imageString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static void ImageChangedProc _ANSI_ARGS_((ClientData clientData,
+ int x, int y, int width, int height, int imgWidth,
+ int imgHeight));
+static int ImageCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv));
+static int ImageToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+static double ImageToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *coordPtr));
+static void ComputeImageBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ ImageItem *imgPtr));
+static int ConfigureImage _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv, int flags));
+static int CreateImage _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int argc, char **argv));
+static void DeleteImage _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayImage _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static void ScaleImage _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void TranslateImage _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+
+/*
+ * The structures below defines the image item type in terms of
+ * procedures that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkImageType = {
+ "image", /* name */
+ sizeof(ImageItem), /* itemSize */
+ CreateImage, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureImage, /* configureProc */
+ ImageCoords, /* coordProc */
+ DeleteImage, /* deleteProc */
+ DisplayImage, /* displayProc */
+ 0, /* alwaysRedraw */
+ ImageToPoint, /* pointProc */
+ ImageToArea, /* areaProc */
+ (Tk_ItemPostscriptProc *) NULL, /* postscriptProc */
+ ScaleImage, /* scaleProc */
+ TranslateImage, /* translateProc */
+ (Tk_ItemIndexProc *) NULL, /* indexProc */
+ (Tk_ItemCursorProc *) NULL, /* icursorProc */
+ (Tk_ItemSelectionProc *) NULL, /* selectionProc */
+ (Tk_ItemInsertProc *) NULL, /* insertProc */
+ (Tk_ItemDCharsProc *) NULL, /* dTextProc */
+ (Tk_ItemType *) NULL /* nextPtr */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateImage --
+ *
+ * This procedure is invoked to create a new image
+ * item in a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in
+ * creating the item, then an error message is left in
+ * interp->result; in this case itemPtr is left uninitialized,
+ * so it can be safely freed by the caller.
+ *
+ * Side effects:
+ * A new image item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateImage(interp, canvas, itemPtr, argc, argv)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas to hold new item. */
+ Tk_Item *itemPtr; /* Record to hold new item; header
+ * has been initialized by caller. */
+ int argc; /* Number of arguments in argv. */
+ char **argv; /* Arguments describing rectangle. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
+ itemPtr->typePtr->name, " x y ?options?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Initialize item's record.
+ */
+
+ imgPtr->canvas = canvas;
+ imgPtr->anchor = TK_ANCHOR_CENTER;
+ imgPtr->imageString = NULL;
+ imgPtr->image = NULL;
+
+ /*
+ * Process the arguments to fill in the item record.
+ */
+
+ if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &imgPtr->x) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[1], &imgPtr->y)
+ != TCL_OK)) {
+ return TCL_ERROR;
+ }
+
+ if (ConfigureImage(interp, canvas, itemPtr, argc-2, argv+2, 0) != TCL_OK) {
+ DeleteImage(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ImageCoords --
+ *
+ * This procedure is invoked to process the "coords" widget
+ * command on image items. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets interp->result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ImageCoords(interp, canvas, itemPtr, argc, argv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item whose coordinates are to be
+ * read or modified. */
+ int argc; /* Number of coordinates supplied in
+ * argv. */
+ char **argv; /* Array of coordinates: x1, y1,
+ * x2, y2, ... */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+ char x[TCL_DOUBLE_SPACE], y[TCL_DOUBLE_SPACE];
+
+ if (argc == 0) {
+ Tcl_PrintDouble(interp, imgPtr->x, x);
+ Tcl_PrintDouble(interp, imgPtr->y, y);
+ Tcl_AppendResult(interp, x, " ", y, (char *) NULL);
+ } else if (argc == 2) {
+ if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &imgPtr->x) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[1],
+ &imgPtr->y) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComputeImageBbox(canvas, imgPtr);
+ } else {
+ sprintf(interp->result,
+ "wrong # coordinates: expected 0 or 2, got %d", argc);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureImage --
+ *
+ * This procedure is invoked to configure various aspects
+ * of an image item, such as its anchor position.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then
+ * an error message is left in interp->result.
+ *
+ * Side effects:
+ * Configuration information may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureImage(interp, canvas, itemPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Image item to reconfigure. */
+ int argc; /* Number of elements in argv. */
+ char **argv; /* Arguments describing things to configure. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+ Tk_Window tkwin;
+ Tk_Image image;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc,
+ argv, (char *) imgPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the image. Save the old image around and don't free it
+ * until after the new one is allocated. This keeps the reference
+ * count from going to zero so the image doesn't have to be recreated
+ * if it hasn't changed.
+ */
+
+ if (imgPtr->imageString != NULL) {
+ image = Tk_GetImage(interp, tkwin, imgPtr->imageString,
+ ImageChangedProc, (ClientData) imgPtr);
+ if (image == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (imgPtr->image != NULL) {
+ Tk_FreeImage(imgPtr->image);
+ }
+ imgPtr->image = image;
+ ComputeImageBbox(canvas, imgPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteImage --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a image item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteImage(canvas, itemPtr, display)
+ Tk_Canvas canvas; /* Info about overall canvas widget. */
+ Tk_Item *itemPtr; /* Item that is being deleted. */
+ Display *display; /* Display containing window for
+ * canvas. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+
+ if (imgPtr->imageString != NULL) {
+ ckfree(imgPtr->imageString);
+ }
+ if (imgPtr->image != NULL) {
+ Tk_FreeImage(imgPtr->image);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeImageBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of a image item.
+ * This procedure is where the child image's placement is
+ * computed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ComputeImageBbox(canvas, imgPtr)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ ImageItem *imgPtr; /* Item whose bbox is to be
+ * recomputed. */
+{
+ int width, height;
+ int x, y;
+
+ x = (int) (imgPtr->x + ((imgPtr->x >= 0) ? 0.5 : - 0.5));
+ y = (int) (imgPtr->y + ((imgPtr->y >= 0) ? 0.5 : - 0.5));
+
+ if (imgPtr->image == None) {
+ imgPtr->header.x1 = imgPtr->header.x2 = x;
+ imgPtr->header.y1 = imgPtr->header.y2 = y;
+ return;
+ }
+
+ /*
+ * Compute location and size of image, using anchor information.
+ */
+
+ Tk_SizeOfImage(imgPtr->image, &width, &height);
+ switch (imgPtr->anchor) {
+ case TK_ANCHOR_N:
+ x -= width/2;
+ break;
+ case TK_ANCHOR_NE:
+ x -= width;
+ break;
+ case TK_ANCHOR_E:
+ x -= width;
+ y -= height/2;
+ break;
+ case TK_ANCHOR_SE:
+ x -= width;
+ y -= height;
+ break;
+ case TK_ANCHOR_S:
+ x -= width/2;
+ y -= height;
+ break;
+ case TK_ANCHOR_SW:
+ y -= height;
+ break;
+ case TK_ANCHOR_W:
+ y -= height/2;
+ break;
+ case TK_ANCHOR_NW:
+ break;
+ case TK_ANCHOR_CENTER:
+ x -= width/2;
+ y -= height/2;
+ break;
+ }
+
+ /*
+ * Store the information in the item header.
+ */
+
+ imgPtr->header.x1 = x;
+ imgPtr->header.y1 = y;
+ imgPtr->header.x2 = x + width;
+ imgPtr->header.y2 = y + height;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayImage --
+ *
+ * This procedure is invoked to draw a image item in a given
+ * drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * information in canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayImage(canvas, itemPtr, display, drawable, x, y, width, height)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ Tk_Item *itemPtr; /* Item to be displayed. */
+ Display *display; /* Display on which to draw item. */
+ Drawable drawable; /* Pixmap or window in which to draw
+ * item. */
+ int x, y, width, height; /* Describes region of canvas that
+ * must be redisplayed (not used). */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+ short drawableX, drawableY;
+
+ if (imgPtr->image == NULL) {
+ return;
+ }
+
+ /*
+ * Translate the coordinates to those of the image, then redisplay it.
+ */
+
+ Tk_CanvasDrawableCoords(canvas, (double) x, (double) y,
+ &drawableX, &drawableY);
+ Tk_RedrawImage(imgPtr->image, x - imgPtr->header.x1, y - imgPtr->header.y1,
+ width, height, drawable, drawableX, drawableY);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ImageToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * rectangle, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are coordPtr[0] and coordPtr[1] is inside the image. If the
+ * point isn't inside the image then the return value is the
+ * distance from the point to the image.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static double
+ImageToPoint(canvas, itemPtr, coordPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *coordPtr; /* Pointer to x and y coordinates. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+ double x1, x2, y1, y2, xDiff, yDiff;
+
+ x1 = imgPtr->header.x1;
+ y1 = imgPtr->header.y1;
+ x2 = imgPtr->header.x2;
+ y2 = imgPtr->header.y2;
+
+ /*
+ * Point is outside rectangle.
+ */
+
+ if (coordPtr[0] < x1) {
+ xDiff = x1 - coordPtr[0];
+ } else if (coordPtr[0] > x2) {
+ xDiff = coordPtr[0] - x2;
+ } else {
+ xDiff = 0;
+ }
+
+ if (coordPtr[1] < y1) {
+ yDiff = y1 - coordPtr[1];
+ } else if (coordPtr[1] > y2) {
+ yDiff = coordPtr[1] - y2;
+ } else {
+ yDiff = 0;
+ }
+
+ return hypot(xDiff, yDiff);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ImageToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given rectangle.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area
+ * given by rectPtr, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ImageToArea(canvas, itemPtr, rectPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against rectangle. */
+ double *rectPtr; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) describing rectangular
+ * area. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+
+ if ((rectPtr[2] <= imgPtr->header.x1)
+ || (rectPtr[0] >= imgPtr->header.x2)
+ || (rectPtr[3] <= imgPtr->header.y1)
+ || (rectPtr[1] >= imgPtr->header.y2)) {
+ return -1;
+ }
+ if ((rectPtr[0] <= imgPtr->header.x1)
+ && (rectPtr[1] <= imgPtr->header.y1)
+ && (rectPtr[2] >= imgPtr->header.x2)
+ && (rectPtr[3] >= imgPtr->header.y2)) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleImage --
+ *
+ * This procedure is invoked to rescale an item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The item referred to by itemPtr is rescaled so that the
+ * following transformation is applied to all point coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleImage(canvas, itemPtr, originX, originY, scaleX, scaleY)
+ Tk_Canvas canvas; /* Canvas containing rectangle. */
+ Tk_Item *itemPtr; /* Rectangle to be scaled. */
+ double originX, originY; /* Origin about which to scale rect. */
+ double scaleX; /* Amount to scale in X direction. */
+ double scaleY; /* Amount to scale in Y direction. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+
+ imgPtr->x = originX + scaleX*(imgPtr->x - originX);
+ imgPtr->y = originY + scaleY*(imgPtr->y - originY);
+ ComputeImageBbox(canvas, imgPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateImage --
+ *
+ * This procedure is called to move an item by a given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the item is offset by (xDelta, yDelta), and
+ * the bounding box is updated in the generic part of the item
+ * structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateImage(canvas, itemPtr, deltaX, deltaY)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item that is being moved. */
+ double deltaX, deltaY; /* Amount by which item is to be
+ * moved. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+
+ imgPtr->x += deltaX;
+ imgPtr->y += deltaY;
+ ComputeImageBbox(canvas, imgPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageChangedProc --
+ *
+ * This procedure is invoked by the image code whenever the manager
+ * for an image does something that affects the image's size or
+ * how it is displayed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for the canvas to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImageChangedProc(clientData, x, y, width, height, imgWidth, imgHeight)
+ ClientData clientData; /* Pointer to canvas item for image. */
+ int x, y; /* Upper left pixel (within image)
+ * that must be redisplayed. */
+ int width, height; /* Dimensions of area to redisplay
+ * (may be <= 0). */
+ int imgWidth, imgHeight; /* New dimensions of image. */
+{
+ ImageItem *imgPtr = (ImageItem *) clientData;
+
+ /*
+ * If the image's size changed and it's not anchored at its
+ * northwest corner then just redisplay the entire area of the
+ * image. This is a bit over-conservative, but we need to do
+ * something because a size change also means a position change.
+ */
+
+ if (((imgPtr->header.x2 - imgPtr->header.x1) != imgWidth)
+ || ((imgPtr->header.y2 - imgPtr->header.y1) != imgHeight)) {
+ x = y = 0;
+ width = imgWidth;
+ height = imgHeight;
+ Tk_CanvasEventuallyRedraw(imgPtr->canvas, imgPtr->header.x1,
+ imgPtr->header.y1, imgPtr->header.x2, imgPtr->header.y2);
+ }
+ ComputeImageBbox(imgPtr->canvas, imgPtr);
+ Tk_CanvasEventuallyRedraw(imgPtr->canvas, imgPtr->header.x1 + x,
+ imgPtr->header.y1 + y, (int) (imgPtr->header.x1 + x + width),
+ (int) (imgPtr->header.y1 + y + height));
+}
diff --git a/generic/tkCanvLine.c b/generic/tkCanvLine.c
new file mode 100644
index 0000000..97cd1f5
--- /dev/null
+++ b/generic/tkCanvLine.c
@@ -0,0 +1,1623 @@
+/*
+ * tkCanvLine.c --
+ *
+ * This file implements line items for canvas widgets.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkCanvLine.c 1.46 97/04/25 16:51:02
+ */
+
+#include <stdio.h>
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * The structure below defines the record for each line item.
+ */
+
+typedef struct LineItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ Tk_Canvas canvas; /* Canvas containing item. Needed for
+ * parsing arrow shapes. */
+ int numPoints; /* Number of points in line (always >= 2). */
+ double *coordPtr; /* Pointer to malloc-ed array containing
+ * x- and y-coords of all points in line.
+ * X-coords are even-valued indices, y-coords
+ * are corresponding odd-valued indices. If
+ * the line has arrowheads then the first
+ * and last points have been adjusted to refer
+ * to the necks of the arrowheads rather than
+ * their tips. The actual endpoints are
+ * stored in the *firstArrowPtr and
+ * *lastArrowPtr, if they exist. */
+ int width; /* Width of line. */
+ XColor *fg; /* Foreground color for line. */
+ Pixmap fillStipple; /* Stipple bitmap for filling line. */
+ int capStyle; /* Cap style for line. */
+ int joinStyle; /* Join style for line. */
+ GC gc; /* Graphics context for filling line. */
+ GC arrowGC; /* Graphics context for drawing arrowheads. */
+ Tk_Uid arrow; /* Indicates whether or not to draw arrowheads:
+ * "none", "first", "last", or "both". */
+ float arrowShapeA; /* Distance from tip of arrowhead to center. */
+ float arrowShapeB; /* Distance from tip of arrowhead to trailing
+ * point, measured along shaft. */
+ float arrowShapeC; /* Distance of trailing points from outside
+ * edge of shaft. */
+ double *firstArrowPtr; /* Points to array of PTS_IN_ARROW points
+ * describing polygon for arrowhead at first
+ * point in line. First point of arrowhead
+ * is tip. Malloc'ed. NULL means no arrowhead
+ * at first point. */
+ double *lastArrowPtr; /* Points to polygon for arrowhead at last
+ * point in line (PTS_IN_ARROW points, first
+ * of which is tip). Malloc'ed. NULL means
+ * no arrowhead at last point. */
+ int smooth; /* Non-zero means draw line smoothed (i.e.
+ * with Bezier splines). */
+ int splineSteps; /* Number of steps in each spline segment. */
+} LineItem;
+
+/*
+ * Number of points in an arrowHead:
+ */
+
+#define PTS_IN_ARROW 6
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static int ArrowheadPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, LineItem *linePtr,
+ double *arrowPtr));
+static void ComputeLineBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ LineItem *linePtr));
+static int ConfigureLine _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv, int flags));
+static int ConfigureArrows _ANSI_ARGS_((Tk_Canvas canvas,
+ LineItem *linePtr));
+static int CreateLine _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int argc, char **argv));
+static void DeleteLine _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayLine _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static int LineCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ int argc, char **argv));
+static int LineToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+static double LineToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *coordPtr));
+static int LineToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+static int ParseArrowShape _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin, char *value,
+ char *recordPtr, int offset));
+static char * PrintArrowShape _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *recordPtr, int offset,
+ Tcl_FreeProc **freeProcPtr));
+static void ScaleLine _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void TranslateLine _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+
+/*
+ * Information used for parsing configuration specs. If you change any
+ * of the default strings, be sure to change the corresponding default
+ * values in CreateLine.
+ */
+
+static Tk_CustomOption arrowShapeOption = {ParseArrowShape,
+ PrintArrowShape, (ClientData) NULL};
+static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_UID, "-arrow", (char *) NULL, (char *) NULL,
+ "none", Tk_Offset(LineItem, arrow), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-arrowshape", (char *) NULL, (char *) NULL,
+ "8 10 3", Tk_Offset(LineItem, arrowShapeA),
+ TK_CONFIG_DONT_SET_DEFAULT, &arrowShapeOption},
+ {TK_CONFIG_CAP_STYLE, "-capstyle", (char *) NULL, (char *) NULL,
+ "butt", Tk_Offset(LineItem, capStyle), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL,
+ "black", Tk_Offset(LineItem, fg), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_JOIN_STYLE, "-joinstyle", (char *) NULL, (char *) NULL,
+ "round", Tk_Offset(LineItem, joinStyle), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_BOOLEAN, "-smooth", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(LineItem, smooth), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_INT, "-splinesteps", (char *) NULL, (char *) NULL,
+ "12", Tk_Offset(LineItem, splineSteps), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(LineItem, fillStipple), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
+ "1", Tk_Offset(LineItem, width), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * The structures below defines the line item type by means
+ * of procedures that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkLineType = {
+ "line", /* name */
+ sizeof(LineItem), /* itemSize */
+ CreateLine, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureLine, /* configureProc */
+ LineCoords, /* coordProc */
+ DeleteLine, /* deleteProc */
+ DisplayLine, /* displayProc */
+ 0, /* alwaysRedraw */
+ LineToPoint, /* pointProc */
+ LineToArea, /* areaProc */
+ LineToPostscript, /* postscriptProc */
+ ScaleLine, /* scaleProc */
+ TranslateLine, /* translateProc */
+ (Tk_ItemIndexProc *) NULL, /* indexProc */
+ (Tk_ItemCursorProc *) NULL, /* icursorProc */
+ (Tk_ItemSelectionProc *) NULL, /* selectionProc */
+ (Tk_ItemInsertProc *) NULL, /* insertProc */
+ (Tk_ItemDCharsProc *) NULL, /* dTextProc */
+ (Tk_ItemType *) NULL /* nextPtr */
+};
+
+/*
+ * The Tk_Uid's below refer to uids for the various arrow types:
+ */
+
+static Tk_Uid noneUid = NULL;
+static Tk_Uid firstUid = NULL;
+static Tk_Uid lastUid = NULL;
+static Tk_Uid bothUid = NULL;
+
+/*
+ * The definition below determines how large are static arrays
+ * used to hold spline points (splines larger than this have to
+ * have their arrays malloc-ed).
+ */
+
+#define MAX_STATIC_POINTS 200
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateLine --
+ *
+ * This procedure is invoked to create a new line item in
+ * a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in
+ * creating the item, then an error message is left in
+ * interp->result; in this case itemPtr is left uninitialized,
+ * so it can be safely freed by the caller.
+ *
+ * Side effects:
+ * A new line item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateLine(interp, canvas, itemPtr, argc, argv)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas to hold new item. */
+ Tk_Item *itemPtr; /* Record to hold new item; header
+ * has been initialized by caller. */
+ int argc; /* Number of arguments in argv. */
+ char **argv; /* Arguments describing line. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ int i;
+
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
+ itemPtr->typePtr->name, " x1 y1 x2 y2 ?x3 y3 ...? ?options?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Carry out initialization that is needed to set defaults and to
+ * allow proper cleanup after errors during the the remainder of
+ * this procedure.
+ */
+
+ linePtr->canvas = canvas;
+ linePtr->numPoints = 0;
+ linePtr->coordPtr = NULL;
+ linePtr->width = 1;
+ linePtr->fg = None;
+ linePtr->fillStipple = None;
+ linePtr->capStyle = CapButt;
+ linePtr->joinStyle = JoinRound;
+ linePtr->gc = None;
+ linePtr->arrowGC = None;
+ if (noneUid == NULL) {
+ noneUid = Tk_GetUid("none");
+ firstUid = Tk_GetUid("first");
+ lastUid = Tk_GetUid("last");
+ bothUid = Tk_GetUid("both");
+ }
+ linePtr->arrow = noneUid;
+ linePtr->arrowShapeA = (float)8.0;
+ linePtr->arrowShapeB = (float)10.0;
+ linePtr->arrowShapeC = (float)3.0;
+ linePtr->firstArrowPtr = NULL;
+ linePtr->lastArrowPtr = NULL;
+ linePtr->smooth = 0;
+ linePtr->splineSteps = 12;
+
+ /*
+ * Count the number of points and then parse them into a point
+ * array. Leading arguments are assumed to be points if they
+ * start with a digit or a minus sign followed by a digit.
+ */
+
+ for (i = 4; i < (argc-1); i+=2) {
+ if ((!isdigit(UCHAR(argv[i][0]))) &&
+ ((argv[i][0] != '-')
+ || ((argv[i][1] != '.') && !isdigit(UCHAR(argv[i][1]))))) {
+ break;
+ }
+ }
+ if (LineCoords(interp, canvas, itemPtr, i, argv) != TCL_OK) {
+ goto error;
+ }
+ if (ConfigureLine(interp, canvas, itemPtr, argc-i, argv+i, 0) == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeleteLine(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LineCoords --
+ *
+ * This procedure is invoked to process the "coords" widget
+ * command on lines. See the user documentation for details
+ * on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets interp->result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+LineCoords(interp, canvas, itemPtr, argc, argv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item whose coordinates are to be
+ * read or modified. */
+ int argc; /* Number of coordinates supplied in
+ * argv. */
+ char **argv; /* Array of coordinates: x1, y1,
+ * x2, y2, ... */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ char buffer[TCL_DOUBLE_SPACE];
+ int i, numPoints;
+
+ if (argc == 0) {
+ double *coordPtr;
+ int numCoords;
+
+ numCoords = 2*linePtr->numPoints;
+ if (linePtr->firstArrowPtr != NULL) {
+ coordPtr = linePtr->firstArrowPtr;
+ } else {
+ coordPtr = linePtr->coordPtr;
+ }
+ for (i = 0; i < numCoords; i++, coordPtr++) {
+ if (i == 2) {
+ coordPtr = linePtr->coordPtr+2;
+ }
+ if ((linePtr->lastArrowPtr != NULL) && (i == (numCoords-2))) {
+ coordPtr = linePtr->lastArrowPtr;
+ }
+ Tcl_PrintDouble(interp, *coordPtr, buffer);
+ Tcl_AppendElement(interp, buffer);
+ }
+ } else if (argc < 4) {
+ Tcl_AppendResult(interp,
+ "too few coordinates for line: must have at least 4",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else if (argc & 1) {
+ Tcl_AppendResult(interp,
+ "odd number of coordinates specified for line",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ numPoints = argc/2;
+ if (linePtr->numPoints != numPoints) {
+ if (linePtr->coordPtr != NULL) {
+ ckfree((char *) linePtr->coordPtr);
+ }
+ linePtr->coordPtr = (double *) ckalloc((unsigned)
+ (sizeof(double) * argc));
+ linePtr->numPoints = numPoints;
+ }
+ for (i = argc-1; i >= 0; i--) {
+ if (Tk_CanvasGetCoord(interp, canvas, argv[i],
+ &linePtr->coordPtr[i]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Update arrowheads by throwing away any existing arrow-head
+ * information and calling ConfigureArrows to recompute it.
+ */
+
+ if (linePtr->firstArrowPtr != NULL) {
+ ckfree((char *) linePtr->firstArrowPtr);
+ linePtr->firstArrowPtr = NULL;
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ ckfree((char *) linePtr->lastArrowPtr);
+ linePtr->lastArrowPtr = NULL;
+ }
+ if (linePtr->arrow != noneUid) {
+ ConfigureArrows(canvas, linePtr);
+ }
+ ComputeLineBbox(canvas, linePtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureLine --
+ *
+ * This procedure is invoked to configure various aspects
+ * of a line item such as its background color.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then
+ * an error message is left in interp->result.
+ *
+ * Side effects:
+ * Configuration information, such as colors and stipple
+ * patterns, may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureLine(interp, canvas, itemPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Line item to reconfigure. */
+ int argc; /* Number of elements in argv. */
+ char **argv; /* Arguments describing things to configure. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ XGCValues gcValues;
+ GC newGC, arrowGC;
+ unsigned long mask;
+ Tk_Window tkwin;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv,
+ (char *) linePtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as
+ * graphics contexts.
+ */
+
+ if (linePtr->fg == NULL) {
+ newGC = arrowGC = None;
+ } else {
+ gcValues.foreground = linePtr->fg->pixel;
+ gcValues.join_style = linePtr->joinStyle;
+ if (linePtr->width < 0) {
+ linePtr->width = 1;
+ }
+ gcValues.line_width = linePtr->width;
+ mask = GCForeground|GCJoinStyle|GCLineWidth;
+ if (linePtr->fillStipple != None) {
+ gcValues.stipple = linePtr->fillStipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ if (linePtr->arrow == noneUid) {
+ gcValues.cap_style = linePtr->capStyle;
+ mask |= GCCapStyle;
+ }
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ gcValues.line_width = 0;
+ arrowGC = Tk_GetGC(tkwin, mask, &gcValues);
+ }
+ if (linePtr->gc != None) {
+ Tk_FreeGC(Tk_Display(tkwin), linePtr->gc);
+ }
+ if (linePtr->arrowGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), linePtr->arrowGC);
+ }
+ linePtr->gc = newGC;
+ linePtr->arrowGC = arrowGC;
+
+ /*
+ * Keep spline parameters within reasonable limits.
+ */
+
+ if (linePtr->splineSteps < 1) {
+ linePtr->splineSteps = 1;
+ } else if (linePtr->splineSteps > 100) {
+ linePtr->splineSteps = 100;
+ }
+
+ /*
+ * Setup arrowheads, if needed. If arrowheads are turned off,
+ * restore the line's endpoints (they were shortened when the
+ * arrowheads were added).
+ */
+
+ if ((linePtr->firstArrowPtr != NULL) && (linePtr->arrow != firstUid)
+ && (linePtr->arrow != bothUid)) {
+ linePtr->coordPtr[0] = linePtr->firstArrowPtr[0];
+ linePtr->coordPtr[1] = linePtr->firstArrowPtr[1];
+ ckfree((char *) linePtr->firstArrowPtr);
+ linePtr->firstArrowPtr = NULL;
+ }
+ if ((linePtr->lastArrowPtr != NULL) && (linePtr->arrow != lastUid)
+ && (linePtr->arrow != bothUid)) {
+ int i;
+
+ i = 2*(linePtr->numPoints-1);
+ linePtr->coordPtr[i] = linePtr->lastArrowPtr[0];
+ linePtr->coordPtr[i+1] = linePtr->lastArrowPtr[1];
+ ckfree((char *) linePtr->lastArrowPtr);
+ linePtr->lastArrowPtr = NULL;
+ }
+ if (linePtr->arrow != noneUid) {
+ if ((linePtr->arrow != firstUid) && (linePtr->arrow != lastUid)
+ && (linePtr->arrow != bothUid)) {
+ Tcl_AppendResult(interp, "bad arrow spec \"",
+ linePtr->arrow, "\": must be none, first, last, or both",
+ (char *) NULL);
+ linePtr->arrow = noneUid;
+ return TCL_ERROR;
+ }
+ ConfigureArrows(canvas, linePtr);
+ }
+
+ /*
+ * Recompute bounding box for line.
+ */
+
+ ComputeLineBbox(canvas, linePtr);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteLine --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a line item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteLine(canvas, itemPtr, display)
+ Tk_Canvas canvas; /* Info about overall canvas widget. */
+ Tk_Item *itemPtr; /* Item that is being deleted. */
+ Display *display; /* Display containing window for
+ * canvas. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+
+ if (linePtr->coordPtr != NULL) {
+ ckfree((char *) linePtr->coordPtr);
+ }
+ if (linePtr->fg != NULL) {
+ Tk_FreeColor(linePtr->fg);
+ }
+ if (linePtr->fillStipple != None) {
+ Tk_FreeBitmap(display, linePtr->fillStipple);
+ }
+ if (linePtr->gc != None) {
+ Tk_FreeGC(display, linePtr->gc);
+ }
+ if (linePtr->arrowGC != None) {
+ Tk_FreeGC(display, linePtr->arrowGC);
+ }
+ if (linePtr->firstArrowPtr != NULL) {
+ ckfree((char *) linePtr->firstArrowPtr);
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ ckfree((char *) linePtr->lastArrowPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeLineBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of a line.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputeLineBbox(canvas, linePtr)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ LineItem *linePtr; /* Item whose bbos is to be
+ * recomputed. */
+{
+ double *coordPtr;
+ int i, width;
+
+ coordPtr = linePtr->coordPtr;
+ linePtr->header.x1 = linePtr->header.x2 = (int) *coordPtr;
+ linePtr->header.y1 = linePtr->header.y2 = (int) coordPtr[1];
+
+ /*
+ * Compute the bounding box of all the points in the line,
+ * then expand in all directions by the line's width to take
+ * care of butting or rounded corners and projecting or
+ * rounded caps. This expansion is an overestimate (worst-case
+ * is square root of two over two) but it's simple. Don't do
+ * anything special for curves. This causes an additional
+ * overestimate in the bounding box, but is faster.
+ */
+
+ for (i = 1, coordPtr = linePtr->coordPtr+2; i < linePtr->numPoints;
+ i++, coordPtr += 2) {
+ TkIncludePoint((Tk_Item *) linePtr, coordPtr);
+ }
+ width = linePtr->width;
+ if (width < 1) {
+ width = 1;
+ }
+ linePtr->header.x1 -= width;
+ linePtr->header.x2 += width;
+ linePtr->header.y1 -= width;
+ linePtr->header.y2 += width;
+
+ /*
+ * For mitered lines, make a second pass through all the points.
+ * Compute the locations of the two miter vertex points and add
+ * those into the bounding box.
+ */
+
+ if (linePtr->joinStyle == JoinMiter) {
+ for (i = linePtr->numPoints, coordPtr = linePtr->coordPtr; i >= 3;
+ i--, coordPtr += 2) {
+ double miter[4];
+ int j;
+
+ if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
+ (double) width, miter, miter+2)) {
+ for (j = 0; j < 4; j += 2) {
+ TkIncludePoint((Tk_Item *) linePtr, miter+j);
+ }
+ }
+ }
+ }
+
+ /*
+ * Add in the sizes of arrowheads, if any.
+ */
+
+ if (linePtr->arrow != noneUid) {
+ if (linePtr->arrow != lastUid) {
+ for (i = 0, coordPtr = linePtr->firstArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint((Tk_Item *) linePtr, coordPtr);
+ }
+ }
+ if (linePtr->arrow != firstUid) {
+ for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint((Tk_Item *) linePtr, coordPtr);
+ }
+ }
+ }
+
+ /*
+ * Add one more pixel of fudge factor just to be safe (e.g.
+ * X may round differently than we do).
+ */
+
+ linePtr->header.x1 -= 1;
+ linePtr->header.x2 += 1;
+ linePtr->header.y1 -= 1;
+ linePtr->header.y2 += 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayLine --
+ *
+ * This procedure is invoked to draw a line item in a given
+ * drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * information in canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayLine(canvas, itemPtr, display, drawable, x, y, width, height)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ Tk_Item *itemPtr; /* Item to be displayed. */
+ Display *display; /* Display on which to draw item. */
+ Drawable drawable; /* Pixmap or window in which to draw
+ * item. */
+ int x, y, width, height; /* Describes region of canvas that
+ * must be redisplayed (not used). */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ XPoint staticPoints[MAX_STATIC_POINTS];
+ XPoint *pointPtr;
+ XPoint *pPtr;
+ double *coordPtr;
+ int i, numPoints;
+
+ if (linePtr->gc == None) {
+ return;
+ }
+
+ /*
+ * Build up an array of points in screen coordinates. Use a
+ * static array unless the line has an enormous number of points;
+ * in this case, dynamically allocate an array. For smoothed lines,
+ * generate the curve points on each redisplay.
+ */
+
+ if ((linePtr->smooth) && (linePtr->numPoints > 2)) {
+ numPoints = 1 + linePtr->numPoints*linePtr->splineSteps;
+ } else {
+ numPoints = linePtr->numPoints;
+ }
+
+ if (numPoints <= MAX_STATIC_POINTS) {
+ pointPtr = staticPoints;
+ } else {
+ pointPtr = (XPoint *) ckalloc((unsigned) (numPoints * sizeof(XPoint)));
+ }
+
+ if ((linePtr->smooth) && (linePtr->numPoints > 2)) {
+ numPoints = TkMakeBezierCurve(canvas, linePtr->coordPtr,
+ linePtr->numPoints, linePtr->splineSteps, pointPtr,
+ (double *) NULL);
+ } else {
+ for (i = 0, coordPtr = linePtr->coordPtr, pPtr = pointPtr;
+ i < linePtr->numPoints; i += 1, coordPtr += 2, pPtr++) {
+ Tk_CanvasDrawableCoords(canvas, coordPtr[0], coordPtr[1],
+ &pPtr->x, &pPtr->y);
+ }
+ }
+
+ /*
+ * Display line, the free up line storage if it was dynamically
+ * allocated. If we're stippling, then modify the stipple offset
+ * in the GC. Be sure to reset the offset when done, since the
+ * GC is supposed to be read-only.
+ */
+
+ if (linePtr->fillStipple != None) {
+ Tk_CanvasSetStippleOrigin(canvas, linePtr->gc);
+ Tk_CanvasSetStippleOrigin(canvas, linePtr->arrowGC);
+ }
+ XDrawLines(display, drawable, linePtr->gc, pointPtr, numPoints,
+ CoordModeOrigin);
+ if (pointPtr != staticPoints) {
+ ckfree((char *) pointPtr);
+ }
+
+ /*
+ * Display arrowheads, if they are wanted.
+ */
+
+ if (linePtr->firstArrowPtr != NULL) {
+ TkFillPolygon(canvas, linePtr->firstArrowPtr, PTS_IN_ARROW,
+ display, drawable, linePtr->gc, NULL);
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ TkFillPolygon(canvas, linePtr->lastArrowPtr, PTS_IN_ARROW,
+ display, drawable, linePtr->gc, NULL);
+ }
+ if (linePtr->fillStipple != None) {
+ XSetTSOrigin(display, linePtr->gc, 0, 0);
+ XSetTSOrigin(display, linePtr->arrowGC, 0, 0);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LineToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * line, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are pointPtr[0] and pointPtr[1] is inside the line. If the
+ * point isn't inside the line then the return value is the
+ * distance from the point to the line.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static double
+LineToPoint(canvas, itemPtr, pointPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *pointPtr; /* Pointer to x and y coordinates. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ double *coordPtr, *linePoints;
+ double staticSpace[2*MAX_STATIC_POINTS];
+ double poly[10];
+ double bestDist, dist;
+ int numPoints, count;
+ int changedMiterToBevel; /* Non-zero means that a mitered corner
+ * had to be treated as beveled after all
+ * because the angle was < 11 degrees. */
+
+ bestDist = 1.0e36;
+
+ /*
+ * Handle smoothed lines by generating an expanded set of points
+ * against which to do the check.
+ */
+
+ if ((linePtr->smooth) && (linePtr->numPoints > 2)) {
+ numPoints = 1 + linePtr->numPoints*linePtr->splineSteps;
+ if (numPoints <= MAX_STATIC_POINTS) {
+ linePoints = staticSpace;
+ } else {
+ linePoints = (double *) ckalloc((unsigned)
+ (2*numPoints*sizeof(double)));
+ }
+ numPoints = TkMakeBezierCurve(canvas, linePtr->coordPtr,
+ linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
+ linePoints);
+ } else {
+ numPoints = linePtr->numPoints;
+ linePoints = linePtr->coordPtr;
+ }
+
+ /*
+ * The overall idea is to iterate through all of the edges of
+ * the line, computing a polygon for each edge and testing the
+ * point against that polygon. In addition, there are additional
+ * tests to deal with rounded joints and caps.
+ */
+
+ changedMiterToBevel = 0;
+ for (count = numPoints, coordPtr = linePoints; count >= 2;
+ count--, coordPtr += 2) {
+
+ /*
+ * If rounding is done around the first point then compute
+ * the distance between the point and the point.
+ */
+
+ if (((linePtr->capStyle == CapRound) && (count == numPoints))
+ || ((linePtr->joinStyle == JoinRound)
+ && (count != numPoints))) {
+ dist = hypot(coordPtr[0] - pointPtr[0], coordPtr[1] - pointPtr[1])
+ - linePtr->width/2.0;
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+
+ /*
+ * Compute the polygonal shape corresponding to this edge,
+ * consisting of two points for the first point of the edge
+ * and two points for the last point of the edge.
+ */
+
+ if (count == numPoints) {
+ TkGetButtPoints(coordPtr+2, coordPtr, (double) linePtr->width,
+ linePtr->capStyle == CapProjecting, poly, poly+2);
+ } else if ((linePtr->joinStyle == JoinMiter) && !changedMiterToBevel) {
+ poly[0] = poly[6];
+ poly[1] = poly[7];
+ poly[2] = poly[4];
+ poly[3] = poly[5];
+ } else {
+ TkGetButtPoints(coordPtr+2, coordPtr, (double) linePtr->width, 0,
+ poly, poly+2);
+
+ /*
+ * If this line uses beveled joints, then check the distance
+ * to a polygon comprising the last two points of the previous
+ * polygon and the first two from this polygon; this checks
+ * the wedges that fill the mitered joint.
+ */
+
+ if ((linePtr->joinStyle == JoinBevel) || changedMiterToBevel) {
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ dist = TkPolygonToPoint(poly, 5, pointPtr);
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ changedMiterToBevel = 0;
+ }
+ }
+ if (count == 2) {
+ TkGetButtPoints(coordPtr, coordPtr+2, (double) linePtr->width,
+ linePtr->capStyle == CapProjecting, poly+4, poly+6);
+ } else if (linePtr->joinStyle == JoinMiter) {
+ if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
+ (double) linePtr->width, poly+4, poly+6) == 0) {
+ changedMiterToBevel = 1;
+ TkGetButtPoints(coordPtr, coordPtr+2, (double) linePtr->width,
+ 0, poly+4, poly+6);
+ }
+ } else {
+ TkGetButtPoints(coordPtr, coordPtr+2, (double) linePtr->width, 0,
+ poly+4, poly+6);
+ }
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ dist = TkPolygonToPoint(poly, 5, pointPtr);
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+
+ /*
+ * If caps are rounded, check the distance to the cap around the
+ * final end point of the line.
+ */
+
+ if (linePtr->capStyle == CapRound) {
+ dist = hypot(coordPtr[0] - pointPtr[0], coordPtr[1] - pointPtr[1])
+ - linePtr->width/2.0;
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+
+ /*
+ * If there are arrowheads, check the distance to the arrowheads.
+ */
+
+ if (linePtr->arrow != noneUid) {
+ if (linePtr->arrow != lastUid) {
+ dist = TkPolygonToPoint(linePtr->firstArrowPtr, PTS_IN_ARROW,
+ pointPtr);
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+ if (linePtr->arrow != firstUid) {
+ dist = TkPolygonToPoint(linePtr->lastArrowPtr, PTS_IN_ARROW,
+ pointPtr);
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+ }
+
+ done:
+ if ((linePoints != staticSpace) && (linePoints != linePtr->coordPtr)) {
+ ckfree((char *) linePoints);
+ }
+ return bestDist;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LineToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the
+ * area, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+LineToArea(canvas, itemPtr, rectPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against line. */
+ double *rectPtr;
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ double staticSpace[2*MAX_STATIC_POINTS];
+ double *linePoints;
+ int numPoints, result;
+
+ /*
+ * Handle smoothed lines by generating an expanded set of points
+ * against which to do the check.
+ */
+
+ if ((linePtr->smooth) && (linePtr->numPoints > 2)) {
+ numPoints = 1 + linePtr->numPoints*linePtr->splineSteps;
+ if (numPoints <= MAX_STATIC_POINTS) {
+ linePoints = staticSpace;
+ } else {
+ linePoints = (double *) ckalloc((unsigned)
+ (2*numPoints*sizeof(double)));
+ }
+ numPoints = TkMakeBezierCurve(canvas, linePtr->coordPtr,
+ linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
+ linePoints);
+ } else {
+ numPoints = linePtr->numPoints;
+ linePoints = linePtr->coordPtr;
+ }
+
+ /*
+ * Check the segments of the line.
+ */
+
+ result = TkThickPolyLineToArea(linePoints, numPoints,
+ (double) linePtr->width, linePtr->capStyle, linePtr->joinStyle,
+ rectPtr);
+ if (result == 0) {
+ goto done;
+ }
+
+ /*
+ * Check arrowheads, if any.
+ */
+
+ if (linePtr->arrow != noneUid) {
+ if (linePtr->arrow != lastUid) {
+ if (TkPolygonToArea(linePtr->firstArrowPtr, PTS_IN_ARROW,
+ rectPtr) != result) {
+ result = 0;
+ goto done;
+ }
+ }
+ if (linePtr->arrow != firstUid) {
+ if (TkPolygonToArea(linePtr->lastArrowPtr, PTS_IN_ARROW,
+ rectPtr) != result) {
+ result = 0;
+ goto done;
+ }
+ }
+ }
+
+ done:
+ if ((linePoints != staticSpace) && (linePoints != linePtr->coordPtr)) {
+ ckfree((char *) linePoints);
+ }
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleLine --
+ *
+ * This procedure is invoked to rescale a line item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The line referred to by itemPtr is rescaled so that the
+ * following transformation is applied to all point
+ * coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleLine(canvas, itemPtr, originX, originY, scaleX, scaleY)
+ Tk_Canvas canvas; /* Canvas containing line. */
+ Tk_Item *itemPtr; /* Line to be scaled. */
+ double originX, originY; /* Origin about which to scale rect. */
+ double scaleX; /* Amount to scale in X direction. */
+ double scaleY; /* Amount to scale in Y direction. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ double *coordPtr;
+ int i;
+
+ /*
+ * Delete any arrowheads before scaling all the points (so that
+ * the end-points of the line get restored).
+ */
+
+ if (linePtr->firstArrowPtr != NULL) {
+ linePtr->coordPtr[0] = linePtr->firstArrowPtr[0];
+ linePtr->coordPtr[1] = linePtr->firstArrowPtr[1];
+ ckfree((char *) linePtr->firstArrowPtr);
+ linePtr->firstArrowPtr = NULL;
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ int i;
+
+ i = 2*(linePtr->numPoints-1);
+ linePtr->coordPtr[i] = linePtr->lastArrowPtr[0];
+ linePtr->coordPtr[i+1] = linePtr->lastArrowPtr[1];
+ ckfree((char *) linePtr->lastArrowPtr);
+ linePtr->lastArrowPtr = NULL;
+ }
+ for (i = 0, coordPtr = linePtr->coordPtr; i < linePtr->numPoints;
+ i++, coordPtr += 2) {
+ coordPtr[0] = originX + scaleX*(*coordPtr - originX);
+ coordPtr[1] = originY + scaleY*(coordPtr[1] - originY);
+ }
+ if (linePtr->arrow != noneUid) {
+ ConfigureArrows(canvas, linePtr);
+ }
+ ComputeLineBbox(canvas, linePtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateLine --
+ *
+ * This procedure is called to move a line by a given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the line is offset by (xDelta, yDelta), and
+ * the bounding box is updated in the generic part of the item
+ * structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateLine(canvas, itemPtr, deltaX, deltaY)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item that is being moved. */
+ double deltaX, deltaY; /* Amount by which item is to be
+ * moved. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ double *coordPtr;
+ int i;
+
+ for (i = 0, coordPtr = linePtr->coordPtr; i < linePtr->numPoints;
+ i++, coordPtr += 2) {
+ coordPtr[0] += deltaX;
+ coordPtr[1] += deltaY;
+ }
+ if (linePtr->firstArrowPtr != NULL) {
+ for (i = 0, coordPtr = linePtr->firstArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ coordPtr[0] += deltaX;
+ coordPtr[1] += deltaY;
+ }
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ coordPtr[0] += deltaX;
+ coordPtr[1] += deltaY;
+ }
+ }
+ ComputeLineBbox(canvas, linePtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ParseArrowShape --
+ *
+ * This procedure is called back during option parsing to
+ * parse arrow shape information.
+ *
+ * Results:
+ * The return value is a standard Tcl result: TCL_OK means
+ * that the arrow shape information was parsed ok, and
+ * TCL_ERROR means it couldn't be parsed.
+ *
+ * Side effects:
+ * Arrow information in recordPtr is updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ParseArrowShape(clientData, interp, tkwin, value, recordPtr, offset)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Window tkwin; /* Not used. */
+ char *value; /* Textual specification of arrow shape. */
+ char *recordPtr; /* Pointer to item record in which to
+ * store arrow information. */
+ int offset; /* Offset of shape information in widget
+ * record. */
+{
+ LineItem *linePtr = (LineItem *) recordPtr;
+ double a, b, c;
+ int argc;
+ char **argv = NULL;
+
+ if (offset != Tk_Offset(LineItem, arrowShapeA)) {
+ panic("ParseArrowShape received bogus offset");
+ }
+
+ if (Tcl_SplitList(interp, value, &argc, &argv) != TCL_OK) {
+ syntaxError:
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad arrow shape \"", value,
+ "\": must be list with three numbers", (char *) NULL);
+ if (argv != NULL) {
+ ckfree((char *) argv);
+ }
+ return TCL_ERROR;
+ }
+ if (argc != 3) {
+ goto syntaxError;
+ }
+ if ((Tk_CanvasGetCoord(interp, linePtr->canvas, argv[0], &a) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, linePtr->canvas, argv[1], &b)
+ != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, linePtr->canvas, argv[2], &c)
+ != TCL_OK)) {
+ goto syntaxError;
+ }
+ linePtr->arrowShapeA = (float)a;
+ linePtr->arrowShapeB = (float)b;
+ linePtr->arrowShapeC = (float)c;
+ ckfree((char *) argv);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PrintArrowShape --
+ *
+ * This procedure is a callback invoked by the configuration
+ * code to return a printable value describing an arrow shape.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+PrintArrowShape(clientData, tkwin, recordPtr, offset, freeProcPtr)
+ ClientData clientData; /* Not used. */
+ Tk_Window tkwin; /* Window associated with linePtr's widget. */
+ char *recordPtr; /* Pointer to item record containing current
+ * shape information. */
+ int offset; /* Offset of arrow information in record. */
+ Tcl_FreeProc **freeProcPtr; /* Store address of procedure to call to
+ * free string here. */
+{
+ LineItem *linePtr = (LineItem *) recordPtr;
+ char *buffer;
+
+ buffer = (char *) ckalloc(120);
+ sprintf(buffer, "%.5g %.5g %.5g", linePtr->arrowShapeA,
+ linePtr->arrowShapeB, linePtr->arrowShapeC);
+ *freeProcPtr = TCL_DYNAMIC;
+ return buffer;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureArrows --
+ *
+ * If arrowheads have been requested for a line, this
+ * procedure makes arrangements for the arrowheads.
+ *
+ * Results:
+ * Always returns TCL_OK.
+ *
+ * Side effects:
+ * Information in linePtr is set up for one or two arrowheads.
+ * the firstArrowPtr and lastArrowPtr polygons are allocated
+ * and initialized, if need be, and the end points of the line
+ * are adjusted so that a thick line doesn't stick out past
+ * the arrowheads.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConfigureArrows(canvas, linePtr)
+ Tk_Canvas canvas; /* Canvas in which arrows will be
+ * displayed (interp and tkwin
+ * fields are needed). */
+ LineItem *linePtr; /* Item to configure for arrows. */
+{
+ double *poly, *coordPtr;
+ double dx, dy, length, sinTheta, cosTheta, temp;
+ double fracHeight; /* Line width as fraction of
+ * arrowhead width. */
+ double backup; /* Distance to backup end points
+ * so the line ends in the middle
+ * of the arrowhead. */
+ double vertX, vertY; /* Position of arrowhead vertex. */
+ double shapeA, shapeB, shapeC; /* Adjusted coordinates (see
+ * explanation below). */
+
+ /*
+ * The code below makes a tiny increase in the shape parameters
+ * for the line. This is a bit of a hack, but it seems to result
+ * in displays that more closely approximate the specified parameters.
+ * Without the adjustment, the arrows come out smaller than expected.
+ */
+
+ shapeA = linePtr->arrowShapeA + 0.001;
+ shapeB = linePtr->arrowShapeB + 0.001;
+ shapeC = linePtr->arrowShapeC + linePtr->width/2.0 + 0.001;
+
+ /*
+ * If there's an arrowhead on the first point of the line, compute
+ * its polygon and adjust the first point of the line so that the
+ * line doesn't stick out past the leading edge of the arrowhead.
+ */
+
+ fracHeight = (linePtr->width/2.0)/shapeC;
+ backup = fracHeight*shapeB + shapeA*(1.0 - fracHeight)/2.0;
+ if (linePtr->arrow != lastUid) {
+ poly = linePtr->firstArrowPtr;
+ if (poly == NULL) {
+ poly = (double *) ckalloc((unsigned)
+ (2*PTS_IN_ARROW*sizeof(double)));
+ poly[0] = poly[10] = linePtr->coordPtr[0];
+ poly[1] = poly[11] = linePtr->coordPtr[1];
+ linePtr->firstArrowPtr = poly;
+ }
+ dx = poly[0] - linePtr->coordPtr[2];
+ dy = poly[1] - linePtr->coordPtr[3];
+ length = hypot(dx, dy);
+ if (length == 0) {
+ sinTheta = cosTheta = 0.0;
+ } else {
+ sinTheta = dy/length;
+ cosTheta = dx/length;
+ }
+ vertX = poly[0] - shapeA*cosTheta;
+ vertY = poly[1] - shapeA*sinTheta;
+ temp = shapeC*sinTheta;
+ poly[2] = poly[0] - shapeB*cosTheta + temp;
+ poly[8] = poly[2] - 2*temp;
+ temp = shapeC*cosTheta;
+ poly[3] = poly[1] - shapeB*sinTheta - temp;
+ poly[9] = poly[3] + 2*temp;
+ poly[4] = poly[2]*fracHeight + vertX*(1.0-fracHeight);
+ poly[5] = poly[3]*fracHeight + vertY*(1.0-fracHeight);
+ poly[6] = poly[8]*fracHeight + vertX*(1.0-fracHeight);
+ poly[7] = poly[9]*fracHeight + vertY*(1.0-fracHeight);
+
+ /*
+ * Polygon done. Now move the first point towards the second so
+ * that the corners at the end of the line are inside the
+ * arrowhead.
+ */
+
+ linePtr->coordPtr[0] = poly[0] - backup*cosTheta;
+ linePtr->coordPtr[1] = poly[1] - backup*sinTheta;
+ }
+
+ /*
+ * Similar arrowhead calculation for the last point of the line.
+ */
+
+ if (linePtr->arrow != firstUid) {
+ coordPtr = linePtr->coordPtr + 2*(linePtr->numPoints-2);
+ poly = linePtr->lastArrowPtr;
+ if (poly == NULL) {
+ poly = (double *) ckalloc((unsigned)
+ (2*PTS_IN_ARROW*sizeof(double)));
+ poly[0] = poly[10] = coordPtr[2];
+ poly[1] = poly[11] = coordPtr[3];
+ linePtr->lastArrowPtr = poly;
+ }
+ dx = poly[0] - coordPtr[0];
+ dy = poly[1] - coordPtr[1];
+ length = hypot(dx, dy);
+ if (length == 0) {
+ sinTheta = cosTheta = 0.0;
+ } else {
+ sinTheta = dy/length;
+ cosTheta = dx/length;
+ }
+ vertX = poly[0] - shapeA*cosTheta;
+ vertY = poly[1] - shapeA*sinTheta;
+ temp = shapeC*sinTheta;
+ poly[2] = poly[0] - shapeB*cosTheta + temp;
+ poly[8] = poly[2] - 2*temp;
+ temp = shapeC*cosTheta;
+ poly[3] = poly[1] - shapeB*sinTheta - temp;
+ poly[9] = poly[3] + 2*temp;
+ poly[4] = poly[2]*fracHeight + vertX*(1.0-fracHeight);
+ poly[5] = poly[3]*fracHeight + vertY*(1.0-fracHeight);
+ poly[6] = poly[8]*fracHeight + vertX*(1.0-fracHeight);
+ poly[7] = poly[9]*fracHeight + vertY*(1.0-fracHeight);
+ coordPtr[2] = poly[0] - backup*cosTheta;
+ coordPtr[3] = poly[1] - backup*sinTheta;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LineToPostscript --
+ *
+ * This procedure is called to generate Postscript for
+ * line items.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error
+ * occurs in generating Postscript then an error message is
+ * left in interp->result, replacing whatever used
+ * to be there. If no error occurs, then Postscript for the
+ * item is appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+LineToPostscript(interp, canvas, itemPtr, prepass)
+ Tcl_Interp *interp; /* Leave Postscript or error message
+ * here. */
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ Tk_Item *itemPtr; /* Item for which Postscript is
+ * wanted. */
+ int prepass; /* 1 means this is a prepass to
+ * collect font information; 0 means
+ * final Postscript is being created. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ char buffer[200];
+ char *style;
+
+ if (linePtr->fg == NULL) {
+ return TCL_OK;
+ }
+
+ /*
+ * Generate a path for the line's center-line (do this differently
+ * for straight lines and smoothed lines).
+ */
+
+ if ((!linePtr->smooth) || (linePtr->numPoints <= 2)) {
+ Tk_CanvasPsPath(interp, canvas, linePtr->coordPtr, linePtr->numPoints);
+ } else {
+ if (linePtr->fillStipple == None) {
+ TkMakeBezierPostscript(interp, canvas, linePtr->coordPtr,
+ linePtr->numPoints);
+ } else {
+ /*
+ * Special hack: Postscript printers don't appear to be able
+ * to turn a path drawn with "curveto"s into a clipping path
+ * without exceeding resource limits, so TkMakeBezierPostscript
+ * won't work for stippled curves. Instead, generate all of
+ * the intermediate points here and output them into the
+ * Postscript file with "lineto"s instead.
+ */
+
+ double staticPoints[2*MAX_STATIC_POINTS];
+ double *pointPtr;
+ int numPoints;
+
+ numPoints = 1 + linePtr->numPoints*linePtr->splineSteps;
+ pointPtr = staticPoints;
+ if (numPoints > MAX_STATIC_POINTS) {
+ pointPtr = (double *) ckalloc((unsigned)
+ (numPoints * 2 * sizeof(double)));
+ }
+ numPoints = TkMakeBezierCurve(canvas, linePtr->coordPtr,
+ linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
+ pointPtr);
+ Tk_CanvasPsPath(interp, canvas, pointPtr, numPoints);
+ if (pointPtr != staticPoints) {
+ ckfree((char *) pointPtr);
+ }
+ }
+ }
+
+ /*
+ * Set other line-drawing parameters and stroke out the line.
+ */
+
+ sprintf(buffer, "%d setlinewidth\n", linePtr->width);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ style = "0 setlinecap\n";
+ if (linePtr->capStyle == CapRound) {
+ style = "1 setlinecap\n";
+ } else if (linePtr->capStyle == CapProjecting) {
+ style = "2 setlinecap\n";
+ }
+ Tcl_AppendResult(interp, style, (char *) NULL);
+ style = "0 setlinejoin\n";
+ if (linePtr->joinStyle == JoinRound) {
+ style = "1 setlinejoin\n";
+ } else if (linePtr->joinStyle == JoinBevel) {
+ style = "2 setlinejoin\n";
+ }
+ Tcl_AppendResult(interp, style, (char *) NULL);
+ if (Tk_CanvasPsColor(interp, canvas, linePtr->fg) != TCL_OK) {
+ return TCL_ERROR;
+ };
+ if (linePtr->fillStipple != None) {
+ Tcl_AppendResult(interp, "StrokeClip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas, linePtr->fillStipple)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "stroke\n", (char *) NULL);
+ }
+
+ /*
+ * Output polygons for the arrowheads, if there are any.
+ */
+
+ if (linePtr->firstArrowPtr != NULL) {
+ if (linePtr->fillStipple != None) {
+ Tcl_AppendResult(interp, "grestore gsave\n",
+ (char *) NULL);
+ }
+ if (ArrowheadPostscript(interp, canvas, linePtr,
+ linePtr->firstArrowPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ if (linePtr->fillStipple != None) {
+ Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
+ }
+ if (ArrowheadPostscript(interp, canvas, linePtr,
+ linePtr->lastArrowPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArrowheadPostscript --
+ *
+ * This procedure is called to generate Postscript for
+ * an arrowhead for a line item.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error
+ * occurs in generating Postscript then an error message is
+ * left in interp->result, replacing whatever used
+ * to be there. If no error occurs, then Postscript for the
+ * arrowhead is appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ArrowheadPostscript(interp, canvas, linePtr, arrowPtr)
+ Tcl_Interp *interp; /* Leave Postscript or error message
+ * here. */
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ LineItem *linePtr; /* Line item for which Postscript is
+ * being generated. */
+ double *arrowPtr; /* Pointer to first of five points
+ * describing arrowhead polygon. */
+{
+ Tk_CanvasPsPath(interp, canvas, arrowPtr, PTS_IN_ARROW);
+ if (linePtr->fillStipple != None) {
+ Tcl_AppendResult(interp, "clip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas, linePtr->fillStipple)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "fill\n", (char *) NULL);
+ }
+ return TCL_OK;
+}
diff --git a/generic/tkCanvPoly.c b/generic/tkCanvPoly.c
new file mode 100644
index 0000000..1320438
--- /dev/null
+++ b/generic/tkCanvPoly.c
@@ -0,0 +1,998 @@
+/*
+ * tkCanvPoly.c --
+ *
+ * This file implements polygon items for canvas widgets.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkCanvPoly.c 1.37 97/04/29 15:39:16
+ */
+
+#include <stdio.h>
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * The structure below defines the record for each polygon item.
+ */
+
+typedef struct PolygonItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ int numPoints; /* Number of points in polygon (always >= 3).
+ * Polygon is always closed. */
+ int pointsAllocated; /* Number of points for which space is
+ * allocated at *coordPtr. */
+ double *coordPtr; /* Pointer to malloc-ed array containing
+ * x- and y-coords of all points in polygon.
+ * X-coords are even-valued indices, y-coords
+ * are corresponding odd-valued indices. */
+ int width; /* Width of outline. */
+ XColor *outlineColor; /* Color for outline. */
+ GC outlineGC; /* Graphics context for drawing outline. */
+ XColor *fillColor; /* Foreground color for polygon. */
+ Pixmap fillStipple; /* Stipple bitmap for filling polygon. */
+ GC fillGC; /* Graphics context for filling polygon. */
+ int smooth; /* Non-zero means draw shape smoothed (i.e.
+ * with Bezier splines). */
+ int splineSteps; /* Number of steps in each spline segment. */
+ int autoClosed; /* Zero means the given polygon was closed,
+ one means that we auto closed it. */
+} PolygonItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL,
+ "black", Tk_Offset(PolygonItem, fillColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-outline", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, outlineColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BOOLEAN, "-smooth", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(PolygonItem, smooth), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_INT, "-splinesteps", (char *) NULL, (char *) NULL,
+ "12", Tk_Offset(PolygonItem, splineSteps), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, fillStipple), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
+ "1", Tk_Offset(PolygonItem, width), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static void ComputePolygonBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ PolygonItem *polyPtr));
+static int ConfigurePolygon _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv, int flags));
+static int CreatePolygon _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int argc, char **argv));
+static void DeletePolygon _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayPolygon _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static int PolygonCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ int argc, char **argv));
+static int PolygonToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+static double PolygonToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *pointPtr));
+static int PolygonToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+static void ScalePolygon _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void TranslatePolygon _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+
+/*
+ * The structures below defines the polygon item type by means
+ * of procedures that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkPolygonType = {
+ "polygon", /* name */
+ sizeof(PolygonItem), /* itemSize */
+ CreatePolygon, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigurePolygon, /* configureProc */
+ PolygonCoords, /* coordProc */
+ DeletePolygon, /* deleteProc */
+ DisplayPolygon, /* displayProc */
+ 0, /* alwaysRedraw */
+ PolygonToPoint, /* pointProc */
+ PolygonToArea, /* areaProc */
+ PolygonToPostscript, /* postscriptProc */
+ ScalePolygon, /* scaleProc */
+ TranslatePolygon, /* translateProc */
+ (Tk_ItemIndexProc *) NULL, /* indexProc */
+ (Tk_ItemCursorProc *) NULL, /* icursorProc */
+ (Tk_ItemSelectionProc *) NULL, /* selectionProc */
+ (Tk_ItemInsertProc *) NULL, /* insertProc */
+ (Tk_ItemDCharsProc *) NULL, /* dTextProc */
+ (Tk_ItemType *) NULL /* nextPtr */
+};
+
+/*
+ * The definition below determines how large are static arrays
+ * used to hold spline points (splines larger than this have to
+ * have their arrays malloc-ed).
+ */
+
+#define MAX_STATIC_POINTS 200
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreatePolygon --
+ *
+ * This procedure is invoked to create a new polygon item in
+ * a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in
+ * creating the item, then an error message is left in
+ * interp->result; in this case itemPtr is
+ * left uninitialized, so it can be safely freed by the
+ * caller.
+ *
+ * Side effects:
+ * A new polygon item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreatePolygon(interp, canvas, itemPtr, argc, argv)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas to hold new item. */
+ Tk_Item *itemPtr; /* Record to hold new item; header
+ * has been initialized by caller. */
+ int argc; /* Number of arguments in argv. */
+ char **argv; /* Arguments describing polygon. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ int i;
+
+ if (argc < 6) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
+ itemPtr->typePtr->name,
+ " x1 y1 x2 y2 x3 y3 ?x4 y4 ...? ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Carry out initialization that is needed in order to clean
+ * up after errors during the the remainder of this procedure.
+ */
+
+ polyPtr->numPoints = 0;
+ polyPtr->pointsAllocated = 0;
+ polyPtr->coordPtr = NULL;
+ polyPtr->width = 1;
+ polyPtr->outlineColor = NULL;
+ polyPtr->outlineGC = None;
+ polyPtr->fillColor = NULL;
+ polyPtr->fillStipple = None;
+ polyPtr->fillGC = None;
+ polyPtr->smooth = 0;
+ polyPtr->splineSteps = 12;
+ polyPtr->autoClosed = 0;
+
+ /*
+ * Count the number of points and then parse them into a point
+ * array. Leading arguments are assumed to be points if they
+ * start with a digit or a minus sign followed by a digit.
+ */
+
+ for (i = 4; i < (argc-1); i+=2) {
+ if ((!isdigit(UCHAR(argv[i][0]))) &&
+ ((argv[i][0] != '-') || (!isdigit(UCHAR(argv[i][1]))))) {
+ break;
+ }
+ }
+ if (PolygonCoords(interp, canvas, itemPtr, i, argv) != TCL_OK) {
+ goto error;
+ }
+
+ if (ConfigurePolygon(interp, canvas, itemPtr, argc-i, argv+i, 0)
+ == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeletePolygon(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PolygonCoords --
+ *
+ * This procedure is invoked to process the "coords" widget
+ * command on polygons. See the user documentation for details
+ * on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets interp->result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+PolygonCoords(interp, canvas, itemPtr, argc, argv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item whose coordinates are to be
+ * read or modified. */
+ int argc; /* Number of coordinates supplied in
+ * argv. */
+ char **argv; /* Array of coordinates: x1, y1,
+ * x2, y2, ... */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ char buffer[TCL_DOUBLE_SPACE];
+ int i, numPoints;
+
+ if (argc == 0) {
+ /*
+ * Print the coords used to create the polygon. If we auto
+ * closed the polygon then we don't report the last point.
+ */
+ for (i = 0; i < 2*(polyPtr->numPoints - polyPtr->autoClosed); i++) {
+ Tcl_PrintDouble(interp, polyPtr->coordPtr[i], buffer);
+ Tcl_AppendElement(interp, buffer);
+ }
+ } else if (argc < 6) {
+ Tcl_AppendResult(interp,
+ "too few coordinates for polygon: must have at least 6",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else if (argc & 1) {
+ Tcl_AppendResult(interp,
+ "odd number of coordinates specified for polygon",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ numPoints = argc/2;
+ if (polyPtr->pointsAllocated <= numPoints) {
+ if (polyPtr->coordPtr != NULL) {
+ ckfree((char *) polyPtr->coordPtr);
+ }
+
+ /*
+ * One extra point gets allocated here, just in case we have
+ * to add another point to close the polygon.
+ */
+
+ polyPtr->coordPtr = (double *) ckalloc((unsigned)
+ (sizeof(double) * (argc+2)));
+ polyPtr->pointsAllocated = numPoints+1;
+ }
+ for (i = argc-1; i >= 0; i--) {
+ if (Tk_CanvasGetCoord(interp, canvas, argv[i],
+ &polyPtr->coordPtr[i]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ polyPtr->numPoints = numPoints;
+ polyPtr->autoClosed = 0;
+
+ /*
+ * Close the polygon if it isn't already closed.
+ */
+
+ if ((polyPtr->coordPtr[argc-2] != polyPtr->coordPtr[0])
+ || (polyPtr->coordPtr[argc-1] != polyPtr->coordPtr[1])) {
+ polyPtr->autoClosed = 1;
+ polyPtr->numPoints++;
+ polyPtr->coordPtr[argc] = polyPtr->coordPtr[0];
+ polyPtr->coordPtr[argc+1] = polyPtr->coordPtr[1];
+ }
+ ComputePolygonBbox(canvas, polyPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigurePolygon --
+ *
+ * This procedure is invoked to configure various aspects
+ * of a polygon item such as its background color.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then
+ * an error message is left in interp->result.
+ *
+ * Side effects:
+ * Configuration information, such as colors and stipple
+ * patterns, may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigurePolygon(interp, canvas, itemPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Polygon item to reconfigure. */
+ int argc; /* Number of elements in argv. */
+ char **argv; /* Arguments describing things to configure. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ XGCValues gcValues;
+ GC newGC;
+ unsigned long mask;
+ Tk_Window tkwin;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv,
+ (char *) polyPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as
+ * graphics contexts.
+ */
+
+ if (polyPtr->width < 1) {
+ polyPtr->width = 1;
+ }
+ if (polyPtr->outlineColor == NULL) {
+ newGC = None;
+ } else {
+ gcValues.foreground = polyPtr->outlineColor->pixel;
+ gcValues.line_width = polyPtr->width;
+ gcValues.cap_style = CapRound;
+ gcValues.join_style = JoinRound;
+ mask = GCForeground|GCLineWidth|GCCapStyle|GCJoinStyle;
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ }
+ if (polyPtr->outlineGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), polyPtr->outlineGC);
+ }
+ polyPtr->outlineGC = newGC;
+
+ if (polyPtr->fillColor == NULL) {
+ newGC = None;
+ } else {
+ gcValues.foreground = polyPtr->fillColor->pixel;
+ mask = GCForeground;
+ if (polyPtr->fillStipple != None) {
+ gcValues.stipple = polyPtr->fillStipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ }
+ if (polyPtr->fillGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), polyPtr->fillGC);
+ }
+ polyPtr->fillGC = newGC;
+
+ /*
+ * Keep spline parameters within reasonable limits.
+ */
+
+ if (polyPtr->splineSteps < 1) {
+ polyPtr->splineSteps = 1;
+ } else if (polyPtr->splineSteps > 100) {
+ polyPtr->splineSteps = 100;
+ }
+
+ ComputePolygonBbox(canvas, polyPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeletePolygon --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a polygon item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeletePolygon(canvas, itemPtr, display)
+ Tk_Canvas canvas; /* Info about overall canvas widget. */
+ Tk_Item *itemPtr; /* Item that is being deleted. */
+ Display *display; /* Display containing window for
+ * canvas. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+
+ if (polyPtr->coordPtr != NULL) {
+ ckfree((char *) polyPtr->coordPtr);
+ }
+ if (polyPtr->fillColor != NULL) {
+ Tk_FreeColor(polyPtr->fillColor);
+ }
+ if (polyPtr->fillStipple != None) {
+ Tk_FreeBitmap(display, polyPtr->fillStipple);
+ }
+ if (polyPtr->outlineColor != NULL) {
+ Tk_FreeColor(polyPtr->outlineColor);
+ }
+ if (polyPtr->outlineGC != None) {
+ Tk_FreeGC(display, polyPtr->outlineGC);
+ }
+ if (polyPtr->fillGC != None) {
+ Tk_FreeGC(display, polyPtr->fillGC);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputePolygonBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of a polygon.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputePolygonBbox(canvas, polyPtr)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ PolygonItem *polyPtr; /* Item whose bbox is to be
+ * recomputed. */
+{
+ double *coordPtr;
+ int i;
+
+ coordPtr = polyPtr->coordPtr;
+ polyPtr->header.x1 = polyPtr->header.x2 = (int) *coordPtr;
+ polyPtr->header.y1 = polyPtr->header.y2 = (int) coordPtr[1];
+
+ for (i = 1, coordPtr = polyPtr->coordPtr+2; i < polyPtr->numPoints;
+ i++, coordPtr += 2) {
+ TkIncludePoint((Tk_Item *) polyPtr, coordPtr);
+ }
+
+ /*
+ * Expand bounding box in all directions to account for the outline,
+ * which can stick out beyond the polygon. Add one extra pixel of
+ * fudge, just in case X rounds differently than we do.
+ */
+
+ i = (polyPtr->width+1)/2 + 1;
+ polyPtr->header.x1 -= i;
+ polyPtr->header.x2 += i;
+ polyPtr->header.y1 -= i;
+ polyPtr->header.y2 += i;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkFillPolygon --
+ *
+ * This procedure is invoked to convert a polygon to screen
+ * coordinates and display it using a particular GC.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * information in canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkFillPolygon(canvas, coordPtr, numPoints, display, drawable, gc, outlineGC)
+ Tk_Canvas canvas; /* Canvas whose coordinate system
+ * is to be used for drawing. */
+ double *coordPtr; /* Array of coordinates for polygon:
+ * x1, y1, x2, y2, .... */
+ int numPoints; /* Twice this many coordinates are
+ * present at *coordPtr. */
+ Display *display; /* Display on which to draw polygon. */
+ Drawable drawable; /* Pixmap or window in which to draw
+ * polygon. */
+ GC gc; /* Graphics context for drawing. */
+ GC outlineGC; /* If not None, use this to draw an
+ * outline around the polygon after
+ * filling it. */
+{
+ XPoint staticPoints[MAX_STATIC_POINTS];
+ XPoint *pointPtr;
+ XPoint *pPtr;
+ int i;
+
+ /*
+ * Build up an array of points in screen coordinates. Use a
+ * static array unless the polygon has an enormous number of points;
+ * in this case, dynamically allocate an array.
+ */
+
+ if (numPoints <= MAX_STATIC_POINTS) {
+ pointPtr = staticPoints;
+ } else {
+ pointPtr = (XPoint *) ckalloc((unsigned) (numPoints * sizeof(XPoint)));
+ }
+
+ for (i = 0, pPtr = pointPtr; i < numPoints; i += 1, coordPtr += 2, pPtr++) {
+ Tk_CanvasDrawableCoords(canvas, coordPtr[0], coordPtr[1], &pPtr->x,
+ &pPtr->y);
+ }
+
+ /*
+ * Display polygon, then free up polygon storage if it was dynamically
+ * allocated.
+ */
+
+ if (gc != None) {
+ XFillPolygon(display, drawable, gc, pointPtr, numPoints, Complex,
+ CoordModeOrigin);
+ }
+ if (outlineGC != None) {
+ XDrawLines(display, drawable, outlineGC, pointPtr,
+ numPoints, CoordModeOrigin);
+ }
+ if (pointPtr != staticPoints) {
+ ckfree((char *) pointPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayPolygon --
+ *
+ * This procedure is invoked to draw a polygon item in a given
+ * drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * information in canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayPolygon(canvas, itemPtr, display, drawable, x, y, width, height)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ Tk_Item *itemPtr; /* Item to be displayed. */
+ Display *display; /* Display on which to draw item. */
+ Drawable drawable; /* Pixmap or window in which to draw
+ * item. */
+ int x, y, width, height; /* Describes region of canvas that
+ * must be redisplayed (not used). */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+
+ if ((polyPtr->fillGC == None) && (polyPtr->outlineGC == None)) {
+ return;
+ }
+
+ /*
+ * If we're stippling then modify the stipple offset in the GC. Be
+ * sure to reset the offset when done, since the GC is supposed to be
+ * read-only.
+ */
+
+ if ((polyPtr->fillStipple != None) && (polyPtr->fillGC != None)) {
+ Tk_CanvasSetStippleOrigin(canvas, polyPtr->fillGC);
+ }
+
+ if (!polyPtr->smooth) {
+ TkFillPolygon(canvas, polyPtr->coordPtr, polyPtr->numPoints,
+ display, drawable, polyPtr->fillGC, polyPtr->outlineGC);
+ } else {
+ int numPoints;
+ XPoint staticPoints[MAX_STATIC_POINTS];
+ XPoint *pointPtr;
+
+ /*
+ * This is a smoothed polygon. Display using a set of generated
+ * spline points rather than the original points.
+ */
+
+ numPoints = 1 + polyPtr->numPoints*polyPtr->splineSteps;
+ if (numPoints <= MAX_STATIC_POINTS) {
+ pointPtr = staticPoints;
+ } else {
+ pointPtr = (XPoint *) ckalloc((unsigned)
+ (numPoints * sizeof(XPoint)));
+ }
+ numPoints = TkMakeBezierCurve(canvas, polyPtr->coordPtr,
+ polyPtr->numPoints, polyPtr->splineSteps, pointPtr,
+ (double *) NULL);
+ if (polyPtr->fillGC != None) {
+ XFillPolygon(display, drawable, polyPtr->fillGC, pointPtr,
+ numPoints, Complex, CoordModeOrigin);
+ }
+ if (polyPtr->outlineGC != None) {
+ XDrawLines(display, drawable, polyPtr->outlineGC, pointPtr,
+ numPoints, CoordModeOrigin);
+ }
+ if (pointPtr != staticPoints) {
+ ckfree((char *) pointPtr);
+ }
+ }
+ if ((polyPtr->fillStipple != None) && (polyPtr->fillGC != None)) {
+ XSetTSOrigin(display, polyPtr->fillGC, 0, 0);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PolygonToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * polygon, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are pointPtr[0] and pointPtr[1] is inside the polygon. If the
+ * point isn't inside the polygon then the return value is the
+ * distance from the point to the polygon.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static double
+PolygonToPoint(canvas, itemPtr, pointPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *pointPtr; /* Pointer to x and y coordinates. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ double *coordPtr, distance;
+ double staticSpace[2*MAX_STATIC_POINTS];
+ int numPoints;
+
+ if (!polyPtr->smooth) {
+ distance = TkPolygonToPoint(polyPtr->coordPtr, polyPtr->numPoints,
+ pointPtr);
+ } else {
+ /*
+ * Smoothed polygon. Generate a new set of points and use them
+ * for comparison.
+ */
+
+ numPoints = 1 + polyPtr->numPoints*polyPtr->splineSteps;
+ if (numPoints <= MAX_STATIC_POINTS) {
+ coordPtr = staticSpace;
+ } else {
+ coordPtr = (double *) ckalloc((unsigned)
+ (2*numPoints*sizeof(double)));
+ }
+ numPoints = TkMakeBezierCurve(canvas, polyPtr->coordPtr,
+ polyPtr->numPoints, polyPtr->splineSteps, (XPoint *) NULL,
+ coordPtr);
+ distance = TkPolygonToPoint(coordPtr, numPoints, pointPtr);
+ if (coordPtr != staticSpace) {
+ ckfree((char *) coordPtr);
+ }
+ }
+ if (polyPtr->outlineColor != NULL) {
+ distance -= polyPtr->width/2.0;
+ if (distance < 0) {
+ distance = 0;
+ }
+ }
+ return distance;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PolygonToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area
+ * given by rectPtr, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+PolygonToArea(canvas, itemPtr, rectPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against polygon. */
+ double *rectPtr; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) describing rectangular
+ * area. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ double *coordPtr, rect2[4], halfWidth;
+ double staticSpace[2*MAX_STATIC_POINTS];
+ int numPoints, result;
+
+ /*
+ * Handle smoothed polygons by generating an expanded set of points
+ * against which to do the check.
+ */
+
+ if (polyPtr->smooth) {
+ numPoints = 1 + polyPtr->numPoints*polyPtr->splineSteps;
+ if (numPoints <= MAX_STATIC_POINTS) {
+ coordPtr = staticSpace;
+ } else {
+ coordPtr = (double *) ckalloc((unsigned)
+ (2*numPoints*sizeof(double)));
+ }
+ numPoints = TkMakeBezierCurve(canvas, polyPtr->coordPtr,
+ polyPtr->numPoints, polyPtr->splineSteps, (XPoint *) NULL,
+ coordPtr);
+ } else {
+ numPoints = polyPtr->numPoints;
+ coordPtr = polyPtr->coordPtr;
+ }
+
+ if (polyPtr->width <= 1) {
+ /*
+ * The outline of the polygon doesn't stick out, so we can
+ * do a simple check.
+ */
+
+ result = TkPolygonToArea(coordPtr, numPoints, rectPtr);
+ } else {
+ /*
+ * The polygon has a wide outline, so the check is more complicated.
+ * First, check the line segments to see if they overlap the area.
+ */
+
+ result = TkThickPolyLineToArea(coordPtr, numPoints,
+ (double) polyPtr->width, CapRound, JoinRound, rectPtr);
+ if (result >= 0) {
+ goto done;
+ }
+
+ /*
+ * There is no overlap between the polygon's outline and the
+ * rectangle. This means either the rectangle is entirely outside
+ * the polygon or entirely inside. To tell the difference,
+ * see whether the polygon (with 0 outline width) overlaps the
+ * rectangle bloated by half the outline width.
+ */
+
+ halfWidth = polyPtr->width/2.0;
+ rect2[0] = rectPtr[0] - halfWidth;
+ rect2[1] = rectPtr[1] - halfWidth;
+ rect2[2] = rectPtr[2] + halfWidth;
+ rect2[3] = rectPtr[3] + halfWidth;
+ if (TkPolygonToArea(coordPtr, numPoints, rect2) == -1) {
+ result = -1;
+ } else {
+ result = 0;
+ }
+ }
+
+ done:
+ if ((coordPtr != staticSpace) && (coordPtr != polyPtr->coordPtr)) {
+ ckfree((char *) coordPtr);
+ }
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScalePolygon --
+ *
+ * This procedure is invoked to rescale a polygon item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The polygon referred to by itemPtr is rescaled so that the
+ * following transformation is applied to all point
+ * coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScalePolygon(canvas, itemPtr, originX, originY, scaleX, scaleY)
+ Tk_Canvas canvas; /* Canvas containing polygon. */
+ Tk_Item *itemPtr; /* Polygon to be scaled. */
+ double originX, originY; /* Origin about which to scale rect. */
+ double scaleX; /* Amount to scale in X direction. */
+ double scaleY; /* Amount to scale in Y direction. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ double *coordPtr;
+ int i;
+
+ for (i = 0, coordPtr = polyPtr->coordPtr; i < polyPtr->numPoints;
+ i++, coordPtr += 2) {
+ *coordPtr = originX + scaleX*(*coordPtr - originX);
+ coordPtr[1] = originY + scaleY*(coordPtr[1] - originY);
+ }
+ ComputePolygonBbox(canvas, polyPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslatePolygon --
+ *
+ * This procedure is called to move a polygon by a given
+ * amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the polygon is offset by (xDelta, yDelta),
+ * and the bounding box is updated in the generic part of the
+ * item structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslatePolygon(canvas, itemPtr, deltaX, deltaY)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item that is being moved. */
+ double deltaX, deltaY; /* Amount by which item is to be
+ * moved. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ double *coordPtr;
+ int i;
+
+ for (i = 0, coordPtr = polyPtr->coordPtr; i < polyPtr->numPoints;
+ i++, coordPtr += 2) {
+ *coordPtr += deltaX;
+ coordPtr[1] += deltaY;
+ }
+ ComputePolygonBbox(canvas, polyPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PolygonToPostscript --
+ *
+ * This procedure is called to generate Postscript for
+ * polygon items.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error
+ * occurs in generating Postscript then an error message is
+ * left in interp->result, replacing whatever used
+ * to be there. If no error occurs, then Postscript for the
+ * item is appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+PolygonToPostscript(interp, canvas, itemPtr, prepass)
+ Tcl_Interp *interp; /* Leave Postscript or error message
+ * here. */
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ Tk_Item *itemPtr; /* Item for which Postscript is
+ * wanted. */
+ int prepass; /* 1 means this is a prepass to
+ * collect font information; 0 means
+ * final Postscript is being created. */
+{
+ char string[100];
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+
+ /*
+ * Fill the area of the polygon.
+ */
+
+ if (polyPtr->fillColor != NULL) {
+ if (!polyPtr->smooth) {
+ Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr,
+ polyPtr->numPoints);
+ } else {
+ TkMakeBezierPostscript(interp, canvas, polyPtr->coordPtr,
+ polyPtr->numPoints);
+ }
+ if (Tk_CanvasPsColor(interp, canvas, polyPtr->fillColor) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (polyPtr->fillStipple != None) {
+ Tcl_AppendResult(interp, "eoclip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas, polyPtr->fillStipple)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (polyPtr->outlineColor != NULL) {
+ Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
+ }
+ } else {
+ Tcl_AppendResult(interp, "eofill\n", (char *) NULL);
+ }
+ }
+
+ /*
+ * Now draw the outline, if there is one.
+ */
+
+ if (polyPtr->outlineColor != NULL) {
+ if (!polyPtr->smooth) {
+ Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr,
+ polyPtr->numPoints);
+ } else {
+ TkMakeBezierPostscript(interp, canvas, polyPtr->coordPtr,
+ polyPtr->numPoints);
+ }
+
+ sprintf(string, "%d setlinewidth\n", polyPtr->width);
+ Tcl_AppendResult(interp, string,
+ "1 setlinecap\n1 setlinejoin\n", (char *) NULL);
+ if (Tk_CanvasPsColor(interp, canvas, polyPtr->outlineColor)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_AppendResult(interp, "stroke\n", (char *) NULL);
+ }
+ return TCL_OK;
+}
diff --git a/generic/tkCanvPs.c b/generic/tkCanvPs.c
new file mode 100644
index 0000000..9bad194
--- /dev/null
+++ b/generic/tkCanvPs.c
@@ -0,0 +1,1163 @@
+/*
+ * tkCanvPs.c --
+ *
+ * This module provides Postscript output support for canvases,
+ * including the "postscript" widget command plus a few utility
+ * procedures used for generating Postscript.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkCanvPs.c 1.57 97/10/28 18:08:39
+ */
+
+#include "tkInt.h"
+#include "tkCanvas.h"
+#include "tkPort.h"
+
+/*
+ * See tkCanvas.h for key data structures used to implement canvases.
+ */
+
+/*
+ * One of the following structures is created to keep track of Postscript
+ * output being generated. It consists mostly of information provided on
+ * the widget command line.
+ */
+
+typedef struct TkPostscriptInfo {
+ int x, y, width, height; /* Area to print, in canvas pixel
+ * coordinates. */
+ int x2, y2; /* x+width and y+height. */
+ char *pageXString; /* String value of "-pagex" option or NULL. */
+ char *pageYString; /* String value of "-pagey" option or NULL. */
+ double pageX, pageY; /* Postscript coordinates (in points)
+ * corresponding to pageXString and
+ * pageYString. Don't forget that y-values
+ * grow upwards for Postscript! */
+ char *pageWidthString; /* Printed width of output. */
+ char *pageHeightString; /* Printed height of output. */
+ double scale; /* Scale factor for conversion: each pixel
+ * maps into this many points. */
+ Tk_Anchor pageAnchor; /* How to anchor bbox on Postscript page. */
+ int rotate; /* Non-zero means output should be rotated
+ * on page (landscape mode). */
+ char *fontVar; /* If non-NULL, gives name of global variable
+ * containing font mapping information.
+ * Malloc'ed. */
+ char *colorVar; /* If non-NULL, give name of global variable
+ * containing color mapping information.
+ * Malloc'ed. */
+ char *colorMode; /* Mode for handling colors: "monochrome",
+ * "gray", or "color". Malloc'ed. */
+ int colorLevel; /* Numeric value corresponding to colorMode:
+ * 0 for mono, 1 for gray, 2 for color. */
+ char *fileName; /* Name of file in which to write Postscript;
+ * NULL means return Postscript info as
+ * result. Malloc'ed. */
+ char *channelName; /* If -channel is specified, the name of
+ * the channel to use. */
+ Tcl_Channel chan; /* Open channel corresponding to fileName. */
+ Tcl_HashTable fontTable; /* Hash table containing names of all font
+ * families used in output. The hash table
+ * values are not used. */
+ int prepass; /* Non-zero means that we're currently in
+ * the pre-pass that collects font information,
+ * so the Postscript generated isn't
+ * relevant. */
+} TkPostscriptInfo;
+
+/*
+ * The table below provides a template that's used to process arguments
+ * to the canvas "postscript" command and fill in TkPostscriptInfo
+ * structures.
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_STRING, "-colormap", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, colorVar), 0},
+ {TK_CONFIG_STRING, "-colormode", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, colorMode), 0},
+ {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, fileName), 0},
+ {TK_CONFIG_STRING, "-channel", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, channelName), 0},
+ {TK_CONFIG_STRING, "-fontmap", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, fontVar), 0},
+ {TK_CONFIG_PIXELS, "-height", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, height), 0},
+ {TK_CONFIG_ANCHOR, "-pageanchor", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageAnchor), 0},
+ {TK_CONFIG_STRING, "-pageheight", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageHeightString), 0},
+ {TK_CONFIG_STRING, "-pagewidth", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageWidthString), 0},
+ {TK_CONFIG_STRING, "-pagex", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageXString), 0},
+ {TK_CONFIG_STRING, "-pagey", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageYString), 0},
+ {TK_CONFIG_BOOLEAN, "-rotate", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, rotate), 0},
+ {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, width), 0},
+ {TK_CONFIG_PIXELS, "-x", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, x), 0},
+ {TK_CONFIG_PIXELS, "-y", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, y), 0},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int GetPostscriptPoints _ANSI_ARGS_((Tcl_Interp *interp,
+ char *string, double *doublePtr));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkCanvPostscriptCmd --
+ *
+ * This procedure is invoked to process the "postscript" options
+ * of the widget command for canvas widgets. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
+ TkCanvas *canvasPtr; /* Information about canvas widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. Caller has
+ * already parsed this command enough
+ * to know that argv[1] is
+ * "postscript". */
+{
+ TkPostscriptInfo psInfo, *oldInfoPtr;
+ int result;
+ Tk_Item *itemPtr;
+#define STRING_LENGTH 400
+ char string[STRING_LENGTH+1], *p;
+ time_t now;
+ size_t length;
+ int deltaX = 0, deltaY = 0; /* Offset of lower-left corner of
+ * area to be marked up, measured
+ * in canvas units from the positioning
+ * point on the page (reflects
+ * anchor position). Initial values
+ * needed only to stop compiler
+ * warnings. */
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+ Tcl_DString buffer;
+
+ /*
+ *----------------------------------------------------------------
+ * Initialize the data structure describing Postscript generation,
+ * then process all the arguments to fill the data structure in.
+ *----------------------------------------------------------------
+ */
+
+ oldInfoPtr = canvasPtr->psInfoPtr;
+ canvasPtr->psInfoPtr = &psInfo;
+ psInfo.x = canvasPtr->xOrigin;
+ psInfo.y = canvasPtr->yOrigin;
+ psInfo.width = -1;
+ psInfo.height = -1;
+ psInfo.pageXString = NULL;
+ psInfo.pageYString = NULL;
+ psInfo.pageX = 72*4.25;
+ psInfo.pageY = 72*5.5;
+ psInfo.pageWidthString = NULL;
+ psInfo.pageHeightString = NULL;
+ psInfo.scale = 1.0;
+ psInfo.pageAnchor = TK_ANCHOR_CENTER;
+ psInfo.rotate = 0;
+ psInfo.fontVar = NULL;
+ psInfo.colorVar = NULL;
+ psInfo.colorMode = NULL;
+ psInfo.colorLevel = 0;
+ psInfo.fileName = NULL;
+ psInfo.channelName = NULL;
+ psInfo.chan = NULL;
+ psInfo.prepass = 0;
+ Tcl_InitHashTable(&psInfo.fontTable, TCL_STRING_KEYS);
+ result = Tk_ConfigureWidget(canvasPtr->interp, canvasPtr->tkwin,
+ configSpecs, argc-2, argv+2, (char *) &psInfo,
+ TK_CONFIG_ARGV_ONLY);
+ if (result != TCL_OK) {
+ goto cleanup;
+ }
+
+ if (psInfo.width == -1) {
+ psInfo.width = Tk_Width(canvasPtr->tkwin);
+ }
+ if (psInfo.height == -1) {
+ psInfo.height = Tk_Height(canvasPtr->tkwin);
+ }
+ psInfo.x2 = psInfo.x + psInfo.width;
+ psInfo.y2 = psInfo.y + psInfo.height;
+
+ if (psInfo.pageXString != NULL) {
+ if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageXString,
+ &psInfo.pageX) != TCL_OK) {
+ goto cleanup;
+ }
+ }
+ if (psInfo.pageYString != NULL) {
+ if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageYString,
+ &psInfo.pageY) != TCL_OK) {
+ goto cleanup;
+ }
+ }
+ if (psInfo.pageWidthString != NULL) {
+ if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageWidthString,
+ &psInfo.scale) != TCL_OK) {
+ goto cleanup;
+ }
+ psInfo.scale /= psInfo.width;
+ } else if (psInfo.pageHeightString != NULL) {
+ if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageHeightString,
+ &psInfo.scale) != TCL_OK) {
+ goto cleanup;
+ }
+ psInfo.scale /= psInfo.height;
+ } else {
+ psInfo.scale = (72.0/25.4)*WidthMMOfScreen(Tk_Screen(canvasPtr->tkwin));
+ psInfo.scale /= WidthOfScreen(Tk_Screen(canvasPtr->tkwin));
+ }
+ switch (psInfo.pageAnchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_SW:
+ deltaX = 0;
+ break;
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_S:
+ deltaX = -psInfo.width/2;
+ break;
+ case TK_ANCHOR_NE:
+ case TK_ANCHOR_E:
+ case TK_ANCHOR_SE:
+ deltaX = -psInfo.width;
+ break;
+ }
+ switch (psInfo.pageAnchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_NE:
+ deltaY = - psInfo.height;
+ break;
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_E:
+ deltaY = -psInfo.height/2;
+ break;
+ case TK_ANCHOR_SW:
+ case TK_ANCHOR_S:
+ case TK_ANCHOR_SE:
+ deltaY = 0;
+ break;
+ }
+
+ if (psInfo.colorMode == NULL) {
+ psInfo.colorLevel = 2;
+ } else {
+ length = strlen(psInfo.colorMode);
+ if (strncmp(psInfo.colorMode, "monochrome", length) == 0) {
+ psInfo.colorLevel = 0;
+ } else if (strncmp(psInfo.colorMode, "gray", length) == 0) {
+ psInfo.colorLevel = 1;
+ } else if (strncmp(psInfo.colorMode, "color", length) == 0) {
+ psInfo.colorLevel = 2;
+ } else {
+ Tcl_AppendResult(canvasPtr->interp, "bad color mode \"",
+ psInfo.colorMode, "\": must be monochrome, ",
+ "gray, or color", (char *) NULL);
+ goto cleanup;
+ }
+ }
+
+ if (psInfo.fileName != NULL) {
+
+ /*
+ * Check that -file and -channel are not both specified.
+ */
+
+ if (psInfo.channelName != NULL) {
+ Tcl_AppendResult(canvasPtr->interp, "can't specify both -file",
+ " and -channel", (char *) NULL);
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+
+ /*
+ * Check that we are not in a safe interpreter. If we are, disallow
+ * the -file specification.
+ */
+
+ if (Tcl_IsSafe(canvasPtr->interp)) {
+ Tcl_AppendResult(canvasPtr->interp, "can't specify -file in a",
+ " safe interpreter", (char *) NULL);
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+
+ p = Tcl_TranslateFileName(canvasPtr->interp, psInfo.fileName, &buffer);
+ if (p == NULL) {
+ goto cleanup;
+ }
+ psInfo.chan = Tcl_OpenFileChannel(canvasPtr->interp, p, "w", 0666);
+ Tcl_DStringFree(&buffer);
+ if (psInfo.chan == NULL) {
+ goto cleanup;
+ }
+ }
+
+ if (psInfo.channelName != NULL) {
+ int mode;
+
+ /*
+ * Check that the channel is found in this interpreter and that it
+ * is open for writing.
+ */
+
+ psInfo.chan = Tcl_GetChannel(canvasPtr->interp, psInfo.channelName,
+ &mode);
+ if (psInfo.chan == (Tcl_Channel) NULL) {
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+ if ((mode & TCL_WRITABLE) == 0) {
+ Tcl_AppendResult(canvasPtr->interp, "channel \"",
+ psInfo.channelName, "\" wasn't opened for writing",
+ (char *) NULL);
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+ }
+
+ /*
+ *--------------------------------------------------------
+ * Make a pre-pass over all of the items, generating Postscript
+ * and then throwing it away. The purpose of this pass is just
+ * to collect information about all the fonts in use, so that
+ * we can output font information in the proper form required
+ * by the Document Structuring Conventions.
+ *--------------------------------------------------------
+ */
+
+ psInfo.prepass = 1;
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x)
+ || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) {
+ continue;
+ }
+ if (itemPtr->typePtr->postscriptProc == NULL) {
+ continue;
+ }
+ result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp,
+ (Tk_Canvas) canvasPtr, itemPtr, 1);
+ Tcl_ResetResult(canvasPtr->interp);
+ if (result != TCL_OK) {
+ /*
+ * An error just occurred. Just skip out of this loop.
+ * There's no need to report the error now; it can be
+ * reported later (errors can happen later that don't
+ * happen now, so we still have to check for errors later
+ * anyway).
+ */
+ break;
+ }
+ }
+ psInfo.prepass = 0;
+
+ /*
+ *--------------------------------------------------------
+ * Generate the header and prolog for the Postscript.
+ *--------------------------------------------------------
+ */
+
+ Tcl_AppendResult(canvasPtr->interp, "%!PS-Adobe-3.0 EPSF-3.0\n",
+ "%%Creator: Tk Canvas Widget\n", (char *) NULL);
+#if !(defined(__WIN32__) || defined(MAC_TCL))
+ if (!Tcl_IsSafe(interp)) {
+ struct passwd *pwPtr = getpwuid(getuid());
+ Tcl_AppendResult(canvasPtr->interp, "%%For: ",
+ (pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n",
+ (char *) NULL);
+ endpwent();
+ }
+#endif /* __WIN32__ || MAC_TCL */
+ Tcl_AppendResult(canvasPtr->interp, "%%Title: Window ",
+ Tk_PathName(canvasPtr->tkwin), "\n", (char *) NULL);
+ time(&now);
+ Tcl_AppendResult(canvasPtr->interp, "%%CreationDate: ",
+ ctime(&now), (char *) NULL);
+ if (!psInfo.rotate) {
+ sprintf(string, "%d %d %d %d",
+ (int) (psInfo.pageX + psInfo.scale*deltaX),
+ (int) (psInfo.pageY + psInfo.scale*deltaY),
+ (int) (psInfo.pageX + psInfo.scale*(deltaX + psInfo.width)
+ + 1.0),
+ (int) (psInfo.pageY + psInfo.scale*(deltaY + psInfo.height)
+ + 1.0));
+ } else {
+ sprintf(string, "%d %d %d %d",
+ (int) (psInfo.pageX - psInfo.scale*(deltaY + psInfo.height)),
+ (int) (psInfo.pageY + psInfo.scale*deltaX),
+ (int) (psInfo.pageX - psInfo.scale*deltaY + 1.0),
+ (int) (psInfo.pageY + psInfo.scale*(deltaX + psInfo.width)
+ + 1.0));
+ }
+ Tcl_AppendResult(canvasPtr->interp, "%%BoundingBox: ", string,
+ "\n", (char *) NULL);
+ Tcl_AppendResult(canvasPtr->interp, "%%Pages: 1\n",
+ "%%DocumentData: Clean7Bit\n", (char *) NULL);
+ Tcl_AppendResult(canvasPtr->interp, "%%Orientation: ",
+ psInfo.rotate ? "Landscape\n" : "Portrait\n", (char *) NULL);
+ p = "%%DocumentNeededResources: font ";
+ for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendResult(canvasPtr->interp, p,
+ Tcl_GetHashKey(&psInfo.fontTable, hPtr),
+ "\n", (char *) NULL);
+ p = "%%+ font ";
+ }
+ Tcl_AppendResult(canvasPtr->interp, "%%EndComments\n\n", (char *) NULL);
+
+ /*
+ * Read a standard prolog file in a native way and insert it into
+ * the Postscript.
+ */
+
+ if (TkGetNativeProlog(canvasPtr->interp) != TCL_OK) {
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+ if (psInfo.chan != NULL) {
+ Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1);
+ Tcl_ResetResult(canvasPtr->interp);
+ }
+
+ /*
+ *-----------------------------------------------------------
+ * Document setup: set the color level and include fonts.
+ *-----------------------------------------------------------
+ */
+
+ sprintf(string, "/CL %d def\n", psInfo.colorLevel);
+ Tcl_AppendResult(canvasPtr->interp, "%%BeginSetup\n", string,
+ (char *) NULL);
+ for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendResult(canvasPtr->interp, "%%IncludeResource: font ",
+ Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", (char *) NULL);
+ }
+ Tcl_AppendResult(canvasPtr->interp, "%%EndSetup\n\n", (char *) NULL);
+
+ /*
+ *-----------------------------------------------------------
+ * Page setup: move to page positioning point, rotate if
+ * needed, set scale factor, offset for proper anchor position,
+ * and set clip region.
+ *-----------------------------------------------------------
+ */
+
+ Tcl_AppendResult(canvasPtr->interp, "%%Page: 1 1\n", "save\n",
+ (char *) NULL);
+ sprintf(string, "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY);
+ Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
+ if (psInfo.rotate) {
+ Tcl_AppendResult(canvasPtr->interp, "90 rotate\n", (char *) NULL);
+ }
+ sprintf(string, "%.4g %.4g scale\n", psInfo.scale, psInfo.scale);
+ Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
+ sprintf(string, "%d %d translate\n", deltaX - psInfo.x, deltaY);
+ Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
+ sprintf(string, "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g",
+ psInfo.x, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y),
+ psInfo.x2, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y),
+ psInfo.x2, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y2),
+ psInfo.x, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y2));
+ Tcl_AppendResult(canvasPtr->interp, string,
+ " lineto closepath clip newpath\n", (char *) NULL);
+ if (psInfo.chan != NULL) {
+ Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1);
+ Tcl_ResetResult(canvasPtr->interp);
+ }
+
+ /*
+ *---------------------------------------------------------------------
+ * Iterate through all the items, having each relevant one draw itself.
+ * Quit if any of the items returns an error.
+ *---------------------------------------------------------------------
+ */
+
+ result = TCL_OK;
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x)
+ || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) {
+ continue;
+ }
+ if (itemPtr->typePtr->postscriptProc == NULL) {
+ continue;
+ }
+ Tcl_AppendResult(canvasPtr->interp, "gsave\n", (char *) NULL);
+ result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp,
+ (Tk_Canvas) canvasPtr, itemPtr, 0);
+ if (result != TCL_OK) {
+ char msg[100];
+
+ sprintf(msg, "\n (generating Postscript for item %d)",
+ itemPtr->id);
+ Tcl_AddErrorInfo(canvasPtr->interp, msg);
+ goto cleanup;
+ }
+ Tcl_AppendResult(canvasPtr->interp, "grestore\n", (char *) NULL);
+ if (psInfo.chan != NULL) {
+ Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1);
+ Tcl_ResetResult(canvasPtr->interp);
+ }
+ }
+
+ /*
+ *---------------------------------------------------------------------
+ * Output page-end information, such as commands to print the page
+ * and document trailer stuff.
+ *---------------------------------------------------------------------
+ */
+
+ Tcl_AppendResult(canvasPtr->interp, "restore showpage\n\n",
+ "%%Trailer\nend\n%%EOF\n", (char *) NULL);
+ if (psInfo.chan != NULL) {
+ Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1);
+ Tcl_ResetResult(canvasPtr->interp);
+ }
+
+ /*
+ * Clean up psInfo to release malloc'ed stuff.
+ */
+
+ cleanup:
+ if (psInfo.pageXString != NULL) {
+ ckfree(psInfo.pageXString);
+ }
+ if (psInfo.pageYString != NULL) {
+ ckfree(psInfo.pageYString);
+ }
+ if (psInfo.pageWidthString != NULL) {
+ ckfree(psInfo.pageWidthString);
+ }
+ if (psInfo.pageHeightString != NULL) {
+ ckfree(psInfo.pageHeightString);
+ }
+ if (psInfo.fontVar != NULL) {
+ ckfree(psInfo.fontVar);
+ }
+ if (psInfo.colorVar != NULL) {
+ ckfree(psInfo.colorVar);
+ }
+ if (psInfo.colorMode != NULL) {
+ ckfree(psInfo.colorMode);
+ }
+ if (psInfo.fileName != NULL) {
+ ckfree(psInfo.fileName);
+ }
+ if ((psInfo.chan != NULL) && (psInfo.channelName == NULL)) {
+ Tcl_Close(canvasPtr->interp, psInfo.chan);
+ }
+ if (psInfo.channelName != NULL) {
+ ckfree(psInfo.channelName);
+ }
+ Tcl_DeleteHashTable(&psInfo.fontTable);
+ canvasPtr->psInfoPtr = oldInfoPtr;
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsColor --
+ *
+ * This procedure is called by individual canvas items when
+ * they want to set a color value for output. Given information
+ * about an X color, this procedure will generate Postscript
+ * commands to set up an appropriate color in Postscript.
+ *
+ * Results:
+ * Returns a standard Tcl return value. If an error occurs
+ * then an error message will be left in interp->result.
+ * If no error occurs, then additional Postscript will be
+ * appended to interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_CanvasPsColor(interp, canvas, colorPtr)
+ Tcl_Interp *interp; /* Interpreter for returning Postscript
+ * or error message. */
+ Tk_Canvas canvas; /* Information about canvas. */
+ XColor *colorPtr; /* Information about color. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
+ int tmp;
+ double red, green, blue;
+ char string[200];
+
+ if (psInfoPtr->prepass) {
+ return TCL_OK;
+ }
+
+ /*
+ * If there is a color map defined, then look up the color's name
+ * in the map and use the Postscript commands found there, if there
+ * are any.
+ */
+
+ if (psInfoPtr->colorVar != NULL) {
+ char *cmdString;
+
+ cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar,
+ Tk_NameOfColor(colorPtr), 0);
+ if (cmdString != NULL) {
+ Tcl_AppendResult(interp, cmdString, "\n", (char *) NULL);
+ return TCL_OK;
+ }
+ }
+
+ /*
+ * No color map entry for this color. Grab the color's intensities
+ * and output Postscript commands for them. Special note: X uses
+ * a range of 0-65535 for intensities, but most displays only use
+ * a range of 0-255, which maps to (0, 256, 512, ... 65280) in the
+ * X scale. This means that there's no way to get perfect white,
+ * since the highest intensity is only 65280 out of 65535. To
+ * work around this problem, rescale the X intensity to a 0-255
+ * scale and use that as the basis for the Postscript colors. This
+ * scheme still won't work if the display only uses 4 bits per color,
+ * but most diplays use at least 8 bits.
+ */
+
+ tmp = colorPtr->red;
+ red = ((double) (tmp >> 8))/255.0;
+ tmp = colorPtr->green;
+ green = ((double) (tmp >> 8))/255.0;
+ tmp = colorPtr->blue;
+ blue = ((double) (tmp >> 8))/255.0;
+ sprintf(string, "%.3f %.3f %.3f setrgbcolor AdjustColor\n",
+ red, green, blue);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsFont --
+ *
+ * This procedure is called by individual canvas items when
+ * they want to output text. Given information about an X
+ * font, this procedure will generate Postscript commands
+ * to set up an appropriate font in Postscript.
+ *
+ * Results:
+ * Returns a standard Tcl return value. If an error occurs
+ * then an error message will be left in interp->result.
+ * If no error occurs, then additional Postscript will be
+ * appended to the interp->result.
+ *
+ * Side effects:
+ * The Postscript font name is entered into psInfoPtr->fontTable
+ * if it wasn't already there.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_CanvasPsFont(interp, canvas, tkfont)
+ Tcl_Interp *interp; /* Interpreter for returning Postscript
+ * or error message. */
+ Tk_Canvas canvas; /* Information about canvas. */
+ Tk_Font tkfont; /* Information about font in which text
+ * is to be printed. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
+ char *end;
+ char pointString[20];
+ Tcl_DString ds;
+ int i, points;
+
+ /*
+ * First, look up the font's name in the font map, if there is one.
+ * If there is an entry for this font, it consists of a list
+ * containing font name and size. Use this information.
+ */
+
+ Tcl_DStringInit(&ds);
+
+ if (psInfoPtr->fontVar != NULL) {
+ char *list, **argv;
+ int argc;
+ double size;
+ char *name;
+
+ name = Tk_NameOfFont(tkfont);
+ list = Tcl_GetVar2(interp, psInfoPtr->fontVar, name, 0);
+ if (list != NULL) {
+ if (Tcl_SplitList(interp, list, &argc, &argv) != TCL_OK) {
+ badMapEntry:
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad font map entry for \"", name,
+ "\": \"", list, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc != 2) {
+ goto badMapEntry;
+ }
+ size = strtod(argv[1], &end);
+ if ((size <= 0) || (*end != 0)) {
+ goto badMapEntry;
+ }
+
+ Tcl_DStringAppend(&ds, argv[0], -1);
+ points = (int) size;
+
+ ckfree((char *) argv);
+ goto findfont;
+ }
+ }
+
+ points = Tk_PostscriptFontName(tkfont, &ds);
+
+ findfont:
+ sprintf(pointString, "%d", points);
+ Tcl_AppendResult(interp, "/", Tcl_DStringValue(&ds), " findfont ",
+ pointString, " scalefont ", (char *) NULL);
+ if (strncasecmp(Tcl_DStringValue(&ds), "Symbol", 7) != 0) {
+ Tcl_AppendResult(interp, "ISOEncode ", (char *) NULL);
+ }
+ Tcl_AppendResult(interp, "setfont\n", (char *) NULL);
+ Tcl_CreateHashEntry(&psInfoPtr->fontTable, Tcl_DStringValue(&ds), &i);
+ Tcl_DStringFree(&ds);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsBitmap --
+ *
+ * This procedure is called to output the contents of a
+ * sub-region of a bitmap in proper image data format for
+ * Postscript (i.e. data between angle brackets, one bit
+ * per pixel).
+ *
+ * Results:
+ * Returns a standard Tcl return value. If an error occurs
+ * then an error message will be left in interp->result.
+ * If no error occurs, then additional Postscript will be
+ * appended to interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_CanvasPsBitmap(interp, canvas, bitmap, startX, startY, width, height)
+ Tcl_Interp *interp; /* Interpreter for returning Postscript
+ * or error message. */
+ Tk_Canvas canvas; /* Information about canvas. */
+ Pixmap bitmap; /* Bitmap for which to generate
+ * Postscript. */
+ int startX, startY; /* Coordinates of upper-left corner
+ * of rectangular region to output. */
+ int width, height; /* Height of rectangular region. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
+ XImage *imagePtr;
+ int charsInLine, x, y, lastX, lastY, value, mask;
+ unsigned int totalWidth, totalHeight;
+ char string[100];
+ Window dummyRoot;
+ int dummyX, dummyY;
+ unsigned dummyBorderwidth, dummyDepth;
+
+ if (psInfoPtr->prepass) {
+ return TCL_OK;
+ }
+
+ /*
+ * The following call should probably be a call to Tk_SizeOfBitmap
+ * instead, but it seems that we are occasionally invoked by custom
+ * item types that create their own bitmaps without registering them
+ * with Tk. XGetGeometry is a bit slower than Tk_SizeOfBitmap, but
+ * it shouldn't matter here.
+ */
+
+ XGetGeometry(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap, &dummyRoot,
+ (int *) &dummyX, (int *) &dummyY, (unsigned int *) &totalWidth,
+ (unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth);
+ imagePtr = XGetImage(Tk_Display(canvasPtr->tkwin), bitmap, 0, 0,
+ totalWidth, totalHeight, 1, XYPixmap);
+ Tcl_AppendResult(interp, "<", (char *) NULL);
+ mask = 0x80;
+ value = 0;
+ charsInLine = 0;
+ lastX = startX + width - 1;
+ lastY = startY + height - 1;
+ for (y = lastY; y >= startY; y--) {
+ for (x = startX; x <= lastX; x++) {
+ if (XGetPixel(imagePtr, x, y)) {
+ value |= mask;
+ }
+ mask >>= 1;
+ if (mask == 0) {
+ sprintf(string, "%02x", value);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ mask = 0x80;
+ value = 0;
+ charsInLine += 2;
+ if (charsInLine >= 60) {
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ charsInLine = 0;
+ }
+ }
+ }
+ if (mask != 0x80) {
+ sprintf(string, "%02x", value);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ mask = 0x80;
+ value = 0;
+ charsInLine += 2;
+ }
+ }
+ Tcl_AppendResult(interp, ">", (char *) NULL);
+ XDestroyImage(imagePtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsStipple --
+ *
+ * This procedure is called by individual canvas items when
+ * they have created a path that they'd like to be filled with
+ * a stipple pattern. Given information about an X bitmap,
+ * this procedure will generate Postscript commands to fill
+ * the current clip region using a stipple pattern defined by the
+ * bitmap.
+ *
+ * Results:
+ * Returns a standard Tcl return value. If an error occurs
+ * then an error message will be left in interp->result.
+ * If no error occurs, then additional Postscript will be
+ * appended to interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_CanvasPsStipple(interp, canvas, bitmap)
+ Tcl_Interp *interp; /* Interpreter for returning Postscript
+ * or error message. */
+ Tk_Canvas canvas; /* Information about canvas. */
+ Pixmap bitmap; /* Bitmap to use for stippling. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
+ int width, height;
+ char string[100];
+ Window dummyRoot;
+ int dummyX, dummyY;
+ unsigned dummyBorderwidth, dummyDepth;
+
+ if (psInfoPtr->prepass) {
+ return TCL_OK;
+ }
+
+ /*
+ * The following call should probably be a call to Tk_SizeOfBitmap
+ * instead, but it seems that we are occasionally invoked by custom
+ * item types that create their own bitmaps without registering them
+ * with Tk. XGetGeometry is a bit slower than Tk_SizeOfBitmap, but
+ * it shouldn't matter here.
+ */
+
+ XGetGeometry(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap, &dummyRoot,
+ (int *) &dummyX, (int *) &dummyY, (unsigned *) &width,
+ (unsigned *) &height, &dummyBorderwidth, &dummyDepth);
+ sprintf(string, "%d %d ", width, height);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ if (Tk_CanvasPsBitmap(interp, (Tk_Canvas) canvasPtr, bitmap, 0, 0,
+ width, height) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_AppendResult(interp, " StippleFill\n", (char *) NULL);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsY --
+ *
+ * Given a y-coordinate in canvas coordinates, this procedure
+ * returns a y-coordinate to use for Postscript output.
+ *
+ * Results:
+ * Returns the Postscript coordinate that corresponds to
+ * "y".
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+double
+Tk_CanvasPsY(canvas, y)
+ Tk_Canvas canvas; /* Token for canvas on whose behalf
+ * Postscript is being generated. */
+ double y; /* Y-coordinate in canvas coords. */
+{
+ TkPostscriptInfo *psInfoPtr = ((TkCanvas *) canvas)->psInfoPtr;
+
+ return psInfoPtr->y2 - y;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsPath --
+ *
+ * Given an array of points for a path, generate Postscript
+ * commands to create the path.
+ *
+ * Results:
+ * Postscript commands get appended to what's in interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CanvasPsPath(interp, canvas, coordPtr, numPoints)
+ Tcl_Interp *interp; /* Put generated Postscript in this
+ * interpreter's result field. */
+ Tk_Canvas canvas; /* Canvas on whose behalf Postscript
+ * is being generated. */
+ double *coordPtr; /* Pointer to first in array of
+ * 2*numPoints coordinates giving
+ * points for path. */
+ int numPoints; /* Number of points at *coordPtr. */
+{
+ TkPostscriptInfo *psInfoPtr = ((TkCanvas *) canvas)->psInfoPtr;
+ char buffer[200];
+
+ if (psInfoPtr->prepass) {
+ return;
+ }
+ sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0],
+ Tk_CanvasPsY(canvas, coordPtr[1]));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ for (numPoints--, coordPtr += 2; numPoints > 0;
+ numPoints--, coordPtr += 2) {
+ sprintf(buffer, "%.15g %.15g lineto\n", coordPtr[0],
+ Tk_CanvasPsY(canvas, coordPtr[1]));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetPostscriptPoints --
+ *
+ * Given a string, returns the number of Postscript points
+ * corresponding to that string.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If
+ * TCL_OK is returned, then everything went well and the
+ * screen distance is stored at *doublePtr; otherwise
+ * TCL_ERROR is returned and an error message is left in
+ * interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetPostscriptPoints(interp, string, doublePtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ char *string; /* String describing a screen distance. */
+ double *doublePtr; /* Place to store converted result. */
+{
+ char *end;
+ double d;
+
+ d = strtod(string, &end);
+ if (end == string) {
+ error:
+ Tcl_AppendResult(interp, "bad distance \"", string,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ switch (*end) {
+ case 'c':
+ d *= 72.0/2.54;
+ end++;
+ break;
+ case 'i':
+ d *= 72.0;
+ end++;
+ break;
+ case 'm':
+ d *= 72.0/25.4;
+ end++;
+ break;
+ case 0:
+ break;
+ case 'p':
+ end++;
+ break;
+ default:
+ goto error;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ if (*end != 0) {
+ goto error;
+ }
+ *doublePtr = d;
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkGetProlog --
+ *
+ * Locate and load the postscript prolog.
+ *
+ * Results:
+ * A standard Tcl Result. If everything is OK the prolog
+ * will be located in the result string of the interpreter.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkGetProlog(interp)
+ Tcl_Interp *interp; /* Places the prolog in the result. */
+{
+ char *libDir;
+ Tcl_Channel chan;
+ Tcl_DString buffer, buffer2;
+ char *prologPathParts[2];
+ int bufferSize;
+ char *prologBuffer;
+
+ libDir = Tcl_GetVar(interp, "tk_library", TCL_GLOBAL_ONLY);
+ if (libDir == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "couldn't find library directory: ",
+ "tk_library variable doesn't exist", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_TranslateFileName(interp, libDir, &buffer);
+ prologPathParts[0] = buffer.string;
+ prologPathParts[1] = "prolog.ps";
+ Tcl_DStringInit(&buffer2);
+ Tcl_JoinPath(2, prologPathParts, &buffer2);
+ Tcl_DStringFree(&buffer);
+
+ /*
+ * Compute size of file by seeking to the end of the file. This will
+ * overallocate if we are performing CRLF translation.
+ */
+
+ chan = Tcl_OpenFileChannel(NULL, buffer2.string, "r", 0);
+ if (chan == NULL) {
+ /*
+ * We have to set the error message ourselves because the
+ * interp's result need to be reset.
+ */
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "couldn't open \"",
+ buffer2.string, "\": ", Tcl_PosixError(interp), (char *) NULL);
+ Tcl_DStringFree(&buffer2);
+ return TCL_ERROR;
+ }
+
+ bufferSize = Tcl_Seek(chan, 0L, SEEK_END);
+ (void) Tcl_Seek(chan, 0L, SEEK_SET);
+ if (bufferSize < 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "error seeking to end of file \"",
+ buffer2.string, "\": ", Tcl_PosixError(interp), (char *) NULL);
+ Tcl_Close(NULL, chan);
+ Tcl_DStringFree(&buffer2);
+ return TCL_ERROR;
+
+ }
+ prologBuffer = (char *) ckalloc((unsigned) bufferSize+1);
+ bufferSize = Tcl_Read(chan, prologBuffer, bufferSize);
+ Tcl_Close(NULL, chan);
+ if (bufferSize < 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "error reading file \"", buffer2.string,
+ "\": ", Tcl_PosixError(interp), (char *) NULL);
+ Tcl_DStringFree(&buffer2);
+ return TCL_ERROR;
+ }
+ Tcl_DStringFree(&buffer2);
+ prologBuffer[bufferSize] = 0;
+ Tcl_AppendResult(interp, prologBuffer, (char *) NULL);
+ ckfree(prologBuffer);
+
+ return TCL_OK;
+}
diff --git a/generic/tkCanvText.c b/generic/tkCanvText.c
new file mode 100644
index 0000000..2938ba1
--- /dev/null
+++ b/generic/tkCanvText.c
@@ -0,0 +1,1313 @@
+/*
+ * tkCanvText.c --
+ *
+ * This file implements text items for canvas widgets.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkCanvText.c 1.68 97/10/09 17:44:53
+ */
+
+#include <stdio.h>
+#include "tkInt.h"
+#include "tkCanvas.h"
+#include "tkPort.h"
+#include "default.h"
+
+/*
+ * The structure below defines the record for each text item.
+ */
+
+typedef struct TextItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ Tk_CanvasTextInfo *textInfoPtr;
+ /* Pointer to a structure containing
+ * information about the selection and
+ * insertion cursor. The structure is owned
+ * by (and shared with) the generic canvas
+ * code. */
+ /*
+ * Fields that are set by widget commands other than "configure".
+ */
+
+ double x, y; /* Positioning point for text. */
+ int insertPos; /* Insertion cursor is displayed just to left
+ * of character with this index. */
+
+ /*
+ * Configuration settings that are updated by Tk_ConfigureWidget.
+ */
+
+ Tk_Anchor anchor; /* Where to anchor text relative to (x,y). */
+ XColor *color; /* Color for text. */
+ Tk_Font tkfont; /* Font for drawing text. */
+ Tk_Justify justify; /* Justification mode for text. */
+ Pixmap stipple; /* Stipple bitmap for text, or None. */
+ char *text; /* Text for item (malloc-ed). */
+ int width; /* Width of lines for word-wrap, pixels.
+ * Zero means no word-wrap. */
+
+ /*
+ * Fields whose values are derived from the current values of the
+ * configuration settings above.
+ */
+
+ int numChars; /* Number of non-NULL characters in text. */
+ Tk_TextLayout textLayout; /* Cached text layout information. */
+ int leftEdge; /* Pixel location of the left edge of the
+ * text item; where the left border of the
+ * text layout is drawn. */
+ int rightEdge; /* Pixel just to right of right edge of
+ * area of text item. Used for selecting up
+ * to end of line. */
+ GC gc; /* Graphics context for drawing text. */
+ GC selTextGC; /* Graphics context for selected text. */
+ GC cursorOffGC; /* If not None, this gives a graphics context
+ * to use to draw the insertion cursor when
+ * it's off. Used if the selection and
+ * insertion cursor colors are the same. */
+} TextItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", (char *) NULL, (char *) NULL,
+ "center", Tk_Offset(TextItem, anchor),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL,
+ "black", Tk_Offset(TextItem, color), 0},
+ {TK_CONFIG_FONT, "-font", (char *) NULL, (char *) NULL,
+ DEF_CANVTEXT_FONT, Tk_Offset(TextItem, tkfont), 0},
+ {TK_CONFIG_JUSTIFY, "-justify", (char *) NULL, (char *) NULL,
+ "left", Tk_Offset(TextItem, justify),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TextItem, stipple), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_STRING, "-text", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TextItem, text), 0},
+ {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(TextItem, width), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static void ComputeTextBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ TextItem *textPtr));
+static int ConfigureText _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv, int flags));
+static int CreateText _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int argc, char **argv));
+static void DeleteText _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayCanvText _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static int GetSelText _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int offset, char *buffer,
+ int maxBytes));
+static int GetTextIndex _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ char *indexString, int *indexPtr));
+static void ScaleText _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void SetTextCursor _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int index));
+static int TextCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ int argc, char **argv));
+static void TextDeleteChars _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int first, int last));
+static void TextInsert _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int beforeThis, char *string));
+static int TextToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+static double TextToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *pointPtr));
+static int TextToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+static void TranslateText _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+
+/*
+ * The structures below defines the rectangle and oval item types
+ * by means of procedures that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkTextType = {
+ "text", /* name */
+ sizeof(TextItem), /* itemSize */
+ CreateText, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureText, /* configureProc */
+ TextCoords, /* coordProc */
+ DeleteText, /* deleteProc */
+ DisplayCanvText, /* displayProc */
+ 0, /* alwaysRedraw */
+ TextToPoint, /* pointProc */
+ TextToArea, /* areaProc */
+ TextToPostscript, /* postscriptProc */
+ ScaleText, /* scaleProc */
+ TranslateText, /* translateProc */
+ GetTextIndex, /* indexProc */
+ SetTextCursor, /* icursorProc */
+ GetSelText, /* selectionProc */
+ TextInsert, /* insertProc */
+ TextDeleteChars, /* dTextProc */
+ (Tk_ItemType *) NULL /* nextPtr */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateText --
+ *
+ * This procedure is invoked to create a new text item
+ * in a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in
+ * creating the item then an error message is left in
+ * interp->result; in this case itemPtr is left uninitialized
+ * so it can be safely freed by the caller.
+ *
+ * Side effects:
+ * A new text item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateText(interp, canvas, itemPtr, argc, argv)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas to hold new item. */
+ Tk_Item *itemPtr; /* Record to hold new item; header
+ * has been initialized by caller. */
+ int argc; /* Number of arguments in argv. */
+ char **argv; /* Arguments describing rectangle. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
+ itemPtr->typePtr->name, " x y ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Carry out initialization that is needed in order to clean
+ * up after errors during the the remainder of this procedure.
+ */
+
+ textPtr->textInfoPtr = Tk_CanvasGetTextInfo(canvas);
+
+ textPtr->insertPos = 0;
+
+ textPtr->anchor = TK_ANCHOR_CENTER;
+ textPtr->color = NULL;
+ textPtr->tkfont = NULL;
+ textPtr->justify = TK_JUSTIFY_LEFT;
+ textPtr->stipple = None;
+ textPtr->text = NULL;
+ textPtr->width = 0;
+
+ textPtr->numChars = 0;
+ textPtr->textLayout = NULL;
+ textPtr->leftEdge = 0;
+ textPtr->rightEdge = 0;
+ textPtr->gc = None;
+ textPtr->selTextGC = None;
+ textPtr->cursorOffGC = None;
+
+ /*
+ * Process the arguments to fill in the item record.
+ */
+
+ if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &textPtr->x) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[1], &textPtr->y)
+ != TCL_OK)) {
+ return TCL_ERROR;
+ }
+
+ if (ConfigureText(interp, canvas, itemPtr, argc-2, argv+2, 0) != TCL_OK) {
+ DeleteText(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextCoords --
+ *
+ * This procedure is invoked to process the "coords" widget
+ * command on text items. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets interp->result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TextCoords(interp, canvas, itemPtr, argc, argv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item whose coordinates are to be
+ * read or modified. */
+ int argc; /* Number of coordinates supplied in
+ * argv. */
+ char **argv; /* Array of coordinates: x1, y1,
+ * x2, y2, ... */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ char x[TCL_DOUBLE_SPACE], y[TCL_DOUBLE_SPACE];
+
+ if (argc == 0) {
+ Tcl_PrintDouble(interp, textPtr->x, x);
+ Tcl_PrintDouble(interp, textPtr->y, y);
+ Tcl_AppendResult(interp, x, " ", y, (char *) NULL);
+ } else if (argc == 2) {
+ if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &textPtr->x) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[1],
+ &textPtr->y) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComputeTextBbox(canvas, textPtr);
+ } else {
+ sprintf(interp->result,
+ "wrong # coordinates: expected 0 or 2, got %d", argc);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureText --
+ *
+ * This procedure is invoked to configure various aspects
+ * of a text item, such as its border and background colors.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then
+ * an error message is left in interp->result.
+ *
+ * Side effects:
+ * Configuration information, such as colors and stipple
+ * patterns, may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureText(interp, canvas, itemPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Rectangle item to reconfigure. */
+ int argc; /* Number of elements in argv. */
+ char **argv; /* Arguments describing things to configure. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ XGCValues gcValues;
+ GC newGC, newSelGC;
+ unsigned long mask;
+ Tk_Window tkwin;
+ Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
+ XColor *selBgColorPtr;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv,
+ (char *) textPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as
+ * graphics contexts.
+ */
+
+ newGC = newSelGC = None;
+ if ((textPtr->color != NULL) && (textPtr->tkfont != NULL)) {
+ gcValues.foreground = textPtr->color->pixel;
+ gcValues.font = Tk_FontId(textPtr->tkfont);
+ mask = GCForeground|GCFont;
+ if (textPtr->stipple != None) {
+ gcValues.stipple = textPtr->stipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCForeground|GCStipple|GCFillStyle;
+ }
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ gcValues.foreground = textInfoPtr->selFgColorPtr->pixel;
+ newSelGC = Tk_GetGC(tkwin, mask, &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->numChars = strlen(textPtr->text);
+ if (textInfoPtr->selItemPtr == itemPtr) {
+ if (textInfoPtr->selectFirst >= textPtr->numChars) {
+ textInfoPtr->selItemPtr = NULL;
+ } else {
+ if (textInfoPtr->selectLast >= textPtr->numChars) {
+ textInfoPtr->selectLast = textPtr->numChars-1;
+ }
+ if ((textInfoPtr->anchorItemPtr == itemPtr)
+ && (textInfoPtr->selectAnchor >= textPtr->numChars)) {
+ textInfoPtr->selectAnchor = textPtr->numChars-1;
+ }
+ }
+ }
+ if (textPtr->insertPos >= textPtr->numChars) {
+ textPtr->insertPos = textPtr->numChars;
+ }
+
+ ComputeTextBbox(canvas, textPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteText --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a text item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteText(canvas, itemPtr, display)
+ Tk_Canvas canvas; /* Info about overall canvas widget. */
+ Tk_Item *itemPtr; /* Item that is being deleted. */
+ Display *display; /* Display containing window for
+ * canvas. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+
+ if (textPtr->color != NULL) {
+ Tk_FreeColor(textPtr->color);
+ }
+ Tk_FreeFont(textPtr->tkfont);
+ if (textPtr->stipple != None) {
+ Tk_FreeBitmap(display, textPtr->stipple);
+ }
+ if (textPtr->text != NULL) {
+ ckfree(textPtr->text);
+ }
+
+ Tk_FreeTextLayout(textPtr->textLayout);
+ if (textPtr->gc != None) {
+ Tk_FreeGC(display, textPtr->gc);
+ }
+ if (textPtr->selTextGC != None) {
+ Tk_FreeGC(display, textPtr->selTextGC);
+ }
+ if (textPtr->cursorOffGC != None) {
+ Tk_FreeGC(display, textPtr->cursorOffGC);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeTextBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of a text item.
+ * In addition, it recomputes all of the geometry information
+ * used to display a text item or check for mouse hits.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr, and the linePtr structure is regenerated
+ * for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputeTextBbox(canvas, textPtr)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ TextItem *textPtr; /* Item whose bbos is to be
+ * recomputed. */
+{
+ Tk_CanvasTextInfo *textInfoPtr;
+ int leftX, topY, width, height, fudge;
+
+ Tk_FreeTextLayout(textPtr->textLayout);
+ textPtr->textLayout = Tk_ComputeTextLayout(textPtr->tkfont,
+ textPtr->text, textPtr->numChars, textPtr->width,
+ textPtr->justify, 0, &width, &height);
+
+ /*
+ * Use overall geometry information to compute the top-left corner
+ * of the bounding box for the text item.
+ */
+
+ leftX = (int) (textPtr->x + 0.5);
+ topY = (int) (textPtr->y + 0.5);
+ switch (textPtr->anchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_NE:
+ break;
+
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_E:
+ topY -= height / 2;
+ break;
+
+ case TK_ANCHOR_SW:
+ case TK_ANCHOR_S:
+ case TK_ANCHOR_SE:
+ topY -= height;
+ break;
+ }
+ switch (textPtr->anchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_SW:
+ break;
+
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_S:
+ leftX -= width / 2;
+ break;
+
+ case TK_ANCHOR_NE:
+ case TK_ANCHOR_E:
+ case TK_ANCHOR_SE:
+ leftX -= width;
+ break;
+ }
+
+ textPtr->leftEdge = leftX;
+ textPtr->rightEdge = leftX + width;
+
+ /*
+ * Last of all, update the bounding box for the item. The item's
+ * bounding box includes the bounding box of all its lines, plus
+ * an extra fudge factor for the cursor border (which could
+ * potentially be quite large).
+ */
+
+ textInfoPtr = textPtr->textInfoPtr;
+ fudge = (textInfoPtr->insertWidth + 1) / 2;
+ if (textInfoPtr->selBorderWidth > fudge) {
+ fudge = textInfoPtr->selBorderWidth;
+ }
+ textPtr->header.x1 = leftX - fudge;
+ textPtr->header.y1 = topY;
+ textPtr->header.x2 = leftX + width + fudge;
+ textPtr->header.y2 = topY + height;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayCanvText --
+ *
+ * This procedure is invoked to draw a text item in a given
+ * drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * information in canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayCanvText(canvas, itemPtr, display, drawable, x, y, width, height)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ Tk_Item *itemPtr; /* Item to be displayed. */
+ Display *display; /* Display on which to draw item. */
+ Drawable drawable; /* Pixmap or window in which to draw
+ * item. */
+ int x, y, width, height; /* Describes region of canvas that
+ * must be redisplayed (not used). */
+{
+ TextItem *textPtr;
+ Tk_CanvasTextInfo *textInfoPtr;
+ int selFirst, selLast;
+ short drawableX, drawableY;
+
+ textPtr = (TextItem *) itemPtr;
+ textInfoPtr = textPtr->textInfoPtr;
+
+ if (textPtr->gc == None) {
+ return;
+ }
+
+ /*
+ * If we're stippling, then modify the stipple offset in the GC. Be
+ * sure to reset the offset when done, since the GC is supposed to be
+ * read-only.
+ */
+
+ if (textPtr->stipple != None) {
+ Tk_CanvasSetStippleOrigin(canvas, textPtr->gc);
+ }
+
+ selFirst = -1;
+ selLast = 0; /* lint. */
+ if (textInfoPtr->selItemPtr == itemPtr) {
+ selFirst = textInfoPtr->selectFirst;
+ selLast = textInfoPtr->selectLast;
+ if (selLast >= textPtr->numChars) {
+ selLast = textPtr->numChars - 1;
+ }
+ if ((selFirst >= 0) && (selFirst <= selLast)) {
+ /*
+ * Draw a special background under the selection.
+ */
+
+ int xFirst, yFirst, hFirst;
+ int xLast, yLast, wLast;
+
+ Tk_CharBbox(textPtr->textLayout, selFirst,
+ &xFirst, &yFirst, NULL, &hFirst);
+ Tk_CharBbox(textPtr->textLayout, selLast,
+ &xLast, &yLast, &wLast, NULL);
+
+ /*
+ * If the selection spans the end of this line, then display
+ * selection background all the way to the end of the line.
+ * However, for the last line we only want to display up to the
+ * last character, not the end of the line.
+ */
+
+ x = xFirst;
+ height = hFirst;
+ for (y = yFirst ; y <= yLast; y += height) {
+ if (y == yLast) {
+ width = (xLast + wLast) - x;
+ } else {
+ width = textPtr->rightEdge - textPtr->leftEdge - x;
+ }
+ Tk_CanvasDrawableCoords(canvas,
+ (double) (textPtr->leftEdge + x
+ - textInfoPtr->selBorderWidth),
+ (double) (textPtr->header.y1 + y),
+ &drawableX, &drawableY);
+ Tk_Fill3DRectangle(Tk_CanvasTkwin(canvas), drawable,
+ textInfoPtr->selBorder, drawableX, drawableY,
+ width + 2 * textInfoPtr->selBorderWidth,
+ height, textInfoPtr->selBorderWidth, TK_RELIEF_RAISED);
+ x = 0;
+ }
+ }
+ }
+
+ /*
+ * If the insertion point should be displayed, then draw a special
+ * background for the cursor before drawing the text. Note: if
+ * we're the cursor item but the cursor is turned off, then redraw
+ * background over the area of the cursor. This guarantees that
+ * the selection won't make the cursor invisible on mono displays,
+ * where both are drawn in the same color.
+ */
+
+ if ((textInfoPtr->focusItemPtr == itemPtr) && (textInfoPtr->gotFocus)) {
+ if (Tk_CharBbox(textPtr->textLayout, textPtr->insertPos,
+ &x, &y, NULL, &height)) {
+ Tk_CanvasDrawableCoords(canvas,
+ (double) (textPtr->leftEdge + x
+ - (textInfoPtr->insertWidth / 2)),
+ (double) (textPtr->header.y1 + y),
+ &drawableX, &drawableY);
+ if (textInfoPtr->cursorOn) {
+ Tk_Fill3DRectangle(Tk_CanvasTkwin(canvas), drawable,
+ textInfoPtr->insertBorder,
+ drawableX, drawableY,
+ textInfoPtr->insertWidth, height,
+ textInfoPtr->insertBorderWidth, TK_RELIEF_RAISED);
+ } else if (textPtr->cursorOffGC != None) {
+ /*
+ * Redraw the background over the area of the cursor,
+ * even though the cursor is turned off. This
+ * guarantees that the selection won't make the cursor
+ * invisible on mono displays, where both may be drawn
+ * in the same color.
+ */
+
+ XFillRectangle(display, drawable, textPtr->cursorOffGC,
+ drawableX, drawableY,
+ (unsigned) textInfoPtr->insertWidth,
+ (unsigned) height);
+ }
+ }
+ }
+
+
+ /*
+ * Display the text in two pieces: draw the entire text item, then
+ * draw the selected text on top of it. The selected text then
+ * will only need to be drawn if it has different attributes (such
+ * as foreground color) than regular text.
+ */
+
+ Tk_CanvasDrawableCoords(canvas, (double) textPtr->leftEdge,
+ (double) textPtr->header.y1, &drawableX, &drawableY);
+ Tk_DrawTextLayout(display, drawable, textPtr->gc, textPtr->textLayout,
+ drawableX, drawableY, 0, -1);
+
+ if ((selFirst >= 0) && (textPtr->selTextGC != textPtr->gc)) {
+ Tk_DrawTextLayout(display, drawable, textPtr->selTextGC,
+ textPtr->textLayout, drawableX, drawableY, selFirst,
+ selLast + 1);
+ }
+
+ if (textPtr->stipple != None) {
+ XSetTSOrigin(display, textPtr->gc, 0, 0);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextInsert --
+ *
+ * Insert characters into a text item at a given position.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The text in the given item is modified. The cursor and
+ * selection positions are also modified to reflect the
+ * insertion.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TextInsert(canvas, itemPtr, beforeThis, string)
+ Tk_Canvas canvas; /* Canvas containing text item. */
+ Tk_Item *itemPtr; /* Text item to be modified. */
+ int beforeThis; /* Index of character before which text is
+ * to be inserted. */
+ char *string; /* New characters to be inserted. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ int length;
+ char *new;
+ Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
+
+ length = strlen(string);
+ if (length == 0) {
+ return;
+ }
+ if (beforeThis < 0) {
+ beforeThis = 0;
+ }
+ if (beforeThis > textPtr->numChars) {
+ beforeThis = textPtr->numChars;
+ }
+
+ new = (char *) ckalloc((unsigned) (textPtr->numChars + length + 1));
+ strncpy(new, textPtr->text, (size_t) beforeThis);
+ strcpy(new+beforeThis, string);
+ strcpy(new+beforeThis+length, textPtr->text+beforeThis);
+ ckfree(textPtr->text);
+ textPtr->text = new;
+ textPtr->numChars += length;
+
+ /*
+ * Inserting characters invalidates indices such as those for the
+ * selection and cursor. Update the indices appropriately.
+ */
+
+ if (textInfoPtr->selItemPtr == itemPtr) {
+ if (textInfoPtr->selectFirst >= beforeThis) {
+ textInfoPtr->selectFirst += length;
+ }
+ if (textInfoPtr->selectLast >= beforeThis) {
+ textInfoPtr->selectLast += length;
+ }
+ if ((textInfoPtr->anchorItemPtr == itemPtr)
+ && (textInfoPtr->selectAnchor >= beforeThis)) {
+ textInfoPtr->selectAnchor += length;
+ }
+ }
+ if (textPtr->insertPos >= beforeThis) {
+ textPtr->insertPos += length;
+ }
+ ComputeTextBbox(canvas, textPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextDeleteChars --
+ *
+ * Delete one or more characters from a text item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Characters between "first" and "last", inclusive, get
+ * deleted from itemPtr, and things like the selection
+ * position get updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TextDeleteChars(canvas, itemPtr, first, last)
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Item in which to delete characters. */
+ int first; /* Index of first character to delete. */
+ int last; /* Index of last character to delete. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ int count;
+ char *new;
+ Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
+
+ if (first < 0) {
+ first = 0;
+ }
+ if (last >= textPtr->numChars) {
+ last = textPtr->numChars-1;
+ }
+ if (first > last) {
+ return;
+ }
+ count = last + 1 - first;
+
+ new = (char *) ckalloc((unsigned) (textPtr->numChars + 1 - count));
+ strncpy(new, textPtr->text, (size_t) first);
+ strcpy(new+first, textPtr->text+last+1);
+ ckfree(textPtr->text);
+ textPtr->text = new;
+ textPtr->numChars -= count;
+
+ /*
+ * Update indexes for the selection and cursor to reflect the
+ * renumbering of the remaining characters.
+ */
+
+ if (textInfoPtr->selItemPtr == itemPtr) {
+ if (textInfoPtr->selectFirst > first) {
+ textInfoPtr->selectFirst -= count;
+ if (textInfoPtr->selectFirst < first) {
+ textInfoPtr->selectFirst = first;
+ }
+ }
+ if (textInfoPtr->selectLast >= first) {
+ textInfoPtr->selectLast -= count;
+ if (textInfoPtr->selectLast < (first-1)) {
+ textInfoPtr->selectLast = (first-1);
+ }
+ }
+ if (textInfoPtr->selectFirst > textInfoPtr->selectLast) {
+ textInfoPtr->selItemPtr = NULL;
+ }
+ if ((textInfoPtr->anchorItemPtr == itemPtr)
+ && (textInfoPtr->selectAnchor > first)) {
+ textInfoPtr->selectAnchor -= count;
+ if (textInfoPtr->selectAnchor < first) {
+ textInfoPtr->selectAnchor = first;
+ }
+ }
+ }
+ if (textPtr->insertPos > first) {
+ textPtr->insertPos -= count;
+ if (textPtr->insertPos < first) {
+ textPtr->insertPos = first;
+ }
+ }
+ ComputeTextBbox(canvas, textPtr);
+ return;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * text item, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are pointPtr[0] and pointPtr[1] is inside the text item. If
+ * the point isn't inside the text item then the return value
+ * is the distance from the point to the text item.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static double
+TextToPoint(canvas, itemPtr, pointPtr)
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *pointPtr; /* Pointer to x and y coordinates. */
+{
+ TextItem *textPtr;
+
+ textPtr = (TextItem *) itemPtr;
+ return (double) Tk_DistanceToTextLayout(textPtr->textLayout,
+ (int) pointPtr[0] - textPtr->leftEdge,
+ (int) pointPtr[1] - textPtr->header.y1);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given rectangle.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area
+ * given by rectPtr, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TextToArea(canvas, itemPtr, rectPtr)
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Item to check against rectangle. */
+ double *rectPtr; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) describing rectangular
+ * area. */
+{
+ TextItem *textPtr;
+
+ textPtr = (TextItem *) itemPtr;
+ return Tk_IntersectTextLayout(textPtr->textLayout,
+ (int) (rectPtr[0] + 0.5) - textPtr->leftEdge,
+ (int) (rectPtr[1] + 0.5) - textPtr->header.y1,
+ (int) (rectPtr[2] - rectPtr[0] + 0.5),
+ (int) (rectPtr[3] - rectPtr[1] + 0.5));
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleText --
+ *
+ * This procedure is invoked to rescale a text item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Scales the position of the text, but not the size
+ * of the font for the text.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ScaleText(canvas, itemPtr, originX, originY, scaleX, scaleY)
+ Tk_Canvas canvas; /* Canvas containing rectangle. */
+ Tk_Item *itemPtr; /* Rectangle to be scaled. */
+ double originX, originY; /* Origin about which to scale rect. */
+ double scaleX; /* Amount to scale in X direction. */
+ double scaleY; /* Amount to scale in Y direction. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+
+ textPtr->x = originX + scaleX*(textPtr->x - originX);
+ textPtr->y = originY + scaleY*(textPtr->y - originY);
+ ComputeTextBbox(canvas, textPtr);
+ return;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateText --
+ *
+ * This procedure is called to move a text item by a
+ * given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the text item is offset by (xDelta, yDelta),
+ * and the bounding box is updated in the generic part of the
+ * item structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateText(canvas, itemPtr, deltaX, deltaY)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item that is being moved. */
+ double deltaX, deltaY; /* Amount by which item is to be
+ * moved. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+
+ textPtr->x += deltaX;
+ textPtr->y += deltaY;
+ ComputeTextBbox(canvas, textPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetTextIndex --
+ *
+ * Parse an index into a text item and return either its value
+ * or an error.
+ *
+ * Results:
+ * A standard Tcl result. If all went well, then *indexPtr is
+ * filled in with the index (into itemPtr) corresponding to
+ * string. Otherwise an error message is left in
+ * interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetTextIndex(interp, canvas, itemPtr, string, indexPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item for which the index is being
+ * specified. */
+ char *string; /* Specification of a particular character
+ * in itemPtr's text. */
+ int *indexPtr; /* Where to store converted index. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ size_t length;
+ int c;
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
+
+ c = string[0];
+ length = strlen(string);
+
+ if ((c == 'e') && (strncmp(string, "end", length) == 0)) {
+ *indexPtr = textPtr->numChars;
+ } else if ((c == 'i') && (strncmp(string, "insert", length) == 0)) {
+ *indexPtr = textPtr->insertPos;
+ } else if ((c == 's') && (strncmp(string, "sel.first", length) == 0)
+ && (length >= 5)) {
+ if (textInfoPtr->selItemPtr != itemPtr) {
+ interp->result = "selection isn't in item";
+ return TCL_ERROR;
+ }
+ *indexPtr = textInfoPtr->selectFirst;
+ } else if ((c == 's') && (strncmp(string, "sel.last", length) == 0)
+ && (length >= 5)) {
+ if (textInfoPtr->selItemPtr != itemPtr) {
+ interp->result = "selection isn't in item";
+ return TCL_ERROR;
+ }
+ *indexPtr = textInfoPtr->selectLast;
+ } else if (c == '@') {
+ int x, y;
+ double tmp;
+ char *end, *p;
+
+ p = string+1;
+ tmp = strtod(p, &end);
+ if ((end == p) || (*end != ',')) {
+ goto badIndex;
+ }
+ x = (int) ((tmp < 0) ? tmp - 0.5 : tmp + 0.5);
+ p = end+1;
+ tmp = strtod(p, &end);
+ if ((end == p) || (*end != 0)) {
+ goto badIndex;
+ }
+ y = (int) ((tmp < 0) ? tmp - 0.5 : tmp + 0.5);
+ *indexPtr = Tk_PointToChar(textPtr->textLayout,
+ x + canvasPtr->scrollX1 - textPtr->leftEdge,
+ y + canvasPtr->scrollY1 - textPtr->header.y1);
+ } else if (Tcl_GetInt(interp, string, indexPtr) == TCL_OK) {
+ if (*indexPtr < 0){
+ *indexPtr = 0;
+ } else if (*indexPtr > textPtr->numChars) {
+ *indexPtr = textPtr->numChars;
+ }
+ } else {
+ /*
+ * Some of the paths here leave messages in interp->result,
+ * so we have to clear it out before storing our own message.
+ */
+
+ badIndex:
+ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
+ Tcl_AppendResult(interp, "bad index \"", string, "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SetTextCursor --
+ *
+ * Set the position of the insertion cursor in this item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor position will change.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+SetTextCursor(canvas, itemPtr, index)
+ Tk_Canvas canvas; /* Record describing canvas widget. */
+ Tk_Item *itemPtr; /* Text item in which cursor position
+ * is to be set. */
+ int index; /* Index of character just before which
+ * cursor is to be positioned. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+
+ if (index < 0) {
+ textPtr->insertPos = 0;
+ } else if (index > textPtr->numChars) {
+ textPtr->insertPos = textPtr->numChars;
+ } else {
+ textPtr->insertPos = index;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetSelText --
+ *
+ * This procedure is invoked to return the selected portion
+ * of a text item. It is only called when this item has
+ * the selection.
+ *
+ * Results:
+ * The return value is the number of non-NULL bytes stored
+ * at buffer. Buffer is filled (or partially filled) with a
+ * NULL-terminated string containing part or all of the selection,
+ * as given by offset and maxBytes.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetSelText(canvas, itemPtr, offset, buffer, maxBytes)
+ Tk_Canvas canvas; /* Canvas containing selection. */
+ Tk_Item *itemPtr; /* Text item containing selection. */
+ int offset; /* Offset within selection of first
+ * character to be returned. */
+ char *buffer; /* Location in which to place
+ * selection. */
+ int maxBytes; /* Maximum number of bytes to place
+ * at buffer, not including terminating
+ * NULL character. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ int count;
+ Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
+
+ count = textInfoPtr->selectLast + 1 - textInfoPtr->selectFirst - offset;
+ if (textInfoPtr->selectLast == textPtr->numChars) {
+ count -= 1;
+ }
+ if (count > maxBytes) {
+ count = maxBytes;
+ }
+ if (count <= 0) {
+ return 0;
+ }
+ strncpy(buffer, textPtr->text + textInfoPtr->selectFirst + offset,
+ (size_t) count);
+ buffer[count] = '\0';
+ return count;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextToPostscript --
+ *
+ * This procedure is called to generate Postscript for
+ * text items.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error
+ * occurs in generating Postscript then an error message is
+ * left in interp->result, replacing whatever used
+ * to be there. If no error occurs, then Postscript for the
+ * item is appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TextToPostscript(interp, canvas, itemPtr, prepass)
+ Tcl_Interp *interp; /* Leave Postscript or error message
+ * here. */
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ Tk_Item *itemPtr; /* Item for which Postscript is
+ * wanted. */
+ int prepass; /* 1 means this is a prepass to
+ * collect font information; 0 means
+ * final Postscript is being created. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ int x, y;
+ Tk_FontMetrics fm;
+ char *justify;
+ char buffer[500];
+
+ if (textPtr->color == NULL) {
+ return TCL_OK;
+ }
+
+ if (Tk_CanvasPsFont(interp, canvas, textPtr->tkfont) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (prepass != 0) {
+ return TCL_OK;
+ }
+ if (Tk_CanvasPsColor(interp, canvas, textPtr->color) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (textPtr->stipple != None) {
+ Tcl_AppendResult(interp, "/StippleText {\n ",
+ (char *) NULL);
+ Tk_CanvasPsStipple(interp, canvas, textPtr->stipple);
+ Tcl_AppendResult(interp, "} bind def\n", (char *) NULL);
+ }
+
+ sprintf(buffer, "%.15g %.15g [\n", textPtr->x,
+ Tk_CanvasPsY(canvas, textPtr->y));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+
+ Tk_TextLayoutToPostscript(interp, textPtr->textLayout);
+
+ x = 0; y = 0; justify = NULL; /* lint. */
+ switch (textPtr->anchor) {
+ case TK_ANCHOR_NW: x = 0; y = 0; break;
+ case TK_ANCHOR_N: x = 1; y = 0; break;
+ case TK_ANCHOR_NE: x = 2; y = 0; break;
+ case TK_ANCHOR_E: x = 2; y = 1; break;
+ case TK_ANCHOR_SE: x = 2; y = 2; break;
+ case TK_ANCHOR_S: x = 1; y = 2; break;
+ case TK_ANCHOR_SW: x = 0; y = 2; break;
+ case TK_ANCHOR_W: x = 0; y = 1; break;
+ case TK_ANCHOR_CENTER: x = 1; y = 1; break;
+ }
+ switch (textPtr->justify) {
+ case TK_JUSTIFY_LEFT: justify = "0"; break;
+ case TK_JUSTIFY_CENTER: justify = "0.5";break;
+ case TK_JUSTIFY_RIGHT: justify = "1"; break;
+ }
+
+ Tk_GetFontMetrics(textPtr->tkfont, &fm);
+ sprintf(buffer, "] %d %g %g %s %s DrawText\n",
+ fm.linespace, x / -2.0, y / 2.0, justify,
+ ((textPtr->stipple == None) ? "false" : "true"));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+
+ return TCL_OK;
+}
diff --git a/generic/tkCanvUtil.c b/generic/tkCanvUtil.c
new file mode 100644
index 0000000..9b52a80
--- /dev/null
+++ b/generic/tkCanvUtil.c
@@ -0,0 +1,376 @@
+/*
+ * tkCanvUtil.c --
+ *
+ * This procedure contains a collection of utility procedures
+ * used by the implementations of various canvas item types.
+ *
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkCanvUtil.c 1.7 96/05/03 10:54:22
+ */
+
+#include "tk.h"
+#include "tkCanvas.h"
+#include "tkPort.h"
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CanvasTkwin --
+ *
+ * Given a token for a canvas, this procedure returns the
+ * widget that represents the canvas.
+ *
+ * Results:
+ * The return value is a handle for the widget.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_CanvasTkwin(canvas)
+ Tk_Canvas canvas; /* Token for the canvas. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ return canvasPtr->tkwin;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CanvasDrawableCoords --
+ *
+ * Given an (x,y) coordinate pair within a canvas, this procedure
+ * returns the corresponding coordinates at which the point should
+ * be drawn in the drawable used for display.
+ *
+ * Results:
+ * There is no return value. The values at *drawableXPtr and
+ * *drawableYPtr are filled in with the coordinates at which
+ * x and y should be drawn. These coordinates are clipped
+ * to fit within a "short", since this is what X uses in
+ * most cases for drawing.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CanvasDrawableCoords(canvas, x, y, drawableXPtr, drawableYPtr)
+ Tk_Canvas canvas; /* Token for the canvas. */
+ double x, y; /* Coordinates in canvas space. */
+ short *drawableXPtr, *drawableYPtr; /* Screen coordinates are stored
+ * here. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ double tmp;
+
+ tmp = x - canvasPtr->drawableXOrigin;
+ if (tmp > 0) {
+ tmp += 0.5;
+ } else {
+ tmp -= 0.5;
+ }
+ if (tmp > 32767) {
+ *drawableXPtr = 32767;
+ } else if (tmp < -32768) {
+ *drawableXPtr = -32768;
+ } else {
+ *drawableXPtr = (short) tmp;
+ }
+
+ tmp = y - canvasPtr->drawableYOrigin;
+ if (tmp > 0) {
+ tmp += 0.5;
+ } else {
+ tmp -= 0.5;
+ }
+ if (tmp > 32767) {
+ *drawableYPtr = 32767;
+ } else if (tmp < -32768) {
+ *drawableYPtr = -32768;
+ } else {
+ *drawableYPtr = (short) tmp;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CanvasWindowCoords --
+ *
+ * Given an (x,y) coordinate pair within a canvas, this procedure
+ * returns the corresponding coordinates in the canvas's window.
+ *
+ * Results:
+ * There is no return value. The values at *screenXPtr and
+ * *screenYPtr are filled in with the coordinates at which
+ * (x,y) appears in the canvas's window. These coordinates
+ * are clipped to fit within a "short", since this is what X
+ * uses in most cases for drawing.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CanvasWindowCoords(canvas, x, y, screenXPtr, screenYPtr)
+ Tk_Canvas canvas; /* Token for the canvas. */
+ double x, y; /* Coordinates in canvas space. */
+ short *screenXPtr, *screenYPtr; /* Screen coordinates are stored
+ * here. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ double tmp;
+
+ tmp = x - canvasPtr->xOrigin;
+ if (tmp > 0) {
+ tmp += 0.5;
+ } else {
+ tmp -= 0.5;
+ }
+ if (tmp > 32767) {
+ *screenXPtr = 32767;
+ } else if (tmp < -32768) {
+ *screenXPtr = -32768;
+ } else {
+ *screenXPtr = (short) tmp;
+ }
+
+ tmp = y - canvasPtr->yOrigin;
+ if (tmp > 0) {
+ tmp += 0.5;
+ } else {
+ tmp -= 0.5;
+ }
+ if (tmp > 32767) {
+ *screenYPtr = 32767;
+ } else if (tmp < -32768) {
+ *screenYPtr = -32768;
+ } else {
+ *screenYPtr = (short) tmp;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasGetCoord --
+ *
+ * Given a string, returns a floating-point canvas coordinate
+ * corresponding to that string.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If
+ * TCL_OK is returned, then everything went well and the
+ * canvas coordinate is stored at *doublePtr; otherwise
+ * TCL_ERROR is returned and an error message is left in
+ * interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_CanvasGetCoord(interp, canvas, string, doublePtr)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas to which coordinate applies. */
+ char *string; /* Describes coordinate (any screen
+ * coordinate form may be used here). */
+ double *doublePtr; /* Place to store converted coordinate. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ if (Tk_GetScreenMM(canvasPtr->interp, canvasPtr->tkwin, string,
+ doublePtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ *doublePtr *= canvasPtr->pixelsPerMM;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CanvasSetStippleOrigin --
+ *
+ * This procedure sets the stipple origin in a graphics context
+ * so that stipples drawn with the GC will line up with other
+ * stipples previously drawn in the canvas.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The graphics context is modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CanvasSetStippleOrigin(canvas, gc)
+ Tk_Canvas canvas; /* Token for a canvas. */
+ GC gc; /* Graphics context that is about to be
+ * used to draw a stippled pattern as
+ * part of redisplaying the canvas. */
+
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+
+ XSetTSOrigin(canvasPtr->display, gc, -canvasPtr->drawableXOrigin,
+ -canvasPtr->drawableYOrigin);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CanvasGetTextInfo --
+ *
+ * This procedure returns a pointer to a structure containing
+ * information about the selection and insertion cursor for
+ * a canvas widget. Items such as text items save the pointer
+ * and use it to share access to the information with the generic
+ * canvas code.
+ *
+ * Results:
+ * The return value is a pointer to the structure holding text
+ * information for the canvas. Most of the fields should not
+ * be modified outside the generic canvas code; see the user
+ * documentation for details.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_CanvasTextInfo *
+Tk_CanvasGetTextInfo(canvas)
+ Tk_Canvas canvas; /* Token for the canvas widget. */
+{
+ return &((TkCanvas *) canvas)->textInfo;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasTagsParseProc --
+ *
+ * This procedure is invoked during option processing to handle
+ * "-tags" options for canvas items.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * The tags for a given item get replaced by those indicated
+ * in the value argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_CanvasTagsParseProc(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* Not used.*/
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ char *value; /* Value of option (list of tag
+ * names). */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item (ignored). */
+{
+ register Tk_Item *itemPtr = (Tk_Item *) widgRec;
+ int argc, i;
+ char **argv;
+ Tk_Uid *newPtr;
+
+ /*
+ * Break the value up into the individual tag names.
+ */
+
+ if (Tcl_SplitList(interp, value, &argc, &argv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure that there's enough space in the item to hold the
+ * tag names.
+ */
+
+ if (itemPtr->tagSpace < argc) {
+ newPtr = (Tk_Uid *) ckalloc((unsigned) (argc * sizeof(Tk_Uid)));
+ for (i = itemPtr->numTags-1; i >= 0; i--) {
+ newPtr[i] = itemPtr->tagPtr[i];
+ }
+ if (itemPtr->tagPtr != itemPtr->staticTagSpace) {
+ ckfree((char *) itemPtr->tagPtr);
+ }
+ itemPtr->tagPtr = newPtr;
+ itemPtr->tagSpace = argc;
+ }
+ itemPtr->numTags = argc;
+ for (i = 0; i < argc; i++) {
+ itemPtr->tagPtr[i] = Tk_GetUid(argv[i]);
+ }
+ ckfree((char *) argv);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasTagsPrintProc --
+ *
+ * This procedure is invoked by the Tk configuration code
+ * to produce a printable string for the "-tags" configuration
+ * option for canvas items.
+ *
+ * Results:
+ * The return value is a string describing all the tags for
+ * the item referred to by "widgRec". In addition, *freeProcPtr
+ * is filled in with the address of a procedure to call to free
+ * the result string when it's no longer needed (or NULL to
+ * indicate that the string doesn't need to be freed).
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_CanvasTagsPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
+ ClientData clientData; /* Ignored. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Ignored. */
+ Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with
+ * information about how to reclaim
+ * storage for return string. */
+{
+ register Tk_Item *itemPtr = (Tk_Item *) widgRec;
+
+ if (itemPtr->numTags == 0) {
+ *freeProcPtr = (Tcl_FreeProc *) NULL;
+ return "";
+ }
+ if (itemPtr->numTags == 1) {
+ *freeProcPtr = (Tcl_FreeProc *) NULL;
+ return (char *) itemPtr->tagPtr[0];
+ }
+ *freeProcPtr = TCL_DYNAMIC;
+ return Tcl_Merge(itemPtr->numTags, (char **) itemPtr->tagPtr);
+}
diff --git a/generic/tkCanvWind.c b/generic/tkCanvWind.c
new file mode 100644
index 0000000..61b21da
--- /dev/null
+++ b/generic/tkCanvWind.c
@@ -0,0 +1,862 @@
+/*
+ * tkCanvWind.c --
+ *
+ * This file implements window items for canvas widgets.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkCanvWind.c 1.29 97/10/14 10:40:54
+ */
+
+#include <stdio.h>
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkCanvas.h"
+
+/*
+ * The structure below defines the record for each window item.
+ */
+
+typedef struct WindowItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ double x, y; /* Coordinates of positioning point for
+ * window. */
+ Tk_Window tkwin; /* Window associated with item. NULL means
+ * window has been destroyed. */
+ int width; /* Width to use for window (<= 0 means use
+ * window's requested width). */
+ int height; /* Width to use for window (<= 0 means use
+ * window's requested width). */
+ Tk_Anchor anchor; /* Where to anchor window relative to
+ * (x,y). */
+ Tk_Canvas canvas; /* Canvas containing this item. */
+} WindowItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", (char *) NULL, (char *) NULL,
+ "center", Tk_Offset(WindowItem, anchor), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_PIXELS, "-height", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(WindowItem, height), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(WindowItem, width), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_WINDOW, "-window", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(WindowItem, tkwin), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static void ComputeWindowBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ WindowItem *winItemPtr));
+static int ConfigureWinItem _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv, int flags));
+static int CreateWinItem _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int argc, char **argv));
+static void DeleteWinItem _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayWinItem _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static void ScaleWinItem _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void TranslateWinItem _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+static int WinItemCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv));
+static void WinItemLostSlaveProc _ANSI_ARGS_((
+ ClientData clientData, Tk_Window tkwin));
+static void WinItemRequestProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+static void WinItemStructureProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+static int WinItemToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+static double WinItemToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *pointPtr));
+
+/*
+ * The structure below defines the window item type by means of procedures
+ * that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkWindowType = {
+ "window", /* name */
+ sizeof(WindowItem), /* itemSize */
+ CreateWinItem, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureWinItem, /* configureProc */
+ WinItemCoords, /* coordProc */
+ DeleteWinItem, /* deleteProc */
+ DisplayWinItem, /* displayProc */
+ 1, /* alwaysRedraw */
+ WinItemToPoint, /* pointProc */
+ WinItemToArea, /* areaProc */
+ (Tk_ItemPostscriptProc *) NULL, /* postscriptProc */
+ ScaleWinItem, /* scaleProc */
+ TranslateWinItem, /* translateProc */
+ (Tk_ItemIndexProc *) NULL, /* indexProc */
+ (Tk_ItemCursorProc *) NULL, /* cursorProc */
+ (Tk_ItemSelectionProc *) NULL, /* selectionProc */
+ (Tk_ItemInsertProc *) NULL, /* insertProc */
+ (Tk_ItemDCharsProc *) NULL, /* dTextProc */
+ (Tk_ItemType *) NULL /* nextPtr */
+};
+
+
+/*
+ * The structure below defines the official type record for the
+ * placer:
+ */
+
+static Tk_GeomMgr canvasGeomType = {
+ "canvas", /* name */
+ WinItemRequestProc, /* requestProc */
+ WinItemLostSlaveProc, /* lostSlaveProc */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateWinItem --
+ *
+ * This procedure is invoked to create a new window
+ * item in a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in
+ * creating the item, then an error message is left in
+ * interp->result; in this case itemPtr is
+ * left uninitialized, so it can be safely freed by the
+ * caller.
+ *
+ * Side effects:
+ * A new window item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateWinItem(interp, canvas, itemPtr, argc, argv)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas to hold new item. */
+ Tk_Item *itemPtr; /* Record to hold new item; header
+ * has been initialized by caller. */
+ int argc; /* Number of arguments in argv. */
+ char **argv; /* Arguments describing rectangle. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
+ itemPtr->typePtr->name, " x y ?options?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Initialize item's record.
+ */
+
+ winItemPtr->tkwin = NULL;
+ winItemPtr->width = 0;
+ winItemPtr->height = 0;
+ winItemPtr->anchor = TK_ANCHOR_CENTER;
+ winItemPtr->canvas = canvas;
+
+ /*
+ * Process the arguments to fill in the item record.
+ */
+
+ if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &winItemPtr->x) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[1],
+ &winItemPtr->y) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+
+ if (ConfigureWinItem(interp, canvas, itemPtr, argc-2, argv+2, 0)
+ != TCL_OK) {
+ DeleteWinItem(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemCoords --
+ *
+ * This procedure is invoked to process the "coords" widget
+ * command on window items. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets interp->result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+WinItemCoords(interp, canvas, itemPtr, argc, argv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item whose coordinates are to be
+ * read or modified. */
+ int argc; /* Number of coordinates supplied in
+ * argv. */
+ char **argv; /* Array of coordinates: x1, y1,
+ * x2, y2, ... */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+ char x[TCL_DOUBLE_SPACE], y[TCL_DOUBLE_SPACE];
+
+ if (argc == 0) {
+ Tcl_PrintDouble(interp, winItemPtr->x, x);
+ Tcl_PrintDouble(interp, winItemPtr->y, y);
+ Tcl_AppendResult(interp, x, " ", y, (char *) NULL);
+ } else if (argc == 2) {
+ if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &winItemPtr->x)
+ != TCL_OK) || (Tk_CanvasGetCoord(interp, canvas, argv[1],
+ &winItemPtr->y) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComputeWindowBbox(canvas, winItemPtr);
+ } else {
+ sprintf(interp->result,
+ "wrong # coordinates: expected 0 or 2, got %d", argc);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureWinItem --
+ *
+ * This procedure is invoked to configure various aspects
+ * of a window item, such as its anchor position.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then
+ * an error message is left in interp->result.
+ *
+ * Side effects:
+ * Configuration information may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureWinItem(interp, canvas, itemPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Window item to reconfigure. */
+ int argc; /* Number of elements in argv. */
+ char **argv; /* Arguments describing things to configure. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+ Tk_Window oldWindow;
+ Tk_Window canvasTkwin;
+
+ oldWindow = winItemPtr->tkwin;
+ canvasTkwin = Tk_CanvasTkwin(canvas);
+ if (Tk_ConfigureWidget(interp, canvasTkwin, configSpecs, argc, argv,
+ (char *) winItemPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing.
+ */
+
+ if (oldWindow != winItemPtr->tkwin) {
+ if (oldWindow != NULL) {
+ Tk_DeleteEventHandler(oldWindow, StructureNotifyMask,
+ WinItemStructureProc, (ClientData) winItemPtr);
+ Tk_ManageGeometry(oldWindow, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ Tk_UnmaintainGeometry(oldWindow, canvasTkwin);
+ Tk_UnmapWindow(oldWindow);
+ }
+ if (winItemPtr->tkwin != NULL) {
+ Tk_Window ancestor, parent;
+
+ /*
+ * Make sure that the canvas is either the parent of the
+ * window associated with the item or a descendant of that
+ * parent. Also, don't allow a top-level window to be
+ * managed inside a canvas.
+ */
+
+ parent = Tk_Parent(winItemPtr->tkwin);
+ for (ancestor = canvasTkwin; ;
+ ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ if (((Tk_FakeWin *) (ancestor))->flags & TK_TOP_LEVEL) {
+ badWindow:
+ Tcl_AppendResult(interp, "can't use ",
+ Tk_PathName(winItemPtr->tkwin),
+ " in a window item of this canvas", (char *) NULL);
+ winItemPtr->tkwin = NULL;
+ return TCL_ERROR;
+ }
+ }
+ if (((Tk_FakeWin *) (winItemPtr->tkwin))->flags & TK_TOP_LEVEL) {
+ goto badWindow;
+ }
+ if (winItemPtr->tkwin == canvasTkwin) {
+ goto badWindow;
+ }
+ Tk_CreateEventHandler(winItemPtr->tkwin, StructureNotifyMask,
+ WinItemStructureProc, (ClientData) winItemPtr);
+ Tk_ManageGeometry(winItemPtr->tkwin, &canvasGeomType,
+ (ClientData) winItemPtr);
+ }
+ }
+
+ ComputeWindowBbox(canvas, winItemPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteWinItem --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a window item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteWinItem(canvas, itemPtr, display)
+ Tk_Canvas canvas; /* Overall info about widget. */
+ Tk_Item *itemPtr; /* Item that is being deleted. */
+ Display *display; /* Display containing window for
+ * canvas. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+ Tk_Window canvasTkwin = Tk_CanvasTkwin(canvas);
+
+ if (winItemPtr->tkwin != NULL) {
+ Tk_DeleteEventHandler(winItemPtr->tkwin, StructureNotifyMask,
+ WinItemStructureProc, (ClientData) winItemPtr);
+ Tk_ManageGeometry(winItemPtr->tkwin, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ if (canvasTkwin != Tk_Parent(winItemPtr->tkwin)) {
+ Tk_UnmaintainGeometry(winItemPtr->tkwin, canvasTkwin);
+ }
+ Tk_UnmapWindow(winItemPtr->tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeWindowBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of a window item.
+ * This procedure is where the child window's placement is
+ * computed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputeWindowBbox(canvas, winItemPtr)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ WindowItem *winItemPtr; /* Item whose bbox is to be
+ * recomputed. */
+{
+ int width, height, x, y;
+
+ x = (int) (winItemPtr->x + ((winItemPtr->x >= 0) ? 0.5 : - 0.5));
+ y = (int) (winItemPtr->y + ((winItemPtr->y >= 0) ? 0.5 : - 0.5));
+
+ if (winItemPtr->tkwin == NULL) {
+ /*
+ * There is no window for this item yet. Just give it a 1x1
+ * bounding box. Don't give it a 0x0 bounding box; there are
+ * strange cases where this bounding box might be used as the
+ * dimensions of the window, and 0x0 causes problems under X.
+ */
+
+ winItemPtr->header.x1 = x;
+ winItemPtr->header.x2 = winItemPtr->header.x1 + 1;
+ winItemPtr->header.y1 = y;
+ winItemPtr->header.y2 = winItemPtr->header.y1 + 1;
+ return;
+ }
+
+ /*
+ * Compute dimensions of window.
+ */
+
+ width = winItemPtr->width;
+ if (width <= 0) {
+ width = Tk_ReqWidth(winItemPtr->tkwin);
+ if (width <= 0) {
+ width = 1;
+ }
+ }
+ height = winItemPtr->height;
+ if (height <= 0) {
+ height = Tk_ReqHeight(winItemPtr->tkwin);
+ if (height <= 0) {
+ height = 1;
+ }
+ }
+
+ /*
+ * Compute location of window, using anchor information.
+ */
+
+ switch (winItemPtr->anchor) {
+ case TK_ANCHOR_N:
+ x -= width/2;
+ break;
+ case TK_ANCHOR_NE:
+ x -= width;
+ break;
+ case TK_ANCHOR_E:
+ x -= width;
+ y -= height/2;
+ break;
+ case TK_ANCHOR_SE:
+ x -= width;
+ y -= height;
+ break;
+ case TK_ANCHOR_S:
+ x -= width/2;
+ y -= height;
+ break;
+ case TK_ANCHOR_SW:
+ y -= height;
+ break;
+ case TK_ANCHOR_W:
+ y -= height/2;
+ break;
+ case TK_ANCHOR_NW:
+ break;
+ case TK_ANCHOR_CENTER:
+ x -= width/2;
+ y -= height/2;
+ break;
+ }
+
+ /*
+ * Store the information in the item header.
+ */
+
+ winItemPtr->header.x1 = x;
+ winItemPtr->header.y1 = y;
+ winItemPtr->header.x2 = x + width;
+ winItemPtr->header.y2 = y + height;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayWinItem --
+ *
+ * This procedure is invoked to "draw" a window item in a given
+ * drawable. Since the window draws itself, we needn't do any
+ * actual redisplay here. However, this procedure takes care
+ * of actually repositioning the child window so that it occupies
+ * the correct screen position.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The child window's position may get changed. Note: this
+ * procedure gets called both when a window needs to be displayed
+ * and when it ceases to be visible on the screen (e.g. it was
+ * scrolled or moved off-screen or the enclosing canvas is
+ * unmapped).
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayWinItem(canvas, itemPtr, display, drawable, regionX, regionY,
+ regionWidth, regionHeight)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ Tk_Item *itemPtr; /* Item to be displayed. */
+ Display *display; /* Display on which to draw item. */
+ Drawable drawable; /* Pixmap or window in which to draw
+ * item. */
+ int regionX, regionY, regionWidth, regionHeight;
+ /* Describes region of canvas that
+ * must be redisplayed (not used). */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+ int width, height;
+ short x, y;
+ Tk_Window canvasTkwin = Tk_CanvasTkwin(canvas);
+
+ if (winItemPtr->tkwin == NULL) {
+ return;
+ }
+
+ Tk_CanvasWindowCoords(canvas, (double) winItemPtr->header.x1,
+ (double) winItemPtr->header.y1, &x, &y);
+ width = winItemPtr->header.x2 - winItemPtr->header.x1;
+ height = winItemPtr->header.y2 - winItemPtr->header.y1;
+
+ /*
+ * If the window is completely out of the visible area of the canvas
+ * then unmap it. This code used not to be present (why unmap the
+ * window if it isn't visible anyway?) but this could cause the
+ * window to suddenly reappear if the canvas window got resized.
+ */
+
+ if (((x + width) <= 0) || ((y + height) <= 0)
+ || (x >= Tk_Width(canvasTkwin)) || (y >= Tk_Height(canvasTkwin))) {
+ if (canvasTkwin == Tk_Parent(winItemPtr->tkwin)) {
+ Tk_UnmapWindow(winItemPtr->tkwin);
+ } else {
+ Tk_UnmaintainGeometry(winItemPtr->tkwin, canvasTkwin);
+ }
+ return;
+ }
+
+ /*
+ * Reposition and map the window (but in different ways depending
+ * on whether the canvas is the window's parent).
+ */
+
+ if (canvasTkwin == Tk_Parent(winItemPtr->tkwin)) {
+ if ((x != Tk_X(winItemPtr->tkwin)) || (y != Tk_Y(winItemPtr->tkwin))
+ || (width != Tk_Width(winItemPtr->tkwin))
+ || (height != Tk_Height(winItemPtr->tkwin))) {
+ Tk_MoveResizeWindow(winItemPtr->tkwin, x, y, width, height);
+ }
+ Tk_MapWindow(winItemPtr->tkwin);
+ } else {
+ Tk_MaintainGeometry(winItemPtr->tkwin, canvasTkwin, x, y,
+ width, height);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * rectangle, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are coordPtr[0] and coordPtr[1] is inside the window. If the
+ * point isn't inside the window then the return value is the
+ * distance from the point to the window.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static double
+WinItemToPoint(canvas, itemPtr, pointPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *pointPtr; /* Pointer to x and y coordinates. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+ double x1, x2, y1, y2, xDiff, yDiff;
+
+ x1 = winItemPtr->header.x1;
+ y1 = winItemPtr->header.y1;
+ x2 = winItemPtr->header.x2;
+ y2 = winItemPtr->header.y2;
+
+ /*
+ * Point is outside rectangle.
+ */
+
+ if (pointPtr[0] < x1) {
+ xDiff = x1 - pointPtr[0];
+ } else if (pointPtr[0] >= x2) {
+ xDiff = pointPtr[0] + 1 - x2;
+ } else {
+ xDiff = 0;
+ }
+
+ if (pointPtr[1] < y1) {
+ yDiff = y1 - pointPtr[1];
+ } else if (pointPtr[1] >= y2) {
+ yDiff = pointPtr[1] + 1 - y2;
+ } else {
+ yDiff = 0;
+ }
+
+ return hypot(xDiff, yDiff);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given rectangle.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area
+ * given by rectPtr, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+WinItemToArea(canvas, itemPtr, rectPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against rectangle. */
+ double *rectPtr; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) describing rectangular
+ * area. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+
+ if ((rectPtr[2] <= winItemPtr->header.x1)
+ || (rectPtr[0] >= winItemPtr->header.x2)
+ || (rectPtr[3] <= winItemPtr->header.y1)
+ || (rectPtr[1] >= winItemPtr->header.y2)) {
+ return -1;
+ }
+ if ((rectPtr[0] <= winItemPtr->header.x1)
+ && (rectPtr[1] <= winItemPtr->header.y1)
+ && (rectPtr[2] >= winItemPtr->header.x2)
+ && (rectPtr[3] >= winItemPtr->header.y2)) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleWinItem --
+ *
+ * This procedure is invoked to rescale a rectangle or oval
+ * item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The rectangle or oval referred to by itemPtr is rescaled
+ * so that the following transformation is applied to all
+ * point coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleWinItem(canvas, itemPtr, originX, originY, scaleX, scaleY)
+ Tk_Canvas canvas; /* Canvas containing rectangle. */
+ Tk_Item *itemPtr; /* Rectangle to be scaled. */
+ double originX, originY; /* Origin about which to scale rect. */
+ double scaleX; /* Amount to scale in X direction. */
+ double scaleY; /* Amount to scale in Y direction. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+
+ winItemPtr->x = originX + scaleX*(winItemPtr->x - originX);
+ winItemPtr->y = originY + scaleY*(winItemPtr->y - originY);
+ if (winItemPtr->width > 0) {
+ winItemPtr->width = (int) (scaleX*winItemPtr->width);
+ }
+ if (winItemPtr->height > 0) {
+ winItemPtr->height = (int) (scaleY*winItemPtr->height);
+ }
+ ComputeWindowBbox(canvas, winItemPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateWinItem --
+ *
+ * This procedure is called to move a rectangle or oval by a
+ * given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the rectangle or oval is offset by
+ * (xDelta, yDelta), and the bounding box is updated in the
+ * generic part of the item structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateWinItem(canvas, itemPtr, deltaX, deltaY)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item that is being moved. */
+ double deltaX, deltaY; /* Amount by which item is to be
+ * moved. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+
+ winItemPtr->x += deltaX;
+ winItemPtr->y += deltaY;
+ ComputeWindowBbox(canvas, winItemPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemStructureProc --
+ *
+ * This procedure is invoked whenever StructureNotify events
+ * occur for a window that's managed as part of a canvas window
+ * item. This procudure's only purpose is to clean up when
+ * windows are deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is disassociated from the window item when it is
+ * deleted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+WinItemStructureProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to record describing window item. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ WindowItem *winItemPtr = (WindowItem *) clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ winItemPtr->tkwin = NULL;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemRequestProc --
+ *
+ * This procedure is invoked whenever a window that's associated
+ * with a window canvas item changes its requested dimensions.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The size and location on the screen of the window may change,
+ * depending on the options specified for the window item.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+WinItemRequestProc(clientData, tkwin)
+ ClientData clientData; /* Pointer to record for window item. */
+ Tk_Window tkwin; /* Window that changed its desired
+ * size. */
+{
+ WindowItem *winItemPtr = (WindowItem *) clientData;
+
+ ComputeWindowBbox(winItemPtr->canvas, winItemPtr);
+ DisplayWinItem(winItemPtr->canvas, (Tk_Item *) winItemPtr,
+ (Display *) NULL, (Drawable) None, 0, 0, 0, 0);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemLostSlaveProc --
+ *
+ * This procedure is invoked by Tk whenever some other geometry
+ * claims control over a slave that used to be managed by us.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Forgets all canvas-related information about the slave.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+WinItemLostSlaveProc(clientData, tkwin)
+ ClientData clientData; /* WindowItem structure for slave window that
+ * was stolen away. */
+ Tk_Window tkwin; /* Tk's handle for the slave window. */
+{
+ WindowItem *winItemPtr = (WindowItem *) clientData;
+ Tk_Window canvasTkwin = Tk_CanvasTkwin(winItemPtr->canvas);
+
+ Tk_DeleteEventHandler(winItemPtr->tkwin, StructureNotifyMask,
+ WinItemStructureProc, (ClientData) winItemPtr);
+ if (canvasTkwin != Tk_Parent(winItemPtr->tkwin)) {
+ Tk_UnmaintainGeometry(winItemPtr->tkwin, canvasTkwin);
+ }
+ Tk_UnmapWindow(winItemPtr->tkwin);
+ winItemPtr->tkwin = NULL;
+}
diff --git a/generic/tkCanvas.c b/generic/tkCanvas.c
new file mode 100644
index 0000000..b093226
--- /dev/null
+++ b/generic/tkCanvas.c
@@ -0,0 +1,3791 @@
+/*
+ * tkCanvas.c --
+ *
+ * This module implements canvas widgets for the Tk toolkit.
+ * A canvas displays a background and a collection of graphical
+ * objects such as rectangles, lines, and texts.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkCanvas.c 1.126 97/07/31 09:05:52
+ */
+
+#include "default.h"
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkCanvas.h"
+
+/*
+ * See tkCanvas.h for key data structures used to implement canvases.
+ */
+
+/*
+ * The structure defined below is used to keep track of a tag search
+ * in progress. Only the "prevPtr" field should be accessed by anyone
+ * other than StartTagSearch and NextItem.
+ */
+
+typedef struct TagSearch {
+ TkCanvas *canvasPtr; /* Canvas widget being searched. */
+ Tk_Uid tag; /* Tag to search for. 0 means return
+ * all items. */
+ Tk_Item *prevPtr; /* Item just before last one found (or NULL
+ * if last one found was first in the item
+ * list of canvasPtr). */
+ Tk_Item *currentPtr; /* Pointer to last item returned. */
+ int searchOver; /* Non-zero means NextItem should always
+ * return NULL. */
+} TagSearch;
+
+/*
+ * Information used for argv parsing.
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_CANVAS_BG_COLOR, Tk_Offset(TkCanvas, bgBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_CANVAS_BG_MONO, Tk_Offset(TkCanvas, bgBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_CANVAS_BORDER_WIDTH, Tk_Offset(TkCanvas, borderWidth), 0},
+ {TK_CONFIG_DOUBLE, "-closeenough", "closeEnough", "CloseEnough",
+ DEF_CANVAS_CLOSE_ENOUGH, Tk_Offset(TkCanvas, closeEnough), 0},
+ {TK_CONFIG_BOOLEAN, "-confine", "confine", "Confine",
+ DEF_CANVAS_CONFINE, Tk_Offset(TkCanvas, confine), 0},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_CANVAS_CURSOR, Tk_Offset(TkCanvas, cursor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-height", "height", "Height",
+ DEF_CANVAS_HEIGHT, Tk_Offset(TkCanvas, height), 0},
+ {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_CANVAS_HIGHLIGHT_BG,
+ Tk_Offset(TkCanvas, highlightBgColorPtr), 0},
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_CANVAS_HIGHLIGHT, Tk_Offset(TkCanvas, highlightColorPtr), 0},
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_CANVAS_HIGHLIGHT_WIDTH, Tk_Offset(TkCanvas, highlightWidth), 0},
+ {TK_CONFIG_BORDER, "-insertbackground", "insertBackground", "Foreground",
+ DEF_CANVAS_INSERT_BG, Tk_Offset(TkCanvas, textInfo.insertBorder), 0},
+ {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
+ DEF_CANVAS_INSERT_BD_COLOR,
+ Tk_Offset(TkCanvas, textInfo.insertBorderWidth), TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
+ DEF_CANVAS_INSERT_BD_MONO,
+ Tk_Offset(TkCanvas, textInfo.insertBorderWidth), TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_INT, "-insertofftime", "insertOffTime", "OffTime",
+ DEF_CANVAS_INSERT_OFF_TIME, Tk_Offset(TkCanvas, insertOffTime), 0},
+ {TK_CONFIG_INT, "-insertontime", "insertOnTime", "OnTime",
+ DEF_CANVAS_INSERT_ON_TIME, Tk_Offset(TkCanvas, insertOnTime), 0},
+ {TK_CONFIG_PIXELS, "-insertwidth", "insertWidth", "InsertWidth",
+ DEF_CANVAS_INSERT_WIDTH, Tk_Offset(TkCanvas, textInfo.insertWidth), 0},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_CANVAS_RELIEF, Tk_Offset(TkCanvas, relief), 0},
+ {TK_CONFIG_STRING, "-scrollregion", "scrollRegion", "ScrollRegion",
+ DEF_CANVAS_SCROLL_REGION, Tk_Offset(TkCanvas, regionString),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_CANVAS_SELECT_COLOR, Tk_Offset(TkCanvas, textInfo.selBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_CANVAS_SELECT_MONO, Tk_Offset(TkCanvas, textInfo.selBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
+ DEF_CANVAS_SELECT_BD_COLOR,
+ Tk_Offset(TkCanvas, textInfo.selBorderWidth), TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
+ DEF_CANVAS_SELECT_BD_MONO, Tk_Offset(TkCanvas, textInfo.selBorderWidth),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_CANVAS_SELECT_FG_COLOR, Tk_Offset(TkCanvas, textInfo.selFgColorPtr),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_CANVAS_SELECT_FG_MONO, Tk_Offset(TkCanvas, textInfo.selFgColorPtr),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_CANVAS_TAKE_FOCUS, Tk_Offset(TkCanvas, takeFocus),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-width", "width", "Width",
+ DEF_CANVAS_WIDTH, Tk_Offset(TkCanvas, width), 0},
+ {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ DEF_CANVAS_X_SCROLL_CMD, Tk_Offset(TkCanvas, xScrollCmd),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-xscrollincrement", "xScrollIncrement",
+ "ScrollIncrement",
+ DEF_CANVAS_X_SCROLL_INCREMENT, Tk_Offset(TkCanvas, xScrollIncrement),
+ 0},
+ {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
+ DEF_CANVAS_Y_SCROLL_CMD, Tk_Offset(TkCanvas, yScrollCmd),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-yscrollincrement", "yScrollIncrement",
+ "ScrollIncrement",
+ DEF_CANVAS_Y_SCROLL_INCREMENT, Tk_Offset(TkCanvas, yScrollIncrement),
+ 0},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * List of all the item types known at present:
+ */
+
+static Tk_ItemType *typeList = NULL; /* NULL means initialization hasn't
+ * been done yet. */
+
+/*
+ * Standard item types provided by Tk:
+ */
+
+extern Tk_ItemType tkArcType, tkBitmapType, tkImageType, tkLineType;
+extern Tk_ItemType tkOvalType, tkPolygonType;
+extern Tk_ItemType tkRectangleType, tkTextType, tkWindowType;
+
+/*
+ * Various Tk_Uid's used by this module (set up during initialization):
+ */
+
+static Tk_Uid allUid = NULL;
+static Tk_Uid currentUid = NULL;
+
+/*
+ * Statistics counters:
+ */
+
+static int numIdSearches;
+static int numSlowSearches;
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static void CanvasBindProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void CanvasBlinkProc _ANSI_ARGS_((ClientData clientData));
+static void CanvasCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void CanvasDoEvent _ANSI_ARGS_((TkCanvas *canvasPtr,
+ XEvent *eventPtr));
+static void CanvasEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int CanvasFetchSelection _ANSI_ARGS_((
+ ClientData clientData, int offset,
+ char *buffer, int maxBytes));
+static Tk_Item * CanvasFindClosest _ANSI_ARGS_((TkCanvas *canvasPtr,
+ double coords[2]));
+static void CanvasFocusProc _ANSI_ARGS_((TkCanvas *canvasPtr,
+ int gotFocus));
+static void CanvasLostSelection _ANSI_ARGS_((
+ ClientData clientData));
+static void CanvasSelectTo _ANSI_ARGS_((TkCanvas *canvasPtr,
+ Tk_Item *itemPtr, int index));
+static void CanvasSetOrigin _ANSI_ARGS_((TkCanvas *canvasPtr,
+ int xOrigin, int yOrigin));
+static void CanvasUpdateScrollbars _ANSI_ARGS_((
+ TkCanvas *canvasPtr));
+static int CanvasWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void CanvasWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+static int ConfigureCanvas _ANSI_ARGS_((Tcl_Interp *interp,
+ TkCanvas *canvasPtr, int argc, char **argv,
+ int flags));
+static void DestroyCanvas _ANSI_ARGS_((char *memPtr));
+static void DisplayCanvas _ANSI_ARGS_((ClientData clientData));
+static void DoItem _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Item *itemPtr, Tk_Uid tag));
+static int FindItems _ANSI_ARGS_((Tcl_Interp *interp,
+ TkCanvas *canvasPtr, int argc, char **argv,
+ char *newTag, char *cmdName, char *option));
+static int FindArea _ANSI_ARGS_((Tcl_Interp *interp,
+ TkCanvas *canvasPtr, char **argv, Tk_Uid uid,
+ int enclosed));
+static double GridAlign _ANSI_ARGS_((double coord, double spacing));
+static void InitCanvas _ANSI_ARGS_((void));
+static Tk_Item * NextItem _ANSI_ARGS_((TagSearch *searchPtr));
+static void PickCurrentItem _ANSI_ARGS_((TkCanvas *canvasPtr,
+ XEvent *eventPtr));
+static void PrintScrollFractions _ANSI_ARGS_((int screen1,
+ int screen2, int object1, int object2,
+ char *string));
+static void RelinkItems _ANSI_ARGS_((TkCanvas *canvasPtr,
+ char *tag, Tk_Item *prevPtr));
+static Tk_Item * StartTagSearch _ANSI_ARGS_((TkCanvas *canvasPtr,
+ char *tag, TagSearch *searchPtr));
+
+/*
+ * The structure below defines canvas class behavior by means of procedures
+ * that can be invoked from generic window code.
+ */
+
+static TkClassProcs canvasClass = {
+ NULL, /* createProc. */
+ CanvasWorldChanged, /* geometryProc. */
+ NULL /* modalProc. */
+};
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasCmd --
+ *
+ * This procedure is invoked to process the "canvas" Tcl
+ * command. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_CanvasCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ TkCanvas *canvasPtr;
+ Tk_Window new;
+
+ if (typeList == NULL) {
+ InitCanvas();
+ }
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " pathName ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Initialize fields that won't be initialized by ConfigureCanvas,
+ * or which ConfigureCanvas expects to have reasonable values
+ * (e.g. resource pointers).
+ */
+
+ canvasPtr = (TkCanvas *) ckalloc(sizeof(TkCanvas));
+ canvasPtr->tkwin = new;
+ canvasPtr->display = Tk_Display(new);
+ canvasPtr->interp = interp;
+ canvasPtr->widgetCmd = Tcl_CreateCommand(interp,
+ Tk_PathName(canvasPtr->tkwin), CanvasWidgetCmd,
+ (ClientData) canvasPtr, CanvasCmdDeletedProc);
+ canvasPtr->firstItemPtr = NULL;
+ canvasPtr->lastItemPtr = NULL;
+ canvasPtr->borderWidth = 0;
+ canvasPtr->bgBorder = NULL;
+ canvasPtr->relief = TK_RELIEF_FLAT;
+ canvasPtr->highlightWidth = 0;
+ canvasPtr->highlightBgColorPtr = NULL;
+ canvasPtr->highlightColorPtr = NULL;
+ canvasPtr->inset = 0;
+ canvasPtr->pixmapGC = None;
+ canvasPtr->width = None;
+ canvasPtr->height = None;
+ canvasPtr->confine = 0;
+ canvasPtr->textInfo.selBorder = NULL;
+ canvasPtr->textInfo.selBorderWidth = 0;
+ canvasPtr->textInfo.selFgColorPtr = NULL;
+ canvasPtr->textInfo.selItemPtr = NULL;
+ canvasPtr->textInfo.selectFirst = -1;
+ canvasPtr->textInfo.selectLast = -1;
+ canvasPtr->textInfo.anchorItemPtr = NULL;
+ canvasPtr->textInfo.selectAnchor = 0;
+ canvasPtr->textInfo.insertBorder = NULL;
+ canvasPtr->textInfo.insertWidth = 0;
+ canvasPtr->textInfo.insertBorderWidth = 0;
+ canvasPtr->textInfo.focusItemPtr = NULL;
+ canvasPtr->textInfo.gotFocus = 0;
+ canvasPtr->textInfo.cursorOn = 0;
+ canvasPtr->insertOnTime = 0;
+ canvasPtr->insertOffTime = 0;
+ canvasPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
+ canvasPtr->xOrigin = canvasPtr->yOrigin = 0;
+ canvasPtr->drawableXOrigin = canvasPtr->drawableYOrigin = 0;
+ canvasPtr->bindingTable = NULL;
+ canvasPtr->currentItemPtr = NULL;
+ canvasPtr->newCurrentPtr = NULL;
+ canvasPtr->closeEnough = 0.0;
+ canvasPtr->pickEvent.type = LeaveNotify;
+ canvasPtr->pickEvent.xcrossing.x = 0;
+ canvasPtr->pickEvent.xcrossing.y = 0;
+ canvasPtr->state = 0;
+ canvasPtr->xScrollCmd = NULL;
+ canvasPtr->yScrollCmd = NULL;
+ canvasPtr->scrollX1 = 0;
+ canvasPtr->scrollY1 = 0;
+ canvasPtr->scrollX2 = 0;
+ canvasPtr->scrollY2 = 0;
+ canvasPtr->regionString = NULL;
+ canvasPtr->xScrollIncrement = 0;
+ canvasPtr->yScrollIncrement = 0;
+ canvasPtr->scanX = 0;
+ canvasPtr->scanXOrigin = 0;
+ canvasPtr->scanY = 0;
+ canvasPtr->scanYOrigin = 0;
+ canvasPtr->hotPtr = NULL;
+ canvasPtr->hotPrevPtr = NULL;
+ canvasPtr->cursor = None;
+ canvasPtr->takeFocus = NULL;
+ canvasPtr->pixelsPerMM = WidthOfScreen(Tk_Screen(new));
+ canvasPtr->pixelsPerMM /= WidthMMOfScreen(Tk_Screen(new));
+ canvasPtr->flags = 0;
+ canvasPtr->nextId = 1;
+ canvasPtr->psInfoPtr = NULL;
+
+ Tk_SetClass(canvasPtr->tkwin, "Canvas");
+ TkSetClassProcs(canvasPtr->tkwin, &canvasClass, (ClientData) canvasPtr);
+ Tk_CreateEventHandler(canvasPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ CanvasEventProc, (ClientData) canvasPtr);
+ Tk_CreateEventHandler(canvasPtr->tkwin, KeyPressMask|KeyReleaseMask
+ |ButtonPressMask|ButtonReleaseMask|EnterWindowMask
+ |LeaveWindowMask|PointerMotionMask|VirtualEventMask,
+ CanvasBindProc, (ClientData) canvasPtr);
+ Tk_CreateSelHandler(canvasPtr->tkwin, XA_PRIMARY, XA_STRING,
+ CanvasFetchSelection, (ClientData) canvasPtr, XA_STRING);
+ if (ConfigureCanvas(interp, canvasPtr, argc-2, argv+2, 0) != TCL_OK) {
+ goto error;
+ }
+
+ interp->result = Tk_PathName(canvasPtr->tkwin);
+ return TCL_OK;
+
+ error:
+ Tk_DestroyWindow(canvasPtr->tkwin);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasWidgetCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to a widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CanvasWidgetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about canvas
+ * widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+ size_t length;
+ int c, result;
+ Tk_Item *itemPtr = NULL; /* Initialization needed only to
+ * prevent compiler warning. */
+ TagSearch search;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_Preserve((ClientData) canvasPtr);
+ result = TCL_OK;
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'a') && (strncmp(argv[1], "addtag", length) == 0)) {
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " addtags tag searchCommand ?arg arg ...?\"",
+ (char *) NULL);
+ goto error;
+ }
+ result = FindItems(interp, canvasPtr, argc-3, argv+3, argv[2], argv[0],
+ " addtag tag");
+ } else if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0)
+ && (length >= 2)) {
+ int i, gotAny;
+ int x1 = 0, y1 = 0, x2 = 0, y2 = 0; /* Initializations needed
+ * only to prevent compiler
+ * warnings. */
+
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " bbox tagOrId ?tagOrId ...?\"",
+ (char *) NULL);
+ goto error;
+ }
+ gotAny = 0;
+ for (i = 2; i < argc; i++) {
+ for (itemPtr = StartTagSearch(canvasPtr, argv[i], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ if ((itemPtr->x1 >= itemPtr->x2)
+ || (itemPtr->y1 >= itemPtr->y2)) {
+ continue;
+ }
+ if (!gotAny) {
+ x1 = itemPtr->x1;
+ y1 = itemPtr->y1;
+ x2 = itemPtr->x2;
+ y2 = itemPtr->y2;
+ gotAny = 1;
+ } else {
+ if (itemPtr->x1 < x1) {
+ x1 = itemPtr->x1;
+ }
+ if (itemPtr->y1 < y1) {
+ y1 = itemPtr->y1;
+ }
+ if (itemPtr->x2 > x2) {
+ x2 = itemPtr->x2;
+ }
+ if (itemPtr->y2 > y2) {
+ y2 = itemPtr->y2;
+ }
+ }
+ }
+ }
+ if (gotAny) {
+ sprintf(interp->result, "%d %d %d %d", x1, y1, x2, y2);
+ }
+ } else if ((c == 'b') && (strncmp(argv[1], "bind", length) == 0)
+ && (length >= 2)) {
+ ClientData object;
+
+ if ((argc < 3) || (argc > 5)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " bind tagOrId ?sequence? ?command?\"",
+ (char *) NULL);
+ goto error;
+ }
+
+ /*
+ * Figure out what object to use for the binding (individual
+ * item vs. tag).
+ */
+
+ object = 0;
+ if (isdigit(UCHAR(argv[2][0]))) {
+ int id;
+ char *end;
+
+ id = strtoul(argv[2], &end, 0);
+ if (*end != 0) {
+ goto bindByTag;
+ }
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if (itemPtr->id == id) {
+ object = (ClientData) itemPtr;
+ break;
+ }
+ }
+ if (object == 0) {
+ Tcl_AppendResult(interp, "item \"", argv[2],
+ "\" doesn't exist", (char *) NULL);
+ goto error;
+ }
+ } else {
+ bindByTag:
+ object = (ClientData) Tk_GetUid(argv[2]);
+ }
+
+ /*
+ * Make a binding table if the canvas doesn't already have
+ * one.
+ */
+
+ if (canvasPtr->bindingTable == NULL) {
+ canvasPtr->bindingTable = Tk_CreateBindingTable(interp);
+ }
+
+ if (argc == 5) {
+ int append = 0;
+ unsigned long mask;
+
+ if (argv[4][0] == 0) {
+ result = Tk_DeleteBinding(interp, canvasPtr->bindingTable,
+ object, argv[3]);
+ goto done;
+ }
+ if (argv[4][0] == '+') {
+ argv[4]++;
+ append = 1;
+ }
+ mask = Tk_CreateBinding(interp, canvasPtr->bindingTable,
+ object, argv[3], argv[4], append);
+ if (mask == 0) {
+ goto error;
+ }
+ if (mask & (unsigned) ~(ButtonMotionMask|Button1MotionMask
+ |Button2MotionMask|Button3MotionMask|Button4MotionMask
+ |Button5MotionMask|ButtonPressMask|ButtonReleaseMask
+ |EnterWindowMask|LeaveWindowMask|KeyPressMask
+ |KeyReleaseMask|PointerMotionMask|VirtualEventMask)) {
+ Tk_DeleteBinding(interp, canvasPtr->bindingTable,
+ object, argv[3]);
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "requested illegal events; ",
+ "only key, button, motion, enter, leave, and virtual ",
+ "events may be used", (char *) NULL);
+ goto error;
+ }
+ } else if (argc == 4) {
+ char *command;
+
+ command = Tk_GetBinding(interp, canvasPtr->bindingTable,
+ object, argv[3]);
+ if (command == NULL) {
+ goto error;
+ }
+ interp->result = command;
+ } else {
+ Tk_GetAllBindings(interp, canvasPtr->bindingTable, object);
+ }
+ } else if ((c == 'c') && (strcmp(argv[1], "canvasx") == 0)) {
+ int x;
+ double grid;
+
+ if ((argc < 3) || (argc > 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " canvasx screenx ?gridspacing?\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (Tk_GetPixels(interp, canvasPtr->tkwin, argv[2], &x) != TCL_OK) {
+ goto error;
+ }
+ if (argc == 4) {
+ if (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[3],
+ &grid) != TCL_OK) {
+ goto error;
+ }
+ } else {
+ grid = 0.0;
+ }
+ x += canvasPtr->xOrigin;
+ Tcl_PrintDouble(interp, GridAlign((double) x, grid), interp->result);
+ } else if ((c == 'c') && (strcmp(argv[1], "canvasy") == 0)) {
+ int y;
+ double grid;
+
+ if ((argc < 3) || (argc > 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " canvasy screeny ?gridspacing?\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (Tk_GetPixels(interp, canvasPtr->tkwin, argv[2], &y) != TCL_OK) {
+ goto error;
+ }
+ if (argc == 4) {
+ if (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr,
+ argv[3], &grid) != TCL_OK) {
+ goto error;
+ }
+ } else {
+ grid = 0.0;
+ }
+ y += canvasPtr->yOrigin;
+ Tcl_PrintDouble(interp, GridAlign((double) y, grid), interp->result);
+ } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
+ && (length >= 2)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " cget option\"",
+ (char *) NULL);
+ goto error;
+ }
+ result = Tk_ConfigureValue(interp, canvasPtr->tkwin, configSpecs,
+ (char *) canvasPtr, argv[2], 0);
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
+ && (length >= 3)) {
+ if (argc == 2) {
+ result = Tk_ConfigureInfo(interp, canvasPtr->tkwin, configSpecs,
+ (char *) canvasPtr, (char *) NULL, 0);
+ } else if (argc == 3) {
+ result = Tk_ConfigureInfo(interp, canvasPtr->tkwin, configSpecs,
+ (char *) canvasPtr, argv[2], 0);
+ } else {
+ result = ConfigureCanvas(interp, canvasPtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ } else if ((c == 'c') && (strncmp(argv[1], "coords", length) == 0)
+ && (length >= 3)) {
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " coords tagOrId ?x y x y ...?\"",
+ (char *) NULL);
+ goto error;
+ }
+ itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ if (itemPtr != NULL) {
+ if (argc != 3) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ }
+ if (itemPtr->typePtr->coordProc != NULL) {
+ result = (*itemPtr->typePtr->coordProc)(interp,
+ (Tk_Canvas) canvasPtr, itemPtr, argc-3, argv+3);
+ }
+ if (argc != 3) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ }
+ }
+ } else if ((c == 'c') && (strncmp(argv[1], "create", length) == 0)
+ && (length >= 2)) {
+ Tk_ItemType *typePtr;
+ Tk_ItemType *matchPtr = NULL;
+ Tk_Item *itemPtr;
+
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " create type ?arg arg ...?\"", (char *) NULL);
+ goto error;
+ }
+ c = argv[2][0];
+ length = strlen(argv[2]);
+ for (typePtr = typeList; typePtr != NULL; typePtr = typePtr->nextPtr) {
+ if ((c == typePtr->name[0])
+ && (strncmp(argv[2], typePtr->name, length) == 0)) {
+ if (matchPtr != NULL) {
+ badType:
+ Tcl_AppendResult(interp,
+ "unknown or ambiguous item type \"",
+ argv[2], "\"", (char *) NULL);
+ goto error;
+ }
+ matchPtr = typePtr;
+ }
+ }
+ if (matchPtr == NULL) {
+ goto badType;
+ }
+ typePtr = matchPtr;
+ itemPtr = (Tk_Item *) ckalloc((unsigned) typePtr->itemSize);
+ itemPtr->id = canvasPtr->nextId;
+ canvasPtr->nextId++;
+ itemPtr->tagPtr = itemPtr->staticTagSpace;
+ itemPtr->tagSpace = TK_TAG_SPACE;
+ itemPtr->numTags = 0;
+ itemPtr->typePtr = typePtr;
+ if ((*typePtr->createProc)(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, argc-3, argv+3) != TCL_OK) {
+ ckfree((char *) itemPtr);
+ goto error;
+ }
+ itemPtr->nextPtr = NULL;
+ canvasPtr->hotPtr = itemPtr;
+ canvasPtr->hotPrevPtr = canvasPtr->lastItemPtr;
+ if (canvasPtr->lastItemPtr == NULL) {
+ canvasPtr->firstItemPtr = itemPtr;
+ } else {
+ canvasPtr->lastItemPtr->nextPtr = itemPtr;
+ }
+ canvasPtr->lastItemPtr = itemPtr;
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ canvasPtr->flags |= REPICK_NEEDED;
+ sprintf(interp->result, "%d", itemPtr->id);
+ } else if ((c == 'd') && (strncmp(argv[1], "dchars", length) == 0)
+ && (length >= 2)) {
+ int first, last;
+
+ if ((argc != 4) && (argc != 5)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " dchars tagOrId first ?last?\"",
+ (char *) NULL);
+ goto error;
+ }
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ if ((itemPtr->typePtr->indexProc == NULL)
+ || (itemPtr->typePtr->dCharsProc == NULL)) {
+ continue;
+ }
+ if ((*itemPtr->typePtr->indexProc)(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, argv[3], &first) != TCL_OK) {
+ goto error;
+ }
+ if (argc == 5) {
+ if ((*itemPtr->typePtr->indexProc)(interp,
+ (Tk_Canvas) canvasPtr, itemPtr, argv[4], &last)
+ != TCL_OK) {
+ goto error;
+ }
+ } else {
+ last = first;
+ }
+
+ /*
+ * Redraw both item's old and new areas: it's possible
+ * that a delete could result in a new area larger than
+ * the old area.
+ */
+
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ (*itemPtr->typePtr->dCharsProc)((Tk_Canvas) canvasPtr,
+ itemPtr, first, last);
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ }
+ } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)
+ && (length >= 2)) {
+ int i;
+
+ for (i = 2; i < argc; i++) {
+ for (itemPtr = StartTagSearch(canvasPtr, argv[i], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ if (canvasPtr->bindingTable != NULL) {
+ Tk_DeleteAllBindings(canvasPtr->bindingTable,
+ (ClientData) itemPtr);
+ }
+ (*itemPtr->typePtr->deleteProc)((Tk_Canvas) canvasPtr, itemPtr,
+ canvasPtr->display);
+ if (itemPtr->tagPtr != itemPtr->staticTagSpace) {
+ ckfree((char *) itemPtr->tagPtr);
+ }
+ if (search.prevPtr == NULL) {
+ canvasPtr->firstItemPtr = itemPtr->nextPtr;
+ if (canvasPtr->firstItemPtr == NULL) {
+ canvasPtr->lastItemPtr = NULL;
+ }
+ } else {
+ search.prevPtr->nextPtr = itemPtr->nextPtr;
+ }
+ if (canvasPtr->lastItemPtr == itemPtr) {
+ canvasPtr->lastItemPtr = search.prevPtr;
+ }
+ ckfree((char *) itemPtr);
+ if (itemPtr == canvasPtr->currentItemPtr) {
+ canvasPtr->currentItemPtr = NULL;
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+ if (itemPtr == canvasPtr->newCurrentPtr) {
+ canvasPtr->newCurrentPtr = NULL;
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+ if (itemPtr == canvasPtr->textInfo.focusItemPtr) {
+ canvasPtr->textInfo.focusItemPtr = NULL;
+ }
+ if (itemPtr == canvasPtr->textInfo.selItemPtr) {
+ canvasPtr->textInfo.selItemPtr = NULL;
+ }
+ if ((itemPtr == canvasPtr->hotPtr)
+ || (itemPtr == canvasPtr->hotPrevPtr)) {
+ canvasPtr->hotPtr = NULL;
+ }
+ }
+ }
+ } else if ((c == 'd') && (strncmp(argv[1], "dtag", length) == 0)
+ && (length >= 2)) {
+ Tk_Uid tag;
+ int i;
+
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " dtag tagOrId ?tagToDelete?\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (argc == 4) {
+ tag = Tk_GetUid(argv[3]);
+ } else {
+ tag = Tk_GetUid(argv[2]);
+ }
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ for (i = itemPtr->numTags-1; i >= 0; i--) {
+ if (itemPtr->tagPtr[i] == tag) {
+ itemPtr->tagPtr[i] = itemPtr->tagPtr[itemPtr->numTags-1];
+ itemPtr->numTags--;
+ }
+ }
+ }
+ } else if ((c == 'f') && (strncmp(argv[1], "find", length) == 0)
+ && (length >= 2)) {
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " find searchCommand ?arg arg ...?\"",
+ (char *) NULL);
+ goto error;
+ }
+ result = FindItems(interp, canvasPtr, argc-2, argv+2, (char *) NULL,
+ argv[0]," find");
+ } else if ((c == 'f') && (strncmp(argv[1], "focus", length) == 0)
+ && (length >= 2)) {
+ if (argc > 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " focus ?tagOrId?\"",
+ (char *) NULL);
+ goto error;
+ }
+ itemPtr = canvasPtr->textInfo.focusItemPtr;
+ if (argc == 2) {
+ if (itemPtr != NULL) {
+ sprintf(interp->result, "%d", itemPtr->id);
+ }
+ goto done;
+ }
+ if ((itemPtr != NULL) && (canvasPtr->textInfo.gotFocus)) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ }
+ if (argv[2][0] == 0) {
+ canvasPtr->textInfo.focusItemPtr = NULL;
+ goto done;
+ }
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ if (itemPtr->typePtr->icursorProc != NULL) {
+ break;
+ }
+ }
+ if (itemPtr == NULL) {
+ goto done;
+ }
+ canvasPtr->textInfo.focusItemPtr = itemPtr;
+ if (canvasPtr->textInfo.gotFocus) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ }
+ } else if ((c == 'g') && (strncmp(argv[1], "gettags", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " gettags tagOrId\"", (char *) NULL);
+ goto error;
+ }
+ itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ if (itemPtr != NULL) {
+ int i;
+ for (i = 0; i < itemPtr->numTags; i++) {
+ Tcl_AppendElement(interp, (char *) itemPtr->tagPtr[i]);
+ }
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "icursor", length) == 0)
+ && (length >= 2)) {
+ int index;
+
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " icursor tagOrId index\"",
+ (char *) NULL);
+ goto error;
+ }
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ if ((itemPtr->typePtr->indexProc == NULL)
+ || (itemPtr->typePtr->icursorProc == NULL)) {
+ goto done;
+ }
+ if ((*itemPtr->typePtr->indexProc)(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, argv[3], &index) != TCL_OK) {
+ goto error;
+ }
+ (*itemPtr->typePtr->icursorProc)((Tk_Canvas) canvasPtr, itemPtr,
+ index);
+ if ((itemPtr == canvasPtr->textInfo.focusItemPtr)
+ && (canvasPtr->textInfo.cursorOn)) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ }
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
+ && (length >= 3)) {
+ int index;
+
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " index tagOrId string\"",
+ (char *) NULL);
+ goto error;
+ }
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ if (itemPtr->typePtr->indexProc != NULL) {
+ break;
+ }
+ }
+ if (itemPtr == NULL) {
+ Tcl_AppendResult(interp, "can't find an indexable item \"",
+ argv[2], "\"", (char *) NULL);
+ goto error;
+ }
+ if ((*itemPtr->typePtr->indexProc)(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, argv[3], &index) != TCL_OK) {
+ goto error;
+ }
+ sprintf(interp->result, "%d", index);
+ } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
+ && (length >= 3)) {
+ int beforeThis;
+
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " insert tagOrId beforeThis string\"",
+ (char *) NULL);
+ goto error;
+ }
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ if ((itemPtr->typePtr->indexProc == NULL)
+ || (itemPtr->typePtr->insertProc == NULL)) {
+ continue;
+ }
+ if ((*itemPtr->typePtr->indexProc)(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, argv[3], &beforeThis) != TCL_OK) {
+ goto error;
+ }
+
+ /*
+ * Redraw both item's old and new areas: it's possible
+ * that an insertion could result in a new area either
+ * larger or smaller than the old area.
+ */
+
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ (*itemPtr->typePtr->insertProc)((Tk_Canvas) canvasPtr,
+ itemPtr, beforeThis, argv[4]);
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, itemPtr->x1,
+ itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "itemcget", length) == 0)
+ && (length >= 6)) {
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " itemcget tagOrId option\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ if (itemPtr != NULL) {
+ result = Tk_ConfigureValue(canvasPtr->interp, canvasPtr->tkwin,
+ itemPtr->typePtr->configSpecs, (char *) itemPtr,
+ argv[3], 0);
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "itemconfigure", length) == 0)
+ && (length >= 6)) {
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " itemconfigure tagOrId ?option value ...?\"",
+ (char *) NULL);
+ goto error;
+ }
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ if (argc == 3) {
+ result = Tk_ConfigureInfo(canvasPtr->interp, canvasPtr->tkwin,
+ itemPtr->typePtr->configSpecs, (char *) itemPtr,
+ (char *) NULL, 0);
+ } else if (argc == 4) {
+ result = Tk_ConfigureInfo(canvasPtr->interp, canvasPtr->tkwin,
+ itemPtr->typePtr->configSpecs, (char *) itemPtr,
+ argv[3], 0);
+ } else {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ result = (*itemPtr->typePtr->configProc)(interp,
+ (Tk_Canvas) canvasPtr, itemPtr, argc-3, argv+3,
+ TK_CONFIG_ARGV_ONLY);
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+ if ((result != TCL_OK) || (argc < 5)) {
+ break;
+ }
+ }
+ } else if ((c == 'l') && (strncmp(argv[1], "lower", length) == 0)) {
+ Tk_Item *prevPtr;
+
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " lower tagOrId ?belowThis?\"",
+ (char *) NULL);
+ goto error;
+ }
+
+ /*
+ * First find the item just after which we'll insert the
+ * named items.
+ */
+
+ if (argc == 3) {
+ prevPtr = NULL;
+ } else {
+ prevPtr = StartTagSearch(canvasPtr, argv[3], &search);
+ if (prevPtr != NULL) {
+ prevPtr = search.prevPtr;
+ } else {
+ Tcl_AppendResult(interp, "tag \"", argv[3],
+ "\" doesn't match any items", (char *) NULL);
+ goto error;
+ }
+ }
+ RelinkItems(canvasPtr, argv[2], prevPtr);
+ } else if ((c == 'm') && (strncmp(argv[1], "move", length) == 0)) {
+ double xAmount, yAmount;
+
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " move tagOrId xAmount yAmount\"",
+ (char *) NULL);
+ goto error;
+ }
+ if ((Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[3],
+ &xAmount) != TCL_OK) || (Tk_CanvasGetCoord(interp,
+ (Tk_Canvas) canvasPtr, argv[4], &yAmount) != TCL_OK)) {
+ goto error;
+ }
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ (void) (*itemPtr->typePtr->translateProc)((Tk_Canvas) canvasPtr,
+ itemPtr, xAmount, yAmount);
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+ } else if ((c == 'p') && (strncmp(argv[1], "postscript", length) == 0)) {
+ result = TkCanvPostscriptCmd(canvasPtr, interp, argc, argv);
+ } else if ((c == 'r') && (strncmp(argv[1], "raise", length) == 0)) {
+ Tk_Item *prevPtr;
+
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " raise tagOrId ?aboveThis?\"",
+ (char *) NULL);
+ goto error;
+ }
+
+ /*
+ * First find the item just after which we'll insert the
+ * named items.
+ */
+
+ if (argc == 3) {
+ prevPtr = canvasPtr->lastItemPtr;
+ } else {
+ prevPtr = NULL;
+ for (itemPtr = StartTagSearch(canvasPtr, argv[3], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ prevPtr = itemPtr;
+ }
+ if (prevPtr == NULL) {
+ Tcl_AppendResult(interp, "tagOrId \"", argv[3],
+ "\" doesn't match any items", (char *) NULL);
+ goto error;
+ }
+ }
+ RelinkItems(canvasPtr, argv[2], prevPtr);
+ } else if ((c == 's') && (strncmp(argv[1], "scale", length) == 0)
+ && (length >= 3)) {
+ double xOrigin, yOrigin, xScale, yScale;
+
+ if (argc != 7) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " scale tagOrId xOrigin yOrigin xScale yScale\"",
+ (char *) NULL);
+ goto error;
+ }
+ if ((Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr,
+ argv[3], &xOrigin) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr,
+ argv[4], &yOrigin) != TCL_OK)
+ || (Tcl_GetDouble(interp, argv[5], &xScale) != TCL_OK)
+ || (Tcl_GetDouble(interp, argv[6], &yScale) != TCL_OK)) {
+ goto error;
+ }
+ if ((xScale == 0.0) || (yScale == 0.0)) {
+ interp->result = "scale factor cannot be zero";
+ goto error;
+ }
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ (void) (*itemPtr->typePtr->scaleProc)((Tk_Canvas) canvasPtr,
+ itemPtr, xOrigin, yOrigin, xScale, yScale);
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+ } else if ((c == 's') && (strncmp(argv[1], "scan", length) == 0)
+ && (length >= 3)) {
+ int x, y;
+
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " scan mark|dragto x y\"", (char *) NULL);
+ goto error;
+ }
+ if ((Tcl_GetInt(interp, argv[3], &x) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[4], &y) != TCL_OK)){
+ goto error;
+ }
+ if ((argv[2][0] == 'm')
+ && (strncmp(argv[2], "mark", strlen(argv[2])) == 0)) {
+ canvasPtr->scanX = x;
+ canvasPtr->scanXOrigin = canvasPtr->xOrigin;
+ canvasPtr->scanY = y;
+ canvasPtr->scanYOrigin = canvasPtr->yOrigin;
+ } else if ((argv[2][0] == 'd')
+ && (strncmp(argv[2], "dragto", strlen(argv[2])) == 0)) {
+ int newXOrigin, newYOrigin, tmp;
+
+ /*
+ * Compute a new view origin for the canvas, amplifying the
+ * mouse motion.
+ */
+
+ tmp = canvasPtr->scanXOrigin - 10*(x - canvasPtr->scanX)
+ - canvasPtr->scrollX1;
+ newXOrigin = canvasPtr->scrollX1 + tmp;
+ tmp = canvasPtr->scanYOrigin - 10*(y - canvasPtr->scanY)
+ - canvasPtr->scrollY1;
+ newYOrigin = canvasPtr->scrollY1 + tmp;
+ CanvasSetOrigin(canvasPtr, newXOrigin, newYOrigin);
+ } else {
+ Tcl_AppendResult(interp, "bad scan option \"", argv[2],
+ "\": must be mark or dragto", (char *) NULL);
+ goto error;
+ }
+ } else if ((c == 's') && (strncmp(argv[1], "select", length) == 0)
+ && (length >= 2)) {
+ int index;
+
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " select option ?tagOrId? ?arg?\"", (char *) NULL);
+ goto error;
+ }
+ if (argc >= 4) {
+ for (itemPtr = StartTagSearch(canvasPtr, argv[3], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ if ((itemPtr->typePtr->indexProc != NULL)
+ && (itemPtr->typePtr->selectionProc != NULL)){
+ break;
+ }
+ }
+ if (itemPtr == NULL) {
+ Tcl_AppendResult(interp,
+ "can't find an indexable and selectable item \"",
+ argv[3], "\"", (char *) NULL);
+ goto error;
+ }
+ }
+ if (argc == 5) {
+ if ((*itemPtr->typePtr->indexProc)(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, argv[4], &index) != TCL_OK) {
+ goto error;
+ }
+ }
+ length = strlen(argv[2]);
+ c = argv[2][0];
+ if ((c == 'a') && (strncmp(argv[2], "adjust", length) == 0)) {
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " select adjust tagOrId index\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (canvasPtr->textInfo.selItemPtr == itemPtr) {
+ if (index < (canvasPtr->textInfo.selectFirst
+ + canvasPtr->textInfo.selectLast)/2) {
+ canvasPtr->textInfo.selectAnchor =
+ canvasPtr->textInfo.selectLast + 1;
+ } else {
+ canvasPtr->textInfo.selectAnchor =
+ canvasPtr->textInfo.selectFirst;
+ }
+ }
+ CanvasSelectTo(canvasPtr, itemPtr, index);
+ } else if ((c == 'c') && (argv[2] != NULL)
+ && (strncmp(argv[2], "clear", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " select clear\"", (char *) NULL);
+ goto error;
+ }
+ if (canvasPtr->textInfo.selItemPtr != NULL) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.selItemPtr->x1,
+ canvasPtr->textInfo.selItemPtr->y1,
+ canvasPtr->textInfo.selItemPtr->x2,
+ canvasPtr->textInfo.selItemPtr->y2);
+ canvasPtr->textInfo.selItemPtr = NULL;
+ }
+ goto done;
+ } else if ((c == 'f') && (strncmp(argv[2], "from", length) == 0)) {
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " select from tagOrId index\"",
+ (char *) NULL);
+ goto error;
+ }
+ canvasPtr->textInfo.anchorItemPtr = itemPtr;
+ canvasPtr->textInfo.selectAnchor = index;
+ } else if ((c == 'i') && (strncmp(argv[2], "item", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " select item\"", (char *) NULL);
+ goto error;
+ }
+ if (canvasPtr->textInfo.selItemPtr != NULL) {
+ sprintf(interp->result, "%d",
+ canvasPtr->textInfo.selItemPtr->id);
+ }
+ } else if ((c == 't') && (strncmp(argv[2], "to", length) == 0)) {
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " select to tagOrId index\"",
+ (char *) NULL);
+ goto error;
+ }
+ CanvasSelectTo(canvasPtr, itemPtr, index);
+ } else {
+ Tcl_AppendResult(interp, "bad select option \"", argv[2],
+ "\": must be adjust, clear, from, item, or to",
+ (char *) NULL);
+ goto error;
+ }
+ } else if ((c == 't') && (strncmp(argv[1], "type", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " type tag\"", (char *) NULL);
+ goto error;
+ }
+ itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ if (itemPtr != NULL) {
+ interp->result = itemPtr->typePtr->name;
+ }
+ } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) {
+ int count, type;
+ int newX = 0; /* Initialization needed only to prevent
+ * gcc warnings. */
+ double fraction;
+
+ if (argc == 2) {
+ PrintScrollFractions(canvasPtr->xOrigin + canvasPtr->inset,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin)
+ - canvasPtr->inset, canvasPtr->scrollX1,
+ canvasPtr->scrollX2, interp->result);
+ } else {
+ type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ goto error;
+ case TK_SCROLL_MOVETO:
+ newX = canvasPtr->scrollX1 - canvasPtr->inset
+ + (int) (fraction * (canvasPtr->scrollX2
+ - canvasPtr->scrollX1) + 0.5);
+ break;
+ case TK_SCROLL_PAGES:
+ newX = (int) (canvasPtr->xOrigin + count * .9
+ * (Tk_Width(canvasPtr->tkwin) - 2*canvasPtr->inset));
+ break;
+ case TK_SCROLL_UNITS:
+ if (canvasPtr->xScrollIncrement > 0) {
+ newX = canvasPtr->xOrigin
+ + count*canvasPtr->xScrollIncrement;
+ } else {
+ newX = (int) (canvasPtr->xOrigin + count * .1
+ * (Tk_Width(canvasPtr->tkwin)
+ - 2*canvasPtr->inset));
+ }
+ break;
+ }
+ CanvasSetOrigin(canvasPtr, newX, canvasPtr->yOrigin);
+ }
+ } else if ((c == 'y') && (strncmp(argv[1], "yview", length) == 0)) {
+ int count, type;
+ int newY = 0; /* Initialization needed only to prevent
+ * gcc warnings. */
+ double fraction;
+
+ if (argc == 2) {
+ PrintScrollFractions(canvasPtr->yOrigin + canvasPtr->inset,
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin)
+ - canvasPtr->inset, canvasPtr->scrollY1,
+ canvasPtr->scrollY2, interp->result);
+ } else {
+ type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ goto error;
+ case TK_SCROLL_MOVETO:
+ newY = canvasPtr->scrollY1 - canvasPtr->inset
+ + (int) (fraction*(canvasPtr->scrollY2
+ - canvasPtr->scrollY1) + 0.5);
+ break;
+ case TK_SCROLL_PAGES:
+ newY = (int) (canvasPtr->yOrigin + count * .9
+ * (Tk_Height(canvasPtr->tkwin)
+ - 2*canvasPtr->inset));
+ break;
+ case TK_SCROLL_UNITS:
+ if (canvasPtr->yScrollIncrement > 0) {
+ newY = canvasPtr->yOrigin
+ + count*canvasPtr->yScrollIncrement;
+ } else {
+ newY = (int) (canvasPtr->yOrigin + count * .1
+ * (Tk_Height(canvasPtr->tkwin)
+ - 2*canvasPtr->inset));
+ }
+ break;
+ }
+ CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, newY);
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be addtag, bbox, bind, ",
+ "canvasx, canvasy, cget, configure, coords, create, ",
+ "dchars, delete, dtag, find, focus, ",
+ "gettags, icursor, index, insert, itemcget, itemconfigure, ",
+ "lower, move, postscript, raise, scale, scan, ",
+ "select, type, xview, or yview",
+ (char *) NULL);
+ goto error;
+ }
+ done:
+ Tcl_Release((ClientData) canvasPtr);
+ return result;
+
+ error:
+ Tcl_Release((ClientData) canvasPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyCanvas --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a canvas at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the canvas is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyCanvas(memPtr)
+ char *memPtr; /* Info about canvas widget. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) memPtr;
+ Tk_Item *itemPtr;
+
+ /*
+ * Free up all of the items in the canvas.
+ */
+
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = canvasPtr->firstItemPtr) {
+ canvasPtr->firstItemPtr = itemPtr->nextPtr;
+ (*itemPtr->typePtr->deleteProc)((Tk_Canvas) canvasPtr, itemPtr,
+ canvasPtr->display);
+ if (itemPtr->tagPtr != itemPtr->staticTagSpace) {
+ ckfree((char *) itemPtr->tagPtr);
+ }
+ ckfree((char *) itemPtr);
+ }
+
+ /*
+ * Free up all the stuff that requires special handling,
+ * then let Tk_FreeOptions handle all the standard option-related
+ * stuff.
+ */
+
+ if (canvasPtr->pixmapGC != None) {
+ Tk_FreeGC(canvasPtr->display, canvasPtr->pixmapGC);
+ }
+ Tcl_DeleteTimerHandler(canvasPtr->insertBlinkHandler);
+ if (canvasPtr->bindingTable != NULL) {
+ Tk_DeleteBindingTable(canvasPtr->bindingTable);
+ }
+ Tk_FreeOptions(configSpecs, (char *) canvasPtr, canvasPtr->display, 0);
+ ckfree((char *) canvasPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureCanvas --
+ *
+ * This procedure is called to process an argv/argc list, plus
+ * the Tk option database, in order to configure (or
+ * reconfigure) a canvas widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then interp->result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width,
+ * etc. get set for canvasPtr; old resources get freed,
+ * if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureCanvas(interp, canvasPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ TkCanvas *canvasPtr; /* Information about widget; may or may
+ * not already have values for some fields. */
+ int argc; /* Number of valid entries in argv. */
+ char **argv; /* Arguments. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ XGCValues gcValues;
+ GC new;
+
+ if (Tk_ConfigureWidget(interp, canvasPtr->tkwin, configSpecs,
+ argc, argv, (char *) canvasPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few options need special processing, such as setting the
+ * background from a 3-D border and creating a GC for copying
+ * bits to the screen.
+ */
+
+ Tk_SetBackgroundFromBorder(canvasPtr->tkwin, canvasPtr->bgBorder);
+
+ if (canvasPtr->highlightWidth < 0) {
+ canvasPtr->highlightWidth = 0;
+ }
+ canvasPtr->inset = canvasPtr->borderWidth + canvasPtr->highlightWidth;
+
+ gcValues.function = GXcopy;
+ gcValues.foreground = Tk_3DBorderColor(canvasPtr->bgBorder)->pixel;
+ gcValues.graphics_exposures = False;
+ new = Tk_GetGC(canvasPtr->tkwin,
+ GCFunction|GCForeground|GCGraphicsExposures, &gcValues);
+ if (canvasPtr->pixmapGC != None) {
+ Tk_FreeGC(canvasPtr->display, canvasPtr->pixmapGC);
+ }
+ canvasPtr->pixmapGC = new;
+
+ /*
+ * Reset the desired dimensions for the window.
+ */
+
+ Tk_GeometryRequest(canvasPtr->tkwin, canvasPtr->width + 2*canvasPtr->inset,
+ canvasPtr->height + 2*canvasPtr->inset);
+
+ /*
+ * Restart the cursor timing sequence in case the on-time or off-time
+ * just changed.
+ */
+
+ if (canvasPtr->textInfo.gotFocus) {
+ CanvasFocusProc(canvasPtr, 1);
+ }
+
+ /*
+ * Recompute the scroll region.
+ */
+
+ canvasPtr->scrollX1 = 0;
+ canvasPtr->scrollY1 = 0;
+ canvasPtr->scrollX2 = 0;
+ canvasPtr->scrollY2 = 0;
+ if (canvasPtr->regionString != NULL) {
+ int argc2;
+ char **argv2;
+
+ if (Tcl_SplitList(canvasPtr->interp, canvasPtr->regionString,
+ &argc2, &argv2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (argc2 != 4) {
+ Tcl_AppendResult(interp, "bad scrollRegion \"",
+ canvasPtr->regionString, "\"", (char *) NULL);
+ badRegion:
+ ckfree(canvasPtr->regionString);
+ ckfree((char *) argv2);
+ canvasPtr->regionString = NULL;
+ return TCL_ERROR;
+ }
+ if ((Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
+ argv2[0], &canvasPtr->scrollX1) != TCL_OK)
+ || (Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
+ argv2[1], &canvasPtr->scrollY1) != TCL_OK)
+ || (Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
+ argv2[2], &canvasPtr->scrollX2) != TCL_OK)
+ || (Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
+ argv2[3], &canvasPtr->scrollY2) != TCL_OK)) {
+ goto badRegion;
+ }
+ ckfree((char *) argv2);
+ }
+
+ /*
+ * Reset the canvas's origin (this is a no-op unless confine
+ * mode has just been turned on or the scroll region has changed).
+ */
+
+ CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, canvasPtr->yOrigin);
+ canvasPtr->flags |= UPDATE_SCROLLBARS|REDRAW_BORDERS;
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->xOrigin, canvasPtr->yOrigin,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * CanvasWorldChanged --
+ *
+ * This procedure is called when the world has changed in some
+ * way and the widget needs to recompute all its graphics contexts
+ * and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Configures all items in the canvas with a empty argc/argv, for
+ * the side effect of causing all the items to recompute their
+ * geometry and to be redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+CanvasWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ TkCanvas *canvasPtr;
+ Tk_Item *itemPtr;
+ int result;
+
+ canvasPtr = (TkCanvas *) instanceData;
+ itemPtr = canvasPtr->firstItemPtr;
+ for ( ; itemPtr != NULL; itemPtr = itemPtr->nextPtr) {
+ result = (*itemPtr->typePtr->configProc)(canvasPtr->interp,
+ (Tk_Canvas) canvasPtr, itemPtr, 0, NULL,
+ TK_CONFIG_ARGV_ONLY);
+ if (result != TCL_OK) {
+ Tcl_ResetResult(canvasPtr->interp);
+ }
+ }
+ canvasPtr->flags |= REPICK_NEEDED;
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->xOrigin, canvasPtr->yOrigin,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayCanvas --
+ *
+ * This procedure redraws the contents of a canvas window.
+ * It is invoked as a do-when-idle handler, so it only runs
+ * when there's nothing else for the application to do.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayCanvas(clientData)
+ ClientData clientData; /* Information about widget. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+ Tk_Window tkwin = canvasPtr->tkwin;
+ Tk_Item *itemPtr;
+ Pixmap pixmap;
+ int screenX1, screenX2, screenY1, screenY2, width, height;
+
+ if (canvasPtr->tkwin == NULL) {
+ return;
+ }
+ if (!Tk_IsMapped(tkwin)) {
+ goto done;
+ }
+
+ /*
+ * Choose a new current item if that is needed (this could cause
+ * event handlers to be invoked).
+ */
+
+ while (canvasPtr->flags & REPICK_NEEDED) {
+ Tcl_Preserve((ClientData) canvasPtr);
+ canvasPtr->flags &= ~REPICK_NEEDED;
+ PickCurrentItem(canvasPtr, &canvasPtr->pickEvent);
+ tkwin = canvasPtr->tkwin;
+ Tcl_Release((ClientData) canvasPtr);
+ if (tkwin == NULL) {
+ return;
+ }
+ }
+
+ /*
+ * Compute the intersection between the area that needs redrawing
+ * and the area that's visible on the screen.
+ */
+
+ if ((canvasPtr->redrawX1 < canvasPtr->redrawX2)
+ && (canvasPtr->redrawY1 < canvasPtr->redrawY2)) {
+ screenX1 = canvasPtr->xOrigin + canvasPtr->inset;
+ screenY1 = canvasPtr->yOrigin + canvasPtr->inset;
+ screenX2 = canvasPtr->xOrigin + Tk_Width(tkwin) - canvasPtr->inset;
+ screenY2 = canvasPtr->yOrigin + Tk_Height(tkwin) - canvasPtr->inset;
+ if (canvasPtr->redrawX1 > screenX1) {
+ screenX1 = canvasPtr->redrawX1;
+ }
+ if (canvasPtr->redrawY1 > screenY1) {
+ screenY1 = canvasPtr->redrawY1;
+ }
+ if (canvasPtr->redrawX2 < screenX2) {
+ screenX2 = canvasPtr->redrawX2;
+ }
+ if (canvasPtr->redrawY2 < screenY2) {
+ screenY2 = canvasPtr->redrawY2;
+ }
+ if ((screenX1 >= screenX2) || (screenY1 >= screenY2)) {
+ goto borders;
+ }
+
+ /*
+ * Redrawing is done in a temporary pixmap that is allocated
+ * here and freed at the end of the procedure. All drawing
+ * is done to the pixmap, and the pixmap is copied to the
+ * screen at the end of the procedure. The temporary pixmap
+ * serves two purposes:
+ *
+ * 1. It provides a smoother visual effect (no clearing and
+ * gradual redraw will be visible to users).
+ * 2. It allows us to redraw only the objects that overlap
+ * the redraw area. Otherwise incorrect results could
+ * occur from redrawing things that stick outside of
+ * the redraw area (we'd have to redraw everything in
+ * order to make the overlaps look right).
+ *
+ * Some tricky points about the pixmap:
+ *
+ * 1. We only allocate a large enough pixmap to hold the
+ * area that has to be redisplayed. This saves time in
+ * in the X server for large objects that cover much
+ * more than the area being redisplayed: only the area
+ * of the pixmap will actually have to be redrawn.
+ * 2. Some X servers (e.g. the one for DECstations) have troubles
+ * with characters that overlap an edge of the pixmap (on the
+ * DEC servers, as of 8/18/92, such characters are drawn one
+ * pixel too far to the right). To handle this problem,
+ * make the pixmap a bit larger than is absolutely needed
+ * so that for normal-sized fonts the characters that overlap
+ * the edge of the pixmap will be outside the area we care
+ * about.
+ */
+
+ canvasPtr->drawableXOrigin = screenX1 - 30;
+ canvasPtr->drawableYOrigin = screenY1 - 30;
+ pixmap = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
+ (screenX2 + 30 - canvasPtr->drawableXOrigin),
+ (screenY2 + 30 - canvasPtr->drawableYOrigin),
+ Tk_Depth(tkwin));
+
+ /*
+ * Clear the area to be redrawn.
+ */
+
+ width = screenX2 - screenX1;
+ height = screenY2 - screenY1;
+
+ XFillRectangle(Tk_Display(tkwin), pixmap, canvasPtr->pixmapGC,
+ screenX1 - canvasPtr->drawableXOrigin,
+ screenY1 - canvasPtr->drawableYOrigin, (unsigned int) width,
+ (unsigned int) height);
+
+ /*
+ * Scan through the item list, redrawing those items that need it.
+ * An item must be redraw if either (a) it intersects the smaller
+ * on-screen area or (b) it intersects the full canvas area and its
+ * type requests that it be redrawn always (e.g. so subwindows can
+ * be unmapped when they move off-screen).
+ */
+
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if ((itemPtr->x1 >= screenX2)
+ || (itemPtr->y1 >= screenY2)
+ || (itemPtr->x2 < screenX1)
+ || (itemPtr->y2 < screenY1)) {
+ if (!itemPtr->typePtr->alwaysRedraw
+ || (itemPtr->x1 >= canvasPtr->redrawX2)
+ || (itemPtr->y1 >= canvasPtr->redrawY2)
+ || (itemPtr->x2 < canvasPtr->redrawX1)
+ || (itemPtr->y2 < canvasPtr->redrawY1)) {
+ continue;
+ }
+ }
+ (*itemPtr->typePtr->displayProc)((Tk_Canvas) canvasPtr, itemPtr,
+ canvasPtr->display, pixmap, screenX1, screenY1, width,
+ height);
+ }
+
+ /*
+ * Copy from the temporary pixmap to the screen, then free up
+ * the temporary pixmap.
+ */
+
+ XCopyArea(Tk_Display(tkwin), pixmap, Tk_WindowId(tkwin),
+ canvasPtr->pixmapGC,
+ screenX1 - canvasPtr->drawableXOrigin,
+ screenY1 - canvasPtr->drawableYOrigin,
+ (unsigned) (screenX2 - screenX1),
+ (unsigned) (screenY2 - screenY1),
+ screenX1 - canvasPtr->xOrigin, screenY1 - canvasPtr->yOrigin);
+ Tk_FreePixmap(Tk_Display(tkwin), pixmap);
+ }
+
+ /*
+ * Draw the window borders, if needed.
+ */
+
+ borders:
+ if (canvasPtr->flags & REDRAW_BORDERS) {
+ canvasPtr->flags &= ~REDRAW_BORDERS;
+ if (canvasPtr->borderWidth > 0) {
+ Tk_Draw3DRectangle(tkwin, Tk_WindowId(tkwin),
+ canvasPtr->bgBorder, canvasPtr->highlightWidth,
+ canvasPtr->highlightWidth,
+ Tk_Width(tkwin) - 2*canvasPtr->highlightWidth,
+ Tk_Height(tkwin) - 2*canvasPtr->highlightWidth,
+ canvasPtr->borderWidth, canvasPtr->relief);
+ }
+ if (canvasPtr->highlightWidth != 0) {
+ GC gc;
+
+ if (canvasPtr->textInfo.gotFocus) {
+ gc = Tk_GCForColor(canvasPtr->highlightColorPtr,
+ Tk_WindowId(tkwin));
+ } else {
+ gc = Tk_GCForColor(canvasPtr->highlightBgColorPtr,
+ Tk_WindowId(tkwin));
+ }
+ Tk_DrawFocusHighlight(tkwin, gc, canvasPtr->highlightWidth,
+ Tk_WindowId(tkwin));
+ }
+ }
+
+ done:
+ canvasPtr->flags &= ~REDRAW_PENDING;
+ canvasPtr->redrawX1 = canvasPtr->redrawX2 = 0;
+ canvasPtr->redrawY1 = canvasPtr->redrawY2 = 0;
+ if (canvasPtr->flags & UPDATE_SCROLLBARS) {
+ CanvasUpdateScrollbars(canvasPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on canvases.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CanvasEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+
+ if (eventPtr->type == Expose) {
+ int x, y;
+
+ x = eventPtr->xexpose.x + canvasPtr->xOrigin;
+ y = eventPtr->xexpose.y + canvasPtr->yOrigin;
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, x, y,
+ x + eventPtr->xexpose.width,
+ y + eventPtr->xexpose.height);
+ if ((eventPtr->xexpose.x < canvasPtr->inset)
+ || (eventPtr->xexpose.y < canvasPtr->inset)
+ || ((eventPtr->xexpose.x + eventPtr->xexpose.width)
+ > (Tk_Width(canvasPtr->tkwin) - canvasPtr->inset))
+ || ((eventPtr->xexpose.y + eventPtr->xexpose.height)
+ > (Tk_Height(canvasPtr->tkwin) - canvasPtr->inset))) {
+ canvasPtr->flags |= REDRAW_BORDERS;
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ if (canvasPtr->tkwin != NULL) {
+ canvasPtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(canvasPtr->interp,
+ canvasPtr->widgetCmd);
+ }
+ if (canvasPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayCanvas, (ClientData) canvasPtr);
+ }
+ Tcl_EventuallyFree((ClientData) canvasPtr, DestroyCanvas);
+ } else if (eventPtr->type == ConfigureNotify) {
+ canvasPtr->flags |= UPDATE_SCROLLBARS;
+
+ /*
+ * The call below is needed in order to recenter the canvas if
+ * it's confined and its scroll region is smaller than the window.
+ */
+
+ CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, canvasPtr->yOrigin);
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, canvasPtr->xOrigin,
+ canvasPtr->yOrigin,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
+ canvasPtr->flags |= REDRAW_BORDERS;
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ CanvasFocusProc(canvasPtr, 1);
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ CanvasFocusProc(canvasPtr, 0);
+ }
+ } else if (eventPtr->type == UnmapNotify) {
+ Tk_Item *itemPtr;
+
+ /*
+ * Special hack: if the canvas is unmapped, then must notify
+ * all items with "alwaysRedraw" set, so that they know that
+ * they are no longer displayed.
+ */
+
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if (itemPtr->typePtr->alwaysRedraw) {
+ (*itemPtr->typePtr->displayProc)((Tk_Canvas) canvasPtr,
+ itemPtr, canvasPtr->display, None, 0, 0, 0, 0);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasCmdDeletedProc --
+ *
+ * This procedure is invoked when a widget command is deleted. If
+ * the widget isn't already in the process of being destroyed,
+ * this command destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CanvasCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+ Tk_Window tkwin = canvasPtr->tkwin;
+
+ /*
+ * This procedure could be invoked either because the window was
+ * destroyed and the command was then deleted (in which case tkwin
+ * is NULL) or because the command was deleted, and then this procedure
+ * destroys the widget.
+ */
+
+ if (tkwin != NULL) {
+ canvasPtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasEventuallyRedraw --
+ *
+ * Arrange for part or all of a canvas widget to redrawn at
+ * some convenient time in the future.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The screen will eventually be refreshed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CanvasEventuallyRedraw(canvas, x1, y1, x2, y2)
+ Tk_Canvas canvas; /* Information about widget. */
+ int x1, y1; /* Upper left corner of area to redraw.
+ * Pixels on edge are redrawn. */
+ int x2, y2; /* Lower right corner of area to redraw.
+ * Pixels on edge are not redrawn. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ if ((x1 == x2) || (y1 == y2)) {
+ return;
+ }
+ if (canvasPtr->flags & REDRAW_PENDING) {
+ if (x1 <= canvasPtr->redrawX1) {
+ canvasPtr->redrawX1 = x1;
+ }
+ if (y1 <= canvasPtr->redrawY1) {
+ canvasPtr->redrawY1 = y1;
+ }
+ if (x2 >= canvasPtr->redrawX2) {
+ canvasPtr->redrawX2 = x2;
+ }
+ if (y2 >= canvasPtr->redrawY2) {
+ canvasPtr->redrawY2 = y2;
+ }
+ } else {
+ canvasPtr->redrawX1 = x1;
+ canvasPtr->redrawY1 = y1;
+ canvasPtr->redrawX2 = x2;
+ canvasPtr->redrawY2 = y2;
+ Tcl_DoWhenIdle(DisplayCanvas, (ClientData) canvasPtr);
+ canvasPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateItemType --
+ *
+ * This procedure may be invoked to add a new kind of canvas
+ * element to the core item types supported by Tk.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * From now on, the new item type will be useable in canvas
+ * widgets (e.g. typePtr->name can be used as the item type
+ * in "create" widget commands). If there was already a
+ * type with the same name as in typePtr, it is replaced with
+ * the new type.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CreateItemType(typePtr)
+ Tk_ItemType *typePtr; /* Information about item type;
+ * storage must be statically
+ * allocated (must live forever). */
+{
+ Tk_ItemType *typePtr2, *prevPtr;
+
+ if (typeList == NULL) {
+ InitCanvas();
+ }
+
+ /*
+ * If there's already an item type with the given name, remove it.
+ */
+
+ for (typePtr2 = typeList, prevPtr = NULL; typePtr2 != NULL;
+ prevPtr = typePtr2, typePtr2 = typePtr2->nextPtr) {
+ if (strcmp(typePtr2->name, typePtr->name) == 0) {
+ if (prevPtr == NULL) {
+ typeList = typePtr2->nextPtr;
+ } else {
+ prevPtr->nextPtr = typePtr2->nextPtr;
+ }
+ break;
+ }
+ }
+ typePtr->nextPtr = typeList;
+ typeList = typePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetItemTypes --
+ *
+ * This procedure returns a pointer to the list of all item
+ * types.
+ *
+ * Results:
+ * The return value is a pointer to the first in the list
+ * of item types currently supported by canvases.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_ItemType *
+Tk_GetItemTypes()
+{
+ if (typeList == NULL) {
+ InitCanvas();
+ }
+ return typeList;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * InitCanvas --
+ *
+ * This procedure is invoked to perform once-only-ever
+ * initialization for the module, such as setting up
+ * the type table.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+InitCanvas()
+{
+ if (typeList != NULL) {
+ return;
+ }
+ typeList = &tkRectangleType;
+ tkRectangleType.nextPtr = &tkTextType;
+ tkTextType.nextPtr = &tkLineType;
+ tkLineType.nextPtr = &tkPolygonType;
+ tkPolygonType.nextPtr = &tkImageType;
+ tkImageType.nextPtr = &tkOvalType;
+ tkOvalType.nextPtr = &tkBitmapType;
+ tkBitmapType.nextPtr = &tkArcType;
+ tkArcType.nextPtr = &tkWindowType;
+ tkWindowType.nextPtr = NULL;
+ allUid = Tk_GetUid("all");
+ currentUid = Tk_GetUid("current");
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * StartTagSearch --
+ *
+ * This procedure is called to initiate an enumeration of
+ * all items in a given canvas that contain a given tag.
+ *
+ * Results:
+ * The return value is a pointer to the first item in
+ * canvasPtr that matches tag, or NULL if there is no
+ * such item. The information at *searchPtr is initialized
+ * such that successive calls to NextItem will return
+ * successive items that match tag.
+ *
+ * Side effects:
+ * SearchPtr is linked into a list of searches in progress
+ * on canvasPtr, so that elements can safely be deleted
+ * while the search is in progress. EndTagSearch must be
+ * called at the end of the search to unlink searchPtr from
+ * this list.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Tk_Item *
+StartTagSearch(canvasPtr, tag, searchPtr)
+ TkCanvas *canvasPtr; /* Canvas whose items are to be
+ * searched. */
+ char *tag; /* String giving tag value. */
+ TagSearch *searchPtr; /* Record describing tag search;
+ * will be initialized here. */
+{
+ int id;
+ Tk_Item *itemPtr, *prevPtr;
+ Tk_Uid *tagPtr;
+ Tk_Uid uid;
+ int count;
+
+ /*
+ * Initialize the search.
+ */
+
+ searchPtr->canvasPtr = canvasPtr;
+ searchPtr->searchOver = 0;
+
+ /*
+ * Find the first matching item in one of several ways. If the tag
+ * is a number then it selects the single item with the matching
+ * identifier. In this case see if the item being requested is the
+ * hot item, in which case the search can be skipped.
+ */
+
+ if (isdigit(UCHAR(*tag))) {
+ char *end;
+
+ numIdSearches++;
+ id = strtoul(tag, &end, 0);
+ if (*end == 0) {
+ itemPtr = canvasPtr->hotPtr;
+ prevPtr = canvasPtr->hotPrevPtr;
+ if ((itemPtr == NULL) || (itemPtr->id != id) || (prevPtr == NULL)
+ || (prevPtr->nextPtr != itemPtr)) {
+ numSlowSearches++;
+ for (prevPtr = NULL, itemPtr = canvasPtr->firstItemPtr;
+ itemPtr != NULL;
+ prevPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
+ if (itemPtr->id == id) {
+ break;
+ }
+ }
+ }
+ searchPtr->prevPtr = prevPtr;
+ searchPtr->searchOver = 1;
+ canvasPtr->hotPtr = itemPtr;
+ canvasPtr->hotPrevPtr = prevPtr;
+ return itemPtr;
+ }
+ }
+
+ searchPtr->tag = uid = Tk_GetUid(tag);
+ if (uid == allUid) {
+
+ /*
+ * All items match.
+ */
+
+ searchPtr->tag = NULL;
+ searchPtr->prevPtr = NULL;
+ searchPtr->currentPtr = canvasPtr->firstItemPtr;
+ return canvasPtr->firstItemPtr;
+ }
+
+ /*
+ * None of the above. Search for an item with a matching tag.
+ */
+
+ for (prevPtr = NULL, itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ prevPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
+ for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
+ count > 0; tagPtr++, count--) {
+ if (*tagPtr == uid) {
+ searchPtr->prevPtr = prevPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+ }
+ }
+ searchPtr->prevPtr = prevPtr;
+ searchPtr->searchOver = 1;
+ return NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * NextItem --
+ *
+ * This procedure returns successive items that match a given
+ * tag; it should be called only after StartTagSearch has been
+ * used to begin a search.
+ *
+ * Results:
+ * The return value is a pointer to the next item that matches
+ * the tag specified to StartTagSearch, or NULL if no such
+ * item exists. *SearchPtr is updated so that the next call
+ * to this procedure will return the next item.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Tk_Item *
+NextItem(searchPtr)
+ TagSearch *searchPtr; /* Record describing search in
+ * progress. */
+{
+ Tk_Item *itemPtr, *prevPtr;
+ int count;
+ Tk_Uid uid;
+ Tk_Uid *tagPtr;
+
+ /*
+ * Find next item in list (this may not actually be a suitable
+ * one to return), and return if there are no items left.
+ */
+
+ prevPtr = searchPtr->prevPtr;
+ if (prevPtr == NULL) {
+ itemPtr = searchPtr->canvasPtr->firstItemPtr;
+ } else {
+ itemPtr = prevPtr->nextPtr;
+ }
+ if ((itemPtr == NULL) || (searchPtr->searchOver)) {
+ searchPtr->searchOver = 1;
+ return NULL;
+ }
+ if (itemPtr != searchPtr->currentPtr) {
+ /*
+ * The structure of the list has changed. Probably the
+ * previously-returned item was removed from the list.
+ * In this case, don't advance prevPtr; just return
+ * its new successor (i.e. do nothing here).
+ */
+ } else {
+ prevPtr = itemPtr;
+ itemPtr = prevPtr->nextPtr;
+ }
+
+ /*
+ * Handle special case of "all" search by returning next item.
+ */
+
+ uid = searchPtr->tag;
+ if (uid == NULL) {
+ searchPtr->prevPtr = prevPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+
+ /*
+ * Look for an item with a particular tag.
+ */
+
+ for ( ; itemPtr != NULL; prevPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
+ for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
+ count > 0; tagPtr++, count--) {
+ if (*tagPtr == uid) {
+ searchPtr->prevPtr = prevPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+ }
+ }
+ searchPtr->prevPtr = prevPtr;
+ searchPtr->searchOver = 1;
+ return NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DoItem --
+ *
+ * This is a utility procedure called by FindItems. It
+ * either adds itemPtr's id to the result forming in interp,
+ * or it adds a new tag to itemPtr, depending on the value
+ * of tag.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If tag is NULL then itemPtr's id is added as a list element
+ * to interp->result; otherwise tag is added to itemPtr's
+ * list of tags.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DoItem(interp, itemPtr, tag)
+ Tcl_Interp *interp; /* Interpreter in which to (possibly)
+ * record item id. */
+ Tk_Item *itemPtr; /* Item to (possibly) modify. */
+ Tk_Uid tag; /* Tag to add to those already
+ * present for item, or NULL. */
+{
+ Tk_Uid *tagPtr;
+ int count;
+
+ /*
+ * Handle the "add-to-result" case and return, if appropriate.
+ */
+
+ if (tag == NULL) {
+ char msg[30];
+ sprintf(msg, "%d", itemPtr->id);
+ Tcl_AppendElement(interp, msg);
+ return;
+ }
+
+ for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
+ count > 0; tagPtr++, count--) {
+ if (tag == *tagPtr) {
+ return;
+ }
+ }
+
+ /*
+ * Grow the tag space if there's no more room left in the current
+ * block.
+ */
+
+ if (itemPtr->tagSpace == itemPtr->numTags) {
+ Tk_Uid *newTagPtr;
+
+ itemPtr->tagSpace += 5;
+ newTagPtr = (Tk_Uid *) ckalloc((unsigned)
+ (itemPtr->tagSpace * sizeof(Tk_Uid)));
+ memcpy((VOID *) newTagPtr, (VOID *) itemPtr->tagPtr,
+ (itemPtr->numTags * sizeof(Tk_Uid)));
+ if (itemPtr->tagPtr != itemPtr->staticTagSpace) {
+ ckfree((char *) itemPtr->tagPtr);
+ }
+ itemPtr->tagPtr = newTagPtr;
+ tagPtr = &itemPtr->tagPtr[itemPtr->numTags];
+ }
+
+ /*
+ * Add in the new tag.
+ */
+
+ *tagPtr = tag;
+ itemPtr->numTags++;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FindItems --
+ *
+ * This procedure does all the work of implementing the
+ * "find" and "addtag" options of the canvas widget command,
+ * which locate items that have certain features (location,
+ * tags, position in display list, etc.).
+ *
+ * Results:
+ * A standard Tcl return value. If newTag is NULL, then a
+ * list of ids from all the items that match argc/argv is
+ * returned in interp->result. If newTag is NULL, then
+ * the normal interp->result is an empty string. If an error
+ * occurs, then interp->result will hold an error message.
+ *
+ * Side effects:
+ * If newTag is non-NULL, then all the items that match the
+ * information in argc/argv have that tag added to their
+ * lists of tags.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+FindItems(interp, canvasPtr, argc, argv, newTag, cmdName, option)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ TkCanvas *canvasPtr; /* Canvas whose items are to be
+ * searched. */
+ int argc; /* Number of entries in argv. Must be
+ * greater than zero. */
+ char **argv; /* Arguments that describe what items
+ * to search for (see user doc on
+ * "find" and "addtag" options). */
+ char *newTag; /* If non-NULL, gives new tag to set
+ * on all found items; if NULL, then
+ * ids of found items are returned
+ * in interp->result. */
+ char *cmdName; /* Name of original Tcl command, for
+ * use in error messages. */
+ char *option; /* For error messages: gives option
+ * from Tcl command and other stuff
+ * up to what's in argc/argv. */
+{
+ int c;
+ size_t length;
+ TagSearch search;
+ Tk_Item *itemPtr;
+ Tk_Uid uid;
+
+ if (newTag != NULL) {
+ uid = Tk_GetUid(newTag);
+ } else {
+ uid = NULL;
+ }
+ c = argv[0][0];
+ length = strlen(argv[0]);
+ if ((c == 'a') && (strncmp(argv[0], "above", length) == 0)
+ && (length >= 2)) {
+ Tk_Item *lastPtr = NULL;
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ cmdName, option, " above tagOrId", (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (itemPtr = StartTagSearch(canvasPtr, argv[1], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ lastPtr = itemPtr;
+ }
+ if ((lastPtr != NULL) && (lastPtr->nextPtr != NULL)) {
+ DoItem(interp, lastPtr->nextPtr, uid);
+ }
+ } else if ((c == 'a') && (strncmp(argv[0], "all", length) == 0)
+ && (length >= 2)) {
+ if (argc != 1) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ cmdName, option, " all", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ DoItem(interp, itemPtr, uid);
+ }
+ } else if ((c == 'b') && (strncmp(argv[0], "below", length) == 0)) {
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ cmdName, option, " below tagOrId", (char *) NULL);
+ return TCL_ERROR;
+ }
+ (void) StartTagSearch(canvasPtr, argv[1], &search);
+ if (search.prevPtr != NULL) {
+ DoItem(interp, search.prevPtr, uid);
+ }
+ } else if ((c == 'c') && (strncmp(argv[0], "closest", length) == 0)) {
+ double closestDist;
+ Tk_Item *startPtr, *closestPtr;
+ double coords[2], halo;
+ int x1, y1, x2, y2;
+
+ if ((argc < 3) || (argc > 5)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ cmdName, option, " closest x y ?halo? ?start?",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ((Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[1],
+ &coords[0]) != TCL_OK) || (Tk_CanvasGetCoord(interp,
+ (Tk_Canvas) canvasPtr, argv[2], &coords[1]) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if (argc > 3) {
+ if (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[3],
+ &halo) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (halo < 0.0) {
+ Tcl_AppendResult(interp, "can't have negative halo value \"",
+ argv[3], "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ halo = 0.0;
+ }
+
+ /*
+ * Find the item at which to start the search.
+ */
+
+ startPtr = canvasPtr->firstItemPtr;
+ if (argc == 5) {
+ itemPtr = StartTagSearch(canvasPtr, argv[4], &search);
+ if (itemPtr != NULL) {
+ startPtr = itemPtr;
+ }
+ }
+
+ /*
+ * The code below is optimized so that it can eliminate most
+ * items without having to call their item-specific procedures.
+ * This is done by keeping a bounding box (x1, y1, x2, y2) that
+ * an item's bbox must overlap if the item is to have any
+ * chance of being closer than the closest so far.
+ */
+
+ itemPtr = startPtr;
+ if (itemPtr == NULL) {
+ return TCL_OK;
+ }
+ closestDist = (*itemPtr->typePtr->pointProc)((Tk_Canvas) canvasPtr,
+ itemPtr, coords) - halo;
+ if (closestDist < 0.0) {
+ closestDist = 0.0;
+ }
+ while (1) {
+ double newDist;
+
+ /*
+ * Update the bounding box using itemPtr, which is the
+ * new closest item.
+ */
+
+ x1 = (int) (coords[0] - closestDist - halo - 1);
+ y1 = (int) (coords[1] - closestDist - halo - 1);
+ x2 = (int) (coords[0] + closestDist + halo + 1);
+ y2 = (int) (coords[1] + closestDist + halo + 1);
+ closestPtr = itemPtr;
+
+ /*
+ * Search for an item that beats the current closest one.
+ * Work circularly through the canvas's item list until
+ * getting back to the starting item.
+ */
+
+ while (1) {
+ itemPtr = itemPtr->nextPtr;
+ if (itemPtr == NULL) {
+ itemPtr = canvasPtr->firstItemPtr;
+ }
+ if (itemPtr == startPtr) {
+ DoItem(interp, closestPtr, uid);
+ return TCL_OK;
+ }
+ if ((itemPtr->x1 >= x2) || (itemPtr->x2 <= x1)
+ || (itemPtr->y1 >= y2) || (itemPtr->y2 <= y1)) {
+ continue;
+ }
+ newDist = (*itemPtr->typePtr->pointProc)((Tk_Canvas) canvasPtr,
+ itemPtr, coords) - halo;
+ if (newDist < 0.0) {
+ newDist = 0.0;
+ }
+ if (newDist <= closestDist) {
+ closestDist = newDist;
+ break;
+ }
+ }
+ }
+ } else if ((c == 'e') && (strncmp(argv[0], "enclosed", length) == 0)) {
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ cmdName, option, " enclosed x1 y1 x2 y2", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return FindArea(interp, canvasPtr, argv+1, uid, 1);
+ } else if ((c == 'o') && (strncmp(argv[0], "overlapping", length) == 0)) {
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ cmdName, option, " overlapping x1 y1 x2 y2",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return FindArea(interp, canvasPtr, argv+1, uid, 0);
+ } else if ((c == 'w') && (strncmp(argv[0], "withtag", length) == 0)) {
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ cmdName, option, " withtag tagOrId", (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (itemPtr = StartTagSearch(canvasPtr, argv[1], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ DoItem(interp, itemPtr, uid);
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad search command \"", argv[0],
+ "\": must be above, all, below, closest, enclosed, ",
+ "overlapping, or withtag", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FindArea --
+ *
+ * This procedure implements area searches for the "find"
+ * and "addtag" options.
+ *
+ * Results:
+ * A standard Tcl return value. If newTag is NULL, then a
+ * list of ids from all the items overlapping or enclosed
+ * by the rectangle given by argc is returned in interp->result.
+ * If newTag is NULL, then the normal interp->result is an
+ * empty string. If an error occurs, then interp->result will
+ * hold an error message.
+ *
+ * Side effects:
+ * If uid is non-NULL, then all the items overlapping
+ * or enclosed by the area in argv have that tag added to
+ * their lists of tags.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+FindArea(interp, canvasPtr, argv, uid, enclosed)
+ Tcl_Interp *interp; /* Interpreter for error reporting
+ * and result storing. */
+ TkCanvas *canvasPtr; /* Canvas whose items are to be
+ * searched. */
+ char **argv; /* Array of four arguments that
+ * give the coordinates of the
+ * rectangular area to search. */
+ Tk_Uid uid; /* If non-NULL, gives new tag to set
+ * on all found items; if NULL, then
+ * ids of found items are returned
+ * in interp->result. */
+ int enclosed; /* 0 means overlapping or enclosed
+ * items are OK, 1 means only enclosed
+ * items are OK. */
+{
+ double rect[4], tmp;
+ int x1, y1, x2, y2;
+ Tk_Item *itemPtr;
+
+ if ((Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[0],
+ &rect[0]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[1],
+ &rect[1]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[2],
+ &rect[2]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[3],
+ &rect[3]) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if (rect[0] > rect[2]) {
+ tmp = rect[0]; rect[0] = rect[2]; rect[2] = tmp;
+ }
+ if (rect[1] > rect[3]) {
+ tmp = rect[1]; rect[1] = rect[3]; rect[3] = tmp;
+ }
+
+ /*
+ * Use an integer bounding box for a quick test, to avoid
+ * calling item-specific code except for items that are close.
+ */
+
+ x1 = (int) (rect[0]-1.0);
+ y1 = (int) (rect[1]-1.0);
+ x2 = (int) (rect[2]+1.0);
+ y2 = (int) (rect[3]+1.0);
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if ((itemPtr->x1 >= x2) || (itemPtr->x2 <= x1)
+ || (itemPtr->y1 >= y2) || (itemPtr->y2 <= y1)) {
+ continue;
+ }
+ if ((*itemPtr->typePtr->areaProc)((Tk_Canvas) canvasPtr, itemPtr, rect)
+ >= enclosed) {
+ DoItem(interp, itemPtr, uid);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * RelinkItems --
+ *
+ * Move one or more items to a different place in the
+ * display order for a canvas.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The items identified by "tag" are moved so that they
+ * are all together in the display list and immediately
+ * after prevPtr. The order of the moved items relative
+ * to each other is not changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+RelinkItems(canvasPtr, tag, prevPtr)
+ TkCanvas *canvasPtr; /* Canvas to be modified. */
+ char *tag; /* Tag identifying items to be moved
+ * in the redisplay list. */
+ Tk_Item *prevPtr; /* Reposition the items so that they
+ * go just after this item (NULL means
+ * put at beginning of list). */
+{
+ Tk_Item *itemPtr;
+ TagSearch search;
+ Tk_Item *firstMovePtr, *lastMovePtr;
+
+ /*
+ * Find all of the items to be moved and remove them from
+ * the list, making an auxiliary list running from firstMovePtr
+ * to lastMovePtr. Record their areas for redisplay.
+ */
+
+ firstMovePtr = lastMovePtr = NULL;
+ for (itemPtr = StartTagSearch(canvasPtr, tag, &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ if (itemPtr == prevPtr) {
+ /*
+ * Item after which insertion is to occur is being
+ * moved! Switch to insert after its predecessor.
+ */
+
+ prevPtr = search.prevPtr;
+ }
+ if (search.prevPtr == NULL) {
+ canvasPtr->firstItemPtr = itemPtr->nextPtr;
+ } else {
+ search.prevPtr->nextPtr = itemPtr->nextPtr;
+ }
+ if (canvasPtr->lastItemPtr == itemPtr) {
+ canvasPtr->lastItemPtr = search.prevPtr;
+ }
+ if (firstMovePtr == NULL) {
+ firstMovePtr = itemPtr;
+ } else {
+ lastMovePtr->nextPtr = itemPtr;
+ }
+ lastMovePtr = itemPtr;
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, itemPtr->x1, itemPtr->y1,
+ itemPtr->x2, itemPtr->y2);
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+
+ /*
+ * Insert the list of to-be-moved items back into the canvas's
+ * at the desired position.
+ */
+
+ if (firstMovePtr == NULL) {
+ return;
+ }
+ if (prevPtr == NULL) {
+ lastMovePtr->nextPtr = canvasPtr->firstItemPtr;
+ canvasPtr->firstItemPtr = firstMovePtr;
+ } else {
+ lastMovePtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = firstMovePtr;
+ }
+ if (canvasPtr->lastItemPtr == prevPtr) {
+ canvasPtr->lastItemPtr = lastMovePtr;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasBindProc --
+ *
+ * This procedure is invoked by the Tk dispatcher to handle
+ * events associated with bindings on items.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the command invoked as part of the binding
+ * (if there was any).
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CanvasBindProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to canvas structure. */
+ XEvent *eventPtr; /* Pointer to X event that just
+ * happened. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+
+ Tcl_Preserve((ClientData) canvasPtr);
+
+ /*
+ * This code below keeps track of the current modifier state in
+ * canvasPtr>state. This information is used to defer repicks of
+ * the current item while buttons are down.
+ */
+
+ if ((eventPtr->type == ButtonPress) || (eventPtr->type == ButtonRelease)) {
+ int mask;
+
+ switch (eventPtr->xbutton.button) {
+ case Button1:
+ mask = Button1Mask;
+ break;
+ case Button2:
+ mask = Button2Mask;
+ break;
+ case Button3:
+ mask = Button3Mask;
+ break;
+ case Button4:
+ mask = Button4Mask;
+ break;
+ case Button5:
+ mask = Button5Mask;
+ break;
+ default:
+ mask = 0;
+ break;
+ }
+
+ /*
+ * For button press events, repick the current item using the
+ * button state before the event, then process the event. For
+ * button release events, first process the event, then repick
+ * the current item using the button state *after* the event
+ * (the button has logically gone up before we change the
+ * current item).
+ */
+
+ if (eventPtr->type == ButtonPress) {
+ /*
+ * On a button press, first repick the current item using
+ * the button state before the event, the process the event.
+ */
+
+ canvasPtr->state = eventPtr->xbutton.state;
+ PickCurrentItem(canvasPtr, eventPtr);
+ canvasPtr->state ^= mask;
+ CanvasDoEvent(canvasPtr, eventPtr);
+ } else {
+ /*
+ * Button release: first process the event, with the button
+ * still considered to be down. Then repick the current
+ * item under the assumption that the button is no longer down.
+ */
+
+ canvasPtr->state = eventPtr->xbutton.state;
+ CanvasDoEvent(canvasPtr, eventPtr);
+ eventPtr->xbutton.state ^= mask;
+ canvasPtr->state = eventPtr->xbutton.state;
+ PickCurrentItem(canvasPtr, eventPtr);
+ eventPtr->xbutton.state ^= mask;
+ }
+ goto done;
+ } else if ((eventPtr->type == EnterNotify)
+ || (eventPtr->type == LeaveNotify)) {
+ canvasPtr->state = eventPtr->xcrossing.state;
+ PickCurrentItem(canvasPtr, eventPtr);
+ goto done;
+ } else if (eventPtr->type == MotionNotify) {
+ canvasPtr->state = eventPtr->xmotion.state;
+ PickCurrentItem(canvasPtr, eventPtr);
+ }
+ CanvasDoEvent(canvasPtr, eventPtr);
+
+ done:
+ Tcl_Release((ClientData) canvasPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PickCurrentItem --
+ *
+ * Find the topmost item in a canvas that contains a given
+ * location and mark the the current item. If the current
+ * item has changed, generate a fake exit event on the old
+ * current item and a fake enter event on the new current
+ * item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The current item for canvasPtr may change. If it does,
+ * then the commands associated with item entry and exit
+ * could do just about anything. A binding script could
+ * delete the canvas, so callers should protect themselves
+ * with Tcl_Preserve and Tcl_Release.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+PickCurrentItem(canvasPtr, eventPtr)
+ TkCanvas *canvasPtr; /* Canvas widget in which to select
+ * current item. */
+ XEvent *eventPtr; /* Event describing location of
+ * mouse cursor. Must be EnterWindow,
+ * LeaveWindow, ButtonRelease, or
+ * MotionNotify. */
+{
+ double coords[2];
+ int buttonDown;
+
+ /*
+ * Check whether or not a button is down. If so, we'll log entry
+ * and exit into and out of the current item, but not entry into
+ * any other item. This implements a form of grabbing equivalent
+ * to what the X server does for windows.
+ */
+
+ buttonDown = canvasPtr->state
+ & (Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask);
+ if (!buttonDown) {
+ canvasPtr->flags &= ~LEFT_GRABBED_ITEM;
+ }
+
+ /*
+ * Save information about this event in the canvas. The event in
+ * the canvas is used for two purposes:
+ *
+ * 1. Event bindings: if the current item changes, fake events are
+ * generated to allow item-enter and item-leave bindings to trigger.
+ * 2. Reselection: if the current item gets deleted, can use the
+ * saved event to find a new current item.
+ * Translate MotionNotify events into EnterNotify events, since that's
+ * what gets reported to item handlers.
+ */
+
+ if (eventPtr != &canvasPtr->pickEvent) {
+ if ((eventPtr->type == MotionNotify)
+ || (eventPtr->type == ButtonRelease)) {
+ canvasPtr->pickEvent.xcrossing.type = EnterNotify;
+ canvasPtr->pickEvent.xcrossing.serial = eventPtr->xmotion.serial;
+ canvasPtr->pickEvent.xcrossing.send_event
+ = eventPtr->xmotion.send_event;
+ canvasPtr->pickEvent.xcrossing.display = eventPtr->xmotion.display;
+ canvasPtr->pickEvent.xcrossing.window = eventPtr->xmotion.window;
+ canvasPtr->pickEvent.xcrossing.root = eventPtr->xmotion.root;
+ canvasPtr->pickEvent.xcrossing.subwindow = None;
+ canvasPtr->pickEvent.xcrossing.time = eventPtr->xmotion.time;
+ canvasPtr->pickEvent.xcrossing.x = eventPtr->xmotion.x;
+ canvasPtr->pickEvent.xcrossing.y = eventPtr->xmotion.y;
+ canvasPtr->pickEvent.xcrossing.x_root = eventPtr->xmotion.x_root;
+ canvasPtr->pickEvent.xcrossing.y_root = eventPtr->xmotion.y_root;
+ canvasPtr->pickEvent.xcrossing.mode = NotifyNormal;
+ canvasPtr->pickEvent.xcrossing.detail = NotifyNonlinear;
+ canvasPtr->pickEvent.xcrossing.same_screen
+ = eventPtr->xmotion.same_screen;
+ canvasPtr->pickEvent.xcrossing.focus = False;
+ canvasPtr->pickEvent.xcrossing.state = eventPtr->xmotion.state;
+ } else {
+ canvasPtr->pickEvent = *eventPtr;
+ }
+ }
+
+ /*
+ * If this is a recursive call (there's already a partially completed
+ * call pending on the stack; it's in the middle of processing a
+ * Leave event handler for the old current item) then just return;
+ * the pending call will do everything that's needed.
+ */
+
+ if (canvasPtr->flags & REPICK_IN_PROGRESS) {
+ return;
+ }
+
+ /*
+ * A LeaveNotify event automatically means that there's no current
+ * object, so the check for closest item can be skipped.
+ */
+
+ coords[0] = canvasPtr->pickEvent.xcrossing.x + canvasPtr->xOrigin;
+ coords[1] = canvasPtr->pickEvent.xcrossing.y + canvasPtr->yOrigin;
+ if (canvasPtr->pickEvent.type != LeaveNotify) {
+ canvasPtr->newCurrentPtr = CanvasFindClosest(canvasPtr, coords);
+ } else {
+ canvasPtr->newCurrentPtr = NULL;
+ }
+
+ if ((canvasPtr->newCurrentPtr == canvasPtr->currentItemPtr)
+ && !(canvasPtr->flags & LEFT_GRABBED_ITEM)) {
+ /*
+ * Nothing to do: the current item hasn't changed.
+ */
+
+ return;
+ }
+
+ /*
+ * Simulate a LeaveNotify event on the previous current item and
+ * an EnterNotify event on the new current item. Remove the "current"
+ * tag from the previous current item and place it on the new current
+ * item.
+ */
+
+ if ((canvasPtr->newCurrentPtr != canvasPtr->currentItemPtr)
+ && (canvasPtr->currentItemPtr != NULL)
+ && !(canvasPtr->flags & LEFT_GRABBED_ITEM)) {
+ XEvent event;
+ Tk_Item *itemPtr = canvasPtr->currentItemPtr;
+ int i;
+
+ event = canvasPtr->pickEvent;
+ event.type = LeaveNotify;
+
+ /*
+ * If the event's detail happens to be NotifyInferior the
+ * binding mechanism will discard the event. To be consistent,
+ * always use NotifyAncestor.
+ */
+
+ event.xcrossing.detail = NotifyAncestor;
+ canvasPtr->flags |= REPICK_IN_PROGRESS;
+ CanvasDoEvent(canvasPtr, &event);
+ canvasPtr->flags &= ~REPICK_IN_PROGRESS;
+
+ /*
+ * The check below is needed because there could be an event
+ * handler for <LeaveNotify> that deletes the current item.
+ */
+
+ if ((itemPtr == canvasPtr->currentItemPtr) && !buttonDown) {
+ for (i = itemPtr->numTags-1; i >= 0; i--) {
+ if (itemPtr->tagPtr[i] == currentUid) {
+ itemPtr->tagPtr[i] = itemPtr->tagPtr[itemPtr->numTags-1];
+ itemPtr->numTags--;
+ break;
+ }
+ }
+ }
+
+ /*
+ * Note: during CanvasDoEvent above, it's possible that
+ * canvasPtr->newCurrentPtr got reset to NULL because the
+ * item was deleted.
+ */
+ }
+ if ((canvasPtr->newCurrentPtr != canvasPtr->currentItemPtr) && buttonDown) {
+ canvasPtr->flags |= LEFT_GRABBED_ITEM;
+ return;
+ }
+
+ /*
+ * Special note: it's possible that canvasPtr->newCurrentPtr ==
+ * canvasPtr->currentItemPtr here. This can happen, for example,
+ * if LEFT_GRABBED_ITEM was set.
+ */
+
+ canvasPtr->flags &= ~LEFT_GRABBED_ITEM;
+ canvasPtr->currentItemPtr = canvasPtr->newCurrentPtr;
+ if (canvasPtr->currentItemPtr != NULL) {
+ XEvent event;
+
+ DoItem((Tcl_Interp *) NULL, canvasPtr->currentItemPtr, currentUid);
+ event = canvasPtr->pickEvent;
+ event.type = EnterNotify;
+ event.xcrossing.detail = NotifyAncestor;
+ CanvasDoEvent(canvasPtr, &event);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasFindClosest --
+ *
+ * Given x and y coordinates, find the topmost canvas item that
+ * is "close" to the coordinates.
+ *
+ * Results:
+ * The return value is a pointer to the topmost item that is
+ * close to (x,y), or NULL if no item is close.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tk_Item *
+CanvasFindClosest(canvasPtr, coords)
+ TkCanvas *canvasPtr; /* Canvas widget to search. */
+ double coords[2]; /* Desired x,y position in canvas,
+ * not screen, coordinates.) */
+{
+ Tk_Item *itemPtr;
+ Tk_Item *bestPtr;
+ int x1, y1, x2, y2;
+
+ x1 = (int) (coords[0] - canvasPtr->closeEnough);
+ y1 = (int) (coords[1] - canvasPtr->closeEnough);
+ x2 = (int) (coords[0] + canvasPtr->closeEnough);
+ y2 = (int) (coords[1] + canvasPtr->closeEnough);
+
+ bestPtr = NULL;
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if ((itemPtr->x1 > x2) || (itemPtr->x2 < x1)
+ || (itemPtr->y1 > y2) || (itemPtr->y2 < y1)) {
+ continue;
+ }
+ if ((*itemPtr->typePtr->pointProc)((Tk_Canvas) canvasPtr,
+ itemPtr, coords) <= canvasPtr->closeEnough) {
+ bestPtr = itemPtr;
+ }
+ }
+ return bestPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasDoEvent --
+ *
+ * This procedure is called to invoke binding processing
+ * for a new event that is associated with the current item
+ * for a canvas.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the bindings for the canvas. A binding script
+ * could delete the canvas, so callers should protect themselves
+ * with Tcl_Preserve and Tcl_Release.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CanvasDoEvent(canvasPtr, eventPtr)
+ TkCanvas *canvasPtr; /* Canvas widget in which event
+ * occurred. */
+ XEvent *eventPtr; /* Real or simulated X event that
+ * is to be processed. */
+{
+#define NUM_STATIC 3
+ ClientData staticObjects[NUM_STATIC];
+ ClientData *objectPtr;
+ int numObjects, i;
+ Tk_Item *itemPtr;
+
+ if (canvasPtr->bindingTable == NULL) {
+ return;
+ }
+
+ itemPtr = canvasPtr->currentItemPtr;
+ if ((eventPtr->type == KeyPress) || (eventPtr->type == KeyRelease)) {
+ itemPtr = canvasPtr->textInfo.focusItemPtr;
+ }
+ if (itemPtr == NULL) {
+ return;
+ }
+
+ /*
+ * Set up an array with all the relevant objects for processing
+ * this event. The relevant objects are (a) the event's item,
+ * (b) the tags associated with the event's item, and (c) the
+ * tag "all". If there are a lot of tags then malloc an array
+ * to hold all of the objects.
+ */
+
+ numObjects = itemPtr->numTags + 2;
+ if (numObjects <= NUM_STATIC) {
+ objectPtr = staticObjects;
+ } else {
+ objectPtr = (ClientData *) ckalloc((unsigned)
+ (numObjects * sizeof(ClientData)));
+ }
+ objectPtr[0] = (ClientData) allUid;
+ for (i = itemPtr->numTags-1; i >= 0; i--) {
+ objectPtr[i+1] = (ClientData) itemPtr->tagPtr[i];
+ }
+ objectPtr[itemPtr->numTags+1] = (ClientData) itemPtr;
+
+ /*
+ * Invoke the binding system, then free up the object array if
+ * it was malloc-ed.
+ */
+
+ if (canvasPtr->tkwin != NULL) {
+ Tk_BindEvent(canvasPtr->bindingTable, eventPtr, canvasPtr->tkwin,
+ numObjects, objectPtr);
+ }
+ if (objectPtr != staticObjects) {
+ ckfree((char *) objectPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasBlinkProc --
+ *
+ * This procedure is called as a timer handler to blink the
+ * insertion cursor off and on.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor gets turned on or off, redisplay gets invoked,
+ * and this procedure reschedules itself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CanvasBlinkProc(clientData)
+ ClientData clientData; /* Pointer to record describing entry. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+
+ if (!canvasPtr->textInfo.gotFocus || (canvasPtr->insertOffTime == 0)) {
+ return;
+ }
+ if (canvasPtr->textInfo.cursorOn) {
+ canvasPtr->textInfo.cursorOn = 0;
+ canvasPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ canvasPtr->insertOffTime, CanvasBlinkProc,
+ (ClientData) canvasPtr);
+ } else {
+ canvasPtr->textInfo.cursorOn = 1;
+ canvasPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ canvasPtr->insertOnTime, CanvasBlinkProc,
+ (ClientData) canvasPtr);
+ }
+ if (canvasPtr->textInfo.focusItemPtr != NULL) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.focusItemPtr->x1,
+ canvasPtr->textInfo.focusItemPtr->y1,
+ canvasPtr->textInfo.focusItemPtr->x2,
+ canvasPtr->textInfo.focusItemPtr->y2);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasFocusProc --
+ *
+ * This procedure is called whenever a canvas gets or loses the
+ * input focus. It's also called whenever the window is
+ * reconfigured while it has the focus.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor gets turned on or off.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CanvasFocusProc(canvasPtr, gotFocus)
+ TkCanvas *canvasPtr; /* Canvas that just got or lost focus. */
+ int gotFocus; /* 1 means window is getting focus, 0 means
+ * it's losing it. */
+{
+ Tcl_DeleteTimerHandler(canvasPtr->insertBlinkHandler);
+ if (gotFocus) {
+ canvasPtr->textInfo.gotFocus = 1;
+ canvasPtr->textInfo.cursorOn = 1;
+ if (canvasPtr->insertOffTime != 0) {
+ canvasPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ canvasPtr->insertOffTime, CanvasBlinkProc,
+ (ClientData) canvasPtr);
+ }
+ } else {
+ canvasPtr->textInfo.gotFocus = 0;
+ canvasPtr->textInfo.cursorOn = 0;
+ canvasPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
+ }
+ if (canvasPtr->textInfo.focusItemPtr != NULL) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.focusItemPtr->x1,
+ canvasPtr->textInfo.focusItemPtr->y1,
+ canvasPtr->textInfo.focusItemPtr->x2,
+ canvasPtr->textInfo.focusItemPtr->y2);
+ }
+ if (canvasPtr->highlightWidth > 0) {
+ canvasPtr->flags |= REDRAW_BORDERS;
+ if (!(canvasPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayCanvas, (ClientData) canvasPtr);
+ canvasPtr->flags |= REDRAW_PENDING;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasSelectTo --
+ *
+ * Modify the selection by moving its un-anchored end. This could
+ * make the selection either larger or smaller.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The selection changes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CanvasSelectTo(canvasPtr, itemPtr, index)
+ TkCanvas *canvasPtr; /* Information about widget. */
+ Tk_Item *itemPtr; /* Item that is to hold selection. */
+ int index; /* Index of element that is to become the
+ * "other" end of the selection. */
+{
+ int oldFirst, oldLast;
+ Tk_Item *oldSelPtr;
+
+ oldFirst = canvasPtr->textInfo.selectFirst;
+ oldLast = canvasPtr->textInfo.selectLast;
+ oldSelPtr = canvasPtr->textInfo.selItemPtr;
+
+ /*
+ * Grab the selection if we don't own it already.
+ */
+
+ if (canvasPtr->textInfo.selItemPtr == NULL) {
+ Tk_OwnSelection(canvasPtr->tkwin, XA_PRIMARY, CanvasLostSelection,
+ (ClientData) canvasPtr);
+ } else if (canvasPtr->textInfo.selItemPtr != itemPtr) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.selItemPtr->x1,
+ canvasPtr->textInfo.selItemPtr->y1,
+ canvasPtr->textInfo.selItemPtr->x2,
+ canvasPtr->textInfo.selItemPtr->y2);
+ }
+ canvasPtr->textInfo.selItemPtr = itemPtr;
+
+ if (canvasPtr->textInfo.anchorItemPtr != itemPtr) {
+ canvasPtr->textInfo.anchorItemPtr = itemPtr;
+ canvasPtr->textInfo.selectAnchor = index;
+ }
+ if (canvasPtr->textInfo.selectAnchor <= index) {
+ canvasPtr->textInfo.selectFirst = canvasPtr->textInfo.selectAnchor;
+ canvasPtr->textInfo.selectLast = index;
+ } else {
+ canvasPtr->textInfo.selectFirst = index;
+ canvasPtr->textInfo.selectLast = canvasPtr->textInfo.selectAnchor - 1;
+ }
+ if ((canvasPtr->textInfo.selectFirst != oldFirst)
+ || (canvasPtr->textInfo.selectLast != oldLast)
+ || (itemPtr != oldSelPtr)) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasFetchSelection --
+ *
+ * This procedure is invoked by Tk to return part or all of
+ * the selection, when the selection is in a canvas widget.
+ * This procedure always returns the selection as a STRING.
+ *
+ * Results:
+ * The return value is the number of non-NULL bytes stored
+ * at buffer. Buffer is filled (or partially filled) with a
+ * NULL-terminated string containing part or all of the selection,
+ * as given by offset and maxBytes.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CanvasFetchSelection(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Information about canvas widget. */
+ int offset; /* Offset within selection of first
+ * character to be returned. */
+ char *buffer; /* Location in which to place
+ * selection. */
+ int maxBytes; /* Maximum number of bytes to place
+ * at buffer, not including terminating
+ * NULL character. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+
+ if (canvasPtr->textInfo.selItemPtr == NULL) {
+ return -1;
+ }
+ if (canvasPtr->textInfo.selItemPtr->typePtr->selectionProc == NULL) {
+ return -1;
+ }
+ return (*canvasPtr->textInfo.selItemPtr->typePtr->selectionProc)(
+ (Tk_Canvas) canvasPtr, canvasPtr->textInfo.selItemPtr, offset,
+ buffer, maxBytes);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasLostSelection --
+ *
+ * This procedure is called back by Tk when the selection is
+ * grabbed away from a canvas widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The existing selection is unhighlighted, and the window is
+ * marked as not containing a selection.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CanvasLostSelection(clientData)
+ ClientData clientData; /* Information about entry widget. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+
+ if (canvasPtr->textInfo.selItemPtr != NULL) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.selItemPtr->x1,
+ canvasPtr->textInfo.selItemPtr->y1,
+ canvasPtr->textInfo.selItemPtr->x2,
+ canvasPtr->textInfo.selItemPtr->y2);
+ }
+ canvasPtr->textInfo.selItemPtr = NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GridAlign --
+ *
+ * Given a coordinate and a grid spacing, this procedure
+ * computes the location of the nearest grid line to the
+ * coordinate.
+ *
+ * Results:
+ * The return value is the location of the grid line nearest
+ * to coord.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static double
+GridAlign(coord, spacing)
+ double coord; /* Coordinate to grid-align. */
+ double spacing; /* Spacing between grid lines. If <= 0
+ * then no alignment is done. */
+{
+ if (spacing <= 0.0) {
+ return coord;
+ }
+ if (coord < 0) {
+ return -((int) ((-coord)/spacing + 0.5)) * spacing;
+ }
+ return ((int) (coord/spacing + 0.5)) * spacing;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PrintScrollFractions --
+ *
+ * Given the range that's visible in the window and the "100%
+ * range" for what's in the canvas, print a string containing
+ * the scroll fractions. This procedure is used for both x
+ * and y scrolling.
+ *
+ * Results:
+ * The memory pointed to by string is modified to hold
+ * two real numbers containing the scroll fractions (between
+ * 0 and 1) corresponding to the other arguments.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PrintScrollFractions(screen1, screen2, object1, object2, string)
+ int screen1; /* Lowest coordinate visible in the window. */
+ int screen2; /* Highest coordinate visible in the window. */
+ int object1; /* Lowest coordinate in the object. */
+ int object2; /* Highest coordinate in the object. */
+ char *string; /* Two real numbers get printed here. Must
+ * have enough storage for two %g
+ * conversions. */
+{
+ double range, f1, f2;
+
+ range = object2 - object1;
+ if (range <= 0) {
+ f1 = 0;
+ f2 = 1.0;
+ } else {
+ f1 = (screen1 - object1)/range;
+ if (f1 < 0) {
+ f1 = 0.0;
+ }
+ f2 = (screen2 - object1)/range;
+ if (f2 > 1.0) {
+ f2 = 1.0;
+ }
+ if (f2 < f1) {
+ f2 = f1;
+ }
+ }
+ sprintf(string, "%g %g", f1, f2);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasUpdateScrollbars --
+ *
+ * This procedure is invoked whenever a canvas has changed in
+ * a way that requires scrollbars to be redisplayed (e.g. the
+ * view in the canvas has changed).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If there are scrollbars associated with the canvas, then
+ * their scrolling commands are invoked to cause them to
+ * redisplay. If errors occur, additional Tcl commands may
+ * be invoked to process the errors.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CanvasUpdateScrollbars(canvasPtr)
+ TkCanvas *canvasPtr; /* Information about canvas. */
+{
+ int result;
+ char buffer[200];
+ Tcl_Interp *interp;
+ int xOrigin, yOrigin, inset, width, height, scrollX1, scrollX2,
+ scrollY1, scrollY2;
+ char *xScrollCmd, *yScrollCmd;
+
+ /*
+ * Save all the relevant values from the canvasPtr, because it might be
+ * deleted as part of either of the two calls to Tcl_VarEval below.
+ */
+
+ interp = canvasPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ xScrollCmd = canvasPtr->xScrollCmd;
+ if (xScrollCmd != (char *) NULL) {
+ Tcl_Preserve((ClientData) xScrollCmd);
+ }
+ yScrollCmd = canvasPtr->yScrollCmd;
+ if (yScrollCmd != (char *) NULL) {
+ Tcl_Preserve((ClientData) yScrollCmd);
+ }
+ xOrigin = canvasPtr->xOrigin;
+ yOrigin = canvasPtr->yOrigin;
+ inset = canvasPtr->inset;
+ width = Tk_Width(canvasPtr->tkwin);
+ height = Tk_Height(canvasPtr->tkwin);
+ scrollX1 = canvasPtr->scrollX1;
+ scrollX2 = canvasPtr->scrollX2;
+ scrollY1 = canvasPtr->scrollY1;
+ scrollY2 = canvasPtr->scrollY2;
+ canvasPtr->flags &= ~UPDATE_SCROLLBARS;
+ if (canvasPtr->xScrollCmd != NULL) {
+ PrintScrollFractions(xOrigin + inset, xOrigin + width - inset,
+ scrollX1, scrollX2, buffer);
+ result = Tcl_VarEval(interp, xScrollCmd, " ", buffer, (char *) NULL);
+ if (result != TCL_OK) {
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_ResetResult(interp);
+ Tcl_Release((ClientData) xScrollCmd);
+ }
+
+ if (yScrollCmd != NULL) {
+ PrintScrollFractions(yOrigin + inset, yOrigin + height - inset,
+ scrollY1, scrollY2, buffer);
+ result = Tcl_VarEval(interp, yScrollCmd, " ", buffer, (char *) NULL);
+ if (result != TCL_OK) {
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_ResetResult(interp);
+ Tcl_Release((ClientData) yScrollCmd);
+ }
+ Tcl_Release((ClientData) interp);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasSetOrigin --
+ *
+ * This procedure is invoked to change the mapping between
+ * canvas coordinates and screen coordinates in the canvas
+ * window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The canvas will be redisplayed to reflect the change in
+ * view. In addition, scrollbars will be updated if there
+ * are any.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CanvasSetOrigin(canvasPtr, xOrigin, yOrigin)
+ TkCanvas *canvasPtr; /* Information about canvas. */
+ int xOrigin; /* New X origin for canvas (canvas x-coord
+ * corresponding to left edge of canvas
+ * window). */
+ int yOrigin; /* New Y origin for canvas (canvas y-coord
+ * corresponding to top edge of canvas
+ * window). */
+{
+ int left, right, top, bottom, delta;
+
+ /*
+ * If scroll increments have been set, round the window origin
+ * to the nearest multiple of the increments. Remember, the
+ * origin is the place just inside the borders, not the upper
+ * left corner.
+ */
+
+ if (canvasPtr->xScrollIncrement > 0) {
+ if (xOrigin >= 0) {
+ xOrigin += canvasPtr->xScrollIncrement/2;
+ xOrigin -= (xOrigin + canvasPtr->inset)
+ % canvasPtr->xScrollIncrement;
+ } else {
+ xOrigin = (-xOrigin) + canvasPtr->xScrollIncrement/2;
+ xOrigin = -(xOrigin - (xOrigin - canvasPtr->inset)
+ % canvasPtr->xScrollIncrement);
+ }
+ }
+ if (canvasPtr->yScrollIncrement > 0) {
+ if (yOrigin >= 0) {
+ yOrigin += canvasPtr->yScrollIncrement/2;
+ yOrigin -= (yOrigin + canvasPtr->inset)
+ % canvasPtr->yScrollIncrement;
+ } else {
+ yOrigin = (-yOrigin) + canvasPtr->yScrollIncrement/2;
+ yOrigin = -(yOrigin - (yOrigin - canvasPtr->inset)
+ % canvasPtr->yScrollIncrement);
+ }
+ }
+
+ /*
+ * Adjust the origin if necessary to keep as much as possible of the
+ * canvas in the view. The variables left, right, etc. keep track of
+ * how much extra space there is on each side of the view before it
+ * will stick out past the scroll region. If one side sticks out past
+ * the edge of the scroll region, adjust the view to bring that side
+ * back to the edge of the scrollregion (but don't move it so much that
+ * the other side sticks out now). If scroll increments are in effect,
+ * be sure to adjust only by full increments.
+ */
+
+ if ((canvasPtr->confine) && (canvasPtr->regionString != NULL)) {
+ left = xOrigin + canvasPtr->inset - canvasPtr->scrollX1;
+ right = canvasPtr->scrollX2
+ - (xOrigin + Tk_Width(canvasPtr->tkwin) - canvasPtr->inset);
+ top = yOrigin + canvasPtr->inset - canvasPtr->scrollY1;
+ bottom = canvasPtr->scrollY2
+ - (yOrigin + Tk_Height(canvasPtr->tkwin) - canvasPtr->inset);
+ if ((left < 0) && (right > 0)) {
+ delta = (right > -left) ? -left : right;
+ if (canvasPtr->xScrollIncrement > 0) {
+ delta -= delta % canvasPtr->xScrollIncrement;
+ }
+ xOrigin += delta;
+ } else if ((right < 0) && (left > 0)) {
+ delta = (left > -right) ? -right : left;
+ if (canvasPtr->xScrollIncrement > 0) {
+ delta -= delta % canvasPtr->xScrollIncrement;
+ }
+ xOrigin -= delta;
+ }
+ if ((top < 0) && (bottom > 0)) {
+ delta = (bottom > -top) ? -top : bottom;
+ if (canvasPtr->yScrollIncrement > 0) {
+ delta -= delta % canvasPtr->yScrollIncrement;
+ }
+ yOrigin += delta;
+ } else if ((bottom < 0) && (top > 0)) {
+ delta = (top > -bottom) ? -bottom : top;
+ if (canvasPtr->yScrollIncrement > 0) {
+ delta -= delta % canvasPtr->yScrollIncrement;
+ }
+ yOrigin -= delta;
+ }
+ }
+
+ if ((xOrigin == canvasPtr->xOrigin) && (yOrigin == canvasPtr->yOrigin)) {
+ return;
+ }
+
+ /*
+ * Tricky point: must redisplay not only everything that's visible
+ * in the window's final configuration, but also everything that was
+ * visible in the initial configuration. This is needed because some
+ * item types, like windows, need to know when they move off-screen
+ * so they can explicitly undisplay themselves.
+ */
+
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->xOrigin, canvasPtr->yOrigin,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
+ canvasPtr->xOrigin = xOrigin;
+ canvasPtr->yOrigin = yOrigin;
+ canvasPtr->flags |= UPDATE_SCROLLBARS;
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->xOrigin, canvasPtr->yOrigin,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
+}
diff --git a/generic/tkCanvas.h b/generic/tkCanvas.h
new file mode 100644
index 0000000..52b3a51
--- /dev/null
+++ b/generic/tkCanvas.h
@@ -0,0 +1,257 @@
+/*
+ * tkCanvas.h --
+ *
+ * Declarations shared among all the files that implement
+ * canvas widgets.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkCanvas.h 1.41 96/02/15 18:51:28
+ */
+
+#ifndef _TKCANVAS
+#define _TKCANVAS
+
+#ifndef _TK
+#include "tk.h"
+#endif
+
+/*
+ * The record below describes a canvas widget. It is made available
+ * to the item procedures so they can access certain shared fields such
+ * as the overall displacement and scale factor for the canvas.
+ */
+
+typedef struct TkCanvas {
+ Tk_Window tkwin; /* Window that embodies the canvas. NULL
+ * means that the window has been destroyed
+ * but the data structures haven't yet been
+ * cleaned up.*/
+ Display *display; /* Display containing widget; needed, among
+ * other things, to release resources after
+ * tkwin has already gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with canvas. */
+ Tcl_Command widgetCmd; /* Token for canvas's widget command. */
+ Tk_Item *firstItemPtr; /* First in list of all items in canvas,
+ * or NULL if canvas empty. */
+ Tk_Item *lastItemPtr; /* Last in list of all items in canvas,
+ * or NULL if canvas empty. */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ int borderWidth; /* Width of 3-D border around window. */
+ Tk_3DBorder bgBorder; /* Used for canvas background. */
+ int relief; /* Indicates whether window as a whole is
+ * raised, sunken, or flat. */
+ int highlightWidth; /* Width in pixels of highlight to draw
+ * around widget when it has the focus.
+ * <= 0 means don't draw a highlight. */
+ XColor *highlightBgColorPtr;
+ /* Color for drawing traversal highlight
+ * area when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ int inset; /* Total width of all borders, including
+ * traversal highlight and 3-D border.
+ * Indicates how much interior stuff must
+ * be offset from outside edges to leave
+ * room for borders. */
+ GC pixmapGC; /* Used to copy bits from a pixmap to the
+ * screen and also to clear the pixmap. */
+ int width, height; /* Dimensions to request for canvas window,
+ * specified in pixels. */
+ int redrawX1, redrawY1; /* Upper left corner of area to redraw,
+ * in pixel coordinates. Border pixels
+ * are included. Only valid if
+ * REDRAW_PENDING flag is set. */
+ int redrawX2, redrawY2; /* Lower right corner of area to redraw,
+ * in integer canvas coordinates. Border
+ * pixels will *not* be redrawn. */
+ int confine; /* Non-zero means constrain view to keep
+ * as much of canvas visible as possible. */
+
+ /*
+ * Information used to manage the selection and insertion cursor:
+ */
+
+ Tk_CanvasTextInfo textInfo; /* Contains lots of fields; see tk.h for
+ * details. This structure is shared with
+ * the code that implements individual items. */
+ int insertOnTime; /* Number of milliseconds cursor should spend
+ * in "on" state for each blink. */
+ int insertOffTime; /* Number of milliseconds cursor should spend
+ * in "off" state for each blink. */
+ Tcl_TimerToken insertBlinkHandler;
+ /* Timer handler used to blink cursor on and
+ * off. */
+
+ /*
+ * Transformation applied to canvas as a whole: to compute screen
+ * coordinates (X,Y) from canvas coordinates (x,y), do the following:
+ *
+ * X = x - xOrigin;
+ * Y = y - yOrigin;
+ */
+
+ int xOrigin, yOrigin; /* Canvas coordinates corresponding to
+ * upper-left corner of window, given in
+ * canvas pixel units. */
+ int drawableXOrigin, drawableYOrigin;
+ /* During redisplay, these fields give the
+ * canvas coordinates corresponding to
+ * the upper-left corner of the drawable
+ * where items are actually being drawn
+ * (typically a pixmap smaller than the
+ * whole window). */
+
+ /*
+ * Information used for event bindings associated with items.
+ */
+
+ Tk_BindingTable bindingTable;
+ /* Table of all bindings currently defined
+ * for this canvas. NULL means that no
+ * bindings exist, so the table hasn't been
+ * created. Each "object" used for this
+ * table is either a Tk_Uid for a tag or
+ * the address of an item named by id. */
+ Tk_Item *currentItemPtr; /* The item currently containing the mouse
+ * pointer, or NULL if none. */
+ Tk_Item *newCurrentPtr; /* The item that is about to become the
+ * current one, or NULL. This field is
+ * used to detect deletions of the new
+ * current item pointer that occur during
+ * Leave processing of the previous current
+ * item. */
+ double closeEnough; /* The mouse is assumed to be inside an
+ * item if it is this close to it. */
+ XEvent pickEvent; /* The event upon which the current choice
+ * of currentItem is based. Must be saved
+ * so that if the currentItem is deleted,
+ * can pick another. */
+ int state; /* Last known modifier state. Used to
+ * defer picking a new current object
+ * while buttons are down. */
+
+ /*
+ * Information used for managing scrollbars:
+ */
+
+ char *xScrollCmd; /* Command prefix for communicating with
+ * horizontal scrollbar. NULL means no
+ * horizontal scrollbar. Malloc'ed*/
+ char *yScrollCmd; /* Command prefix for communicating with
+ * vertical scrollbar. NULL means no
+ * vertical scrollbar. Malloc'ed*/
+ int scrollX1, scrollY1, scrollX2, scrollY2;
+ /* These four coordinates define the region
+ * that is the 100% area for scrolling (i.e.
+ * these numbers determine the size and
+ * location of the sliders on scrollbars).
+ * Units are pixels in canvas coords. */
+ char *regionString; /* The option string from which scrollX1
+ * etc. are derived. Malloc'ed. */
+ int xScrollIncrement; /* If >0, defines a grid for horizontal
+ * scrolling. This is the size of the "unit",
+ * and the left edge of the screen will always
+ * lie on an even unit boundary. */
+ int yScrollIncrement; /* If >0, defines a grid for horizontal
+ * scrolling. This is the size of the "unit",
+ * and the left edge of the screen will always
+ * lie on an even unit boundary. */
+
+ /*
+ * Information used for scanning:
+ */
+
+ int scanX; /* X-position at which scan started (e.g.
+ * button was pressed here). */
+ int scanXOrigin; /* Value of xOrigin field when scan started. */
+ int scanY; /* Y-position at which scan started (e.g.
+ * button was pressed here). */
+ int scanYOrigin; /* Value of yOrigin field when scan started. */
+
+ /*
+ * Information used to speed up searches by remembering the last item
+ * created or found with an item id search.
+ */
+
+ Tk_Item *hotPtr; /* Pointer to "hot" item (one that's been
+ * recently used. NULL means there's no
+ * hot item. */
+ Tk_Item *hotPrevPtr; /* Pointer to predecessor to hotPtr (NULL
+ * means item is first in list). This is
+ * only a hint and may not really be hotPtr's
+ * predecessor. */
+
+ /*
+ * Miscellaneous information:
+ */
+
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ char *takeFocus; /* Value of -takefocus option; not used in
+ * the C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+ double pixelsPerMM; /* Scale factor between MM and pixels;
+ * used when converting coordinates. */
+ int flags; /* Various flags; see below for
+ * definitions. */
+ int nextId; /* Number to use as id for next item
+ * created in widget. */
+ struct TkPostscriptInfo *psInfoPtr;
+ /* Pointer to information used for generating
+ * Postscript for the canvas. NULL means
+ * no Postscript is currently being
+ * generated. */
+} TkCanvas;
+
+/*
+ * Flag bits for canvases:
+ *
+ * REDRAW_PENDING - 1 means a DoWhenIdle handler has already
+ * been created to redraw some or all of the
+ * canvas.
+ * REDRAW_BORDERS - 1 means that the borders need to be redrawn
+ * during the next redisplay operation.
+ * REPICK_NEEDED - 1 means DisplayCanvas should pick a new
+ * current item before redrawing the canvas.
+ * GOT_FOCUS - 1 means the focus is currently in this
+ * widget, so should draw the insertion cursor
+ * and traversal highlight.
+ * CURSOR_ON - 1 means the insertion cursor is in the "on"
+ * phase of its blink cycle. 0 means either
+ * we don't have the focus or the cursor is in
+ * the "off" phase of its cycle.
+ * UPDATE_SCROLLBARS - 1 means the scrollbars should get updated
+ * as part of the next display operation.
+ * LEFT_GRABBED_ITEM - 1 means that the mouse left the current
+ * item while a grab was in effect, so we
+ * didn't change canvasPtr->currentItemPtr.
+ * REPICK_IN_PROGRESS - 1 means PickCurrentItem is currently
+ * executing. If it should be called recursively,
+ * it should simply return immediately.
+ */
+
+#define REDRAW_PENDING 1
+#define REDRAW_BORDERS 2
+#define REPICK_NEEDED 4
+#define GOT_FOCUS 8
+#define CURSOR_ON 0x10
+#define UPDATE_SCROLLBARS 0x20
+#define LEFT_GRABBED_ITEM 0x40
+#define REPICK_IN_PROGRESS 0x100
+
+/*
+ * Canvas-related procedures that are shared among Tk modules but not
+ * exported to the outside world:
+ */
+
+extern int TkCanvPostscriptCmd _ANSI_ARGS_((TkCanvas *canvasPtr,
+ Tcl_Interp *interp, int argc, char **argv));
+
+#endif /* _TKCANVAS */
diff --git a/generic/tkClipboard.c b/generic/tkClipboard.c
new file mode 100644
index 0000000..e1c9510
--- /dev/null
+++ b/generic/tkClipboard.c
@@ -0,0 +1,606 @@
+/*
+ * tkClipboard.c --
+ *
+ * This file manages the clipboard for the Tk toolkit,
+ * maintaining a collection of data buffers that will be
+ * supplied on demand to requesting applications.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkClipboard.c 1.15 96/05/03 10:51:08
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkSelect.h"
+
+/*
+ * Prototypes for procedures used only in this file:
+ */
+
+static int ClipboardAppHandler _ANSI_ARGS_((ClientData clientData,
+ int offset, char *buffer, int maxBytes));
+static int ClipboardHandler _ANSI_ARGS_((ClientData clientData,
+ int offset, char *buffer, int maxBytes));
+static int ClipboardWindowHandler _ANSI_ARGS_((
+ ClientData clientData, int offset, char *buffer,
+ int maxBytes));
+static void ClipboardLostSel _ANSI_ARGS_((ClientData clientData));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClipboardHandler --
+ *
+ * This procedure acts as selection handler for the
+ * clipboard manager. It extracts the required chunk of
+ * data from the buffer chain for a given selection target.
+ *
+ * Results:
+ * The return value is a count of the number of bytes
+ * actually stored at buffer.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ClipboardHandler(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Information about data to fetch. */
+ int offset; /* Return selection bytes starting at this
+ * offset. */
+ char *buffer; /* Place to store converted selection. */
+ int maxBytes; /* Maximum # of bytes to store at buffer. */
+{
+ TkClipboardTarget *targetPtr = (TkClipboardTarget*) clientData;
+ TkClipboardBuffer *cbPtr;
+ char *srcPtr, *destPtr;
+ int count = 0;
+ int scanned = 0;
+ size_t length, freeCount;
+
+ /*
+ * Skip to buffer containing offset byte
+ */
+
+ for (cbPtr = targetPtr->firstBufferPtr; ; cbPtr = cbPtr->nextPtr) {
+ if (cbPtr == NULL) {
+ return 0;
+ }
+ if (scanned + cbPtr->length > offset) {
+ break;
+ }
+ scanned += cbPtr->length;
+ }
+
+ /*
+ * Copy up to maxBytes or end of list, switching buffers as needed.
+ */
+
+ freeCount = maxBytes;
+ srcPtr = cbPtr->buffer + (offset - scanned);
+ destPtr = buffer;
+ length = cbPtr->length - (offset - scanned);
+ while (1) {
+ if (length > freeCount) {
+ strncpy(destPtr, srcPtr, freeCount);
+ return maxBytes;
+ } else {
+ strncpy(destPtr, srcPtr, length);
+ destPtr += length;
+ count += length;
+ freeCount -= length;
+ }
+ cbPtr = cbPtr->nextPtr;
+ if (cbPtr == NULL) {
+ break;
+ }
+ srcPtr = cbPtr->buffer;
+ length = cbPtr->length;
+ }
+ return count;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClipboardAppHandler --
+ *
+ * This procedure acts as selection handler for retrievals of type
+ * TK_APPLICATION. It returns the name of the application that
+ * owns the clipboard. Note: we can't use the default Tk
+ * selection handler for this selection type, because the clipboard
+ * window isn't a "real" window and doesn't have the necessary
+ * information.
+ *
+ * Results:
+ * The return value is a count of the number of bytes
+ * actually stored at buffer.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ClipboardAppHandler(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Pointer to TkDisplay structure. */
+ int offset; /* Return selection bytes starting at this
+ * offset. */
+ char *buffer; /* Place to store converted selection. */
+ int maxBytes; /* Maximum # of bytes to store at buffer. */
+{
+ TkDisplay *dispPtr = (TkDisplay *) clientData;
+ size_t length;
+ char *p;
+
+ p = dispPtr->clipboardAppPtr->winPtr->nameUid;
+ length = strlen(p);
+ length -= offset;
+ if (length <= 0) {
+ return 0;
+ }
+ if (length > (size_t) maxBytes) {
+ length = maxBytes;
+ }
+ strncpy(buffer, p, length);
+ return length;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClipboardWindowHandler --
+ *
+ * This procedure acts as selection handler for retrievals of
+ * type TK_WINDOW. Since the clipboard doesn't correspond to
+ * any particular window, we just return ".". We can't use Tk's
+ * default handler for this selection type, because the clipboard
+ * window isn't a valid window.
+ *
+ * Results:
+ * The return value is 1, the number of non-null bytes stored
+ * at buffer.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ClipboardWindowHandler(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Not used. */
+ int offset; /* Return selection bytes starting at this
+ * offset. */
+ char *buffer; /* Place to store converted selection. */
+ int maxBytes; /* Maximum # of bytes to store at buffer. */
+{
+ buffer[0] = '.';
+ buffer[1] = 0;
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClipboardLostSel --
+ *
+ * This procedure is invoked whenever clipboard ownership is
+ * claimed by another window. It just sets a flag so that we
+ * know the clipboard was taken away.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The clipboard is marked as inactive.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ClipboardLostSel(clientData)
+ ClientData clientData; /* Pointer to TkDisplay structure. */
+{
+ TkDisplay *dispPtr = (TkDisplay*) clientData;
+
+ dispPtr->clipboardActive = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ClipboardClear --
+ *
+ * Take control of the clipboard and clear out the previous
+ * contents. This procedure must be invoked before any
+ * calls to Tk_AppendToClipboard.
+ *
+ * Results:
+ * A standard Tcl result. If an error occurs, an error message is
+ * left in interp->result.
+ *
+ * Side effects:
+ * From now on, requests for the CLIPBOARD selection will be
+ * directed to the clipboard manager routines associated with
+ * clipWindow for the display of tkwin. In order to guarantee
+ * atomicity, no event handling should occur between
+ * Tk_ClipboardClear and the following Tk_AppendToClipboard
+ * calls. This procedure may cause a user-defined LostSel command
+ * to be invoked when the CLIPBOARD is claimed, so any calling
+ * function should be reentrant at the point Tk_ClipboardClear is
+ * invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ClipboardClear(interp, tkwin)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ Tk_Window tkwin; /* Window in application that is clearing
+ * clipboard; identifies application and
+ * display. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkClipboardTarget *targetPtr, *nextTargetPtr;
+ TkClipboardBuffer *cbPtr, *nextCbPtr;
+
+ if (dispPtr->clipWindow == NULL) {
+ int result;
+
+ result = TkClipInit(interp, dispPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+
+ /*
+ * Discard any existing clipboard data and delete the selection
+ * handler(s) associated with that data.
+ */
+
+ for (targetPtr = dispPtr->clipTargetPtr; targetPtr != NULL;
+ targetPtr = nextTargetPtr) {
+ for (cbPtr = targetPtr->firstBufferPtr; cbPtr != NULL;
+ cbPtr = nextCbPtr) {
+ ckfree(cbPtr->buffer);
+ nextCbPtr = cbPtr->nextPtr;
+ ckfree((char *) cbPtr);
+ }
+ nextTargetPtr = targetPtr->nextPtr;
+ Tk_DeleteSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ targetPtr->type);
+ ckfree((char *) targetPtr);
+ }
+ dispPtr->clipTargetPtr = NULL;
+
+ /*
+ * Reclaim the clipboard selection if we lost it.
+ */
+
+ if (!dispPtr->clipboardActive) {
+ Tk_OwnSelection(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ ClipboardLostSel, (ClientData) dispPtr);
+ dispPtr->clipboardActive = 1;
+ }
+ dispPtr->clipboardAppPtr = winPtr->mainPtr;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ClipboardAppend --
+ *
+ * Append a buffer of data to the clipboard. The first buffer of
+ * a given type determines the format for that type. Any successive
+ * appends to that type must have the same format or an error will
+ * be returned. Tk_ClipboardClear must be called before a sequence
+ * of Tk_ClipboardAppend calls can be issued. In order to guarantee
+ * atomicity, no event handling should occur between Tk_ClipboardClear
+ * and the following Tk_AppendToClipboard calls.
+ *
+ * Results:
+ * A standard Tcl result. If an error is returned, an error message
+ * is left in interp->result.
+ *
+ * Side effects:
+ * The specified buffer will be copied onto the end of the clipboard.
+ * The clipboard maintains a list of buffers which will be used to
+ * supply the data for a selection get request. The first time a given
+ * type is appended, Tk_ClipboardAppend will register a selection
+ * handler of the appropriate type.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ClipboardAppend(interp, tkwin, type, format, buffer)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Window tkwin; /* Window that selects a display. */
+ Atom type; /* The desired conversion type for this
+ * clipboard item, e.g. STRING or LENGTH. */
+ Atom format; /* Format in which the selection
+ * information should be returned to
+ * the requestor. */
+ char* buffer; /* NULL terminated string containing the data
+ * to be added to the clipboard. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkClipboardTarget *targetPtr;
+ TkClipboardBuffer *cbPtr;
+
+ /*
+ * If this application doesn't already own the clipboard, clear
+ * the clipboard. If we don't own the clipboard selection, claim it.
+ */
+
+ if (dispPtr->clipboardAppPtr != winPtr->mainPtr) {
+ Tk_ClipboardClear(interp, tkwin);
+ } else if (!dispPtr->clipboardActive) {
+ Tk_OwnSelection(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ ClipboardLostSel, (ClientData) dispPtr);
+ dispPtr->clipboardActive = 1;
+ }
+
+ /*
+ * Check to see if the specified target is already present on the
+ * clipboard. If it isn't, we need to create a new target; otherwise,
+ * we just append the new buffer to the clipboard list.
+ */
+
+ for (targetPtr = dispPtr->clipTargetPtr; targetPtr != NULL;
+ targetPtr = targetPtr->nextPtr) {
+ if (targetPtr->type == type)
+ break;
+ }
+ if (targetPtr == NULL) {
+ targetPtr = (TkClipboardTarget*) ckalloc(sizeof(TkClipboardTarget));
+ targetPtr->type = type;
+ targetPtr->format = format;
+ targetPtr->firstBufferPtr = targetPtr->lastBufferPtr = NULL;
+ targetPtr->nextPtr = dispPtr->clipTargetPtr;
+ dispPtr->clipTargetPtr = targetPtr;
+ Tk_CreateSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ type, ClipboardHandler, (ClientData) targetPtr, format);
+ } else if (targetPtr->format != format) {
+ Tcl_AppendResult(interp, "format \"", Tk_GetAtomName(tkwin, format),
+ "\" does not match current format \"",
+ Tk_GetAtomName(tkwin, targetPtr->format),"\" for ",
+ Tk_GetAtomName(tkwin, type), (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Append a new buffer to the buffer chain.
+ */
+
+ cbPtr = (TkClipboardBuffer*) ckalloc(sizeof(TkClipboardBuffer));
+ cbPtr->nextPtr = NULL;
+ if (targetPtr->lastBufferPtr != NULL) {
+ targetPtr->lastBufferPtr->nextPtr = cbPtr;
+ } else {
+ targetPtr->firstBufferPtr = cbPtr;
+ }
+ targetPtr->lastBufferPtr = cbPtr;
+
+ cbPtr->length = strlen(buffer);
+ cbPtr->buffer = (char *) ckalloc((unsigned) (cbPtr->length + 1));
+ strcpy(cbPtr->buffer, buffer);
+
+ TkSelUpdateClipboard((TkWindow*)(dispPtr->clipWindow), targetPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ClipboardCmd --
+ *
+ * This procedure is invoked to process the "clipboard" Tcl
+ * command. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ClipboardCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ char *path = NULL;
+ size_t length;
+ int count;
+ char c;
+ char **args;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'a') && (strncmp(argv[1], "append", length) == 0)) {
+ Atom target, format;
+ char *targetName = NULL;
+ char *formatName = NULL;
+
+ for (count = argc-2, args = argv+2; count > 1; count -= 2, args += 2) {
+ if (args[0][0] != '-') {
+ break;
+ }
+ c = args[0][1];
+ length = strlen(args[0]);
+ if ((c == '-') && (length == 2)) {
+ args++;
+ count--;
+ break;
+ }
+ if ((c == 'd') && (strncmp(args[0], "-displayof", length) == 0)) {
+ path = args[1];
+ } else if ((c == 'f')
+ && (strncmp(args[0], "-format", length) == 0)) {
+ formatName = args[1];
+ } else if ((c == 't')
+ && (strncmp(args[0], "-type", length) == 0)) {
+ targetName = args[1];
+ } else {
+ Tcl_AppendResult(interp, "unknown option \"", args[0],
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (count != 1) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " append ?options? data\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (path != NULL) {
+ tkwin = Tk_NameToWindow(interp, path, tkwin);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (targetName != NULL) {
+ target = Tk_InternAtom(tkwin, targetName);
+ } else {
+ target = XA_STRING;
+ }
+ if (formatName != NULL) {
+ format = Tk_InternAtom(tkwin, formatName);
+ } else {
+ format = XA_STRING;
+ }
+ return Tk_ClipboardAppend(interp, tkwin, target, format, args[0]);
+ } else if ((c == 'c') && (strncmp(argv[1], "clear", length) == 0)) {
+ for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) {
+ if (args[0][0] != '-') {
+ break;
+ }
+ if (count < 2) {
+ Tcl_AppendResult(interp, "value for \"", *args,
+ "\" missing", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = args[0][1];
+ length = strlen(args[0]);
+ if ((c == 'd') && (strncmp(args[0], "-displayof", length) == 0)) {
+ path = args[1];
+ } else {
+ Tcl_AppendResult(interp, "unknown option \"", args[0],
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (count > 0) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " clear ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (path != NULL) {
+ tkwin = Tk_NameToWindow(interp, path, tkwin);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ return Tk_ClipboardClear(interp, tkwin);
+ } else {
+ sprintf(interp->result,
+ "bad option \"%.50s\": must be clear or append",
+ argv[1]);
+ return TCL_ERROR;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkClipInit --
+ *
+ * This procedure is called to initialize the window for claiming
+ * clipboard ownership and for receiving selection get results. This
+ * function is called from tkSelect.c as well as tkClipboard.c.
+ *
+ * Results:
+ * The result is a standard Tcl return value, which is normally TCL_OK.
+ * If an error occurs then an error message is left in interp->result
+ * and TCL_ERROR is returned.
+ *
+ * Side effects:
+ * Sets up the clipWindow and related data structures.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkClipInit(interp, dispPtr)
+ Tcl_Interp *interp; /* Interpreter to use for error
+ * reporting. */
+ register TkDisplay *dispPtr;/* Display to initialize. */
+{
+ XSetWindowAttributes atts;
+
+ dispPtr->clipTargetPtr = NULL;
+ dispPtr->clipboardActive = 0;
+ dispPtr->clipboardAppPtr = NULL;
+
+ /*
+ * Create the window used for clipboard ownership and selection retrieval,
+ * and set up an event handler for it.
+ */
+
+ dispPtr->clipWindow = Tk_CreateWindow(interp, (Tk_Window) NULL,
+ "_clip", DisplayString(dispPtr->display));
+ if (dispPtr->clipWindow == NULL) {
+ return TCL_ERROR;
+ }
+ atts.override_redirect = True;
+ Tk_ChangeWindowAttributes(dispPtr->clipWindow, CWOverrideRedirect, &atts);
+ Tk_MakeWindowExist(dispPtr->clipWindow);
+
+ if (dispPtr->multipleAtom == None) {
+ /*
+ * Need to invoke selection initialization to make sure that
+ * atoms we depend on below are defined.
+ */
+
+ TkSelInit(dispPtr->clipWindow);
+ }
+
+ /*
+ * Create selection handlers for types TK_APPLICATION and TK_WINDOW
+ * on this window. Can't use the default handlers for these types
+ * because this isn't a full-fledged window.
+ */
+
+ Tk_CreateSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ dispPtr->applicationAtom, ClipboardAppHandler,
+ (ClientData) dispPtr, XA_STRING);
+ Tk_CreateSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ dispPtr->windowAtom, ClipboardWindowHandler,
+ (ClientData) dispPtr, XA_STRING);
+ return TCL_OK;
+}
diff --git a/generic/tkCmds.c b/generic/tkCmds.c
new file mode 100644
index 0000000..34e2867
--- /dev/null
+++ b/generic/tkCmds.c
@@ -0,0 +1,1646 @@
+/*
+ * tkCmds.c --
+ *
+ * This file contains a collection of Tk-related Tcl commands
+ * that didn't fit in any particular file of the toolkit.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkCmds.c 1.125 97/05/20 16:16:33
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+#include <errno.h>
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static TkWindow * GetToplevel _ANSI_ARGS_((Tk_Window tkwin));
+static char * WaitVariableProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, char *name1, char *name2,
+ int flags));
+static void WaitVisibilityProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void WaitWindowProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_BellCmd --
+ *
+ * This procedure is invoked to process the "bell" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_BellCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ size_t length;
+
+ if ((argc != 1) && (argc != 3)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " ?-displayof window?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (argc == 3) {
+ length = strlen(argv[1]);
+ if ((length < 2) || (strncmp(argv[1], "-displayof", length) != 0)) {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be -displayof", (char *) NULL);
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ XBell(Tk_Display(tkwin), 0);
+ XForceScreenSaver(Tk_Display(tkwin), ScreenSaverReset);
+ XFlush(Tk_Display(tkwin));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_BindCmd --
+ *
+ * This procedure is invoked to process the "bind" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_BindCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ TkWindow *winPtr;
+ ClientData object;
+
+ if ((argc < 2) || (argc > 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " window ?pattern? ?command?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argv[1][0] == '.') {
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ object = (ClientData) winPtr->pathName;
+ } else {
+ winPtr = (TkWindow *) clientData;
+ object = (ClientData) Tk_GetUid(argv[1]);
+ }
+
+ if (argc == 4) {
+ int append = 0;
+ unsigned long mask;
+
+ if (argv[3][0] == 0) {
+ return Tk_DeleteBinding(interp, winPtr->mainPtr->bindingTable,
+ object, argv[2]);
+ }
+ if (argv[3][0] == '+') {
+ argv[3]++;
+ append = 1;
+ }
+ mask = Tk_CreateBinding(interp, winPtr->mainPtr->bindingTable,
+ object, argv[2], argv[3], append);
+ if (mask == 0) {
+ return TCL_ERROR;
+ }
+ } else if (argc == 3) {
+ char *command;
+
+ command = Tk_GetBinding(interp, winPtr->mainPtr->bindingTable,
+ object, argv[2]);
+ if (command == NULL) {
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+ }
+ interp->result = command;
+ } else {
+ Tk_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBindEventProc --
+ *
+ * This procedure is invoked by Tk_HandleEvent for each event; it
+ * causes any appropriate bindings for that event to be invoked.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on what bindings have been established with the "bind"
+ * command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBindEventProc(winPtr, eventPtr)
+ TkWindow *winPtr; /* Pointer to info about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+#define MAX_OBJS 20
+ ClientData objects[MAX_OBJS], *objPtr;
+ static Tk_Uid allUid = NULL;
+ TkWindow *topLevPtr;
+ int i, count;
+ char *p;
+ Tcl_HashEntry *hPtr;
+
+ if ((winPtr->mainPtr == NULL) || (winPtr->mainPtr->bindingTable == NULL)) {
+ return;
+ }
+
+ objPtr = objects;
+ if (winPtr->numTags != 0) {
+ /*
+ * Make a copy of the tags for the window, replacing window names
+ * with pointers to the pathName from the appropriate window.
+ */
+
+ if (winPtr->numTags > MAX_OBJS) {
+ objPtr = (ClientData *) ckalloc((unsigned)
+ (winPtr->numTags * sizeof(ClientData)));
+ }
+ for (i = 0; i < winPtr->numTags; i++) {
+ p = (char *) winPtr->tagPtr[i];
+ if (*p == '.') {
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->nameTable, p);
+ if (hPtr != NULL) {
+ p = ((TkWindow *) Tcl_GetHashValue(hPtr))->pathName;
+ } else {
+ p = NULL;
+ }
+ }
+ objPtr[i] = (ClientData) p;
+ }
+ count = winPtr->numTags;
+ } else {
+ objPtr[0] = (ClientData) winPtr->pathName;
+ objPtr[1] = (ClientData) winPtr->classUid;
+ for (topLevPtr = winPtr;
+ (topLevPtr != NULL) && !(topLevPtr->flags & TK_TOP_LEVEL);
+ topLevPtr = topLevPtr->parentPtr) {
+ /* Empty loop body. */
+ }
+ if ((winPtr != topLevPtr) && (topLevPtr != NULL)) {
+ count = 4;
+ objPtr[2] = (ClientData) topLevPtr->pathName;
+ } else {
+ count = 3;
+ }
+ if (allUid == NULL) {
+ allUid = Tk_GetUid("all");
+ }
+ objPtr[count-1] = (ClientData) allUid;
+ }
+ Tk_BindEvent(winPtr->mainPtr->bindingTable, eventPtr, (Tk_Window) winPtr,
+ count, objPtr);
+ if (objPtr != objects) {
+ ckfree((char *) objPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_BindtagsCmd --
+ *
+ * This procedure is invoked to process the "bindtags" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_BindtagsCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ TkWindow *winPtr, *winPtr2;
+ int i, tagArgc;
+ char *p, **tagArgv;
+
+ if ((argc < 2) || (argc > 3)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " window ?tags?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (argc == 2) {
+ if (winPtr->numTags == 0) {
+ Tcl_AppendElement(interp, winPtr->pathName);
+ Tcl_AppendElement(interp, winPtr->classUid);
+ for (winPtr2 = winPtr;
+ (winPtr2 != NULL) && !(winPtr2->flags & TK_TOP_LEVEL);
+ winPtr2 = winPtr2->parentPtr) {
+ /* Empty loop body. */
+ }
+ if ((winPtr != winPtr2) && (winPtr2 != NULL)) {
+ Tcl_AppendElement(interp, winPtr2->pathName);
+ }
+ Tcl_AppendElement(interp, "all");
+ } else {
+ for (i = 0; i < winPtr->numTags; i++) {
+ Tcl_AppendElement(interp, (char *) winPtr->tagPtr[i]);
+ }
+ }
+ return TCL_OK;
+ }
+ if (winPtr->tagPtr != NULL) {
+ TkFreeBindingTags(winPtr);
+ }
+ if (argv[2][0] == 0) {
+ return TCL_OK;
+ }
+ if (Tcl_SplitList(interp, argv[2], &tagArgc, &tagArgv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ winPtr->numTags = tagArgc;
+ winPtr->tagPtr = (ClientData *) ckalloc((unsigned)
+ (tagArgc * sizeof(ClientData)));
+ for (i = 0; i < tagArgc; i++) {
+ p = tagArgv[i];
+ if (p[0] == '.') {
+ char *copy;
+
+ /*
+ * Handle names starting with "." specially: store a malloc'ed
+ * string, rather than a Uid; at event time we'll look up the
+ * name in the window table and use the corresponding window,
+ * if there is one.
+ */
+
+ copy = (char *) ckalloc((unsigned) (strlen(p) + 1));
+ strcpy(copy, p);
+ winPtr->tagPtr[i] = (ClientData) copy;
+ } else {
+ winPtr->tagPtr[i] = (ClientData) Tk_GetUid(p);
+ }
+ }
+ ckfree((char *) tagArgv);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFreeBindingTags --
+ *
+ * This procedure is called to free all of the binding tags
+ * associated with a window; typically it is only invoked where
+ * there are window-specific tags.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Any binding tags for winPtr are freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFreeBindingTags(winPtr)
+ TkWindow *winPtr; /* Window whose tags are to be released. */
+{
+ int i;
+ char *p;
+
+ for (i = 0; i < winPtr->numTags; i++) {
+ p = (char *) (winPtr->tagPtr[i]);
+ if (*p == '.') {
+ /*
+ * Names starting with "." are malloced rather than Uids, so
+ * they have to be freed.
+ */
+
+ ckfree(p);
+ }
+ }
+ ckfree((char *) winPtr->tagPtr);
+ winPtr->numTags = 0;
+ winPtr->tagPtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DestroyCmd --
+ *
+ * This procedure is invoked to process the "destroy" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_DestroyCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window window;
+ Tk_Window tkwin = (Tk_Window) clientData;
+ int i;
+
+ for (i = 1; i < argc; i++) {
+ window = Tk_NameToWindow(interp, argv[i], tkwin);
+ if (window == NULL) {
+ Tcl_ResetResult(interp);
+ continue;
+ }
+ Tk_DestroyWindow(window);
+ if (window == tkwin) {
+ /*
+ * We just deleted the main window for the application! This
+ * makes it impossible to do anything more (tkwin isn't
+ * valid anymore).
+ */
+
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_LowerCmd --
+ *
+ * This procedure is invoked to process the "lower" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tk_LowerCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window main = (Tk_Window) clientData;
+ Tk_Window tkwin, other;
+
+ if ((argc != 2) && (argc != 3)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " window ?belowThis?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_NameToWindow(interp, argv[1], main);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (argc == 2) {
+ other = NULL;
+ } else {
+ other = Tk_NameToWindow(interp, argv[2], main);
+ if (other == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (Tk_RestackWindow(tkwin, Below, other) != TCL_OK) {
+ Tcl_AppendResult(interp, "can't lower \"", argv[1], "\" below \"",
+ argv[2], "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_RaiseCmd --
+ *
+ * This procedure is invoked to process the "raise" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tk_RaiseCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window main = (Tk_Window) clientData;
+ Tk_Window tkwin, other;
+
+ if ((argc != 2) && (argc != 3)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " window ?aboveThis?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_NameToWindow(interp, argv[1], main);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (argc == 2) {
+ other = NULL;
+ } else {
+ other = Tk_NameToWindow(interp, argv[2], main);
+ if (other == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (Tk_RestackWindow(tkwin, Above, other) != TCL_OK) {
+ Tcl_AppendResult(interp, "can't raise \"", argv[1], "\" above \"",
+ argv[2], "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_TkObjCmd --
+ *
+ * This procedure is invoked to process the "tk" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_TkObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ int index;
+ Tk_Window tkwin;
+ static char *optionStrings[] = {
+ "appname", "scaling", NULL
+ };
+ enum options {
+ TK_APPNAME, TK_SCALING
+ };
+
+ tkwin = (Tk_Window) clientData;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case TK_APPNAME: {
+ TkWindow *winPtr;
+ char *string;
+
+ winPtr = (TkWindow *) tkwin;
+
+ if (objc > 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?newName?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, string));
+ }
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), winPtr->nameUid, -1);
+ break;
+ }
+ case TK_SCALING: {
+ Screen *screenPtr;
+ int skip, width, height;
+ double d;
+
+ screenPtr = Tk_Screen(tkwin);
+
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip == 2) {
+ d = 25.4 / 72;
+ d *= WidthOfScreen(screenPtr);
+ d /= WidthMMOfScreen(screenPtr);
+ Tcl_SetDoubleObj(Tcl_GetObjResult(interp), d);
+ } else if (objc - skip == 3) {
+ if (Tcl_GetDoubleFromObj(interp, objv[2 + skip], &d) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ d = (25.4 / 72) / d;
+ width = (int) (d * WidthOfScreen(screenPtr) + 0.5);
+ if (width <= 0) {
+ width = 1;
+ }
+ height = (int) (d * HeightOfScreen(screenPtr) + 0.5);
+ if (height <= 0) {
+ height = 1;
+ }
+ WidthMMOfScreen(screenPtr) = width;
+ HeightMMOfScreen(screenPtr) = height;
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?-displayof window? ?factor?");
+ return TCL_ERROR;
+ }
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_TkwaitCmd --
+ *
+ * This procedure is invoked to process the "tkwait" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tk_TkwaitCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ int c, done;
+ size_t length;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " variable|visibility|window name\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'v') && (strncmp(argv[1], "variable", length) == 0)
+ && (length >= 2)) {
+ if (Tcl_TraceVar(interp, argv[2],
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ WaitVariableProc, (ClientData) &done) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ done = 0;
+ while (!done) {
+ Tcl_DoOneEvent(0);
+ }
+ Tcl_UntraceVar(interp, argv[2],
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ WaitVariableProc, (ClientData) &done);
+ } else if ((c == 'v') && (strncmp(argv[1], "visibility", length) == 0)
+ && (length >= 2)) {
+ Tk_Window window;
+
+ window = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (window == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_CreateEventHandler(window, VisibilityChangeMask|StructureNotifyMask,
+ WaitVisibilityProc, (ClientData) &done);
+ done = 0;
+ while (!done) {
+ Tcl_DoOneEvent(0);
+ }
+ if (done != 1) {
+ /*
+ * Note that we do not delete the event handler because it
+ * was deleted automatically when the window was destroyed.
+ */
+
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "window \"", argv[2],
+ "\" was deleted before its visibility changed",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tk_DeleteEventHandler(window, VisibilityChangeMask|StructureNotifyMask,
+ WaitVisibilityProc, (ClientData) &done);
+ } else if ((c == 'w') && (strncmp(argv[1], "window", length) == 0)) {
+ Tk_Window window;
+
+ window = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (window == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_CreateEventHandler(window, StructureNotifyMask,
+ WaitWindowProc, (ClientData) &done);
+ done = 0;
+ while (!done) {
+ Tcl_DoOneEvent(0);
+ }
+ /*
+ * Note: there's no need to delete the event handler. It was
+ * deleted automatically when the window was destroyed.
+ */
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be variable, visibility, or window", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Clear out the interpreter's result, since it may have been set
+ * by event handlers.
+ */
+
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+}
+
+ /* ARGSUSED */
+static char *
+WaitVariableProc(clientData, interp, name1, name2, flags)
+ ClientData clientData; /* Pointer to integer to set to 1. */
+ Tcl_Interp *interp; /* Interpreter containing variable. */
+ char *name1; /* Name of variable. */
+ char *name2; /* Second part of variable name. */
+ int flags; /* Information about what happened. */
+{
+ int *donePtr = (int *) clientData;
+
+ *donePtr = 1;
+ return (char *) NULL;
+}
+
+ /*ARGSUSED*/
+static void
+WaitVisibilityProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to integer to set to 1. */
+ XEvent *eventPtr; /* Information about event (not used). */
+{
+ int *donePtr = (int *) clientData;
+
+ if (eventPtr->type == VisibilityNotify) {
+ *donePtr = 1;
+ }
+ if (eventPtr->type == DestroyNotify) {
+ *donePtr = 2;
+ }
+}
+
+static void
+WaitWindowProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to integer to set to 1. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ int *donePtr = (int *) clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ *donePtr = 1;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_UpdateCmd --
+ *
+ * This procedure is invoked to process the "update" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tk_UpdateCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ int flags;
+ TkDisplay *dispPtr;
+
+ if (argc == 1) {
+ flags = TCL_DONT_WAIT;
+ } else if (argc == 2) {
+ if (strncmp(argv[1], "idletasks", strlen(argv[1])) != 0) {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be idletasks", (char *) NULL);
+ return TCL_ERROR;
+ }
+ flags = TCL_IDLE_EVENTS;
+ } else {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " ?idletasks?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Handle all pending events, sync all displays, and repeat over
+ * and over again until all pending events have been handled.
+ * Special note: it's possible that the entire application could
+ * be destroyed by an event handler that occurs during the update.
+ * Thus, don't use any information from tkwin after calling
+ * Tcl_DoOneEvent.
+ */
+
+ while (1) {
+ while (Tcl_DoOneEvent(flags) != 0) {
+ /* Empty loop body */
+ }
+ for (dispPtr = tkDisplayList; dispPtr != NULL;
+ dispPtr = dispPtr->nextPtr) {
+ XSync(dispPtr->display, False);
+ }
+ if (Tcl_DoOneEvent(flags) == 0) {
+ break;
+ }
+ }
+
+ /*
+ * Must clear the interpreter's result because event handlers could
+ * have executed commands.
+ */
+
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_WinfoObjCmd --
+ *
+ * This procedure is invoked to process the "winfo" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_WinfoObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ int index, x, y, width, height, useX, useY, class, skip;
+ char buf[128];
+ char *string;
+ TkWindow *winPtr;
+ Tk_Window tkwin;
+
+ static TkStateMap visualMap[] = {
+ {PseudoColor, "pseudocolor"},
+ {GrayScale, "grayscale"},
+ {DirectColor, "directcolor"},
+ {TrueColor, "truecolor"},
+ {StaticColor, "staticcolor"},
+ {StaticGray, "staticgray"},
+ {-1, NULL}
+ };
+ static char *optionStrings[] = {
+ "cells", "children", "class", "colormapfull",
+ "depth", "geometry", "height", "id",
+ "ismapped", "manager", "name", "parent",
+ "pointerx", "pointery", "pointerxy", "reqheight",
+ "reqwidth", "rootx", "rooty", "screen",
+ "screencells", "screendepth", "screenheight", "screenwidth",
+ "screenmmheight","screenmmwidth","screenvisual","server",
+ "toplevel", "viewable", "visual", "visualid",
+ "vrootheight", "vrootwidth", "vrootx", "vrooty",
+ "width", "x", "y",
+
+ "atom", "atomname", "containing", "interps",
+ "pathname",
+
+ "exists", "fpixels", "pixels", "rgb",
+ "visualsavailable",
+
+ NULL
+ };
+ enum options {
+ WIN_CELLS, WIN_CHILDREN, WIN_CLASS, WIN_COLORMAPFULL,
+ WIN_DEPTH, WIN_GEOMETRY, WIN_HEIGHT, WIN_ID,
+ WIN_ISMAPPED, WIN_MANAGER, WIN_NAME, WIN_PARENT,
+ WIN_POINTERX, WIN_POINTERY, WIN_POINTERXY, WIN_REQHEIGHT,
+ WIN_REQWIDTH, WIN_ROOTX, WIN_ROOTY, WIN_SCREEN,
+ WIN_SCREENCELLS,WIN_SCREENDEPTH,WIN_SCREENHEIGHT,WIN_SCREENWIDTH,
+ WIN_SCREENMMHEIGHT,WIN_SCREENMMWIDTH,WIN_SCREENVISUAL,WIN_SERVER,
+ WIN_TOPLEVEL, WIN_VIEWABLE, WIN_VISUAL, WIN_VISUALID,
+ WIN_VROOTHEIGHT,WIN_VROOTWIDTH, WIN_VROOTX, WIN_VROOTY,
+ WIN_WIDTH, WIN_X, WIN_Y,
+
+ WIN_ATOM, WIN_ATOMNAME, WIN_CONTAINING, WIN_INTERPS,
+ WIN_PATHNAME,
+
+ WIN_EXISTS, WIN_FPIXELS, WIN_PIXELS, WIN_RGB,
+ WIN_VISUALSAVAILABLE
+ };
+
+ tkwin = (Tk_Window) clientData;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (index < WIN_ATOM) {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ winPtr = (TkWindow *) tkwin;
+
+ switch ((enum options) index) {
+ case WIN_CELLS: {
+ Tcl_ResetResult(interp);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp),
+ Tk_Visual(tkwin)->map_entries);
+ break;
+ }
+ case WIN_CHILDREN: {
+ Tcl_Obj *strPtr;
+
+ Tcl_ResetResult(interp);
+ winPtr = winPtr->childList;
+ for ( ; winPtr != NULL; winPtr = winPtr->nextPtr) {
+ strPtr = Tcl_NewStringObj(winPtr->pathName, -1);
+ Tcl_ListObjAppendElement(NULL,
+ Tcl_GetObjResult(interp), strPtr);
+ }
+ break;
+ }
+ case WIN_CLASS: {
+ Tcl_ResetResult(interp);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_Class(tkwin), -1);
+ break;
+ }
+ case WIN_COLORMAPFULL: {
+ Tcl_ResetResult(interp);
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
+ TkpCmapStressed(tkwin, Tk_Colormap(tkwin)));
+ break;
+ }
+ case WIN_DEPTH: {
+ Tcl_ResetResult(interp);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_Depth(tkwin));
+ break;
+ }
+ case WIN_GEOMETRY: {
+ Tcl_ResetResult(interp);
+ sprintf(buf, "%dx%d+%d+%d", Tk_Width(tkwin), Tk_Height(tkwin),
+ Tk_X(tkwin), Tk_Y(tkwin));
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
+ break;
+ }
+ case WIN_HEIGHT: {
+ Tcl_ResetResult(interp);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_Height(tkwin));
+ break;
+ }
+ case WIN_ID: {
+ Tk_MakeWindowExist(tkwin);
+ TkpPrintWindowId(buf, Tk_WindowId(tkwin));
+ Tcl_ResetResult(interp);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
+ break;
+ }
+ case WIN_ISMAPPED: {
+ Tcl_ResetResult(interp);
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
+ (int) Tk_IsMapped(tkwin));
+ break;
+ }
+ case WIN_MANAGER: {
+ Tcl_ResetResult(interp);
+ if (winPtr->geomMgrPtr != NULL) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ winPtr->geomMgrPtr->name, -1);
+ }
+ break;
+ }
+ case WIN_NAME: {
+ Tcl_ResetResult(interp);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_Name(tkwin), -1);
+ break;
+ }
+ case WIN_PARENT: {
+ Tcl_ResetResult(interp);
+ if (winPtr->parentPtr != NULL) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ winPtr->parentPtr->pathName, -1);
+ }
+ break;
+ }
+ case WIN_POINTERX: {
+ useX = 1;
+ useY = 0;
+ goto pointerxy;
+ }
+ case WIN_POINTERY: {
+ useX = 0;
+ useY = 1;
+ goto pointerxy;
+ }
+ case WIN_POINTERXY: {
+ useX = 1;
+ useY = 1;
+
+ pointerxy:
+ winPtr = GetToplevel(tkwin);
+ if (winPtr == NULL) {
+ x = -1;
+ y = -1;
+ } else {
+ TkGetPointerCoords((Tk_Window) winPtr, &x, &y);
+ }
+ Tcl_ResetResult(interp);
+ if (useX & useY) {
+ sprintf(buf, "%d %d", x, y);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
+ } else if (useX) {
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), x);
+ } else {
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), y);
+ }
+ break;
+ }
+ case WIN_REQHEIGHT: {
+ Tcl_ResetResult(interp);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_ReqHeight(tkwin));
+ break;
+ }
+ case WIN_REQWIDTH: {
+ Tcl_ResetResult(interp);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_ReqWidth(tkwin));
+ break;
+ }
+ case WIN_ROOTX: {
+ Tk_GetRootCoords(tkwin, &x, &y);
+ Tcl_ResetResult(interp);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), x);
+ break;
+ }
+ case WIN_ROOTY: {
+ Tk_GetRootCoords(tkwin, &x, &y);
+ Tcl_ResetResult(interp);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), y);
+ break;
+ }
+ case WIN_SCREEN: {
+ sprintf(buf, "%d", Tk_ScreenNumber(tkwin));
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ Tk_DisplayName(tkwin), ".", buf, NULL);
+ break;
+ }
+ case WIN_SCREENCELLS: {
+ Tcl_ResetResult(interp);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp),
+ CellsOfScreen(Tk_Screen(tkwin)));
+ break;
+ }
+ case WIN_SCREENDEPTH: {
+ Tcl_ResetResult(interp);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp),
+ DefaultDepthOfScreen(Tk_Screen(tkwin)));
+ break;
+ }
+ case WIN_SCREENHEIGHT: {
+ Tcl_ResetResult(interp);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp),
+ HeightOfScreen(Tk_Screen(tkwin)));
+ break;
+ }
+ case WIN_SCREENWIDTH: {
+ Tcl_ResetResult(interp);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp),
+ WidthOfScreen(Tk_Screen(tkwin)));
+ break;
+ }
+ case WIN_SCREENMMHEIGHT: {
+ Tcl_ResetResult(interp);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp),
+ HeightMMOfScreen(Tk_Screen(tkwin)));
+ break;
+ }
+ case WIN_SCREENMMWIDTH: {
+ Tcl_ResetResult(interp);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp),
+ WidthMMOfScreen(Tk_Screen(tkwin)));
+ break;
+ }
+ case WIN_SCREENVISUAL: {
+ class = DefaultVisualOfScreen(Tk_Screen(tkwin))->class;
+ goto visual;
+ }
+ case WIN_SERVER: {
+ TkGetServerInfo(interp, tkwin);
+ break;
+ }
+ case WIN_TOPLEVEL: {
+ winPtr = GetToplevel(tkwin);
+ if (winPtr != NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ winPtr->pathName, -1);
+ }
+ break;
+ }
+ case WIN_VIEWABLE: {
+ int viewable;
+
+ viewable = 0;
+ for ( ; ; winPtr = winPtr->parentPtr) {
+ if ((winPtr == NULL) || !(winPtr->flags & TK_MAPPED)) {
+ break;
+ }
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ viewable = 1;
+ break;
+ }
+ }
+ Tcl_ResetResult(interp);
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp), viewable);
+ break;
+ }
+ case WIN_VISUAL: {
+ class = Tk_Visual(tkwin)->class;
+
+ visual:
+ string = TkFindStateString(visualMap, class);
+ if (string == NULL) {
+ string = "unknown";
+ }
+ Tcl_ResetResult(interp);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), string, -1);
+ break;
+ }
+ case WIN_VISUALID: {
+ Tcl_ResetResult(interp);
+ sprintf(buf, "0x%x",
+ (unsigned int) XVisualIDFromVisual(Tk_Visual(tkwin)));
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
+ break;
+ }
+ case WIN_VROOTHEIGHT: {
+ Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+ Tcl_ResetResult(interp);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), height);
+ break;
+ }
+ case WIN_VROOTWIDTH: {
+ Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+ Tcl_ResetResult(interp);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), width);
+ break;
+ }
+ case WIN_VROOTX: {
+ Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+ Tcl_ResetResult(interp);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), x);
+ break;
+ }
+ case WIN_VROOTY: {
+ Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+ Tcl_ResetResult(interp);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), y);
+ break;
+ }
+ case WIN_WIDTH: {
+ Tcl_ResetResult(interp);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_Width(tkwin));
+ break;
+ }
+ case WIN_X: {
+ Tcl_ResetResult(interp);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_X(tkwin));
+ break;
+ }
+ case WIN_Y: {
+ Tcl_ResetResult(interp);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_Y(tkwin));
+ break;
+ }
+
+ /*
+ * Uses -displayof.
+ */
+
+ case WIN_ATOM: {
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? name");
+ return TCL_ERROR;
+ }
+ objv += skip;
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ Tcl_ResetResult(interp);
+ Tcl_SetLongObj(Tcl_GetObjResult(interp),
+ (long) Tk_InternAtom(tkwin, string));
+ break;
+ }
+ case WIN_ATOMNAME: {
+ char *name;
+ long id;
+
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? id");
+ return TCL_ERROR;
+ }
+ objv += skip;
+ if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_ResetResult(interp);
+ name = Tk_GetAtomName(tkwin, (Atom) id);
+ if (strcmp(name, "?bad atom?") == 0) {
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "no atom exists with id \"", string, "\"", NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), name, -1);
+ break;
+ }
+ case WIN_CONTAINING: {
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?-displayof window? rootX rootY");
+ return TCL_ERROR;
+ }
+ objv += skip;
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ if (Tk_GetPixels(interp, tkwin, string, &x) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[3], NULL);
+ if (Tk_GetPixels(interp, tkwin, string, &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ tkwin = Tk_CoordsToWindow(x, y, tkwin);
+ if (tkwin != NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ Tk_PathName(tkwin), -1);
+ }
+ break;
+ }
+ case WIN_INTERPS: {
+ int result;
+
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");
+ return TCL_ERROR;
+ }
+ result = TkGetInterpNames(interp, tkwin);
+ return result;
+ }
+ case WIN_PATHNAME: {
+ int id;
+
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? id");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[2 + skip], NULL);
+ if (TkpScanWindowId(interp, string, &id) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ winPtr = (TkWindow *)
+ Tk_IdToWindow(Tk_Display(tkwin), (Window) id);
+ if ((winPtr == NULL) ||
+ (winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "window id \"", string,
+ "\" doesn't exist in this application", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the window is a utility window with no associated path
+ * (such as a wrapper window or send communication window), just
+ * return an empty string.
+ */
+
+ tkwin = (Tk_Window) winPtr;
+ if (Tk_PathName(tkwin) != NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ Tk_PathName(tkwin), -1);
+ }
+ break;
+ }
+
+ /*
+ * objv[3] is window.
+ */
+
+ case WIN_EXISTS: {
+ int alive;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, string, tkwin);
+ alive = 1;
+ if ((winPtr == NULL) || (winPtr->flags & TK_ALREADY_DEAD)) {
+ alive = 0;
+ }
+ Tcl_ResetResult(interp); /* clear any error msg */
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp), alive);
+ break;
+ }
+ case WIN_FPIXELS: {
+ double mm, pixels;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window number");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[3], NULL);
+ if (Tk_GetScreenMM(interp, tkwin, string, &mm) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ pixels = mm * WidthOfScreen(Tk_Screen(tkwin))
+ / WidthMMOfScreen(Tk_Screen(tkwin));
+ Tcl_ResetResult(interp);
+ Tcl_SetDoubleObj(Tcl_GetObjResult(interp), pixels);
+ break;
+ }
+ case WIN_PIXELS: {
+ int pixels;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window number");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[3], NULL);
+ if (Tk_GetPixels(interp, tkwin, string, &pixels) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_ResetResult(interp);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), pixels);
+ break;
+ }
+ case WIN_RGB: {
+ XColor *colorPtr;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window colorName");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[3], NULL);
+ colorPtr = Tk_GetColor(interp, tkwin, string);
+ if (colorPtr == NULL) {
+ return TCL_ERROR;
+ }
+ sprintf(buf, "%d %d %d", colorPtr->red, colorPtr->green,
+ colorPtr->blue);
+ Tk_FreeColor(colorPtr);
+ Tcl_ResetResult(interp);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
+ break;
+ }
+ case WIN_VISUALSAVAILABLE: {
+ XVisualInfo template, *visInfoPtr;
+ int count, i;
+ char visualIdString[16];
+ int includeVisualId;
+ Tcl_Obj *strPtr;
+
+ if (objc == 3) {
+ includeVisualId = 0;
+ } else if ((objc == 4)
+ && (strcmp(Tcl_GetStringFromObj(objv[3], NULL),
+ "includeids") == 0)) {
+ includeVisualId = 1;
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?includeids?");
+ return TCL_ERROR;
+ }
+
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ template.screen = Tk_ScreenNumber(tkwin);
+ visInfoPtr = XGetVisualInfo(Tk_Display(tkwin), VisualScreenMask,
+ &template, &count);
+ Tcl_ResetResult(interp);
+ if (visInfoPtr == NULL) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "can't find any visuals for screen", -1);
+ return TCL_ERROR;
+ }
+ for (i = 0; i < count; i++) {
+ string = TkFindStateString(visualMap, visInfoPtr[i].class);
+ if (string == NULL) {
+ strcpy(buf, "unknown");
+ } else {
+ sprintf(buf, "%s %d", string, visInfoPtr[i].depth);
+ }
+ if (includeVisualId) {
+ sprintf(visualIdString, " 0x%x",
+ (unsigned int) visInfoPtr[i].visualid);
+ strcat(buf, visualIdString);
+ }
+ strPtr = Tcl_NewStringObj(buf, -1);
+ Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+ strPtr);
+ }
+ XFree((char *) visInfoPtr);
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetDisplayOf --
+ *
+ * Parses a "-displayof window" option for various commands. If
+ * present, the literal "-displayof" should be in objv[0] and the
+ * window name in objv[1].
+ *
+ * Results:
+ * The return value is 0 if the argument strings did not contain
+ * the "-displayof" option. The return value is 2 if the
+ * argument strings contained both the "-displayof" option and
+ * a valid window name. Otherwise, the return value is -1 if
+ * the window name was missing or did not specify a valid window.
+ *
+ * If the return value was 2, *tkwinPtr is filled with the
+ * token for the window specified on the command line. If the
+ * return value was -1, an error message is left in interp's
+ * result object.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkGetDisplayOf(interp, objc, objv, tkwinPtr)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. If it is present,
+ * "-displayof" should be in objv[0] and
+ * objv[1] the name of a window. */
+ Tk_Window *tkwinPtr; /* On input, contains main window of
+ * application associated with interp. On
+ * output, filled with window specified as
+ * option to "-displayof" argument, or
+ * unmodified if "-displayof" argument was not
+ * present. */
+{
+ char *string;
+ int length;
+
+ if (objc < 1) {
+ return 0;
+ }
+ string = Tcl_GetStringFromObj(objv[0], &length);
+ if ((length >= 2) && (strncmp(string, "-displayof", (unsigned) length) == 0)) {
+ if (objc < 2) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "value for \"-displayof\" missing", -1);
+ return -1;
+ }
+ string = Tcl_GetStringFromObj(objv[1], NULL);
+ *tkwinPtr = Tk_NameToWindow(interp, string, *tkwinPtr);
+ if (*tkwinPtr == NULL) {
+ return -1;
+ }
+ return 2;
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDeadAppCmd --
+ *
+ * If an application has been deleted then all Tk commands will be
+ * re-bound to this procedure.
+ *
+ * Results:
+ * A standard Tcl error is reported to let the user know that
+ * the application is dead.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TkDeadAppCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Dummy. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tcl_AppendResult(interp, "can't invoke \"", argv[0],
+ "\" command: application has been destroyed", (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetToplevel --
+ *
+ * Retrieves the toplevel window which is the nearest ancestor of
+ * of the specified window.
+ *
+ * Results:
+ * Returns the toplevel window or NULL if the window has no
+ * ancestor which is a toplevel.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkWindow *
+GetToplevel(tkwin)
+ Tk_Window tkwin; /* Window for which the toplevel should be
+ * deterined. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+
+ while (!(winPtr->flags & TK_TOP_LEVEL)) {
+ winPtr = winPtr->parentPtr;
+ if (winPtr == NULL) {
+ return NULL;
+ }
+ }
+ return winPtr;
+}
diff --git a/generic/tkColor.c b/generic/tkColor.c
new file mode 100644
index 0000000..781971c
--- /dev/null
+++ b/generic/tkColor.c
@@ -0,0 +1,397 @@
+/*
+ * tkColor.c --
+ *
+ * This file maintains a database of color values for the Tk
+ * toolkit, in order to avoid round-trips to the server to
+ * map color names to pixel values.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkColor.c 1.44 96/11/04 13:55:25
+ */
+
+#include <tkColor.h>
+
+/*
+ * A two-level data structure is used to manage the color database.
+ * The top level consists of one entry for each color name that is
+ * currently active, and the bottom level contains one entry for each
+ * pixel value that is still in use. The distinction between
+ * levels is necessary because the same pixel may have several
+ * different names. There are two hash tables, one used to index into
+ * each of the data structures. The name hash table is used when
+ * allocating colors, and the pixel hash table is used when freeing
+ * colors.
+ */
+
+
+/*
+ * Hash table for name -> TkColor mapping, and key structure used to
+ * index into that table:
+ */
+
+static Tcl_HashTable nameTable;
+typedef struct {
+ Tk_Uid name; /* Name of desired color. */
+ Colormap colormap; /* Colormap from which color will be
+ * allocated. */
+ Display *display; /* Display for colormap. */
+} NameKey;
+
+/*
+ * Hash table for value -> TkColor mapping, and key structure used to
+ * index into that table:
+ */
+
+static Tcl_HashTable valueTable;
+typedef struct {
+ int red, green, blue; /* Values for desired color. */
+ Colormap colormap; /* Colormap from which color will be
+ * allocated. */
+ Display *display; /* Display for colormap. */
+} ValueKey;
+
+static int initialized = 0; /* 0 means static structures haven't been
+ * initialized yet. */
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void ColorInit _ANSI_ARGS_((void));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetColor --
+ *
+ * Given a string name for a color, map the name to a corresponding
+ * XColor structure.
+ *
+ * Results:
+ * The return value is a pointer to an XColor structure that
+ * indicates the red, blue, and green intensities for the color
+ * given by "name", and also specifies a pixel value to use to
+ * draw in that color. If an error occurs, NULL is returned and
+ * an error message will be left in interp->result.
+ *
+ * Side effects:
+ * The color is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeColor so that the database is cleaned up when colors
+ * aren't in use anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+XColor *
+Tk_GetColor(interp, tkwin, name)
+ Tcl_Interp *interp; /* Place to leave error message if
+ * color can't be found. */
+ Tk_Window tkwin; /* Window in which color will be used. */
+ Tk_Uid name; /* Name of color to allocated (in form
+ * suitable for passing to XParseColor). */
+{
+ NameKey nameKey;
+ Tcl_HashEntry *nameHashPtr;
+ int new;
+ TkColor *tkColPtr;
+ Display *display = Tk_Display(tkwin);
+
+ if (!initialized) {
+ ColorInit();
+ }
+
+ /*
+ * First, check to see if there's already a mapping for this color
+ * name.
+ */
+
+ nameKey.name = name;
+ nameKey.colormap = Tk_Colormap(tkwin);
+ nameKey.display = display;
+ nameHashPtr = Tcl_CreateHashEntry(&nameTable, (char *) &nameKey, &new);
+ if (!new) {
+ tkColPtr = (TkColor *) Tcl_GetHashValue(nameHashPtr);
+ tkColPtr->refCount++;
+ return &tkColPtr->color;
+ }
+
+ /*
+ * The name isn't currently known. Map from the name to a pixel
+ * value.
+ */
+
+ tkColPtr = TkpGetColor(tkwin, name);
+ if (tkColPtr == NULL) {
+ if (interp != NULL) {
+ if (*name == '#') {
+ Tcl_AppendResult(interp, "invalid color name \"", name,
+ "\"", (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, "unknown color name \"", name,
+ "\"", (char *) NULL);
+ }
+ }
+ Tcl_DeleteHashEntry(nameHashPtr);
+ return (XColor *) NULL;
+ }
+
+ /*
+ * Now create a new TkColor structure and add it to nameTable.
+ */
+
+ tkColPtr->magic = COLOR_MAGIC;
+ tkColPtr->gc = None;
+ tkColPtr->screen = Tk_Screen(tkwin);
+ tkColPtr->colormap = nameKey.colormap;
+ tkColPtr->visual = Tk_Visual(tkwin);
+ tkColPtr->refCount = 1;
+ tkColPtr->tablePtr = &nameTable;
+ tkColPtr->hashPtr = nameHashPtr;
+ Tcl_SetHashValue(nameHashPtr, tkColPtr);
+
+ return &tkColPtr->color;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetColorByValue --
+ *
+ * Given a desired set of red-green-blue intensities for a color,
+ * locate a pixel value to use to draw that color in a given
+ * window.
+ *
+ * Results:
+ * The return value is a pointer to an XColor structure that
+ * indicates the closest red, blue, and green intensities available
+ * to those specified in colorPtr, and also specifies a pixel
+ * value to use to draw in that color.
+ *
+ * Side effects:
+ * The color is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeColor, so that the database is cleaned up when colors
+ * aren't in use anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+XColor *
+Tk_GetColorByValue(tkwin, colorPtr)
+ Tk_Window tkwin; /* Window where color will be used. */
+ XColor *colorPtr; /* Red, green, and blue fields indicate
+ * desired color. */
+{
+ ValueKey valueKey;
+ Tcl_HashEntry *valueHashPtr;
+ int new;
+ TkColor *tkColPtr;
+ Display *display = Tk_Display(tkwin);
+
+ if (!initialized) {
+ ColorInit();
+ }
+
+ /*
+ * First, check to see if there's already a mapping for this color
+ * name.
+ */
+
+ valueKey.red = colorPtr->red;
+ valueKey.green = colorPtr->green;
+ valueKey.blue = colorPtr->blue;
+ valueKey.colormap = Tk_Colormap(tkwin);
+ valueKey.display = display;
+ valueHashPtr = Tcl_CreateHashEntry(&valueTable, (char *) &valueKey, &new);
+ if (!new) {
+ tkColPtr = (TkColor *) Tcl_GetHashValue(valueHashPtr);
+ tkColPtr->refCount++;
+ return &tkColPtr->color;
+ }
+
+ /*
+ * The name isn't currently known. Find a pixel value for this
+ * color and add a new structure to valueTable.
+ */
+
+ tkColPtr = TkpGetColorByValue(tkwin, colorPtr);
+ tkColPtr->magic = COLOR_MAGIC;
+ tkColPtr->gc = None;
+ tkColPtr->screen = Tk_Screen(tkwin);
+ tkColPtr->colormap = valueKey.colormap;
+ tkColPtr->visual = Tk_Visual(tkwin);
+ tkColPtr->refCount = 1;
+ tkColPtr->tablePtr = &valueTable;
+ tkColPtr->hashPtr = valueHashPtr;
+ Tcl_SetHashValue(valueHashPtr, tkColPtr);
+ return &tkColPtr->color;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfColor --
+ *
+ * Given a color, return a textual string identifying
+ * the color.
+ *
+ * Results:
+ * If colorPtr was created by Tk_GetColor, then the return
+ * value is the "string" that was used to create it.
+ * Otherwise the return value is a string that could have
+ * been passed to Tk_GetColor to allocate that color. The
+ * storage for the returned string is only guaranteed to
+ * persist up until the next call to this procedure.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_NameOfColor(colorPtr)
+ XColor *colorPtr; /* Color whose name is desired. */
+{
+ register TkColor *tkColPtr = (TkColor *) colorPtr;
+ static char string[20];
+
+ if ((tkColPtr->magic == COLOR_MAGIC)
+ && (tkColPtr->tablePtr == &nameTable)) {
+ return ((NameKey *) tkColPtr->hashPtr->key.words)->name;
+ }
+ sprintf(string, "#%04x%04x%04x", colorPtr->red, colorPtr->green,
+ colorPtr->blue);
+ return string;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GCForColor --
+ *
+ * Given a color allocated from this module, this procedure
+ * returns a GC that can be used for simple drawing with that
+ * color.
+ *
+ * Results:
+ * The return value is a GC with color set as its foreground
+ * color and all other fields defaulted. This GC is only valid
+ * as long as the color exists; it is freed automatically when
+ * the last reference to the color is freed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+GC
+Tk_GCForColor(colorPtr, drawable)
+ XColor *colorPtr; /* Color for which a GC is desired. Must
+ * have been allocated by Tk_GetColor or
+ * Tk_GetColorByName. */
+ Drawable drawable; /* Drawable in which the color will be
+ * used (must have same screen and depth
+ * as the one for which the color was
+ * allocated). */
+{
+ TkColor *tkColPtr = (TkColor *) colorPtr;
+ XGCValues gcValues;
+
+ /*
+ * Do a quick sanity check to make sure this color was really
+ * allocated by Tk_GetColor.
+ */
+
+ if (tkColPtr->magic != COLOR_MAGIC) {
+ panic("Tk_GCForColor called with bogus color");
+ }
+
+ if (tkColPtr->gc == None) {
+ gcValues.foreground = tkColPtr->color.pixel;
+ tkColPtr->gc = XCreateGC(DisplayOfScreen(tkColPtr->screen),
+ drawable, GCForeground, &gcValues);
+ }
+ return tkColPtr->gc;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeColor --
+ *
+ * This procedure is called to release a color allocated by
+ * Tk_GetColor.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with colorPtr is deleted, and
+ * the color is released to X if there are no remaining uses
+ * for it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeColor(colorPtr)
+ XColor *colorPtr; /* Color to be released. Must have been
+ * allocated by Tk_GetColor or
+ * Tk_GetColorByValue. */
+{
+ register TkColor *tkColPtr = (TkColor *) colorPtr;
+ Screen *screen = tkColPtr->screen;
+
+ /*
+ * Do a quick sanity check to make sure this color was really
+ * allocated by Tk_GetColor.
+ */
+
+ if (tkColPtr->magic != COLOR_MAGIC) {
+ panic("Tk_FreeColor called with bogus color");
+ }
+
+ tkColPtr->refCount--;
+ if (tkColPtr->refCount == 0) {
+ if (tkColPtr->gc != None) {
+ XFreeGC(DisplayOfScreen(screen), tkColPtr->gc);
+ tkColPtr->gc = None;
+ }
+ TkpFreeColor(tkColPtr);
+ Tcl_DeleteHashEntry(tkColPtr->hashPtr);
+ tkColPtr->magic = 0;
+ ckfree((char *) tkColPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ColorInit --
+ *
+ * Initialize the structure used for color management.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Read the code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ColorInit()
+{
+ initialized = 1;
+ Tcl_InitHashTable(&nameTable, sizeof(NameKey)/sizeof(int));
+ Tcl_InitHashTable(&valueTable, sizeof(ValueKey)/sizeof(int));
+}
diff --git a/generic/tkColor.h b/generic/tkColor.h
new file mode 100644
index 0000000..9653243
--- /dev/null
+++ b/generic/tkColor.h
@@ -0,0 +1,60 @@
+/*
+ * tkColor.h --
+ *
+ * Declarations of data types and functions used by the
+ * Tk color module.
+ *
+ * Copyright (c) 1996 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkColor.h 1.1 96/10/22 16:53:09
+ */
+
+#ifndef _TKCOLOR
+#define _TKCOLOR
+
+#include <tkInt.h>
+
+/*
+ * One of the following data structures is used to keep track of
+ * each color that the color module has allocated from the X display
+ * server.
+ */
+
+#define COLOR_MAGIC ((unsigned int) 0x46140277)
+
+typedef struct TkColor {
+ XColor color; /* Information about this color. */
+ unsigned int magic; /* Used for quick integrity check on this
+ * structure. Must always have the
+ * value COLOR_MAGIC. */
+ GC gc; /* Simple gc with this color as foreground
+ * color and all other fields defaulted.
+ * May be None. */
+ Screen *screen; /* Screen where this color is valid. Used
+ * to delete it, and to find its display. */
+ Colormap colormap; /* Colormap from which this entry was
+ * allocated. */
+ Visual *visual; /* Visual associated with colormap. */
+ int refCount; /* Number of uses of this structure. */
+ Tcl_HashTable *tablePtr; /* Hash table that indexes this structure
+ * (needed when deleting structure). */
+ Tcl_HashEntry *hashPtr; /* Pointer to hash table entry for this
+ * structure. (for use in deleting entry). */
+} TkColor;
+
+/*
+ * Common APIs exported from all platform-specific implementations.
+ */
+
+#ifndef TkpFreeColor
+EXTERN void TkpFreeColor _ANSI_ARGS_((TkColor *tkColPtr));
+#endif
+EXTERN TkColor * TkpGetColor _ANSI_ARGS_((Tk_Window tkwin,
+ Tk_Uid name));
+EXTERN TkColor * TkpGetColorByValue _ANSI_ARGS_((Tk_Window tkwin,
+ XColor *colorPtr));
+
+#endif /* _TKCOLOR */
diff --git a/generic/tkConfig.c b/generic/tkConfig.c
new file mode 100644
index 0000000..2204714
--- /dev/null
+++ b/generic/tkConfig.c
@@ -0,0 +1,990 @@
+/*
+ * tkConfig.c --
+ *
+ * This file contains the Tk_ConfigureWidget procedure.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkConfig.c 1.53 96/04/26 10:29:31
+ */
+
+#include "tkPort.h"
+#include "tk.h"
+
+/*
+ * Values for "flags" field of Tk_ConfigSpec structures. Be sure
+ * to coordinate these values with those defined in tk.h
+ * (TK_CONFIG_COLOR_ONLY, etc.). There must not be overlap!
+ *
+ * INIT - Non-zero means (char *) things have been
+ * converted to Tk_Uid's.
+ */
+
+#define INIT 0x20
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int DoConfig _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_ConfigSpec *specPtr,
+ Tk_Uid value, int valueIsUid, char *widgRec));
+static Tk_ConfigSpec * FindConfigSpec _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_ConfigSpec *specs, char *argvName,
+ int needFlags, int hateFlags));
+static char * FormatConfigInfo _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_ConfigSpec *specPtr,
+ char *widgRec));
+static char * FormatConfigValue _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_ConfigSpec *specPtr,
+ char *widgRec, char *buffer,
+ Tcl_FreeProc **freeProcPtr));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ConfigureWidget --
+ *
+ * Process command-line options and database options to
+ * fill in fields of a widget record with resources and
+ * other parameters.
+ *
+ * Results:
+ * A standard Tcl return value. In case of an error,
+ * interp->result will hold an error message.
+ *
+ * Side effects:
+ * The fields of widgRec get filled in with information
+ * from argc/argv and the option database. Old information
+ * in widgRec's fields gets recycled.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_ConfigureWidget(interp, tkwin, specs, argc, argv, widgRec, flags)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Window tkwin; /* Window containing widget (needed to
+ * set up X resources). */
+ Tk_ConfigSpec *specs; /* Describes legal options. */
+ int argc; /* Number of elements in argv. */
+ char **argv; /* Command-line options. */
+ char *widgRec; /* Record whose fields are to be
+ * modified. Values must be properly
+ * initialized. */
+ int flags; /* Used to specify additional flags
+ * that must be present in config specs
+ * for them to be considered. Also,
+ * may have TK_CONFIG_ARGV_ONLY set. */
+{
+ register Tk_ConfigSpec *specPtr;
+ Tk_Uid value; /* Value of option from database. */
+ int needFlags; /* Specs must contain this set of flags
+ * or else they are not considered. */
+ int hateFlags; /* If a spec contains any bits here, it's
+ * not considered. */
+
+ needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
+ if (Tk_Depth(tkwin) <= 1) {
+ hateFlags = TK_CONFIG_COLOR_ONLY;
+ } else {
+ hateFlags = TK_CONFIG_MONO_ONLY;
+ }
+
+ /*
+ * Pass one: scan through all the option specs, replacing strings
+ * with Tk_Uids (if this hasn't been done already) and clearing
+ * the TK_CONFIG_OPTION_SPECIFIED flags.
+ */
+
+ for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
+ if (!(specPtr->specFlags & INIT) && (specPtr->argvName != NULL)) {
+ if (specPtr->dbName != NULL) {
+ specPtr->dbName = Tk_GetUid(specPtr->dbName);
+ }
+ if (specPtr->dbClass != NULL) {
+ specPtr->dbClass = Tk_GetUid(specPtr->dbClass);
+ }
+ if (specPtr->defValue != NULL) {
+ specPtr->defValue = Tk_GetUid(specPtr->defValue);
+ }
+ }
+ specPtr->specFlags = (specPtr->specFlags & ~TK_CONFIG_OPTION_SPECIFIED)
+ | INIT;
+ }
+
+ /*
+ * Pass two: scan through all of the arguments, processing those
+ * that match entries in the specs.
+ */
+
+ for ( ; argc > 0; argc -= 2, argv += 2) {
+ specPtr = FindConfigSpec(interp, specs, *argv, needFlags, hateFlags);
+ if (specPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Process the entry.
+ */
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "value for \"", *argv,
+ "\" missing", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (DoConfig(interp, tkwin, specPtr, argv[1], 0, widgRec) != TCL_OK) {
+ char msg[100];
+
+ sprintf(msg, "\n (processing \"%.40s\" option)",
+ specPtr->argvName);
+ Tcl_AddErrorInfo(interp, msg);
+ return TCL_ERROR;
+ }
+ specPtr->specFlags |= TK_CONFIG_OPTION_SPECIFIED;
+ }
+
+ /*
+ * Pass three: scan through all of the specs again; if no
+ * command-line argument matched a spec, then check for info
+ * in the option database. If there was nothing in the
+ * database, then use the default.
+ */
+
+ if (!(flags & TK_CONFIG_ARGV_ONLY)) {
+ for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
+ if ((specPtr->specFlags & TK_CONFIG_OPTION_SPECIFIED)
+ || (specPtr->argvName == NULL)
+ || (specPtr->type == TK_CONFIG_SYNONYM)) {
+ continue;
+ }
+ if (((specPtr->specFlags & needFlags) != needFlags)
+ || (specPtr->specFlags & hateFlags)) {
+ continue;
+ }
+ value = NULL;
+ if (specPtr->dbName != NULL) {
+ value = Tk_GetOption(tkwin, specPtr->dbName, specPtr->dbClass);
+ }
+ if (value != NULL) {
+ if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) !=
+ TCL_OK) {
+ char msg[200];
+
+ sprintf(msg, "\n (%s \"%.50s\" in widget \"%.50s\")",
+ "database entry for",
+ specPtr->dbName, Tk_PathName(tkwin));
+ Tcl_AddErrorInfo(interp, msg);
+ return TCL_ERROR;
+ }
+ } else {
+ value = specPtr->defValue;
+ if ((value != NULL) && !(specPtr->specFlags
+ & TK_CONFIG_DONT_SET_DEFAULT)) {
+ if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) !=
+ TCL_OK) {
+ char msg[200];
+
+ sprintf(msg,
+ "\n (%s \"%.50s\" in widget \"%.50s\")",
+ "default value for",
+ specPtr->dbName, Tk_PathName(tkwin));
+ Tcl_AddErrorInfo(interp, msg);
+ return TCL_ERROR;
+ }
+ }
+ }
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FindConfigSpec --
+ *
+ * Search through a table of configuration specs, looking for
+ * one that matches a given argvName.
+ *
+ * Results:
+ * The return value is a pointer to the matching entry, or NULL
+ * if nothing matched. In that case an error message is left
+ * in interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Tk_ConfigSpec *
+FindConfigSpec(interp, specs, argvName, needFlags, hateFlags)
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_ConfigSpec *specs; /* Pointer to table of configuration
+ * specifications for a widget. */
+ char *argvName; /* Name (suitable for use in a "config"
+ * command) identifying particular option. */
+ int needFlags; /* Flags that must be present in matching
+ * entry. */
+ int hateFlags; /* Flags that must NOT be present in
+ * matching entry. */
+{
+ register Tk_ConfigSpec *specPtr;
+ register char c; /* First character of current argument. */
+ Tk_ConfigSpec *matchPtr; /* Matching spec, or NULL. */
+ size_t length;
+
+ c = argvName[1];
+ length = strlen(argvName);
+ matchPtr = NULL;
+ for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
+ if (specPtr->argvName == NULL) {
+ continue;
+ }
+ if ((specPtr->argvName[1] != c)
+ || (strncmp(specPtr->argvName, argvName, length) != 0)) {
+ continue;
+ }
+ if (((specPtr->specFlags & needFlags) != needFlags)
+ || (specPtr->specFlags & hateFlags)) {
+ continue;
+ }
+ if (specPtr->argvName[length] == 0) {
+ matchPtr = specPtr;
+ goto gotMatch;
+ }
+ if (matchPtr != NULL) {
+ Tcl_AppendResult(interp, "ambiguous option \"", argvName,
+ "\"", (char *) NULL);
+ return (Tk_ConfigSpec *) NULL;
+ }
+ matchPtr = specPtr;
+ }
+
+ if (matchPtr == NULL) {
+ Tcl_AppendResult(interp, "unknown option \"", argvName,
+ "\"", (char *) NULL);
+ return (Tk_ConfigSpec *) NULL;
+ }
+
+ /*
+ * Found a matching entry. If it's a synonym, then find the
+ * entry that it's a synonym for.
+ */
+
+ gotMatch:
+ specPtr = matchPtr;
+ if (specPtr->type == TK_CONFIG_SYNONYM) {
+ for (specPtr = specs; ; specPtr++) {
+ if (specPtr->type == TK_CONFIG_END) {
+ Tcl_AppendResult(interp,
+ "couldn't find synonym for option \"",
+ argvName, "\"", (char *) NULL);
+ return (Tk_ConfigSpec *) NULL;
+ }
+ if ((specPtr->dbName == matchPtr->dbName)
+ && (specPtr->type != TK_CONFIG_SYNONYM)
+ && ((specPtr->specFlags & needFlags) == needFlags)
+ && !(specPtr->specFlags & hateFlags)) {
+ break;
+ }
+ }
+ }
+ return specPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DoConfig --
+ *
+ * This procedure applies a single configuration option
+ * to a widget record.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * WidgRec is modified as indicated by specPtr and value.
+ * The old value is recycled, if that is appropriate for
+ * the value type.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+DoConfig(interp, tkwin, specPtr, value, valueIsUid, widgRec)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Window tkwin; /* Window containing widget (needed to
+ * set up X resources). */
+ Tk_ConfigSpec *specPtr; /* Specifier to apply. */
+ char *value; /* Value to use to fill in widgRec. */
+ int valueIsUid; /* Non-zero means value is a Tk_Uid;
+ * zero means it's an ordinary string. */
+ char *widgRec; /* Record whose fields are to be
+ * modified. Values must be properly
+ * initialized. */
+{
+ char *ptr;
+ Tk_Uid uid;
+ int nullValue;
+
+ nullValue = 0;
+ if ((*value == 0) && (specPtr->specFlags & TK_CONFIG_NULL_OK)) {
+ nullValue = 1;
+ }
+
+ do {
+ ptr = widgRec + specPtr->offset;
+ switch (specPtr->type) {
+ case TK_CONFIG_BOOLEAN:
+ if (Tcl_GetBoolean(interp, value, (int *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_INT:
+ if (Tcl_GetInt(interp, value, (int *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_DOUBLE:
+ if (Tcl_GetDouble(interp, value, (double *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_STRING: {
+ char *old, *new;
+
+ if (nullValue) {
+ new = NULL;
+ } else {
+ new = (char *) ckalloc((unsigned) (strlen(value) + 1));
+ strcpy(new, value);
+ }
+ old = *((char **) ptr);
+ if (old != NULL) {
+ ckfree(old);
+ }
+ *((char **) ptr) = new;
+ break;
+ }
+ case TK_CONFIG_UID:
+ if (nullValue) {
+ *((Tk_Uid *) ptr) = NULL;
+ } else {
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ *((Tk_Uid *) ptr) = uid;
+ }
+ break;
+ case TK_CONFIG_COLOR: {
+ XColor *newPtr, *oldPtr;
+
+ if (nullValue) {
+ newPtr = NULL;
+ } else {
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ newPtr = Tk_GetColor(interp, tkwin, uid);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ oldPtr = *((XColor **) ptr);
+ if (oldPtr != NULL) {
+ Tk_FreeColor(oldPtr);
+ }
+ *((XColor **) ptr) = newPtr;
+ break;
+ }
+ case TK_CONFIG_FONT: {
+ Tk_Font new;
+
+ if (nullValue) {
+ new = NULL;
+ } else {
+ new = Tk_GetFont(interp, tkwin, value);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ Tk_FreeFont(*((Tk_Font *) ptr));
+ *((Tk_Font *) ptr) = new;
+ break;
+ }
+ case TK_CONFIG_BITMAP: {
+ Pixmap new, old;
+
+ if (nullValue) {
+ new = None;
+ } else {
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ new = Tk_GetBitmap(interp, tkwin, uid);
+ if (new == None) {
+ return TCL_ERROR;
+ }
+ }
+ old = *((Pixmap *) ptr);
+ if (old != None) {
+ Tk_FreeBitmap(Tk_Display(tkwin), old);
+ }
+ *((Pixmap *) ptr) = new;
+ break;
+ }
+ case TK_CONFIG_BORDER: {
+ Tk_3DBorder new, old;
+
+ if (nullValue) {
+ new = NULL;
+ } else {
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ new = Tk_Get3DBorder(interp, tkwin, uid);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ old = *((Tk_3DBorder *) ptr);
+ if (old != NULL) {
+ Tk_Free3DBorder(old);
+ }
+ *((Tk_3DBorder *) ptr) = new;
+ break;
+ }
+ case TK_CONFIG_RELIEF:
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ if (Tk_GetRelief(interp, uid, (int *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_CURSOR:
+ case TK_CONFIG_ACTIVE_CURSOR: {
+ Tk_Cursor new, old;
+
+ if (nullValue) {
+ new = None;
+ } else {
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ new = Tk_GetCursor(interp, tkwin, uid);
+ if (new == None) {
+ return TCL_ERROR;
+ }
+ }
+ old = *((Tk_Cursor *) ptr);
+ if (old != None) {
+ Tk_FreeCursor(Tk_Display(tkwin), old);
+ }
+ *((Tk_Cursor *) ptr) = new;
+ if (specPtr->type == TK_CONFIG_ACTIVE_CURSOR) {
+ Tk_DefineCursor(tkwin, new);
+ }
+ break;
+ }
+ case TK_CONFIG_JUSTIFY:
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ if (Tk_GetJustify(interp, uid, (Tk_Justify *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_ANCHOR:
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ if (Tk_GetAnchor(interp, uid, (Tk_Anchor *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_CAP_STYLE:
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ if (Tk_GetCapStyle(interp, uid, (int *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_JOIN_STYLE:
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ if (Tk_GetJoinStyle(interp, uid, (int *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_PIXELS:
+ if (Tk_GetPixels(interp, tkwin, value, (int *) ptr)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_MM:
+ if (Tk_GetScreenMM(interp, tkwin, value, (double *) ptr)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_WINDOW: {
+ Tk_Window tkwin2;
+
+ if (nullValue) {
+ tkwin2 = NULL;
+ } else {
+ tkwin2 = Tk_NameToWindow(interp, value, tkwin);
+ if (tkwin2 == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ *((Tk_Window *) ptr) = tkwin2;
+ break;
+ }
+ case TK_CONFIG_CUSTOM:
+ if ((*specPtr->customPtr->parseProc)(
+ specPtr->customPtr->clientData, interp, tkwin,
+ value, widgRec, specPtr->offset) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ default: {
+ sprintf(interp->result, "bad config table: unknown type %d",
+ specPtr->type);
+ return TCL_ERROR;
+ }
+ }
+ specPtr++;
+ } while ((specPtr->argvName == NULL) && (specPtr->type != TK_CONFIG_END));
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ConfigureInfo --
+ *
+ * Return information about the configuration options
+ * for a window, and their current values.
+ *
+ * Results:
+ * Always returns TCL_OK. Interp->result will be modified
+ * hold a description of either a single configuration option
+ * available for "widgRec" via "specs", or all the configuration
+ * options available. In the "all" case, the result will
+ * available for "widgRec" via "specs". The result will
+ * be a list, each of whose entries describes one option.
+ * Each entry will itself be a list containing the option's
+ * name for use on command lines, database name, database
+ * class, default value, and current value (empty string
+ * if none). For options that are synonyms, the list will
+ * contain only two values: name and synonym name. If the
+ * "name" argument is non-NULL, then the only information
+ * returned is that for the named argument (i.e. the corresponding
+ * entry in the overall list is returned).
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_ConfigureInfo(interp, tkwin, specs, widgRec, argvName, flags)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Window tkwin; /* Window corresponding to widgRec. */
+ Tk_ConfigSpec *specs; /* Describes legal options. */
+ char *widgRec; /* Record whose fields contain current
+ * values for options. */
+ char *argvName; /* If non-NULL, indicates a single option
+ * whose info is to be returned. Otherwise
+ * info is returned for all options. */
+ int flags; /* Used to specify additional flags
+ * that must be present in config specs
+ * for them to be considered. */
+{
+ register Tk_ConfigSpec *specPtr;
+ int needFlags, hateFlags;
+ char *list;
+ char *leader = "{";
+
+ needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
+ if (Tk_Depth(tkwin) <= 1) {
+ hateFlags = TK_CONFIG_COLOR_ONLY;
+ } else {
+ hateFlags = TK_CONFIG_MONO_ONLY;
+ }
+
+ /*
+ * If information is only wanted for a single configuration
+ * spec, then handle that one spec specially.
+ */
+
+ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
+ if (argvName != NULL) {
+ specPtr = FindConfigSpec(interp, specs, argvName, needFlags,
+ hateFlags);
+ if (specPtr == NULL) {
+ return TCL_ERROR;
+ }
+ interp->result = FormatConfigInfo(interp, tkwin, specPtr, widgRec);
+ interp->freeProc = TCL_DYNAMIC;
+ return TCL_OK;
+ }
+
+ /*
+ * Loop through all the specs, creating a big list with all
+ * their information.
+ */
+
+ for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
+ if ((argvName != NULL) && (specPtr->argvName != argvName)) {
+ continue;
+ }
+ if (((specPtr->specFlags & needFlags) != needFlags)
+ || (specPtr->specFlags & hateFlags)) {
+ continue;
+ }
+ if (specPtr->argvName == NULL) {
+ continue;
+ }
+ list = FormatConfigInfo(interp, tkwin, specPtr, widgRec);
+ Tcl_AppendResult(interp, leader, list, "}", (char *) NULL);
+ ckfree(list);
+ leader = " {";
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FormatConfigInfo --
+ *
+ * Create a valid Tcl list holding the configuration information
+ * for a single configuration option.
+ *
+ * Results:
+ * A Tcl list, dynamically allocated. The caller is expected to
+ * arrange for this list to be freed eventually.
+ *
+ * Side effects:
+ * Memory is allocated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static char *
+FormatConfigInfo(interp, tkwin, specPtr, widgRec)
+ Tcl_Interp *interp; /* Interpreter to use for things
+ * like floating-point precision. */
+ Tk_Window tkwin; /* Window corresponding to widget. */
+ register Tk_ConfigSpec *specPtr; /* Pointer to information describing
+ * option. */
+ char *widgRec; /* Pointer to record holding current
+ * values of info for widget. */
+{
+ char *argv[6], *result;
+ char buffer[200];
+ Tcl_FreeProc *freeProc = (Tcl_FreeProc *) NULL;
+
+ argv[0] = specPtr->argvName;
+ argv[1] = specPtr->dbName;
+ argv[2] = specPtr->dbClass;
+ argv[3] = specPtr->defValue;
+ if (specPtr->type == TK_CONFIG_SYNONYM) {
+ return Tcl_Merge(2, argv);
+ }
+ argv[4] = FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer,
+ &freeProc);
+ if (argv[1] == NULL) {
+ argv[1] = "";
+ }
+ if (argv[2] == NULL) {
+ argv[2] = "";
+ }
+ if (argv[3] == NULL) {
+ argv[3] = "";
+ }
+ if (argv[4] == NULL) {
+ argv[4] = "";
+ }
+ result = Tcl_Merge(5, argv);
+ if (freeProc != NULL) {
+ if ((freeProc == TCL_DYNAMIC) || (freeProc == (Tcl_FreeProc *) free)) {
+ ckfree(argv[4]);
+ } else {
+ (*freeProc)(argv[4]);
+ }
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FormatConfigValue --
+ *
+ * This procedure formats the current value of a configuration
+ * option.
+ *
+ * Results:
+ * The return value is the formatted value of the option given
+ * by specPtr and widgRec. If the value is static, so that it
+ * need not be freed, *freeProcPtr will be set to NULL; otherwise
+ * *freeProcPtr will be set to the address of a procedure to
+ * free the result, and the caller must invoke this procedure
+ * when it is finished with the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer, freeProcPtr)
+ Tcl_Interp *interp; /* Interpreter for use in real conversions. */
+ Tk_Window tkwin; /* Window corresponding to widget. */
+ Tk_ConfigSpec *specPtr; /* Pointer to information describing option.
+ * Must not point to a synonym option. */
+ char *widgRec; /* Pointer to record holding current
+ * values of info for widget. */
+ char *buffer; /* Static buffer to use for small values.
+ * Must have at least 200 bytes of storage. */
+ Tcl_FreeProc **freeProcPtr; /* Pointer to word to fill in with address
+ * of procedure to free the result, or NULL
+ * if result is static. */
+{
+ char *ptr, *result;
+
+ *freeProcPtr = NULL;
+ ptr = widgRec + specPtr->offset;
+ result = "";
+ switch (specPtr->type) {
+ case TK_CONFIG_BOOLEAN:
+ if (*((int *) ptr) == 0) {
+ result = "0";
+ } else {
+ result = "1";
+ }
+ break;
+ case TK_CONFIG_INT:
+ sprintf(buffer, "%d", *((int *) ptr));
+ result = buffer;
+ break;
+ case TK_CONFIG_DOUBLE:
+ Tcl_PrintDouble(interp, *((double *) ptr), buffer);
+ result = buffer;
+ break;
+ case TK_CONFIG_STRING:
+ result = (*(char **) ptr);
+ if (result == NULL) {
+ result = "";
+ }
+ break;
+ case TK_CONFIG_UID: {
+ Tk_Uid uid = *((Tk_Uid *) ptr);
+ if (uid != NULL) {
+ result = uid;
+ }
+ break;
+ }
+ case TK_CONFIG_COLOR: {
+ XColor *colorPtr = *((XColor **) ptr);
+ if (colorPtr != NULL) {
+ result = Tk_NameOfColor(colorPtr);
+ }
+ break;
+ }
+ case TK_CONFIG_FONT: {
+ Tk_Font tkfont = *((Tk_Font *) ptr);
+ if (tkfont != NULL) {
+ result = Tk_NameOfFont(tkfont);
+ }
+ break;
+ }
+ case TK_CONFIG_BITMAP: {
+ Pixmap pixmap = *((Pixmap *) ptr);
+ if (pixmap != None) {
+ result = Tk_NameOfBitmap(Tk_Display(tkwin), pixmap);
+ }
+ break;
+ }
+ case TK_CONFIG_BORDER: {
+ Tk_3DBorder border = *((Tk_3DBorder *) ptr);
+ if (border != NULL) {
+ result = Tk_NameOf3DBorder(border);
+ }
+ break;
+ }
+ case TK_CONFIG_RELIEF:
+ result = Tk_NameOfRelief(*((int *) ptr));
+ break;
+ case TK_CONFIG_CURSOR:
+ case TK_CONFIG_ACTIVE_CURSOR: {
+ Tk_Cursor cursor = *((Tk_Cursor *) ptr);
+ if (cursor != None) {
+ result = Tk_NameOfCursor(Tk_Display(tkwin), cursor);
+ }
+ break;
+ }
+ case TK_CONFIG_JUSTIFY:
+ result = Tk_NameOfJustify(*((Tk_Justify *) ptr));
+ break;
+ case TK_CONFIG_ANCHOR:
+ result = Tk_NameOfAnchor(*((Tk_Anchor *) ptr));
+ break;
+ case TK_CONFIG_CAP_STYLE:
+ result = Tk_NameOfCapStyle(*((int *) ptr));
+ break;
+ case TK_CONFIG_JOIN_STYLE:
+ result = Tk_NameOfJoinStyle(*((int *) ptr));
+ break;
+ case TK_CONFIG_PIXELS:
+ sprintf(buffer, "%d", *((int *) ptr));
+ result = buffer;
+ break;
+ case TK_CONFIG_MM:
+ Tcl_PrintDouble(interp, *((double *) ptr), buffer);
+ result = buffer;
+ break;
+ case TK_CONFIG_WINDOW: {
+ Tk_Window tkwin;
+
+ tkwin = *((Tk_Window *) ptr);
+ if (tkwin != NULL) {
+ result = Tk_PathName(tkwin);
+ }
+ break;
+ }
+ case TK_CONFIG_CUSTOM:
+ result = (*specPtr->customPtr->printProc)(
+ specPtr->customPtr->clientData, tkwin, widgRec,
+ specPtr->offset, freeProcPtr);
+ break;
+ default:
+ result = "?? unknown type ??";
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ConfigureValue --
+ *
+ * This procedure returns the current value of a configuration
+ * option for a widget.
+ *
+ * Results:
+ * The return value is a standard Tcl completion code (TCL_OK or
+ * TCL_ERROR). Interp->result will be set to hold either the value
+ * of the option given by argvName (if TCL_OK is returned) or
+ * an error message (if TCL_ERROR is returned).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ConfigureValue(interp, tkwin, specs, widgRec, argvName, flags)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Window tkwin; /* Window corresponding to widgRec. */
+ Tk_ConfigSpec *specs; /* Describes legal options. */
+ char *widgRec; /* Record whose fields contain current
+ * values for options. */
+ char *argvName; /* Gives the command-line name for the
+ * option whose value is to be returned. */
+ int flags; /* Used to specify additional flags
+ * that must be present in config specs
+ * for them to be considered. */
+{
+ Tk_ConfigSpec *specPtr;
+ int needFlags, hateFlags;
+
+ needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
+ if (Tk_Depth(tkwin) <= 1) {
+ hateFlags = TK_CONFIG_COLOR_ONLY;
+ } else {
+ hateFlags = TK_CONFIG_MONO_ONLY;
+ }
+ specPtr = FindConfigSpec(interp, specs, argvName, needFlags, hateFlags);
+ if (specPtr == NULL) {
+ return TCL_ERROR;
+ }
+ interp->result = FormatConfigValue(interp, tkwin, specPtr, widgRec,
+ interp->result, &interp->freeProc);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeOptions --
+ *
+ * Free up all resources associated with configuration options.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Any resource in widgRec that is controlled by a configuration
+ * option (e.g. a Tk_3DBorder or XColor) is freed in the appropriate
+ * fashion.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+void
+Tk_FreeOptions(specs, widgRec, display, needFlags)
+ Tk_ConfigSpec *specs; /* Describes legal options. */
+ char *widgRec; /* Record whose fields contain current
+ * values for options. */
+ Display *display; /* X display; needed for freeing some
+ * resources. */
+ int needFlags; /* Used to specify additional flags
+ * that must be present in config specs
+ * for them to be considered. */
+{
+ register Tk_ConfigSpec *specPtr;
+ char *ptr;
+
+ for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
+ if ((specPtr->specFlags & needFlags) != needFlags) {
+ continue;
+ }
+ ptr = widgRec + specPtr->offset;
+ switch (specPtr->type) {
+ case TK_CONFIG_STRING:
+ if (*((char **) ptr) != NULL) {
+ ckfree(*((char **) ptr));
+ *((char **) ptr) = NULL;
+ }
+ break;
+ case TK_CONFIG_COLOR:
+ if (*((XColor **) ptr) != NULL) {
+ Tk_FreeColor(*((XColor **) ptr));
+ *((XColor **) ptr) = NULL;
+ }
+ break;
+ case TK_CONFIG_FONT:
+ Tk_FreeFont(*((Tk_Font *) ptr));
+ *((Tk_Font *) ptr) = NULL;
+ break;
+ case TK_CONFIG_BITMAP:
+ if (*((Pixmap *) ptr) != None) {
+ Tk_FreeBitmap(display, *((Pixmap *) ptr));
+ *((Pixmap *) ptr) = None;
+ }
+ break;
+ case TK_CONFIG_BORDER:
+ if (*((Tk_3DBorder *) ptr) != NULL) {
+ Tk_Free3DBorder(*((Tk_3DBorder *) ptr));
+ *((Tk_3DBorder *) ptr) = NULL;
+ }
+ break;
+ case TK_CONFIG_CURSOR:
+ case TK_CONFIG_ACTIVE_CURSOR:
+ if (*((Tk_Cursor *) ptr) != None) {
+ Tk_FreeCursor(display, *((Tk_Cursor *) ptr));
+ *((Tk_Cursor *) ptr) = None;
+ }
+ }
+ }
+}
diff --git a/generic/tkConsole.c b/generic/tkConsole.c
new file mode 100644
index 0000000..c213371
--- /dev/null
+++ b/generic/tkConsole.c
@@ -0,0 +1,616 @@
+/*
+ * tkConsole.c --
+ *
+ * This file implements a Tcl console for systems that may not
+ * otherwise have access to a console. It uses the Text widget
+ * and provides special access via a console command.
+ *
+ * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkConsole.c 1.54 97/10/17 10:46:08
+ */
+
+#include "tk.h"
+#include <string.h>
+
+/*
+ * A data structure of the following type holds information for each console
+ * which a handler (i.e. a Tcl command) has been defined for a particular
+ * top-level window.
+ */
+
+typedef struct ConsoleInfo {
+ Tcl_Interp *consoleInterp; /* Interpreter for the console. */
+ Tcl_Interp *interp; /* Interpreter to send console commands. */
+} ConsoleInfo;
+
+static Tcl_Interp *gStdoutInterp = NULL;
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ *
+ * The first three will be used in the tk app shells...
+ */
+
+void TkConsoleCreate _ANSI_ARGS_((void));
+int TkConsoleInit _ANSI_ARGS_((Tcl_Interp *interp));
+void TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp,
+ int devId, char *buffer, long size));
+
+static int ConsoleCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void ConsoleDeleteProc _ANSI_ARGS_((ClientData clientData));
+static void ConsoleEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int InterpreterCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+
+static int ConsoleInput _ANSI_ARGS_((ClientData instanceData,
+ char *buf, int toRead, int *errorCode));
+static int ConsoleOutput _ANSI_ARGS_((ClientData instanceData,
+ char *buf, int toWrite, int *errorCode));
+static int ConsoleClose _ANSI_ARGS_((ClientData instanceData,
+ Tcl_Interp *interp));
+static void ConsoleWatch _ANSI_ARGS_((ClientData instanceData,
+ int mask));
+static int ConsoleHandle _ANSI_ARGS_((ClientData instanceData,
+ int direction, ClientData *handlePtr));
+
+/*
+ * This structure describes the channel type structure for file based IO:
+ */
+
+static Tcl_ChannelType consoleChannelType = {
+ "console", /* Type name. */
+ NULL, /* Always non-blocking.*/
+ ConsoleClose, /* Close proc. */
+ ConsoleInput, /* Input proc. */
+ ConsoleOutput, /* Output proc. */
+ NULL, /* Seek proc. */
+ NULL, /* Set option proc. */
+ NULL, /* Get option proc. */
+ ConsoleWatch, /* Watch for events on console. */
+ ConsoleHandle, /* Get a handle from the device. */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkConsoleCreate --
+ *
+ * Create the console channels and install them as the standard
+ * channels. All I/O will be discarded until TkConsoleInit is
+ * called to attach the console to a text widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates the console channel and installs it as the standard
+ * channels.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkConsoleCreate()
+{
+ Tcl_Channel consoleChannel;
+
+ consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
+ (ClientData) TCL_STDIN, TCL_READABLE);
+ if (consoleChannel != NULL) {
+ Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
+ Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
+ }
+ Tcl_SetStdChannel(consoleChannel, TCL_STDIN);
+ consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
+ (ClientData) TCL_STDOUT, TCL_WRITABLE);
+ if (consoleChannel != NULL) {
+ Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
+ Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
+ }
+ Tcl_SetStdChannel(consoleChannel, TCL_STDOUT);
+ consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
+ (ClientData) TCL_STDERR, TCL_WRITABLE);
+ if (consoleChannel != NULL) {
+ Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
+ Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
+ }
+ Tcl_SetStdChannel(consoleChannel, TCL_STDERR);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkConsoleInit --
+ *
+ * Initialize the console. This code actually creates a new
+ * application and associated interpreter. This effectivly hides
+ * the implementation from the main application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new console it created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkConsoleInit(interp)
+ Tcl_Interp *interp; /* Interpreter to use for prompting. */
+{
+ Tcl_Interp *consoleInterp;
+ ConsoleInfo *info;
+ Tk_Window mainWindow = Tk_MainWindow(interp);
+#ifdef MAC_TCL
+ static char initCmd[] = "source -rsrc {Console}";
+#else
+ static char initCmd[] = "source $tk_library/console.tcl";
+#endif
+
+ consoleInterp = Tcl_CreateInterp();
+ if (consoleInterp == NULL) {
+ goto error;
+ }
+
+ /*
+ * Initialized Tcl and Tk.
+ */
+
+ if (Tcl_Init(consoleInterp) != TCL_OK) {
+ goto error;
+ }
+ if (Tk_Init(consoleInterp) != TCL_OK) {
+ goto error;
+ }
+ gStdoutInterp = interp;
+
+ /*
+ * Add console commands to the interp
+ */
+ info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
+ info->interp = interp;
+ info->consoleInterp = consoleInterp;
+ Tcl_CreateCommand(interp, "console", ConsoleCmd, (ClientData) info,
+ (Tcl_CmdDeleteProc *) ConsoleDeleteProc);
+ Tcl_CreateCommand(consoleInterp, "consoleinterp", InterpreterCmd,
+ (ClientData) info, (Tcl_CmdDeleteProc *) NULL);
+
+ Tk_CreateEventHandler(mainWindow, StructureNotifyMask, ConsoleEventProc,
+ (ClientData) info);
+
+ Tcl_Preserve((ClientData) consoleInterp);
+ if (Tcl_Eval(consoleInterp, initCmd) == TCL_ERROR) {
+ /* goto error; -- no problem for now... */
+ printf("Eval error: %s", consoleInterp->result);
+ }
+ Tcl_Release((ClientData) consoleInterp);
+ return TCL_OK;
+
+ error:
+ if (consoleInterp != NULL) {
+ Tcl_DeleteInterp(consoleInterp);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleOutput--
+ *
+ * Writes the given output on the IO channel. Returns count of how
+ * many characters were actually written, and an error indication.
+ *
+ * Results:
+ * A count of how many characters were written is returned and an
+ * error indication is returned in an output argument.
+ *
+ * Side effects:
+ * Writes output on the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleOutput(instanceData, buf, toWrite, errorCode)
+ ClientData instanceData; /* Indicates which device to use. */
+ char *buf; /* The data buffer. */
+ int toWrite; /* How many bytes to write? */
+ int *errorCode; /* Where to store error code. */
+{
+ *errorCode = 0;
+ Tcl_SetErrno(0);
+
+ if (gStdoutInterp != NULL) {
+ TkConsolePrint(gStdoutInterp, (int) instanceData, buf, toWrite);
+ }
+
+ return toWrite;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleInput --
+ *
+ * Read input from the console. Not currently implemented.
+ *
+ * Results:
+ * Always returns EOF.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleInput(instanceData, buf, bufSize, errorCode)
+ ClientData instanceData; /* Unused. */
+ char *buf; /* Where to store data read. */
+ int bufSize; /* How much space is available
+ * in the buffer? */
+ int *errorCode; /* Where to store error code. */
+{
+ return 0; /* Always return EOF. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleClose --
+ *
+ * Closes the IO channel.
+ *
+ * Results:
+ * Always returns 0 (success).
+ *
+ * Side effects:
+ * Frees the dummy file associated with the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleClose(instanceData, interp)
+ ClientData instanceData; /* Unused. */
+ Tcl_Interp *interp; /* Unused. */
+{
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleWatch --
+ *
+ * Called by the notifier to set up the console device so that
+ * events will be noticed. Since there are no events on the
+ * console, this routine just returns without doing anything.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ConsoleWatch(instanceData, mask)
+ ClientData instanceData; /* Device ID for the channel. */
+ int mask; /* OR-ed combination of
+ * TCL_READABLE, TCL_WRITABLE and
+ * TCL_EXCEPTION, for the events
+ * we are interested in. */
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleHandle --
+ *
+ * Invoked by the generic IO layer to get a handle from a channel.
+ * Because console channels are not devices, this function always
+ * fails.
+ *
+ * Results:
+ * Always returns TCL_ERROR.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleHandle(instanceData, direction, handlePtr)
+ ClientData instanceData; /* Device ID for the channel. */
+ int direction; /* TCL_READABLE or TCL_WRITABLE to indicate
+ * which direction of the channel is being
+ * requested. */
+ ClientData *handlePtr; /* Where to store handle */
+{
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleCmd --
+ *
+ * The console command implements a Tcl interface to the various console
+ * options.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+ char c;
+ int length;
+ int result;
+ Tcl_Interp *consoleInterp;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ result = TCL_OK;
+ consoleInterp = info->consoleInterp;
+ Tcl_Preserve((ClientData) consoleInterp);
+ if ((c == 't') && (strncmp(argv[1], "title", length)) == 0) {
+ Tcl_DString dString;
+
+ Tcl_DStringInit(&dString);
+ Tcl_DStringAppend(&dString, "wm title . ", -1);
+ if (argc == 3) {
+ Tcl_DStringAppendElement(&dString, argv[2]);
+ }
+ Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
+ Tcl_DStringFree(&dString);
+ } else if ((c == 'h') && (strncmp(argv[1], "hide", length)) == 0) {
+ Tcl_Eval(info->consoleInterp, "wm withdraw .");
+ } else if ((c == 's') && (strncmp(argv[1], "show", length)) == 0) {
+ Tcl_Eval(info->consoleInterp, "wm deiconify .");
+ } else if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
+ if (argc == 3) {
+ Tcl_Eval(info->consoleInterp, argv[2]);
+ } else {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " eval command\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": should be hide, show, or title",
+ (char *) NULL);
+ result = TCL_ERROR;
+ }
+ Tcl_Release((ClientData) consoleInterp);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpreterCmd --
+ *
+ * This command allows the console interp to communicate with the
+ * main interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InterpreterCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+ char c;
+ int length;
+ int result;
+ Tcl_Interp *otherInterp;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ otherInterp = info->interp;
+ Tcl_Preserve((ClientData) otherInterp);
+ if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
+ result = Tcl_GlobalEval(otherInterp, argv[2]);
+ Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
+ } else if ((c == 'r') && (strncmp(argv[1], "record", length)) == 0) {
+ Tcl_RecordAndEval(otherInterp, argv[2], TCL_EVAL_GLOBAL);
+ result = TCL_OK;
+ Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": should be eval or record",
+ (char *) NULL);
+ result = TCL_ERROR;
+ }
+ Tcl_Release((ClientData) otherInterp);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleDeleteProc --
+ *
+ * If the console command is deleted we destroy the console window
+ * and all associated data structures.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new console it created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+ConsoleDeleteProc(clientData)
+ ClientData clientData;
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+
+ Tcl_DeleteInterp(info->consoleInterp);
+ info->consoleInterp = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleEventProc --
+ *
+ * This event procedure is registered on the main window of the
+ * slave interpreter. If the user or a running script causes the
+ * main window to be destroyed, then we need to inform the console
+ * interpreter by invoking "tkConsoleExit".
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Invokes the "tkConsoleExit" procedure in the console interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConsoleEventProc(clientData, eventPtr)
+ ClientData clientData;
+ XEvent *eventPtr;
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+ Tcl_Interp *consoleInterp;
+
+ if (eventPtr->type == DestroyNotify) {
+ consoleInterp = info->consoleInterp;
+
+ /*
+ * It is possible that the console interpreter itself has
+ * already been deleted. In that case the consoleInterp
+ * field will be set to NULL. If the interpreter is already
+ * gone, we do not have to do any work here.
+ */
+
+ if (consoleInterp == (Tcl_Interp *) NULL) {
+ return;
+ }
+ Tcl_Preserve((ClientData) consoleInterp);
+ Tcl_Eval(consoleInterp, "tkConsoleExit");
+ Tcl_Release((ClientData) consoleInterp);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkConsolePrint --
+ *
+ * Prints to the give text to the console. Given the main interp
+ * this functions find the appropiate console interp and forwards
+ * the text to be added to that console.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkConsolePrint(interp, devId, buffer, size)
+ Tcl_Interp *interp; /* Main interpreter. */
+ int devId; /* TCL_STDOUT for stdout, TCL_STDERR for
+ * stderr. */
+ char *buffer; /* Text buffer. */
+ long size; /* Size of text buffer. */
+{
+ Tcl_DString command, output;
+ Tcl_CmdInfo cmdInfo;
+ char *cmd;
+ ConsoleInfo *info;
+ Tcl_Interp *consoleInterp;
+ int result;
+
+ if (interp == NULL) {
+ return;
+ }
+
+ if (devId == TCL_STDERR) {
+ cmd = "tkConsoleOutput stderr ";
+ } else {
+ cmd = "tkConsoleOutput stdout ";
+ }
+
+ result = Tcl_GetCommandInfo(interp, "console", &cmdInfo);
+ if (result == 0) {
+ return;
+ }
+ info = (ConsoleInfo *) cmdInfo.clientData;
+
+ Tcl_DStringInit(&output);
+ Tcl_DStringAppend(&output, buffer, size);
+
+ Tcl_DStringInit(&command);
+ Tcl_DStringAppend(&command, cmd, strlen(cmd));
+ Tcl_DStringAppendElement(&command, output.string);
+
+ consoleInterp = info->consoleInterp;
+ Tcl_Preserve((ClientData) consoleInterp);
+ Tcl_Eval(consoleInterp, command.string);
+ Tcl_Release((ClientData) consoleInterp);
+
+ Tcl_DStringFree(&command);
+ Tcl_DStringFree(&output);
+}
diff --git a/generic/tkCursor.c b/generic/tkCursor.c
new file mode 100644
index 0000000..e185109
--- /dev/null
+++ b/generic/tkCursor.c
@@ -0,0 +1,384 @@
+/*
+ * tkCursor.c --
+ *
+ * This file maintains a database of read-only cursors for the Tk
+ * toolkit. This allows cursors to be shared between widgets and
+ * also avoids round-trips to the X server.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkCursor.c 1.27 96/02/15 18:52:40
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * A TkCursor structure exists for each cursor that is currently
+ * active. Each structure is indexed with two hash tables defined
+ * below. One of the tables is idTable, and the other is either
+ * nameTable or dataTable, also defined below.
+ */
+
+/*
+ * Hash table to map from a textual description of a cursor to the
+ * TkCursor record for the cursor, and key structure used in that
+ * hash table:
+ */
+
+static Tcl_HashTable nameTable;
+typedef struct {
+ Tk_Uid name; /* Textual name for desired cursor. */
+ Display *display; /* Display for which cursor will be used. */
+} NameKey;
+
+/*
+ * Hash table to map from a collection of in-core data about a
+ * cursor (bitmap contents, etc.) to a TkCursor structure:
+ */
+
+static Tcl_HashTable dataTable;
+typedef struct {
+ char *source; /* Cursor bits. */
+ char *mask; /* Mask bits. */
+ int width, height; /* Dimensions of cursor (and data
+ * and mask). */
+ int xHot, yHot; /* Location of cursor hot-spot. */
+ Tk_Uid fg, bg; /* Colors for cursor. */
+ Display *display; /* Display on which cursor will be used. */
+} DataKey;
+
+/*
+ * Hash table that maps from <display + cursor id> to the TkCursor structure
+ * for the cursor. This table is used by Tk_FreeCursor.
+ */
+
+static Tcl_HashTable idTable;
+typedef struct {
+ Display *display; /* Display for which cursor was allocated. */
+ Tk_Cursor cursor; /* Cursor identifier. */
+} IdKey;
+
+static int initialized = 0; /* 0 means static structures haven't been
+ * initialized yet. */
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void CursorInit _ANSI_ARGS_((void));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetCursor --
+ *
+ * Given a string describing a cursor, locate (or create if necessary)
+ * a cursor that fits the description.
+ *
+ * Results:
+ * The return value is the X identifer for the desired cursor,
+ * unless string couldn't be parsed correctly. In this case,
+ * None is returned and an error message is left in interp->result.
+ * The caller should never modify the cursor that is returned, and
+ * should eventually call Tk_FreeCursor when the cursor is no longer
+ * needed.
+ *
+ * Side effects:
+ * The cursor is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeCursor, so that the database can be cleaned up when cursors
+ * aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Cursor
+Tk_GetCursor(interp, tkwin, string)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ Tk_Window tkwin; /* Window in which cursor will be used. */
+ Tk_Uid string; /* Description of cursor. See manual entry
+ * for details on legal syntax. */
+{
+ NameKey nameKey;
+ IdKey idKey;
+ Tcl_HashEntry *nameHashPtr, *idHashPtr;
+ register TkCursor *cursorPtr;
+ int new;
+
+ if (!initialized) {
+ CursorInit();
+ }
+
+ nameKey.name = string;
+ nameKey.display = Tk_Display(tkwin);
+ nameHashPtr = Tcl_CreateHashEntry(&nameTable, (char *) &nameKey, &new);
+ if (!new) {
+ cursorPtr = (TkCursor *) Tcl_GetHashValue(nameHashPtr);
+ cursorPtr->refCount++;
+ return cursorPtr->cursor;
+ }
+
+ cursorPtr = TkGetCursorByName(interp, tkwin, string);
+
+ if (cursorPtr == NULL) {
+ Tcl_DeleteHashEntry(nameHashPtr);
+ return None;
+ }
+
+ /*
+ * Add information about this cursor to our database.
+ */
+
+ cursorPtr->refCount = 1;
+ cursorPtr->otherTable = &nameTable;
+ cursorPtr->hashPtr = nameHashPtr;
+ idKey.display = nameKey.display;
+ idKey.cursor = cursorPtr->cursor;
+ idHashPtr = Tcl_CreateHashEntry(&idTable, (char *) &idKey, &new);
+ if (!new) {
+ panic("cursor already registered in Tk_GetCursor");
+ }
+ Tcl_SetHashValue(nameHashPtr, cursorPtr);
+ Tcl_SetHashValue(idHashPtr, cursorPtr);
+
+ return cursorPtr->cursor;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetCursorFromData --
+ *
+ * Given a description of the bits and colors for a cursor,
+ * make a cursor that has the given properties.
+ *
+ * Results:
+ * The return value is the X identifer for the desired cursor,
+ * unless it couldn't be created properly. In this case, None is
+ * returned and an error message is left in interp->result. The
+ * caller should never modify the cursor that is returned, and
+ * should eventually call Tk_FreeCursor when the cursor is no
+ * longer needed.
+ *
+ * Side effects:
+ * The cursor is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeCursor, so that the database can be cleaned up when cursors
+ * aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Cursor
+Tk_GetCursorFromData(interp, tkwin, source, mask, width, height,
+ xHot, yHot, fg, bg)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ Tk_Window tkwin; /* Window in which cursor will be used. */
+ char *source; /* Bitmap data for cursor shape. */
+ char *mask; /* Bitmap data for cursor mask. */
+ int width, height; /* Dimensions of cursor. */
+ int xHot, yHot; /* Location of hot-spot in cursor. */
+ Tk_Uid fg; /* Foreground color for cursor. */
+ Tk_Uid bg; /* Background color for cursor. */
+{
+ DataKey dataKey;
+ IdKey idKey;
+ Tcl_HashEntry *dataHashPtr, *idHashPtr;
+ register TkCursor *cursorPtr;
+ int new;
+ XColor fgColor, bgColor;
+
+ if (!initialized) {
+ CursorInit();
+ }
+
+ dataKey.source = source;
+ dataKey.mask = mask;
+ dataKey.width = width;
+ dataKey.height = height;
+ dataKey.xHot = xHot;
+ dataKey.yHot = yHot;
+ dataKey.fg = fg;
+ dataKey.bg = bg;
+ dataKey.display = Tk_Display(tkwin);
+ dataHashPtr = Tcl_CreateHashEntry(&dataTable, (char *) &dataKey, &new);
+ if (!new) {
+ cursorPtr = (TkCursor *) Tcl_GetHashValue(dataHashPtr);
+ cursorPtr->refCount++;
+ return cursorPtr->cursor;
+ }
+
+ /*
+ * No suitable cursor exists yet. Make one using the data
+ * available and add it to the database.
+ */
+
+ if (XParseColor(dataKey.display, Tk_Colormap(tkwin), fg, &fgColor) == 0) {
+ Tcl_AppendResult(interp, "invalid color name \"", fg, "\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (XParseColor(dataKey.display, Tk_Colormap(tkwin), bg, &bgColor) == 0) {
+ Tcl_AppendResult(interp, "invalid color name \"", bg, "\"",
+ (char *) NULL);
+ goto error;
+ }
+
+ cursorPtr = TkCreateCursorFromData(tkwin, source, mask, width, height,
+ xHot, yHot, fgColor, bgColor);
+
+ if (cursorPtr == NULL) {
+ goto error;
+ }
+
+ cursorPtr->refCount = 1;
+ cursorPtr->otherTable = &dataTable;
+ cursorPtr->hashPtr = dataHashPtr;
+ idKey.display = dataKey.display;
+ idKey.cursor = cursorPtr->cursor;
+ idHashPtr = Tcl_CreateHashEntry(&idTable, (char *) &idKey, &new);
+ if (!new) {
+ panic("cursor already registered in Tk_GetCursorFromData");
+ }
+ Tcl_SetHashValue(dataHashPtr, cursorPtr);
+ Tcl_SetHashValue(idHashPtr, cursorPtr);
+ return cursorPtr->cursor;
+
+ error:
+ Tcl_DeleteHashEntry(dataHashPtr);
+ return None;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfCursor --
+ *
+ * Given a cursor, return a textual string identifying it.
+ *
+ * Results:
+ * If cursor was created by Tk_GetCursor, then the return
+ * value is the "string" that was used to create it.
+ * Otherwise the return value is a string giving the X
+ * identifier for the cursor. The storage for the returned
+ * string is only guaranteed to persist up until the next
+ * call to this procedure.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_NameOfCursor(display, cursor)
+ Display *display; /* Display for which cursor was allocated. */
+ Tk_Cursor cursor; /* Identifier for cursor whose name is
+ * wanted. */
+{
+ IdKey idKey;
+ Tcl_HashEntry *idHashPtr;
+ TkCursor *cursorPtr;
+ static char string[20];
+
+ if (!initialized) {
+ printid:
+ sprintf(string, "cursor id 0x%x", (unsigned int) cursor);
+ return string;
+ }
+ idKey.display = display;
+ idKey.cursor = cursor;
+ idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey);
+ if (idHashPtr == NULL) {
+ goto printid;
+ }
+ cursorPtr = (TkCursor *) Tcl_GetHashValue(idHashPtr);
+ if (cursorPtr->otherTable != &nameTable) {
+ goto printid;
+ }
+ return ((NameKey *) cursorPtr->hashPtr->key.words)->name;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeCursor --
+ *
+ * This procedure is called to release a cursor allocated by
+ * Tk_GetCursor or TkGetCursorFromData.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with cursor is decremented, and
+ * it is officially deallocated if no-one is using it anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeCursor(display, cursor)
+ Display *display; /* Display for which cursor was allocated. */
+ Tk_Cursor cursor; /* Identifier for cursor to be released. */
+{
+ IdKey idKey;
+ Tcl_HashEntry *idHashPtr;
+ register TkCursor *cursorPtr;
+
+ if (!initialized) {
+ panic("Tk_FreeCursor called before Tk_GetCursor");
+ }
+
+ idKey.display = display;
+ idKey.cursor = cursor;
+ idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey);
+ if (idHashPtr == NULL) {
+ panic("Tk_FreeCursor received unknown cursor argument");
+ }
+ cursorPtr = (TkCursor *) Tcl_GetHashValue(idHashPtr);
+ cursorPtr->refCount--;
+ if (cursorPtr->refCount == 0) {
+ Tcl_DeleteHashEntry(cursorPtr->hashPtr);
+ Tcl_DeleteHashEntry(idHashPtr);
+ TkFreeCursor(cursorPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CursorInit --
+ *
+ * Initialize the structures used for cursor management.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Read the code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CursorInit()
+{
+ initialized = 1;
+ Tcl_InitHashTable(&nameTable, sizeof(NameKey)/sizeof(int));
+ Tcl_InitHashTable(&dataTable, sizeof(DataKey)/sizeof(int));
+
+ /*
+ * The call below is tricky: can't use sizeof(IdKey) because it
+ * gets padded with extra unpredictable bytes on some 64-bit
+ * machines.
+ */
+
+ Tcl_InitHashTable(&idTable, (sizeof(Display *) + sizeof(Tk_Cursor))
+ /sizeof(int));
+}
diff --git a/generic/tkEntry.c b/generic/tkEntry.c
new file mode 100644
index 0000000..35cc66c
--- /dev/null
+++ b/generic/tkEntry.c
@@ -0,0 +1,2313 @@
+/*
+ * tkEntry.c --
+ *
+ * This module implements entry widgets for the Tk
+ * toolkit. An entry displays a string and allows
+ * the string to be edited.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkEntry.c 1.112 97/11/06 16:56:16
+ */
+
+#include "tkInt.h"
+#include "default.h"
+
+/*
+ * A data structure of the following type is kept for each entry
+ * widget managed by this file:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the entry. NULL
+ * means that the window has been destroyed
+ * but the data structures haven't yet been
+ * cleaned up.*/
+ Display *display; /* Display containing widget. Used, among
+ * other things, so that resources can be
+ * freed even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with entry. */
+ Tcl_Command widgetCmd; /* Token for entry's widget command. */
+
+ /*
+ * Fields that are set by widget commands other than "configure".
+ */
+
+ char *string; /* Pointer to storage for string;
+ * NULL-terminated; malloc-ed. */
+ int insertPos; /* Index of character before which next
+ * typed character will be inserted. */
+
+ /*
+ * Information about what's selected, if any.
+ */
+
+ int selectFirst; /* Index of first selected character (-1 means
+ * nothing selected. */
+ int selectLast; /* Index of last selected character (-1 means
+ * nothing selected. */
+ int selectAnchor; /* Fixed end of selection (i.e. "select to"
+ * operation will use this as one end of the
+ * selection). */
+
+ /*
+ * Information for scanning:
+ */
+
+ int scanMarkX; /* X-position at which scan started (e.g.
+ * button was pressed here). */
+ int scanMarkIndex; /* Index of character that was at left of
+ * window when scan started. */
+
+ /*
+ * Configuration settings that are updated by Tk_ConfigureWidget.
+ */
+
+ Tk_3DBorder normalBorder; /* Used for drawing border around whole
+ * window, plus used for background. */
+ int borderWidth; /* Width of 3-D border around window. */
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ int exportSelection; /* Non-zero means tie internal entry selection
+ * to X selection. */
+ Tk_Font tkfont; /* Information about text font, or NULL. */
+ XColor *fgColorPtr; /* Text color in normal mode. */
+ XColor *highlightBgColorPtr;/* Color for drawing traversal highlight
+ * area when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ int highlightWidth; /* Width in pixels of highlight to draw
+ * around widget when it has the focus.
+ * <= 0 means don't draw a highlight. */
+ Tk_3DBorder insertBorder; /* Used to draw vertical bar for insertion
+ * cursor. */
+ int insertBorderWidth; /* Width of 3-D border around insert cursor. */
+ int insertOffTime; /* Number of milliseconds cursor should spend
+ * in "off" state for each blink. */
+ int insertOnTime; /* Number of milliseconds cursor should spend
+ * in "on" state for each blink. */
+ int insertWidth; /* Total width of insert cursor. */
+ Tk_Justify justify; /* Justification to use for text within
+ * window. */
+ int relief; /* 3-D effect: TK_RELIEF_RAISED, etc. */
+ Tk_3DBorder selBorder; /* Border and background for selected
+ * characters. */
+ int selBorderWidth; /* Width of border around selection. */
+ XColor *selFgColorPtr; /* Foreground color for selected text. */
+ char *showChar; /* Value of -show option. If non-NULL, first
+ * character is used for displaying all
+ * characters in entry. Malloc'ed. */
+ Tk_Uid state; /* Normal or disabled. Entry is read-only
+ * when disabled. */
+ char *textVarName; /* Name of variable (malloc'ed) or NULL.
+ * If non-NULL, entry's string tracks the
+ * contents of this variable and vice versa. */
+ char *takeFocus; /* Value of -takefocus option; not used in
+ * the C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+ int prefWidth; /* Desired width of window, measured in
+ * average characters. */
+ char *scrollCmd; /* Command prefix for communicating with
+ * scrollbar(s). Malloc'ed. NULL means
+ * no command to issue. */
+
+ /*
+ * Fields whose values are derived from the current values of the
+ * configuration settings above.
+ */
+
+ int numChars; /* Number of non-NULL characters in
+ * string (may be 0). */
+ char *displayString; /* If non-NULL, points to string with same
+ * length as string but whose characters
+ * are all equal to showChar. Malloc'ed. */
+ int inset; /* Number of pixels on the left and right
+ * sides that are taken up by XPAD, borderWidth
+ * (if any), and highlightWidth (if any). */
+ Tk_TextLayout textLayout; /* Cached text layout information. */
+ int layoutX, layoutY; /* Origin for layout. */
+ int leftIndex; /* Index of left-most character visible in
+ * window. */
+ int leftX; /* X position at which character at leftIndex
+ * is drawn (varies depending on justify). */
+ Tcl_TimerToken insertBlinkHandler;
+ /* Timer handler used to blink cursor on and
+ * off. */
+ GC textGC; /* For drawing normal text. */
+ GC selTextGC; /* For drawing selected text. */
+ GC highlightGC; /* For drawing traversal highlight. */
+ int avgWidth; /* Width of average character. */
+ int flags; /* Miscellaneous flags; see below for
+ * definitions. */
+} Entry;
+
+/*
+ * Assigned bits of "flags" fields of Entry structures, and what those
+ * bits mean:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler has
+ * already been queued to redisplay the entry.
+ * BORDER_NEEDED: Non-zero means 3-D border must be redrawn
+ * around window during redisplay. Normally
+ * only text portion needs to be redrawn.
+ * CURSOR_ON: Non-zero means insert cursor is displayed at
+ * present. 0 means it isn't displayed.
+ * GOT_FOCUS: Non-zero means this window has the input
+ * focus.
+ * UPDATE_SCROLLBAR: Non-zero means scrollbar should be updated
+ * during next redisplay operation.
+ * GOT_SELECTION: Non-zero means we've claimed the selection.
+ */
+
+#define REDRAW_PENDING 1
+#define BORDER_NEEDED 2
+#define CURSOR_ON 4
+#define GOT_FOCUS 8
+#define UPDATE_SCROLLBAR 0x10
+#define GOT_SELECTION 0x20
+
+/*
+ * The following macro defines how many extra pixels to leave on each
+ * side of the text in the entry.
+ */
+
+#define XPAD 1
+#define YPAD 1
+
+/*
+ * Information used for argv parsing.
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_ENTRY_BG_COLOR, Tk_Offset(Entry, normalBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_ENTRY_BG_MONO, Tk_Offset(Entry, normalBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_ENTRY_BORDER_WIDTH, Tk_Offset(Entry, borderWidth), 0},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_ENTRY_CURSOR, Tk_Offset(Entry, cursor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BOOLEAN, "-exportselection", "exportSelection",
+ "ExportSelection", DEF_ENTRY_EXPORT_SELECTION,
+ Tk_Offset(Entry, exportSelection), 0},
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_FONT, "-font", "font", "Font",
+ DEF_ENTRY_FONT, Tk_Offset(Entry, tkfont), 0},
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_ENTRY_FG, Tk_Offset(Entry, fgColorPtr), 0},
+ {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_ENTRY_HIGHLIGHT_BG,
+ Tk_Offset(Entry, highlightBgColorPtr), 0},
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_ENTRY_HIGHLIGHT, Tk_Offset(Entry, highlightColorPtr), 0},
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_ENTRY_HIGHLIGHT_WIDTH, Tk_Offset(Entry, highlightWidth), 0},
+ {TK_CONFIG_BORDER, "-insertbackground", "insertBackground", "Foreground",
+ DEF_ENTRY_INSERT_BG, Tk_Offset(Entry, insertBorder), 0},
+ {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
+ DEF_ENTRY_INSERT_BD_COLOR, Tk_Offset(Entry, insertBorderWidth),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
+ DEF_ENTRY_INSERT_BD_MONO, Tk_Offset(Entry, insertBorderWidth),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_INT, "-insertofftime", "insertOffTime", "OffTime",
+ DEF_ENTRY_INSERT_OFF_TIME, Tk_Offset(Entry, insertOffTime), 0},
+ {TK_CONFIG_INT, "-insertontime", "insertOnTime", "OnTime",
+ DEF_ENTRY_INSERT_ON_TIME, Tk_Offset(Entry, insertOnTime), 0},
+ {TK_CONFIG_PIXELS, "-insertwidth", "insertWidth", "InsertWidth",
+ DEF_ENTRY_INSERT_WIDTH, Tk_Offset(Entry, insertWidth), 0},
+ {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_ENTRY_JUSTIFY, Tk_Offset(Entry, justify), 0},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_ENTRY_RELIEF, Tk_Offset(Entry, relief), 0},
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_ENTRY_SELECT_COLOR, Tk_Offset(Entry, selBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_ENTRY_SELECT_MONO, Tk_Offset(Entry, selBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
+ DEF_ENTRY_SELECT_BD_COLOR, Tk_Offset(Entry, selBorderWidth),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
+ DEF_ENTRY_SELECT_BD_MONO, Tk_Offset(Entry, selBorderWidth),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_ENTRY_SELECT_FG_COLOR, Tk_Offset(Entry, selFgColorPtr),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_ENTRY_SELECT_FG_MONO, Tk_Offset(Entry, selFgColorPtr),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_STRING, "-show", "show", "Show",
+ DEF_ENTRY_SHOW, Tk_Offset(Entry, showChar), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_UID, "-state", "state", "State",
+ DEF_ENTRY_STATE, Tk_Offset(Entry, state), 0},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_ENTRY_TAKE_FOCUS, Tk_Offset(Entry, takeFocus), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_ENTRY_TEXT_VARIABLE, Tk_Offset(Entry, textVarName),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_INT, "-width", "width", "Width",
+ DEF_ENTRY_WIDTH, Tk_Offset(Entry, prefWidth), 0},
+ {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ DEF_ENTRY_SCROLL_COMMAND, Tk_Offset(Entry, scrollCmd),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Flags for GetEntryIndex procedure:
+ */
+
+#define ZERO_OK 1
+#define LAST_PLUS_ONE_OK 2
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int ConfigureEntry _ANSI_ARGS_((Tcl_Interp *interp,
+ Entry *entryPtr, int argc, char **argv,
+ int flags));
+static void DeleteChars _ANSI_ARGS_((Entry *entryPtr, int index,
+ int count));
+static void DestroyEntry _ANSI_ARGS_((char *memPtr));
+static void DisplayEntry _ANSI_ARGS_((ClientData clientData));
+static void EntryBlinkProc _ANSI_ARGS_((ClientData clientData));
+static void EntryCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void EntryComputeGeometry _ANSI_ARGS_((Entry *entryPtr));
+static void EntryEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void EntryFocusProc _ANSI_ARGS_ ((Entry *entryPtr,
+ int gotFocus));
+static int EntryFetchSelection _ANSI_ARGS_((ClientData clientData,
+ int offset, char *buffer, int maxBytes));
+static void EntryLostSelection _ANSI_ARGS_((
+ ClientData clientData));
+static void EventuallyRedraw _ANSI_ARGS_((Entry *entryPtr));
+static void EntryScanTo _ANSI_ARGS_((Entry *entryPtr, int y));
+static void EntrySetValue _ANSI_ARGS_((Entry *entryPtr,
+ char *value));
+static void EntrySelectTo _ANSI_ARGS_((
+ Entry *entryPtr, int index));
+static char * EntryTextVarProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, char *name1, char *name2,
+ int flags));
+static void EntryUpdateScrollbar _ANSI_ARGS_((Entry *entryPtr));
+static void EntryValueChanged _ANSI_ARGS_((Entry *entryPtr));
+static void EntryVisibleRange _ANSI_ARGS_((Entry *entryPtr,
+ double *firstPtr, double *lastPtr));
+static int EntryWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void EntryWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+static int GetEntryIndex _ANSI_ARGS_((Tcl_Interp *interp,
+ Entry *entryPtr, char *string, int *indexPtr));
+static void InsertChars _ANSI_ARGS_((Entry *entryPtr, int index,
+ char *string));
+
+/*
+ * The structure below defines entry class behavior by means of procedures
+ * that can be invoked from generic window code.
+ */
+
+static TkClassProcs entryClass = {
+ NULL, /* createProc. */
+ EntryWorldChanged, /* geometryProc. */
+ NULL /* modalProc. */
+};
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_EntryCmd --
+ *
+ * This procedure is invoked to process the "entry" Tcl
+ * command. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_EntryCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ register Entry *entryPtr;
+ Tk_Window new;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " pathName ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Initialize the fields of the structure that won't be initialized
+ * by ConfigureEntry, or that ConfigureEntry requires to be
+ * initialized already (e.g. resource pointers).
+ */
+
+ entryPtr = (Entry *) ckalloc(sizeof(Entry));
+ entryPtr->tkwin = new;
+ entryPtr->display = Tk_Display(new);
+ entryPtr->interp = interp;
+ entryPtr->widgetCmd = Tcl_CreateCommand(interp,
+ Tk_PathName(entryPtr->tkwin), EntryWidgetCmd,
+ (ClientData) entryPtr, EntryCmdDeletedProc);
+ entryPtr->string = (char *) ckalloc(1);
+ entryPtr->string[0] = '\0';
+ entryPtr->insertPos = 0;
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+ entryPtr->selectAnchor = 0;
+ entryPtr->scanMarkX = 0;
+ entryPtr->scanMarkIndex = 0;
+
+ entryPtr->normalBorder = NULL;
+ entryPtr->borderWidth = 0;
+ entryPtr->cursor = None;
+ entryPtr->exportSelection = 1;
+ entryPtr->tkfont = NULL;
+ entryPtr->fgColorPtr = NULL;
+ entryPtr->highlightBgColorPtr = NULL;
+ entryPtr->highlightColorPtr = NULL;
+ entryPtr->highlightWidth = 0;
+ entryPtr->insertBorder = NULL;
+ entryPtr->insertBorderWidth = 0;
+ entryPtr->insertOffTime = 0;
+ entryPtr->insertOnTime = 0;
+ entryPtr->insertWidth = 0;
+ entryPtr->justify = TK_JUSTIFY_LEFT;
+ entryPtr->relief = TK_RELIEF_FLAT;
+ entryPtr->selBorder = NULL;
+ entryPtr->selBorderWidth = 0;
+ entryPtr->selFgColorPtr = NULL;
+ entryPtr->showChar = NULL;
+ entryPtr->state = tkNormalUid;
+ entryPtr->textVarName = NULL;
+ entryPtr->takeFocus = NULL;
+ entryPtr->prefWidth = 0;
+ entryPtr->scrollCmd = NULL;
+
+ entryPtr->numChars = 0;
+ entryPtr->displayString = NULL;
+ entryPtr->inset = XPAD;
+ entryPtr->textLayout = NULL;
+ entryPtr->layoutX = 0;
+ entryPtr->layoutY = 0;
+ entryPtr->leftIndex = 0;
+ entryPtr->leftX = 0;
+ entryPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
+ entryPtr->textGC = None;
+ entryPtr->selTextGC = None;
+ entryPtr->highlightGC = None;
+ entryPtr->avgWidth = 1;
+ entryPtr->flags = 0;
+
+ Tk_SetClass(entryPtr->tkwin, "Entry");
+ TkSetClassProcs(entryPtr->tkwin, &entryClass, (ClientData) entryPtr);
+ Tk_CreateEventHandler(entryPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ EntryEventProc, (ClientData) entryPtr);
+ Tk_CreateSelHandler(entryPtr->tkwin, XA_PRIMARY, XA_STRING,
+ EntryFetchSelection, (ClientData) entryPtr, XA_STRING);
+ if (ConfigureEntry(interp, entryPtr, argc-2, argv+2, 0) != TCL_OK) {
+ goto error;
+ }
+
+ interp->result = Tk_PathName(entryPtr->tkwin);
+ return TCL_OK;
+
+ error:
+ Tk_DestroyWindow(entryPtr->tkwin);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EntryWidgetCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to a widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+EntryWidgetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about entry widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ register Entry *entryPtr = (Entry *) clientData;
+ int result = TCL_OK;
+ size_t length;
+ int c;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_Preserve((ClientData) entryPtr);
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0)) {
+ int index;
+ int x, y, width, height;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " bbox index\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, argv[2], &index) != TCL_OK) {
+ goto error;
+ }
+ if ((index == entryPtr->numChars) && (index > 0)) {
+ index--;
+ }
+ Tk_CharBbox(entryPtr->textLayout, index, &x, &y, &width, &height);
+ sprintf(interp->result, "%d %d %d %d",
+ x + entryPtr->layoutX, y + entryPtr->layoutY, width, height);
+ } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
+ && (length >= 2)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " cget option\"",
+ (char *) NULL);
+ goto error;
+ }
+ result = Tk_ConfigureValue(interp, entryPtr->tkwin, configSpecs,
+ (char *) entryPtr, argv[2], 0);
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
+ && (length >= 2)) {
+ if (argc == 2) {
+ result = Tk_ConfigureInfo(interp, entryPtr->tkwin, configSpecs,
+ (char *) entryPtr, (char *) NULL, 0);
+ } else if (argc == 3) {
+ result = Tk_ConfigureInfo(interp, entryPtr->tkwin, configSpecs,
+ (char *) entryPtr, argv[2], 0);
+ } else {
+ result = ConfigureEntry(interp, entryPtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) {
+ int first, last;
+
+ if ((argc < 3) || (argc > 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " delete firstIndex ?lastIndex?\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, argv[2], &first) != TCL_OK) {
+ goto error;
+ }
+ if (argc == 3) {
+ last = first+1;
+ } else {
+ if (GetEntryIndex(interp, entryPtr, argv[3], &last) != TCL_OK) {
+ goto error;
+ }
+ }
+ if ((last >= first) && (entryPtr->state == tkNormalUid)) {
+ DeleteChars(entryPtr, first, last-first);
+ }
+ } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " get\"", (char *) NULL);
+ goto error;
+ }
+ interp->result = entryPtr->string;
+ } else if ((c == 'i') && (strncmp(argv[1], "icursor", length) == 0)
+ && (length >= 2)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " icursor pos\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, argv[2], &entryPtr->insertPos)
+ != TCL_OK) {
+ goto error;
+ }
+ EventuallyRedraw(entryPtr);
+ } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
+ && (length >= 3)) {
+ int index;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " index string\"", (char *) NULL);
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, argv[2], &index) != TCL_OK) {
+ goto error;
+ }
+ sprintf(interp->result, "%d", index);
+ } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
+ && (length >= 3)) {
+ int index;
+
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " insert index text\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, argv[2], &index) != TCL_OK) {
+ goto error;
+ }
+ if (entryPtr->state == tkNormalUid) {
+ InsertChars(entryPtr, index, argv[3]);
+ }
+ } else if ((c == 's') && (length >= 2)
+ && (strncmp(argv[1], "scan", length) == 0)) {
+ int x;
+
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " scan mark|dragto x\"", (char *) NULL);
+ goto error;
+ }
+ if (Tcl_GetInt(interp, argv[3], &x) != TCL_OK) {
+ goto error;
+ }
+ if ((argv[2][0] == 'm')
+ && (strncmp(argv[2], "mark", strlen(argv[2])) == 0)) {
+ entryPtr->scanMarkX = x;
+ entryPtr->scanMarkIndex = entryPtr->leftIndex;
+ } else if ((argv[2][0] == 'd')
+ && (strncmp(argv[2], "dragto", strlen(argv[2])) == 0)) {
+ EntryScanTo(entryPtr, x);
+ } else {
+ Tcl_AppendResult(interp, "bad scan option \"", argv[2],
+ "\": must be mark or dragto", (char *) NULL);
+ goto error;
+ }
+ } else if ((c == 's') && (length >= 2)
+ && (strncmp(argv[1], "selection", length) == 0)) {
+ int index, index2;
+
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " select option ?index?\"", (char *) NULL);
+ goto error;
+ }
+ length = strlen(argv[2]);
+ c = argv[2][0];
+ if ((c == 'c') && (strncmp(argv[2], "clear", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " selection clear\"", (char *) NULL);
+ goto error;
+ }
+ if (entryPtr->selectFirst != -1) {
+ entryPtr->selectFirst = entryPtr->selectLast = -1;
+ EventuallyRedraw(entryPtr);
+ }
+ goto done;
+ } else if ((c == 'p') && (strncmp(argv[2], "present", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " selection present\"", (char *) NULL);
+ goto error;
+ }
+ if (entryPtr->selectFirst == -1) {
+ interp->result = "0";
+ } else {
+ interp->result = "1";
+ }
+ goto done;
+ }
+ if (argc >= 4) {
+ if (GetEntryIndex(interp, entryPtr, argv[3], &index) != TCL_OK) {
+ goto error;
+ }
+ }
+ if ((c == 'a') && (strncmp(argv[2], "adjust", length) == 0)) {
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " selection adjust index\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (entryPtr->selectFirst >= 0) {
+ int half1, half2;
+
+ half1 = (entryPtr->selectFirst + entryPtr->selectLast)/2;
+ half2 = (entryPtr->selectFirst + entryPtr->selectLast + 1)/2;
+ if (index < half1) {
+ entryPtr->selectAnchor = entryPtr->selectLast;
+ } else if (index > half2) {
+ entryPtr->selectAnchor = entryPtr->selectFirst;
+ } else {
+ /*
+ * We're at about the halfway point in the selection;
+ * just keep the existing anchor.
+ */
+ }
+ }
+ EntrySelectTo(entryPtr, index);
+ } else if ((c == 'f') && (strncmp(argv[2], "from", length) == 0)) {
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " selection from index\"",
+ (char *) NULL);
+ goto error;
+ }
+ entryPtr->selectAnchor = index;
+ } else if ((c == 'r') && (strncmp(argv[2], "range", length) == 0)) {
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " selection range start end\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, argv[4], &index2) != TCL_OK) {
+ goto error;
+ }
+ if (index >= index2) {
+ entryPtr->selectFirst = entryPtr->selectLast = -1;
+ } else {
+ entryPtr->selectFirst = index;
+ entryPtr->selectLast = index2;
+ }
+ if (!(entryPtr->flags & GOT_SELECTION)
+ && (entryPtr->exportSelection)) {
+ Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY,
+ EntryLostSelection, (ClientData) entryPtr);
+ entryPtr->flags |= GOT_SELECTION;
+ }
+ EventuallyRedraw(entryPtr);
+ } else if ((c == 't') && (strncmp(argv[2], "to", length) == 0)) {
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " selection to index\"",
+ (char *) NULL);
+ goto error;
+ }
+ EntrySelectTo(entryPtr, index);
+ } else {
+ Tcl_AppendResult(interp, "bad selection option \"", argv[2],
+ "\": must be adjust, clear, from, present, range, or to",
+ (char *) NULL);
+ goto error;
+ }
+ } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) {
+ int index, type, count, charsPerPage;
+ double fraction, first, last;
+
+ if (argc == 2) {
+ EntryVisibleRange(entryPtr, &first, &last);
+ sprintf(interp->result, "%g %g", first, last);
+ goto done;
+ } else if (argc == 3) {
+ if (GetEntryIndex(interp, entryPtr, argv[2], &index) != TCL_OK) {
+ goto error;
+ }
+ } else {
+ type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
+ index = entryPtr->leftIndex;
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ goto error;
+ case TK_SCROLL_MOVETO:
+ index = (int) ((fraction * entryPtr->numChars) + 0.5);
+ break;
+ case TK_SCROLL_PAGES:
+ charsPerPage = ((Tk_Width(entryPtr->tkwin)
+ - 2*entryPtr->inset) / entryPtr->avgWidth) - 2;
+ if (charsPerPage < 1) {
+ charsPerPage = 1;
+ }
+ index += charsPerPage*count;
+ break;
+ case TK_SCROLL_UNITS:
+ index += count;
+ break;
+ }
+ }
+ if (index >= entryPtr->numChars) {
+ index = entryPtr->numChars-1;
+ }
+ if (index < 0) {
+ index = 0;
+ }
+ entryPtr->leftIndex = index;
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EntryComputeGeometry(entryPtr);
+ EventuallyRedraw(entryPtr);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be bbox, cget, configure, delete, get, ",
+ "icursor, index, insert, scan, selection, or xview",
+ (char *) NULL);
+ goto error;
+ }
+ done:
+ Tcl_Release((ClientData) entryPtr);
+ return result;
+
+ error:
+ Tcl_Release((ClientData) entryPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyEntry --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of an entry at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the entry is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyEntry(memPtr)
+ char *memPtr; /* Info about entry widget. */
+{
+ register Entry *entryPtr = (Entry *) memPtr;
+
+ /*
+ * Free up all the stuff that requires special handling, then
+ * let Tk_FreeOptions handle all the standard option-related
+ * stuff.
+ */
+
+ ckfree(entryPtr->string);
+ if (entryPtr->textVarName != NULL) {
+ Tcl_UntraceVar(entryPtr->interp, entryPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ EntryTextVarProc, (ClientData) entryPtr);
+ }
+ if (entryPtr->textGC != None) {
+ Tk_FreeGC(entryPtr->display, entryPtr->textGC);
+ }
+ if (entryPtr->selTextGC != None) {
+ Tk_FreeGC(entryPtr->display, entryPtr->selTextGC);
+ }
+ Tcl_DeleteTimerHandler(entryPtr->insertBlinkHandler);
+ if (entryPtr->displayString != NULL) {
+ ckfree(entryPtr->displayString);
+ }
+ Tk_FreeTextLayout(entryPtr->textLayout);
+ Tk_FreeOptions(configSpecs, (char *) entryPtr, entryPtr->display, 0);
+ ckfree((char *) entryPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureEntry --
+ *
+ * This procedure is called to process an argv/argc list, plus
+ * the Tk option database, in order to configure (or reconfigure)
+ * an entry widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then interp->result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width,
+ * etc. get set for entryPtr; old resources get freed,
+ * if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureEntry(interp, entryPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register Entry *entryPtr; /* Information about widget; may or may
+ * not already have values for some fields. */
+ int argc; /* Number of valid entries in argv. */
+ char **argv; /* Arguments. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ int oldExport;
+
+ /*
+ * Eliminate any existing trace on a variable monitored by the entry.
+ */
+
+ if (entryPtr->textVarName != NULL) {
+ Tcl_UntraceVar(interp, entryPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ EntryTextVarProc, (ClientData) entryPtr);
+ }
+
+ oldExport = entryPtr->exportSelection;
+ if (Tk_ConfigureWidget(interp, entryPtr->tkwin, configSpecs,
+ argc, argv, (char *) entryPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the entry is tied to the value of a variable, then set up
+ * a trace on the variable's value, create the variable if it doesn't
+ * exist, and set the entry's value from the variable's value.
+ */
+
+ if (entryPtr->textVarName != NULL) {
+ char *value;
+
+ value = Tcl_GetVar(interp, entryPtr->textVarName, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ EntryValueChanged(entryPtr);
+ } else {
+ EntrySetValue(entryPtr, value);
+ }
+ Tcl_TraceVar(interp, entryPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ EntryTextVarProc, (ClientData) entryPtr);
+ }
+
+ /*
+ * A few other options also need special processing, such as parsing
+ * the geometry and setting the background from a 3-D border.
+ */
+
+ if ((entryPtr->state != tkNormalUid)
+ && (entryPtr->state != tkDisabledUid)) {
+ Tcl_AppendResult(interp, "bad state value \"", entryPtr->state,
+ "\": must be normal or disabled", (char *) NULL);
+ entryPtr->state = tkNormalUid;
+ return TCL_ERROR;
+ }
+
+ Tk_SetBackgroundFromBorder(entryPtr->tkwin, entryPtr->normalBorder);
+
+ if (entryPtr->insertWidth <= 0) {
+ entryPtr->insertWidth = 2;
+ }
+ if (entryPtr->insertBorderWidth > entryPtr->insertWidth/2) {
+ entryPtr->insertBorderWidth = entryPtr->insertWidth/2;
+ }
+
+ /*
+ * Restart the cursor timing sequence in case the on-time or off-time
+ * just changed.
+ */
+
+ if (entryPtr->flags & GOT_FOCUS) {
+ EntryFocusProc(entryPtr, 1);
+ }
+
+ /*
+ * Claim the selection if we've suddenly started exporting it.
+ */
+
+ if (entryPtr->exportSelection && (!oldExport)
+ && (entryPtr->selectFirst != -1)
+ && !(entryPtr->flags & GOT_SELECTION)) {
+ Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, EntryLostSelection,
+ (ClientData) entryPtr);
+ entryPtr->flags |= GOT_SELECTION;
+ }
+
+ /*
+ * Recompute the window's geometry and arrange for it to be
+ * redisplayed.
+ */
+
+ Tk_SetInternalBorder(entryPtr->tkwin,
+ entryPtr->borderWidth + entryPtr->highlightWidth);
+ if (entryPtr->highlightWidth <= 0) {
+ entryPtr->highlightWidth = 0;
+ }
+ entryPtr->inset = entryPtr->highlightWidth + entryPtr->borderWidth + XPAD;
+
+ EntryWorldChanged((ClientData) entryPtr);
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * EntryWorldChanged --
+ *
+ * This procedure is called when the world has changed in some
+ * way and the widget needs to recompute all its graphics contexts
+ * and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Entry will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+EntryWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ XGCValues gcValues;
+ GC gc;
+ unsigned long mask;
+ Entry *entryPtr;
+
+ entryPtr = (Entry *) instanceData;
+
+ entryPtr->avgWidth = Tk_TextWidth(entryPtr->tkfont, "0", 1);
+ if (entryPtr->avgWidth == 0) {
+ entryPtr->avgWidth = 1;
+ }
+
+ gcValues.foreground = entryPtr->fgColorPtr->pixel;
+ gcValues.font = Tk_FontId(entryPtr->tkfont);
+ gcValues.graphics_exposures = False;
+ mask = GCForeground | GCFont | GCGraphicsExposures;
+ gc = Tk_GetGC(entryPtr->tkwin, mask, &gcValues);
+ if (entryPtr->textGC != None) {
+ Tk_FreeGC(entryPtr->display, entryPtr->textGC);
+ }
+ entryPtr->textGC = gc;
+
+ gcValues.foreground = entryPtr->selFgColorPtr->pixel;
+ gcValues.font = Tk_FontId(entryPtr->tkfont);
+ mask = GCForeground | GCFont;
+ gc = Tk_GetGC(entryPtr->tkwin, mask, &gcValues);
+ if (entryPtr->selTextGC != None) {
+ Tk_FreeGC(entryPtr->display, entryPtr->selTextGC);
+ }
+ entryPtr->selTextGC = gc;
+
+ /*
+ * Recompute the window's geometry and arrange for it to be
+ * redisplayed.
+ */
+
+ EntryComputeGeometry(entryPtr);
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EventuallyRedraw(entryPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayEntry --
+ *
+ * This procedure redraws the contents of an entry window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayEntry(clientData)
+ ClientData clientData; /* Information about window. */
+{
+ register Entry *entryPtr = (Entry *) clientData;
+ register Tk_Window tkwin = entryPtr->tkwin;
+ int baseY, selStartX, selEndX, cursorX, x, w;
+ int xBound;
+ Tk_FontMetrics fm;
+ Pixmap pixmap;
+ int showSelection;
+
+ entryPtr->flags &= ~REDRAW_PENDING;
+ if ((entryPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ Tk_GetFontMetrics(entryPtr->tkfont, &fm);
+
+ /*
+ * Update the scrollbar if that's needed.
+ */
+
+ if (entryPtr->flags & UPDATE_SCROLLBAR) {
+ entryPtr->flags &= ~UPDATE_SCROLLBAR;
+ EntryUpdateScrollbar(entryPtr);
+ }
+
+ /*
+ * In order to avoid screen flashes, this procedure redraws the
+ * textual area of the entry into off-screen memory, then copies
+ * it back on-screen in a single operation. This means there's
+ * no point in time where the on-screen image has been cleared.
+ */
+
+ pixmap = Tk_GetPixmap(entryPtr->display, Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+
+ /*
+ * Compute x-coordinate of the pixel just after last visible
+ * one, plus vertical position of baseline of text.
+ */
+
+ xBound = Tk_Width(tkwin) - entryPtr->inset;
+ baseY = (Tk_Height(tkwin) + fm.ascent - fm.descent) / 2;
+
+ /*
+ * On Windows and Mac, we need to hide the selection whenever we
+ * don't have the focus.
+ */
+
+#ifdef ALWAYS_SHOW_SELECTION
+ showSelection = 1;
+#else
+ showSelection = (entryPtr->flags & GOT_FOCUS);
+#endif
+
+ /*
+ * Draw the background in three layers. From bottom to top the
+ * layers are: normal background, selection background, and
+ * insertion cursor background.
+ */
+
+ Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->normalBorder,
+ 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
+ if (showSelection && (entryPtr->selectLast > entryPtr->leftIndex)) {
+ if (entryPtr->selectFirst <= entryPtr->leftIndex) {
+ selStartX = entryPtr->leftX;
+ } else {
+ Tk_CharBbox(entryPtr->textLayout, entryPtr->selectFirst,
+ &x, NULL, NULL, NULL);
+ selStartX = x + entryPtr->layoutX;
+ }
+ if ((selStartX - entryPtr->selBorderWidth) < xBound) {
+ Tk_CharBbox(entryPtr->textLayout, entryPtr->selectLast - 1,
+ &x, NULL, &w, NULL);
+ selEndX = x + w + entryPtr->layoutX;
+ Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->selBorder,
+ selStartX - entryPtr->selBorderWidth,
+ baseY - fm.ascent - entryPtr->selBorderWidth,
+ (selEndX - selStartX) + 2*entryPtr->selBorderWidth,
+ (fm.ascent + fm.descent) + 2*entryPtr->selBorderWidth,
+ entryPtr->selBorderWidth, TK_RELIEF_RAISED);
+ }
+ }
+
+ /*
+ * Draw a special background for the insertion cursor, overriding
+ * even the selection background. As a special hack to keep the
+ * cursor visible when the insertion cursor color is the same as
+ * the color for selected text (e.g., on mono displays), write
+ * background in the cursor area (instead of nothing) when the
+ * cursor isn't on. Otherwise the selection would hide the cursor.
+ */
+
+ if ((entryPtr->insertPos >= entryPtr->leftIndex)
+ && (entryPtr->state == tkNormalUid)
+ && (entryPtr->flags & GOT_FOCUS)) {
+ if (entryPtr->insertPos == 0) {
+ cursorX = 0;
+ } else if (entryPtr->insertPos >= entryPtr->numChars) {
+ Tk_CharBbox(entryPtr->textLayout, entryPtr->numChars - 1,
+ &x, NULL, &w, NULL);
+ cursorX = x + w;
+ } else {
+ Tk_CharBbox(entryPtr->textLayout, entryPtr->insertPos,
+ &x, NULL, NULL, NULL);
+ cursorX = x;
+ }
+ cursorX += entryPtr->layoutX;
+ cursorX -= (entryPtr->insertWidth)/2;
+ if (cursorX < xBound) {
+ if (entryPtr->flags & CURSOR_ON) {
+ Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->insertBorder,
+ cursorX, baseY - fm.ascent,
+ entryPtr->insertWidth, fm.ascent + fm.descent,
+ entryPtr->insertBorderWidth, TK_RELIEF_RAISED);
+ } else if (entryPtr->insertBorder == entryPtr->selBorder) {
+ Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->normalBorder,
+ cursorX, baseY - fm.ascent,
+ entryPtr->insertWidth, fm.ascent + fm.descent,
+ 0, TK_RELIEF_FLAT);
+ }
+ }
+ }
+
+ /*
+ * Draw the text in two pieces: first the unselected portion, then the
+ * selected portion on top of it.
+ */
+
+ Tk_DrawTextLayout(entryPtr->display, pixmap, entryPtr->textGC,
+ entryPtr->textLayout, entryPtr->layoutX, entryPtr->layoutY,
+ entryPtr->leftIndex, entryPtr->numChars);
+
+ if (showSelection && (entryPtr->selTextGC != entryPtr->textGC) &&
+ (entryPtr->selectFirst < entryPtr->selectLast)) {
+ int first;
+
+ if (entryPtr->selectFirst - entryPtr->leftIndex < 0) {
+ first = entryPtr->leftIndex;
+ } else {
+ first = entryPtr->selectFirst;
+ }
+ Tk_DrawTextLayout(entryPtr->display, pixmap, entryPtr->selTextGC,
+ entryPtr->textLayout, entryPtr->layoutX, entryPtr->layoutY,
+ first, entryPtr->selectLast);
+ }
+
+ /*
+ * Draw the border and focus highlight last, so they will overwrite
+ * any text that extends past the viewable part of the window.
+ */
+
+ if (entryPtr->relief != TK_RELIEF_FLAT) {
+ Tk_Draw3DRectangle(tkwin, pixmap, entryPtr->normalBorder,
+ entryPtr->highlightWidth, entryPtr->highlightWidth,
+ Tk_Width(tkwin) - 2*entryPtr->highlightWidth,
+ Tk_Height(tkwin) - 2*entryPtr->highlightWidth,
+ entryPtr->borderWidth, entryPtr->relief);
+ }
+ if (entryPtr->highlightWidth != 0) {
+ GC gc;
+
+ if (entryPtr->flags & GOT_FOCUS) {
+ gc = Tk_GCForColor(entryPtr->highlightColorPtr, pixmap);
+ } else {
+ gc = Tk_GCForColor(entryPtr->highlightBgColorPtr, pixmap);
+ }
+ Tk_DrawFocusHighlight(tkwin, gc, entryPtr->highlightWidth, pixmap);
+ }
+
+ /*
+ * Everything's been redisplayed; now copy the pixmap onto the screen
+ * and free up the pixmap.
+ */
+
+ XCopyArea(entryPtr->display, pixmap, Tk_WindowId(tkwin), entryPtr->textGC,
+ 0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin),
+ 0, 0);
+ Tk_FreePixmap(entryPtr->display, pixmap);
+ entryPtr->flags &= ~BORDER_NEEDED;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryComputeGeometry --
+ *
+ * This procedure is invoked to recompute information about where
+ * in its window an entry's string will be displayed. It also
+ * computes the requested size for the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The leftX and tabOrigin fields are recomputed for entryPtr,
+ * and leftIndex may be adjusted. Tk_GeometryRequest is called
+ * to register the desired dimensions for the window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntryComputeGeometry(entryPtr)
+ Entry *entryPtr; /* Widget record for entry. */
+{
+ int totalLength, overflow, maxOffScreen, rightX;
+ int height, width, i;
+ Tk_FontMetrics fm;
+ char *p, *displayString;
+
+ /*
+ * If we're displaying a special character instead of the value of
+ * the entry, recompute the displayString.
+ */
+
+ if (entryPtr->displayString != NULL) {
+ ckfree(entryPtr->displayString);
+ entryPtr->displayString = NULL;
+ }
+ if (entryPtr->showChar != NULL) {
+ entryPtr->displayString = (char *) ckalloc((unsigned)
+ (entryPtr->numChars + 1));
+ for (p = entryPtr->displayString, i = entryPtr->numChars; i > 0;
+ i--, p++) {
+ *p = entryPtr->showChar[0];
+ }
+ *p = 0;
+ displayString = entryPtr->displayString;
+ } else {
+ displayString = entryPtr->string;
+ }
+ Tk_FreeTextLayout(entryPtr->textLayout);
+ entryPtr->textLayout = Tk_ComputeTextLayout(entryPtr->tkfont,
+ displayString, entryPtr->numChars, 0, entryPtr->justify,
+ TK_IGNORE_NEWLINES, &totalLength, &height);
+
+ entryPtr->layoutY = (Tk_Height(entryPtr->tkwin) - height) / 2;
+
+ /*
+ * Recompute where the leftmost character on the display will
+ * be drawn (entryPtr->leftX) and adjust leftIndex if necessary
+ * so that we don't let characters hang off the edge of the
+ * window unless the entire window is full.
+ */
+
+ overflow = totalLength - (Tk_Width(entryPtr->tkwin) - 2*entryPtr->inset);
+ if (overflow <= 0) {
+ entryPtr->leftIndex = 0;
+ if (entryPtr->justify == TK_JUSTIFY_LEFT) {
+ entryPtr->leftX = entryPtr->inset;
+ } else if (entryPtr->justify == TK_JUSTIFY_RIGHT) {
+ entryPtr->leftX = Tk_Width(entryPtr->tkwin) - entryPtr->inset
+ - totalLength;
+ } else {
+ entryPtr->leftX = (Tk_Width(entryPtr->tkwin) - totalLength)/2;
+ }
+ entryPtr->layoutX = entryPtr->leftX;
+ } else {
+ /*
+ * The whole string can't fit in the window. Compute the
+ * maximum number of characters that may be off-screen to
+ * the left without leaving empty space on the right of the
+ * window, then don't let leftIndex be any greater than that.
+ */
+
+ maxOffScreen = Tk_PointToChar(entryPtr->textLayout, overflow, 0);
+ Tk_CharBbox(entryPtr->textLayout, maxOffScreen,
+ &rightX, NULL, NULL, NULL);
+ if (rightX < overflow) {
+ maxOffScreen += 1;
+ }
+ if (entryPtr->leftIndex > maxOffScreen) {
+ entryPtr->leftIndex = maxOffScreen;
+ }
+ Tk_CharBbox(entryPtr->textLayout, entryPtr->leftIndex,
+ &rightX, NULL, NULL, NULL);
+ entryPtr->leftX = entryPtr->inset;
+ entryPtr->layoutX = entryPtr->leftX - rightX;
+ }
+
+ Tk_GetFontMetrics(entryPtr->tkfont, &fm);
+ height = fm.linespace + 2*entryPtr->inset + 2*(YPAD-XPAD);
+ if (entryPtr->prefWidth > 0) {
+ width = entryPtr->prefWidth*entryPtr->avgWidth + 2*entryPtr->inset;
+ } else {
+ if (totalLength == 0) {
+ width = entryPtr->avgWidth + 2*entryPtr->inset;
+ } else {
+ width = totalLength + 2*entryPtr->inset;
+ }
+ }
+ Tk_GeometryRequest(entryPtr->tkwin, width, height);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InsertChars --
+ *
+ * Add new characters to an entry widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * New information gets added to entryPtr; it will be redisplayed
+ * soon, but not necessarily immediately.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InsertChars(entryPtr, index, string)
+ register Entry *entryPtr; /* Entry that is to get the new
+ * elements. */
+ int index; /* Add the new elements before this
+ * element. */
+ char *string; /* New characters to add (NULL-terminated
+ * string). */
+{
+ int length;
+ char *new;
+
+ length = strlen(string);
+ if (length == 0) {
+ return;
+ }
+ new = (char *) ckalloc((unsigned) (entryPtr->numChars + length + 1));
+ strncpy(new, entryPtr->string, (size_t) index);
+ strcpy(new+index, string);
+ strcpy(new+index+length, entryPtr->string+index);
+ ckfree(entryPtr->string);
+ entryPtr->string = new;
+ entryPtr->numChars += length;
+
+ /*
+ * Inserting characters invalidates all indexes into the string.
+ * Touch up the indexes so that they still refer to the same
+ * characters (at new positions). When updating the selection
+ * end-points, don't include the new text in the selection unless
+ * it was completely surrounded by the selection.
+ */
+
+ if (entryPtr->selectFirst >= index) {
+ entryPtr->selectFirst += length;
+ }
+ if (entryPtr->selectLast > index) {
+ entryPtr->selectLast += length;
+ }
+ if ((entryPtr->selectAnchor > index) || (entryPtr->selectFirst >= index)) {
+ entryPtr->selectAnchor += length;
+ }
+ if (entryPtr->leftIndex > index) {
+ entryPtr->leftIndex += length;
+ }
+ if (entryPtr->insertPos >= index) {
+ entryPtr->insertPos += length;
+ }
+ EntryValueChanged(entryPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteChars --
+ *
+ * Remove one or more characters from an entry widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory gets freed, the entry gets modified and (eventually)
+ * redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteChars(entryPtr, index, count)
+ register Entry *entryPtr; /* Entry widget to modify. */
+ int index; /* Index of first character to delete. */
+ int count; /* How many characters to delete. */
+{
+ char *new;
+
+ if ((index + count) > entryPtr->numChars) {
+ count = entryPtr->numChars - index;
+ }
+ if (count <= 0) {
+ return;
+ }
+
+ new = (char *) ckalloc((unsigned) (entryPtr->numChars + 1 - count));
+ strncpy(new, entryPtr->string, (size_t) index);
+ strcpy(new+index, entryPtr->string+index+count);
+ ckfree(entryPtr->string);
+ entryPtr->string = new;
+ entryPtr->numChars -= count;
+
+ /*
+ * Deleting characters results in the remaining characters being
+ * renumbered. Update the various indexes into the string to reflect
+ * this change.
+ */
+
+ if (entryPtr->selectFirst >= index) {
+ if (entryPtr->selectFirst >= (index+count)) {
+ entryPtr->selectFirst -= count;
+ } else {
+ entryPtr->selectFirst = index;
+ }
+ }
+ if (entryPtr->selectLast >= index) {
+ if (entryPtr->selectLast >= (index+count)) {
+ entryPtr->selectLast -= count;
+ } else {
+ entryPtr->selectLast = index;
+ }
+ }
+ if (entryPtr->selectLast <= entryPtr->selectFirst) {
+ entryPtr->selectFirst = entryPtr->selectLast = -1;
+ }
+ if (entryPtr->selectAnchor >= index) {
+ if (entryPtr->selectAnchor >= (index+count)) {
+ entryPtr->selectAnchor -= count;
+ } else {
+ entryPtr->selectAnchor = index;
+ }
+ }
+ if (entryPtr->leftIndex > index) {
+ if (entryPtr->leftIndex >= (index+count)) {
+ entryPtr->leftIndex -= count;
+ } else {
+ entryPtr->leftIndex = index;
+ }
+ }
+ if (entryPtr->insertPos >= index) {
+ if (entryPtr->insertPos >= (index+count)) {
+ entryPtr->insertPos -= count;
+ } else {
+ entryPtr->insertPos = index;
+ }
+ }
+ EntryValueChanged(entryPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryValueChanged --
+ *
+ * This procedure is invoked when characters are inserted into
+ * an entry or deleted from it. It updates the entry's associated
+ * variable, if there is one, and does other bookkeeping such
+ * as arranging for redisplay.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntryValueChanged(entryPtr)
+ Entry *entryPtr; /* Entry whose value just changed. */
+{
+ char *newValue;
+
+ if (entryPtr->textVarName == NULL) {
+ newValue = NULL;
+ } else {
+ newValue = Tcl_SetVar(entryPtr->interp, entryPtr->textVarName,
+ entryPtr->string, TCL_GLOBAL_ONLY);
+ }
+
+ if ((newValue != NULL) && (strcmp(newValue, entryPtr->string) != 0)) {
+ /*
+ * The value of the variable is different than what we asked for.
+ * This means that a trace on the variable modified it. In this
+ * case our trace procedure wasn't invoked since the modification
+ * came while a trace was already active on the variable. So,
+ * update our value to reflect the variable's latest value.
+ */
+
+ EntrySetValue(entryPtr, newValue);
+ } else {
+ /*
+ * Arrange for redisplay.
+ */
+
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EntryComputeGeometry(entryPtr);
+ EventuallyRedraw(entryPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntrySetValue --
+ *
+ * Replace the contents of a text entry with a given value. This
+ * procedure is invoked when updating the entry from the entry's
+ * associated variable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The string displayed in the entry will change. The selection,
+ * insertion point, and view may have to be adjusted to keep them
+ * within the bounds of the new string. Note: this procedure does
+ * *not* update the entry's associated variable, since that could
+ * result in an infinite loop.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntrySetValue(entryPtr, value)
+ register Entry *entryPtr; /* Entry whose value is to be
+ * changed. */
+ char *value; /* New text to display in entry. */
+{
+ ckfree(entryPtr->string);
+ entryPtr->numChars = strlen(value);
+ entryPtr->string = (char *) ckalloc((unsigned) (entryPtr->numChars + 1));
+ strcpy(entryPtr->string, value);
+ if (entryPtr->selectFirst != -1) {
+ if (entryPtr->selectFirst >= entryPtr->numChars) {
+ entryPtr->selectFirst = entryPtr->selectLast = -1;
+ } else if (entryPtr->selectLast > entryPtr->numChars) {
+ entryPtr->selectLast = entryPtr->numChars;
+ }
+ }
+ if (entryPtr->leftIndex >= entryPtr->numChars) {
+ entryPtr->leftIndex = entryPtr->numChars-1;
+ if (entryPtr->leftIndex < 0) {
+ entryPtr->leftIndex = 0;
+ }
+ }
+ if (entryPtr->insertPos > entryPtr->numChars) {
+ entryPtr->insertPos = entryPtr->numChars;
+ }
+
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EntryComputeGeometry(entryPtr);
+ EventuallyRedraw(entryPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EntryEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on entryes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EntryEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ Entry *entryPtr = (Entry *) clientData;
+ if (eventPtr->type == Expose) {
+ EventuallyRedraw(entryPtr);
+ entryPtr->flags |= BORDER_NEEDED;
+ } else if (eventPtr->type == DestroyNotify) {
+ if (entryPtr->tkwin != NULL) {
+ entryPtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(entryPtr->interp, entryPtr->widgetCmd);
+ }
+ if (entryPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayEntry, (ClientData) entryPtr);
+ }
+ Tcl_EventuallyFree((ClientData) entryPtr, DestroyEntry);
+ } else if (eventPtr->type == ConfigureNotify) {
+ Tcl_Preserve((ClientData) entryPtr);
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EntryComputeGeometry(entryPtr);
+ EventuallyRedraw(entryPtr);
+ Tcl_Release((ClientData) entryPtr);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ EntryFocusProc(entryPtr, 1);
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ EntryFocusProc(entryPtr, 0);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryCmdDeletedProc --
+ *
+ * This procedure is invoked when a widget command is deleted. If
+ * the widget isn't already in the process of being destroyed,
+ * this command destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntryCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ Entry *entryPtr = (Entry *) clientData;
+ Tk_Window tkwin = entryPtr->tkwin;
+
+ /*
+ * This procedure could be invoked either because the window was
+ * destroyed and the command was then deleted (in which case tkwin
+ * is NULL) or because the command was deleted, and then this procedure
+ * destroys the widget.
+ */
+
+ if (tkwin != NULL) {
+ entryPtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetEntryIndex --
+ *
+ * Parse an index into an entry and return either its value
+ * or an error.
+ *
+ * Results:
+ * A standard Tcl result. If all went well, then *indexPtr is
+ * filled in with the index (into entryPtr) corresponding to
+ * string. The index value is guaranteed to lie between 0 and
+ * the number of characters in the string, inclusive. If an
+ * error occurs then an error message is left in interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetEntryIndex(interp, entryPtr, string, indexPtr)
+ Tcl_Interp *interp; /* For error messages. */
+ Entry *entryPtr; /* Entry for which the index is being
+ * specified. */
+ char *string; /* Specifies character in entryPtr. */
+ int *indexPtr; /* Where to store converted index. */
+{
+ size_t length;
+
+ length = strlen(string);
+
+ if (string[0] == 'a') {
+ if (strncmp(string, "anchor", length) == 0) {
+ *indexPtr = entryPtr->selectAnchor;
+ } else {
+ badIndex:
+
+ /*
+ * Some of the paths here leave messages in interp->result,
+ * so we have to clear it out before storing our own message.
+ */
+
+ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
+ Tcl_AppendResult(interp, "bad entry index \"", string,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if (string[0] == 'e') {
+ if (strncmp(string, "end", length) == 0) {
+ *indexPtr = entryPtr->numChars;
+ } else {
+ goto badIndex;
+ }
+ } else if (string[0] == 'i') {
+ if (strncmp(string, "insert", length) == 0) {
+ *indexPtr = entryPtr->insertPos;
+ } else {
+ goto badIndex;
+ }
+ } else if (string[0] == 's') {
+ if (entryPtr->selectFirst == -1) {
+ interp->result = "selection isn't in entry";
+ return TCL_ERROR;
+ }
+ if (length < 5) {
+ goto badIndex;
+ }
+ if (strncmp(string, "sel.first", length) == 0) {
+ *indexPtr = entryPtr->selectFirst;
+ } else if (strncmp(string, "sel.last", length) == 0) {
+ *indexPtr = entryPtr->selectLast;
+ } else {
+ goto badIndex;
+ }
+ } else if (string[0] == '@') {
+ int x, roundUp;
+
+ if (Tcl_GetInt(interp, string+1, &x) != TCL_OK) {
+ goto badIndex;
+ }
+ if (x < entryPtr->inset) {
+ x = entryPtr->inset;
+ }
+ roundUp = 0;
+ if (x >= (Tk_Width(entryPtr->tkwin) - entryPtr->inset)) {
+ x = Tk_Width(entryPtr->tkwin) - entryPtr->inset - 1;
+ roundUp = 1;
+ }
+ *indexPtr = Tk_PointToChar(entryPtr->textLayout,
+ x - entryPtr->layoutX, 0);
+
+ /*
+ * Special trick: if the x-position was off-screen to the right,
+ * round the index up to refer to the character just after the
+ * last visible one on the screen. This is needed to enable the
+ * last character to be selected, for example.
+ */
+
+ if (roundUp && (*indexPtr < entryPtr->numChars)) {
+ *indexPtr += 1;
+ }
+ } else {
+ if (Tcl_GetInt(interp, string, indexPtr) != TCL_OK) {
+ goto badIndex;
+ }
+ if (*indexPtr < 0){
+ *indexPtr = 0;
+ } else if (*indexPtr > entryPtr->numChars) {
+ *indexPtr = entryPtr->numChars;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryScanTo --
+ *
+ * Given a y-coordinate (presumably of the curent mouse location)
+ * drag the view in the window to implement the scan operation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The view in the window may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntryScanTo(entryPtr, x)
+ register Entry *entryPtr; /* Information about widget. */
+ int x; /* X-coordinate to use for scan
+ * operation. */
+{
+ int newLeftIndex;
+
+ /*
+ * Compute new leftIndex for entry by amplifying the difference
+ * between the current position and the place where the scan
+ * started (the "mark" position). If we run off the left or right
+ * side of the entry, then reset the mark point so that the current
+ * position continues to correspond to the edge of the window.
+ * This means that the picture will start dragging as soon as the
+ * mouse reverses direction (without this reset, might have to slide
+ * mouse a long ways back before the picture starts moving again).
+ */
+
+ newLeftIndex = entryPtr->scanMarkIndex
+ - (10*(x - entryPtr->scanMarkX))/entryPtr->avgWidth;
+ if (newLeftIndex >= entryPtr->numChars) {
+ newLeftIndex = entryPtr->scanMarkIndex = entryPtr->numChars-1;
+ entryPtr->scanMarkX = x;
+ }
+ if (newLeftIndex < 0) {
+ newLeftIndex = entryPtr->scanMarkIndex = 0;
+ entryPtr->scanMarkX = x;
+ }
+ if (newLeftIndex != entryPtr->leftIndex) {
+ entryPtr->leftIndex = newLeftIndex;
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EntryComputeGeometry(entryPtr);
+ EventuallyRedraw(entryPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntrySelectTo --
+ *
+ * Modify the selection by moving its un-anchored end. This could
+ * make the selection either larger or smaller.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The selection changes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntrySelectTo(entryPtr, index)
+ register Entry *entryPtr; /* Information about widget. */
+ int index; /* Index of element that is to
+ * become the "other" end of the
+ * selection. */
+{
+ int newFirst, newLast;
+
+ /*
+ * Grab the selection if we don't own it already.
+ */
+
+ if (!(entryPtr->flags & GOT_SELECTION) && (entryPtr->exportSelection)) {
+ Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, EntryLostSelection,
+ (ClientData) entryPtr);
+ entryPtr->flags |= GOT_SELECTION;
+ }
+
+ /*
+ * Pick new starting and ending points for the selection.
+ */
+
+ if (entryPtr->selectAnchor > entryPtr->numChars) {
+ entryPtr->selectAnchor = entryPtr->numChars;
+ }
+ if (entryPtr->selectAnchor <= index) {
+ newFirst = entryPtr->selectAnchor;
+ newLast = index;
+ } else {
+ newFirst = index;
+ newLast = entryPtr->selectAnchor;
+ if (newLast < 0) {
+ newFirst = newLast = -1;
+ }
+ }
+ if ((entryPtr->selectFirst == newFirst)
+ && (entryPtr->selectLast == newLast)) {
+ return;
+ }
+ entryPtr->selectFirst = newFirst;
+ entryPtr->selectLast = newLast;
+ EventuallyRedraw(entryPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryFetchSelection --
+ *
+ * This procedure is called back by Tk when the selection is
+ * requested by someone. It returns part or all of the selection
+ * in a buffer provided by the caller.
+ *
+ * Results:
+ * The return value is the number of non-NULL bytes stored
+ * at buffer. Buffer is filled (or partially filled) with a
+ * NULL-terminated string containing part or all of the selection,
+ * as given by offset and maxBytes.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+EntryFetchSelection(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Information about entry widget. */
+ int offset; /* Offset within selection of first
+ * character to be returned. */
+ char *buffer; /* Location in which to place
+ * selection. */
+ int maxBytes; /* Maximum number of bytes to place
+ * at buffer, not including terminating
+ * NULL character. */
+{
+ Entry *entryPtr = (Entry *) clientData;
+ int count;
+ char *displayString;
+
+ if ((entryPtr->selectFirst < 0) || !(entryPtr->exportSelection)) {
+ return -1;
+ }
+ count = entryPtr->selectLast - entryPtr->selectFirst - offset;
+ if (count > maxBytes) {
+ count = maxBytes;
+ }
+ if (count <= 0) {
+ return 0;
+ }
+ if (entryPtr->displayString == NULL) {
+ displayString = entryPtr->string;
+ } else {
+ displayString = entryPtr->displayString;
+ }
+ strncpy(buffer, displayString + entryPtr->selectFirst + offset,
+ (size_t) count);
+ buffer[count] = '\0';
+ return count;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryLostSelection --
+ *
+ * This procedure is called back by Tk when the selection is
+ * grabbed away from an entry widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The existing selection is unhighlighted, and the window is
+ * marked as not containing a selection.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntryLostSelection(clientData)
+ ClientData clientData; /* Information about entry widget. */
+{
+ Entry *entryPtr = (Entry *) clientData;
+
+ entryPtr->flags &= ~GOT_SELECTION;
+
+ /*
+ * On Windows and Mac systems, we want to remember the selection
+ * for the next time the focus enters the window. On Unix, we need
+ * to clear the selection since it is always visible.
+ */
+
+#ifdef ALWAYS_SHOW_SELECTION
+ if ((entryPtr->selectFirst != -1) && entryPtr->exportSelection) {
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+ EventuallyRedraw(entryPtr);
+ }
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EventuallyRedraw --
+ *
+ * Ensure that an entry is eventually redrawn on the display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets redisplayed. Right now we don't do selective
+ * redisplays: the whole window will be redrawn. This doesn't
+ * seem to hurt performance noticeably, but if it does then this
+ * could be changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EventuallyRedraw(entryPtr)
+ register Entry *entryPtr; /* Information about widget. */
+{
+ if ((entryPtr->tkwin == NULL) || !Tk_IsMapped(entryPtr->tkwin)) {
+ return;
+ }
+
+ /*
+ * Right now we don't do selective redisplays: the whole window
+ * will be redrawn. This doesn't seem to hurt performance noticeably,
+ * but if it does then this could be changed.
+ */
+
+ if (!(entryPtr->flags & REDRAW_PENDING)) {
+ entryPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayEntry, (ClientData) entryPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryVisibleRange --
+ *
+ * Return information about the range of the entry that is
+ * currently visible.
+ *
+ * Results:
+ * *firstPtr and *lastPtr are modified to hold fractions between
+ * 0 and 1 identifying the range of characters visible in the
+ * entry.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntryVisibleRange(entryPtr, firstPtr, lastPtr)
+ Entry *entryPtr; /* Information about widget. */
+ double *firstPtr; /* Return position of first visible
+ * character in widget. */
+ double *lastPtr; /* Return position of char just after
+ * last visible one. */
+{
+ int charsInWindow;
+
+ if (entryPtr->numChars == 0) {
+ *firstPtr = 0.0;
+ *lastPtr = 1.0;
+ } else {
+ charsInWindow = Tk_PointToChar(entryPtr->textLayout,
+ Tk_Width(entryPtr->tkwin) - entryPtr->inset
+ - entryPtr->layoutX - 1, 0) + 1;
+ if (charsInWindow > entryPtr->numChars) {
+ /*
+ * If all chars were visible, then charsInWindow will be
+ * the index just after the last char that was visible.
+ */
+
+ charsInWindow = entryPtr->numChars;
+ }
+ charsInWindow -= entryPtr->leftIndex;
+ if (charsInWindow == 0) {
+ charsInWindow = 1;
+ }
+ *firstPtr = ((double) entryPtr->leftIndex)/entryPtr->numChars;
+ *lastPtr = ((double) (entryPtr->leftIndex + charsInWindow))
+ /entryPtr->numChars;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryUpdateScrollbar --
+ *
+ * This procedure is invoked whenever information has changed in
+ * an entry in a way that would invalidate a scrollbar display.
+ * If there is an associated scrollbar, then this procedure updates
+ * it by invoking a Tcl command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A Tcl command is invoked, and an additional command may be
+ * invoked to process errors in the command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntryUpdateScrollbar(entryPtr)
+ Entry *entryPtr; /* Information about widget. */
+{
+ char args[100];
+ int code;
+ double first, last;
+ Tcl_Interp *interp;
+
+ if (entryPtr->scrollCmd == NULL) {
+ return;
+ }
+
+ interp = entryPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ EntryVisibleRange(entryPtr, &first, &last);
+ sprintf(args, " %g %g", first, last);
+ code = Tcl_VarEval(interp, entryPtr->scrollCmd, args, (char *) NULL);
+ if (code != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (horizontal scrolling command executed by entry)");
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
+ Tcl_Release((ClientData) interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryBlinkProc --
+ *
+ * This procedure is called as a timer handler to blink the
+ * insertion cursor off and on.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor gets turned on or off, redisplay gets invoked,
+ * and this procedure reschedules itself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntryBlinkProc(clientData)
+ ClientData clientData; /* Pointer to record describing entry. */
+{
+ register Entry *entryPtr = (Entry *) clientData;
+
+ if (!(entryPtr->flags & GOT_FOCUS) || (entryPtr->insertOffTime == 0)) {
+ return;
+ }
+ if (entryPtr->flags & CURSOR_ON) {
+ entryPtr->flags &= ~CURSOR_ON;
+ entryPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ entryPtr->insertOffTime, EntryBlinkProc, (ClientData) entryPtr);
+ } else {
+ entryPtr->flags |= CURSOR_ON;
+ entryPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ entryPtr->insertOnTime, EntryBlinkProc, (ClientData) entryPtr);
+ }
+ EventuallyRedraw(entryPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryFocusProc --
+ *
+ * This procedure is called whenever the entry gets or loses the
+ * input focus. It's also called whenever the window is reconfigured
+ * while it has the focus.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor gets turned on or off.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntryFocusProc(entryPtr, gotFocus)
+ register Entry *entryPtr; /* Entry that got or lost focus. */
+ int gotFocus; /* 1 means window is getting focus, 0 means
+ * it's losing it. */
+{
+ Tcl_DeleteTimerHandler(entryPtr->insertBlinkHandler);
+ if (gotFocus) {
+ entryPtr->flags |= GOT_FOCUS | CURSOR_ON;
+ if (entryPtr->insertOffTime != 0) {
+ entryPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ entryPtr->insertOnTime, EntryBlinkProc,
+ (ClientData) entryPtr);
+ }
+ } else {
+ entryPtr->flags &= ~(GOT_FOCUS | CURSOR_ON);
+ entryPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
+ }
+ EventuallyRedraw(entryPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EntryTextVarProc --
+ *
+ * This procedure is invoked when someone changes the variable
+ * whose contents are to be displayed in an entry.
+ *
+ * Results:
+ * NULL is always returned.
+ *
+ * Side effects:
+ * The text displayed in the entry will change to match the
+ * variable.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+EntryTextVarProc(clientData, interp, name1, name2, flags)
+ ClientData clientData; /* Information about button. */
+ Tcl_Interp *interp; /* Interpreter containing variable. */
+ char *name1; /* Not used. */
+ char *name2; /* Not used. */
+ int flags; /* Information about what happened. */
+{
+ register Entry *entryPtr = (Entry *) clientData;
+ char *value;
+
+ /*
+ * If the variable is unset, then immediately recreate it unless
+ * the whole interpreter is going away.
+ */
+
+ if (flags & TCL_TRACE_UNSETS) {
+ if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+ Tcl_SetVar(interp, entryPtr->textVarName, entryPtr->string,
+ TCL_GLOBAL_ONLY);
+ Tcl_TraceVar(interp, entryPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ EntryTextVarProc, clientData);
+ }
+ return (char *) NULL;
+ }
+
+ /*
+ * Update the entry's text with the value of the variable, unless
+ * the entry already has that value (this happens when the variable
+ * changes value because we changed it because someone typed in
+ * the entry).
+ */
+
+ value = Tcl_GetVar(interp, entryPtr->textVarName, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ value = "";
+ }
+ if (strcmp(value, entryPtr->string) != 0) {
+ EntrySetValue(entryPtr, value);
+ }
+ return (char *) NULL;
+}
diff --git a/generic/tkError.c b/generic/tkError.c
new file mode 100644
index 0000000..3d52793
--- /dev/null
+++ b/generic/tkError.c
@@ -0,0 +1,307 @@
+/*
+ * tkError.c --
+ *
+ * This file provides a high-performance mechanism for
+ * selectively dealing with errors that occur in talking
+ * to the X server. This is useful, for example, when
+ * communicating with a window that may not exist.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkError.c 1.23 97/04/25 16:51:27
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * The default X error handler gets saved here, so that it can
+ * be invoked if an error occurs that we can't handle.
+ */
+
+static int (*defaultHandler) _ANSI_ARGS_((Display *display,
+ XErrorEvent *eventPtr)) = NULL;
+
+
+/*
+ * Forward references to procedures declared later in this file:
+ */
+
+static int ErrorProc _ANSI_ARGS_((Display *display,
+ XErrorEvent *errEventPtr));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateErrorHandler --
+ *
+ * Arrange for all a given procedure to be invoked whenever
+ * certain errors occur.
+ *
+ * Results:
+ * The return value is a token identifying the handler;
+ * it must be passed to Tk_DeleteErrorHandler to delete the
+ * handler.
+ *
+ * Side effects:
+ * If an X error occurs that matches the error, request,
+ * and minor arguments, then errorProc will be invoked.
+ * ErrorProc should have the following structure:
+ *
+ * int
+ * errorProc(clientData, errorEventPtr)
+ * caddr_t clientData;
+ * XErrorEvent *errorEventPtr;
+ * {
+ * }
+ *
+ * The clientData argument will be the same as the clientData
+ * argument to this procedure, and errorEvent will describe
+ * the error. If errorProc returns 0, it means that it
+ * completely "handled" the error: no further processing
+ * should be done. If errorProc returns 1, it means that it
+ * didn't know how to deal with the error, so we should look
+ * for other error handlers, or invoke the default error
+ * handler if no other handler returns zero. Handlers are
+ * invoked in order of age: youngest handler first.
+ *
+ * Note: errorProc will only be called for errors associated
+ * with X requests made AFTER this call, but BEFORE the handler
+ * is deleted by calling Tk_DeleteErrorHandler.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_ErrorHandler
+Tk_CreateErrorHandler(display, error, request, minorCode, errorProc, clientData)
+ Display *display; /* Display for which to handle
+ * errors. */
+ int error; /* Consider only errors with this
+ * error_code (-1 means consider
+ * all errors). */
+ int request; /* Consider only errors with this
+ * major request code (-1 means
+ * consider all major codes). */
+ int minorCode; /* Consider only errors with this
+ * minor request code (-1 means
+ * consider all minor codes). */
+ Tk_ErrorProc *errorProc; /* Procedure to invoke when a
+ * matching error occurs. NULL means
+ * just ignore matching errors. */
+ ClientData clientData; /* Arbitrary value to pass to
+ * errorProc. */
+{
+ register TkErrorHandler *errorPtr;
+ register TkDisplay *dispPtr;
+
+ /*
+ * Find the display. If Tk doesn't know about this display then
+ * it's an error: panic.
+ */
+
+ dispPtr = TkGetDisplay(display);
+ if (dispPtr == NULL) {
+ panic("Unknown display passed to Tk_CreateErrorHandler");
+ }
+
+ /*
+ * Make sure that X calls us whenever errors occur.
+ */
+
+ if (defaultHandler == NULL) {
+ defaultHandler = XSetErrorHandler(ErrorProc);
+ }
+
+ /*
+ * Create the handler record.
+ */
+
+ errorPtr = (TkErrorHandler *) ckalloc(sizeof(TkErrorHandler));
+ errorPtr->dispPtr = dispPtr;
+ errorPtr->firstRequest = NextRequest(display);
+ errorPtr->lastRequest = (unsigned) -1;
+ errorPtr->error = error;
+ errorPtr->request = request;
+ errorPtr->minorCode = minorCode;
+ errorPtr->errorProc = errorProc;
+ errorPtr->clientData = clientData;
+ errorPtr->nextPtr = dispPtr->errorPtr;
+ dispPtr->errorPtr = errorPtr;
+
+ return (Tk_ErrorHandler) errorPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteErrorHandler --
+ *
+ * Do not use an error handler anymore.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The handler denoted by the "handler" argument will not
+ * be invoked for any X errors associated with requests
+ * made after this call. However, if errors arrive later
+ * for requests made BEFORE this call, then the handler
+ * will still be invoked. Call XSync if you want to be
+ * sure that all outstanding errors have been received
+ * and processed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_DeleteErrorHandler(handler)
+ Tk_ErrorHandler handler; /* Token for handler to delete;
+ * was previous return value from
+ * Tk_CreateErrorHandler. */
+{
+ register TkErrorHandler *errorPtr = (TkErrorHandler *) handler;
+ register TkDisplay *dispPtr = errorPtr->dispPtr;
+
+ errorPtr->lastRequest = NextRequest(dispPtr->display) - 1;
+
+ /*
+ * Every once-in-a-while, cleanup handlers that are no longer
+ * active. We probably won't be able to free the handler that
+ * was just deleted (need to wait for any outstanding requests to
+ * be processed by server), but there may be previously-deleted
+ * handlers that are now ready for garbage collection. To reduce
+ * the cost of the cleanup, let a few dead handlers pile up, then
+ * clean them all at once. This adds a bit of overhead to errors
+ * that might occur while the dead handlers are hanging around,
+ * but reduces the overhead of scanning the list to clean up
+ * (particularly if there are many handlers that stay around
+ * forever).
+ */
+
+ dispPtr->deleteCount += 1;
+ if (dispPtr->deleteCount >= 10) {
+ register TkErrorHandler *prevPtr;
+ TkErrorHandler *nextPtr;
+ int lastSerial;
+
+ dispPtr->deleteCount = 0;
+ lastSerial = LastKnownRequestProcessed(dispPtr->display);
+ errorPtr = dispPtr->errorPtr;
+ for (prevPtr = NULL; errorPtr != NULL; errorPtr = nextPtr) {
+ nextPtr = errorPtr->nextPtr;
+ if ((errorPtr->lastRequest != (unsigned long) -1)
+ && (errorPtr->lastRequest <= (unsigned long) lastSerial)) {
+ if (prevPtr == NULL) {
+ dispPtr->errorPtr = nextPtr;
+ } else {
+ prevPtr->nextPtr = nextPtr;
+ }
+ ckfree((char *) errorPtr);
+ continue;
+ }
+ prevPtr = errorPtr;
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ErrorProc --
+ *
+ * This procedure is invoked by the X system when error
+ * events arrive.
+ *
+ * Results:
+ * If it returns, the return value is zero. However,
+ * it is possible that one of the error handlers may
+ * just exit.
+ *
+ * Side effects:
+ * This procedure does two things. First, it uses the
+ * serial # in the error event to eliminate handlers whose
+ * expiration serials are now in the past. Second, it
+ * invokes any handlers that want to deal with the error.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ErrorProc(display, errEventPtr)
+ Display *display; /* Display for which error
+ * occurred. */
+ register XErrorEvent *errEventPtr; /* Information about error. */
+{
+ register TkDisplay *dispPtr;
+ register TkErrorHandler *errorPtr;
+
+ /*
+ * See if we know anything about the display. If not, then
+ * invoke the default error handler.
+ */
+
+ dispPtr = TkGetDisplay(display);
+ if (dispPtr == NULL) {
+ goto couldntHandle;
+ }
+
+ /*
+ * Otherwise invoke any relevant handlers for the error, in order.
+ */
+
+ for (errorPtr = dispPtr->errorPtr; errorPtr != NULL;
+ errorPtr = errorPtr->nextPtr) {
+ if ((errorPtr->firstRequest > errEventPtr->serial)
+ || ((errorPtr->error != -1)
+ && (errorPtr->error != errEventPtr->error_code))
+ || ((errorPtr->request != -1)
+ && (errorPtr->request != errEventPtr->request_code))
+ || ((errorPtr->minorCode != -1)
+ && (errorPtr->minorCode != errEventPtr->minor_code))
+ || ((errorPtr->lastRequest != (unsigned long) -1)
+ && (errorPtr->lastRequest < errEventPtr->serial))) {
+ continue;
+ }
+ if (errorPtr->errorProc == NULL) {
+ return 0;
+ } else {
+ if ((*errorPtr->errorProc)(errorPtr->clientData,
+ errEventPtr) == 0) {
+ return 0;
+ }
+ }
+ }
+
+ /*
+ * See if the error is a BadWindow error. If so, and it refers
+ * to a window that still exists in our window table, then ignore
+ * the error. Errors like this can occur if a window owned by us
+ * is deleted by someone externally, like a window manager. We'll
+ * ignore the errors at least long enough to clean up internally and
+ * remove the entry from the window table.
+ *
+ * NOTE: For embedding, we must also check whether the window was
+ * recently deleted. If so, it may be that Tk generated operations on
+ * windows that were deleted by the container. Now we are getting
+ * the errors (BadWindow) after Tk already deleted the window itself.
+ */
+
+ if ((errEventPtr->error_code == BadWindow) &&
+ ((Tk_IdToWindow(display, (Window) errEventPtr->resourceid) !=
+ NULL) ||
+ (TkpWindowWasRecentlyDeleted((Window) errEventPtr->resourceid,
+ dispPtr)))) {
+ return 0;
+ }
+
+ /*
+ * We couldn't handle the error. Use the default handler.
+ */
+
+ couldntHandle:
+ return (*defaultHandler)(display, errEventPtr);
+}
diff --git a/generic/tkEvent.c b/generic/tkEvent.c
new file mode 100644
index 0000000..045a478
--- /dev/null
+++ b/generic/tkEvent.c
@@ -0,0 +1,1038 @@
+/*
+ * tkEvent.c --
+ *
+ * This file provides basic low-level facilities for managing
+ * X events in Tk.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkEvent.c 1.20 96/09/20 09:33:38
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+#include <signal.h>
+
+/*
+ * There's a potential problem if a handler is deleted while it's
+ * current (i.e. its procedure is executing), since Tk_HandleEvent
+ * will need to read the handler's "nextPtr" field when the procedure
+ * returns. To handle this problem, structures of the type below
+ * indicate the next handler to be processed for any (recursively
+ * nested) dispatches in progress. The nextHandler fields get
+ * updated if the handlers pointed to are deleted. Tk_HandleEvent
+ * also needs to know if the entire window gets deleted; the winPtr
+ * field is set to zero if that particular window gets deleted.
+ */
+
+typedef struct InProgress {
+ XEvent *eventPtr; /* Event currently being handled. */
+ TkWindow *winPtr; /* Window for event. Gets set to None if
+ * window is deleted while event is being
+ * handled. */
+ TkEventHandler *nextHandler; /* Next handler in search. */
+ struct InProgress *nextPtr; /* Next higher nested search. */
+} InProgress;
+
+static InProgress *pendingPtr = NULL;
+ /* Topmost search in progress, or
+ * NULL if none. */
+
+/*
+ * For each call to Tk_CreateGenericHandler, an instance of the following
+ * structure will be created. All of the active handlers are linked into a
+ * list.
+ */
+
+typedef struct GenericHandler {
+ Tk_GenericProc *proc; /* Procedure to dispatch on all X events. */
+ ClientData clientData; /* Client data to pass to procedure. */
+ int deleteFlag; /* Flag to set when this handler is deleted. */
+ struct GenericHandler *nextPtr;
+ /* Next handler in list of all generic
+ * handlers, or NULL for end of list. */
+} GenericHandler;
+
+static GenericHandler *genericList = NULL;
+ /* First handler in the list, or NULL. */
+static GenericHandler *lastGenericPtr = NULL;
+ /* Last handler in list. */
+
+/*
+ * There's a potential problem if Tk_HandleEvent is entered recursively.
+ * A handler cannot be deleted physically until we have returned from
+ * calling it. Otherwise, we're looking at unallocated memory in advancing to
+ * its `next' entry. We deal with the problem by using the `delete flag' and
+ * deleting handlers only when it's known that there's no handler active.
+ *
+ * The following variable has a non-zero value when a handler is active.
+ */
+
+static int genericHandlersActive = 0;
+
+/*
+ * The following structure is used for queueing X-style events on the
+ * Tcl event queue.
+ */
+
+typedef struct TkWindowEvent {
+ Tcl_Event header; /* Standard information for all events. */
+ XEvent event; /* The X event. */
+} TkWindowEvent;
+
+/*
+ * Array of event masks corresponding to each X event:
+ */
+
+static unsigned long eventMasks[TK_LASTEVENT] = {
+ 0,
+ 0,
+ KeyPressMask, /* KeyPress */
+ KeyReleaseMask, /* KeyRelease */
+ ButtonPressMask, /* ButtonPress */
+ ButtonReleaseMask, /* ButtonRelease */
+ PointerMotionMask|PointerMotionHintMask|ButtonMotionMask
+ |Button1MotionMask|Button2MotionMask|Button3MotionMask
+ |Button4MotionMask|Button5MotionMask,
+ /* MotionNotify */
+ EnterWindowMask, /* EnterNotify */
+ LeaveWindowMask, /* LeaveNotify */
+ FocusChangeMask, /* FocusIn */
+ FocusChangeMask, /* FocusOut */
+ KeymapStateMask, /* KeymapNotify */
+ ExposureMask, /* Expose */
+ ExposureMask, /* GraphicsExpose */
+ ExposureMask, /* NoExpose */
+ VisibilityChangeMask, /* VisibilityNotify */
+ SubstructureNotifyMask, /* CreateNotify */
+ StructureNotifyMask, /* DestroyNotify */
+ StructureNotifyMask, /* UnmapNotify */
+ StructureNotifyMask, /* MapNotify */
+ SubstructureRedirectMask, /* MapRequest */
+ StructureNotifyMask, /* ReparentNotify */
+ StructureNotifyMask, /* ConfigureNotify */
+ SubstructureRedirectMask, /* ConfigureRequest */
+ StructureNotifyMask, /* GravityNotify */
+ ResizeRedirectMask, /* ResizeRequest */
+ StructureNotifyMask, /* CirculateNotify */
+ SubstructureRedirectMask, /* CirculateRequest */
+ PropertyChangeMask, /* PropertyNotify */
+ 0, /* SelectionClear */
+ 0, /* SelectionRequest */
+ 0, /* SelectionNotify */
+ ColormapChangeMask, /* ColormapNotify */
+ 0, /* ClientMessage */
+ 0, /* Mapping Notify */
+ VirtualEventMask, /* VirtualEvents */
+ ActivateMask, /* ActivateNotify */
+ ActivateMask /* DeactivateNotify */
+};
+
+/*
+ * If someone has called Tk_RestrictEvents, the information below
+ * keeps track of it.
+ */
+
+static Tk_RestrictProc *restrictProc;
+ /* Procedure to call. NULL means no
+ * restrictProc is currently in effect. */
+static ClientData restrictArg; /* Argument to pass to restrictProc. */
+
+/*
+ * Prototypes for procedures that are only referenced locally within
+ * this file.
+ */
+
+static void DelayedMotionProc _ANSI_ARGS_((ClientData clientData));
+static int WindowEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
+ int flags));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateEventHandler --
+ *
+ * Arrange for a given procedure to be invoked whenever
+ * events from a given class occur in a given window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * From now on, whenever an event of the type given by
+ * mask occurs for token and is processed by Tk_HandleEvent,
+ * proc will be called. See the manual entry for details
+ * of the calling sequence and return value for proc.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CreateEventHandler(token, mask, proc, clientData)
+ Tk_Window token; /* Token for window in which to
+ * create handler. */
+ unsigned long mask; /* Events for which proc should
+ * be called. */
+ Tk_EventProc *proc; /* Procedure to call for each
+ * selected event */
+ ClientData clientData; /* Arbitrary data to pass to proc. */
+{
+ register TkEventHandler *handlerPtr;
+ register TkWindow *winPtr = (TkWindow *) token;
+ int found;
+
+ /*
+ * Skim through the list of existing handlers to (a) compute the
+ * overall event mask for the window (so we can pass this new
+ * value to the X system) and (b) see if there's already a handler
+ * declared with the same callback and clientData (if so, just
+ * change the mask). If no existing handler matches, then create
+ * a new handler.
+ */
+
+ found = 0;
+ if (winPtr->handlerList == NULL) {
+ handlerPtr = (TkEventHandler *) ckalloc(
+ (unsigned) sizeof(TkEventHandler));
+ winPtr->handlerList = handlerPtr;
+ goto initHandler;
+ } else {
+ for (handlerPtr = winPtr->handlerList; ;
+ handlerPtr = handlerPtr->nextPtr) {
+ if ((handlerPtr->proc == proc)
+ && (handlerPtr->clientData == clientData)) {
+ handlerPtr->mask = mask;
+ found = 1;
+ }
+ if (handlerPtr->nextPtr == NULL) {
+ break;
+ }
+ }
+ }
+
+ /*
+ * Create a new handler if no matching old handler was found.
+ */
+
+ if (!found) {
+ handlerPtr->nextPtr = (TkEventHandler *)
+ ckalloc(sizeof(TkEventHandler));
+ handlerPtr = handlerPtr->nextPtr;
+ initHandler:
+ handlerPtr->mask = mask;
+ handlerPtr->proc = proc;
+ handlerPtr->clientData = clientData;
+ handlerPtr->nextPtr = NULL;
+ }
+
+ /*
+ * No need to call XSelectInput: Tk always selects on all events
+ * for all windows (needed to support bindings on classes and "all").
+ */
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteEventHandler --
+ *
+ * Delete a previously-created handler.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If there existed a handler as described by the
+ * parameters, the handler is deleted so that proc
+ * will not be invoked again.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_DeleteEventHandler(token, mask, proc, clientData)
+ Tk_Window token; /* Same as corresponding arguments passed */
+ unsigned long mask; /* previously to Tk_CreateEventHandler. */
+ Tk_EventProc *proc;
+ ClientData clientData;
+{
+ register TkEventHandler *handlerPtr;
+ register InProgress *ipPtr;
+ TkEventHandler *prevPtr;
+ register TkWindow *winPtr = (TkWindow *) token;
+
+ /*
+ * Find the event handler to be deleted, or return
+ * immediately if it doesn't exist.
+ */
+
+ for (handlerPtr = winPtr->handlerList, prevPtr = NULL; ;
+ prevPtr = handlerPtr, handlerPtr = handlerPtr->nextPtr) {
+ if (handlerPtr == NULL) {
+ return;
+ }
+ if ((handlerPtr->mask == mask) && (handlerPtr->proc == proc)
+ && (handlerPtr->clientData == clientData)) {
+ break;
+ }
+ }
+
+ /*
+ * If Tk_HandleEvent is about to process this handler, tell it to
+ * process the next one instead.
+ */
+
+ for (ipPtr = pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
+ if (ipPtr->nextHandler == handlerPtr) {
+ ipPtr->nextHandler = handlerPtr->nextPtr;
+ }
+ }
+
+ /*
+ * Free resources associated with the handler.
+ */
+
+ if (prevPtr == NULL) {
+ winPtr->handlerList = handlerPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = handlerPtr->nextPtr;
+ }
+ ckfree((char *) handlerPtr);
+
+
+ /*
+ * No need to call XSelectInput: Tk always selects on all events
+ * for all windows (needed to support bindings on classes and "all").
+ */
+}
+
+/*--------------------------------------------------------------
+ *
+ * Tk_CreateGenericHandler --
+ *
+ * Register a procedure to be called on each X event, regardless
+ * of display or window. Generic handlers are useful for capturing
+ * events that aren't associated with windows, or events for windows
+ * not managed by Tk.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * From now on, whenever an X event is given to Tk_HandleEvent,
+ * invoke proc, giving it clientData and the event as arguments.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CreateGenericHandler(proc, clientData)
+ Tk_GenericProc *proc; /* Procedure to call on every event. */
+ ClientData clientData; /* One-word value to pass to proc. */
+{
+ GenericHandler *handlerPtr;
+
+ handlerPtr = (GenericHandler *) ckalloc (sizeof (GenericHandler));
+
+ handlerPtr->proc = proc;
+ handlerPtr->clientData = clientData;
+ handlerPtr->deleteFlag = 0;
+ handlerPtr->nextPtr = NULL;
+ if (genericList == NULL) {
+ genericList = handlerPtr;
+ } else {
+ lastGenericPtr->nextPtr = handlerPtr;
+ }
+ lastGenericPtr = handlerPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteGenericHandler --
+ *
+ * Delete a previously-created generic handler.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * If there existed a handler as described by the parameters,
+ * that handler is logically deleted so that proc will not be
+ * invoked again. The physical deletion happens in the event
+ * loop in Tk_HandleEvent.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_DeleteGenericHandler(proc, clientData)
+ Tk_GenericProc *proc;
+ ClientData clientData;
+{
+ GenericHandler * handler;
+
+ for (handler = genericList; handler; handler = handler->nextPtr) {
+ if ((handler->proc == proc) && (handler->clientData == clientData)) {
+ handler->deleteFlag = 1;
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_HandleEvent --
+ *
+ * Given an event, invoke all the handlers that have
+ * been registered for the event.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the handlers.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_HandleEvent(eventPtr)
+ XEvent *eventPtr; /* Event to dispatch. */
+{
+ register TkEventHandler *handlerPtr;
+ register GenericHandler *genericPtr;
+ register GenericHandler *genPrevPtr;
+ TkWindow *winPtr;
+ unsigned long mask;
+ InProgress ip;
+ Window handlerWindow;
+ TkDisplay *dispPtr;
+ Tcl_Interp *interp = (Tcl_Interp *) NULL;
+
+ /*
+ * Next, invoke all the generic event handlers (those that are
+ * invoked for all events). If a generic event handler reports that
+ * an event is fully processed, go no further.
+ */
+
+ for (genPrevPtr = NULL, genericPtr = genericList; genericPtr != NULL; ) {
+ if (genericPtr->deleteFlag) {
+ if (!genericHandlersActive) {
+ GenericHandler *tmpPtr;
+
+ /*
+ * This handler needs to be deleted and there are no
+ * calls pending through the handler, so now is a safe
+ * time to delete it.
+ */
+
+ tmpPtr = genericPtr->nextPtr;
+ if (genPrevPtr == NULL) {
+ genericList = tmpPtr;
+ } else {
+ genPrevPtr->nextPtr = tmpPtr;
+ }
+ if (tmpPtr == NULL) {
+ lastGenericPtr = genPrevPtr;
+ }
+ (void) ckfree((char *) genericPtr);
+ genericPtr = tmpPtr;
+ continue;
+ }
+ } else {
+ int done;
+
+ genericHandlersActive++;
+ done = (*genericPtr->proc)(genericPtr->clientData, eventPtr);
+ genericHandlersActive--;
+ if (done) {
+ return;
+ }
+ }
+ genPrevPtr = genericPtr;
+ genericPtr = genPrevPtr->nextPtr;
+ }
+
+ /*
+ * If the event is a MappingNotify event, find its display and
+ * refresh the keyboard mapping information for the display.
+ * After that there's nothing else to do with the event, so just
+ * quit.
+ */
+
+ if (eventPtr->type == MappingNotify) {
+ dispPtr = TkGetDisplay(eventPtr->xmapping.display);
+ if (dispPtr != NULL) {
+ XRefreshKeyboardMapping(&eventPtr->xmapping);
+ dispPtr->bindInfoStale = 1;
+ }
+ return;
+ }
+
+ /*
+ * Events selected by StructureNotify require special handling.
+ * They look the same as those selected by SubstructureNotify.
+ * The only difference is whether the "event" and "window" fields
+ * are the same. Compare the two fields and convert StructureNotify
+ * to SubstructureNotify if necessary.
+ */
+
+ handlerWindow = eventPtr->xany.window;
+ mask = eventMasks[eventPtr->xany.type];
+ if (mask == StructureNotifyMask) {
+ if (eventPtr->xmap.event != eventPtr->xmap.window) {
+ mask = SubstructureNotifyMask;
+ handlerWindow = eventPtr->xmap.event;
+ }
+ }
+ winPtr = (TkWindow *) Tk_IdToWindow(eventPtr->xany.display, handlerWindow);
+ if (winPtr == NULL) {
+
+ /*
+ * There isn't a TkWindow structure for this window.
+ * However, if the event is a PropertyNotify event then call
+ * the selection manager (it deals beneath-the-table with
+ * certain properties).
+ */
+
+ if (eventPtr->type == PropertyNotify) {
+ TkSelPropProc(eventPtr);
+ }
+ return;
+ }
+
+ /*
+ * Once a window has started getting deleted, don't process any more
+ * events for it except for the DestroyNotify event. This check is
+ * needed because a DestroyNotify handler could re-invoke the event
+ * loop, causing other pending events to be handled for the window
+ * (the window doesn't get totally expunged from our tables until
+ * after the DestroyNotify event has been completely handled).
+ */
+
+ if ((winPtr->flags & TK_ALREADY_DEAD)
+ && (eventPtr->type != DestroyNotify)) {
+ return;
+ }
+
+ if (winPtr->mainPtr != NULL) {
+
+ /*
+ * Protect interpreter for this window from possible deletion
+ * while we are dealing with the event for this window. Thus,
+ * widget writers do not have to worry about protecting the
+ * interpreter in their own code.
+ */
+
+ interp = winPtr->mainPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+
+ /*
+ * Call focus-related code to look at FocusIn, FocusOut, Enter,
+ * and Leave events; depending on its return value, ignore the
+ * event.
+ */
+
+ if ((mask & (FocusChangeMask|EnterWindowMask|LeaveWindowMask))
+ && !TkFocusFilterEvent(winPtr, eventPtr)) {
+ Tcl_Release((ClientData) interp);
+ return;
+ }
+
+ /*
+ * Redirect KeyPress and KeyRelease events to the focus window,
+ * or ignore them entirely if there is no focus window.
+ */
+
+ if (mask & (KeyPressMask|KeyReleaseMask)) {
+ winPtr->dispPtr->lastEventTime = eventPtr->xkey.time;
+ winPtr = TkFocusKeyEvent(winPtr, eventPtr);
+ if (winPtr == NULL) {
+ Tcl_Release((ClientData) interp);
+ return;
+ }
+ }
+
+ /*
+ * Call a grab-related procedure to do special processing on
+ * pointer events.
+ */
+
+ if (mask & (ButtonPressMask|ButtonReleaseMask|PointerMotionMask
+ |EnterWindowMask|LeaveWindowMask)) {
+ if (mask & (ButtonPressMask|ButtonReleaseMask)) {
+ winPtr->dispPtr->lastEventTime = eventPtr->xbutton.time;
+ } else if (mask & PointerMotionMask) {
+ winPtr->dispPtr->lastEventTime = eventPtr->xmotion.time;
+ } else {
+ winPtr->dispPtr->lastEventTime = eventPtr->xcrossing.time;
+ }
+ if (TkPointerEvent(eventPtr, winPtr) == 0) {
+ goto done;
+ }
+ }
+ }
+
+#ifdef TK_USE_INPUT_METHODS
+ /*
+ * Pass the event to the input method(s), if there are any, and
+ * discard the event if the input method(s) insist. Create the
+ * input context for the window if it hasn't already been done
+ * (XFilterEvent needs this context).
+ */
+
+ if (!(winPtr->flags & TK_CHECKED_IC)) {
+ if (winPtr->dispPtr->inputMethod != NULL) {
+ winPtr->inputContext = XCreateIC(
+ winPtr->dispPtr->inputMethod, XNInputStyle,
+ XIMPreeditNothing|XIMStatusNothing,
+ XNClientWindow, winPtr->window,
+ XNFocusWindow, winPtr->window, NULL);
+ }
+ winPtr->flags |= TK_CHECKED_IC;
+ }
+ if (XFilterEvent(eventPtr, None)) {
+ goto done;
+ }
+#endif /* TK_USE_INPUT_METHODS */
+
+ /*
+ * For events where it hasn't already been done, update the current
+ * time in the display.
+ */
+
+ if (eventPtr->type == PropertyNotify) {
+ winPtr->dispPtr->lastEventTime = eventPtr->xproperty.time;
+ }
+
+ /*
+ * There's a potential interaction here with Tk_DeleteEventHandler.
+ * Read the documentation for pendingPtr.
+ */
+
+ ip.eventPtr = eventPtr;
+ ip.winPtr = winPtr;
+ ip.nextHandler = NULL;
+ ip.nextPtr = pendingPtr;
+ pendingPtr = &ip;
+ if (mask == 0) {
+ if ((eventPtr->type == SelectionClear)
+ || (eventPtr->type == SelectionRequest)
+ || (eventPtr->type == SelectionNotify)) {
+ TkSelEventProc((Tk_Window) winPtr, eventPtr);
+ } else if ((eventPtr->type == ClientMessage)
+ && (eventPtr->xclient.message_type ==
+ Tk_InternAtom((Tk_Window) winPtr, "WM_PROTOCOLS"))) {
+ TkWmProtocolEventProc(winPtr, eventPtr);
+ }
+ } else {
+ for (handlerPtr = winPtr->handlerList; handlerPtr != NULL; ) {
+ if ((handlerPtr->mask & mask) != 0) {
+ ip.nextHandler = handlerPtr->nextPtr;
+ (*(handlerPtr->proc))(handlerPtr->clientData, eventPtr);
+ handlerPtr = ip.nextHandler;
+ } else {
+ handlerPtr = handlerPtr->nextPtr;
+ }
+ }
+
+ /*
+ * Pass the event to the "bind" command mechanism. But, don't
+ * do this for SubstructureNotify events. The "bind" command
+ * doesn't support them anyway, and it's easier to filter out
+ * these events here than in the lower-level procedures.
+ */
+
+ if ((ip.winPtr != None) && (mask != SubstructureNotifyMask)) {
+ TkBindEventProc(winPtr, eventPtr);
+ }
+ }
+ pendingPtr = ip.nextPtr;
+done:
+
+ /*
+ * Release the interpreter for this window so that it can be potentially
+ * deleted if requested.
+ */
+
+ if (interp != (Tcl_Interp *) NULL) {
+ Tcl_Release((ClientData) interp);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkEventDeadWindow --
+ *
+ * This procedure is invoked when it is determined that
+ * a window is dead. It cleans up event-related information
+ * about the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Various things get cleaned up and recycled.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkEventDeadWindow(winPtr)
+ TkWindow *winPtr; /* Information about the window
+ * that is being deleted. */
+{
+ register TkEventHandler *handlerPtr;
+ register InProgress *ipPtr;
+
+ /*
+ * While deleting all the handlers, be careful to check for
+ * Tk_HandleEvent being about to process one of the deleted
+ * handlers. If it is, tell it to quit (all of the handlers
+ * are being deleted).
+ */
+
+ while (winPtr->handlerList != NULL) {
+ handlerPtr = winPtr->handlerList;
+ winPtr->handlerList = handlerPtr->nextPtr;
+ for (ipPtr = pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
+ if (ipPtr->nextHandler == handlerPtr) {
+ ipPtr->nextHandler = NULL;
+ }
+ if (ipPtr->winPtr == winPtr) {
+ ipPtr->winPtr = None;
+ }
+ }
+ ckfree((char *) handlerPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCurrentTime --
+ *
+ * Try to deduce the current time. "Current time" means the time
+ * of the event that led to the current code being executed, which
+ * means the time in the most recently-nested invocation of
+ * Tk_HandleEvent.
+ *
+ * Results:
+ * The return value is the time from the current event, or
+ * CurrentTime if there is no current event or if the current
+ * event contains no time.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Time
+TkCurrentTime(dispPtr)
+ TkDisplay *dispPtr; /* Display for which the time is desired. */
+{
+ register XEvent *eventPtr;
+
+ if (pendingPtr == NULL) {
+ return dispPtr->lastEventTime;
+ }
+ eventPtr = pendingPtr->eventPtr;
+ switch (eventPtr->type) {
+ case ButtonPress:
+ case ButtonRelease:
+ return eventPtr->xbutton.time;
+ case KeyPress:
+ case KeyRelease:
+ return eventPtr->xkey.time;
+ case MotionNotify:
+ return eventPtr->xmotion.time;
+ case EnterNotify:
+ case LeaveNotify:
+ return eventPtr->xcrossing.time;
+ case PropertyNotify:
+ return eventPtr->xproperty.time;
+ }
+ return dispPtr->lastEventTime;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_RestrictEvents --
+ *
+ * This procedure is used to globally restrict the set of events
+ * that will be dispatched. The restriction is done by filtering
+ * all incoming X events through a procedure that determines
+ * whether they are to be processed immediately, deferred, or
+ * discarded.
+ *
+ * Results:
+ * The return value is the previous restriction procedure in effect,
+ * if there was one, or NULL if there wasn't.
+ *
+ * Side effects:
+ * From now on, proc will be called to determine whether to process,
+ * defer or discard each incoming X event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_RestrictProc *
+Tk_RestrictEvents(proc, arg, prevArgPtr)
+ Tk_RestrictProc *proc; /* Procedure to call for each incoming
+ * event. */
+ ClientData arg; /* Arbitrary argument to pass to proc. */
+ ClientData *prevArgPtr; /* Place to store information about previous
+ * argument. */
+{
+ Tk_RestrictProc *prev;
+
+ prev = restrictProc;
+ *prevArgPtr = restrictArg;
+ restrictProc = proc;
+ restrictArg = arg;
+ return prev;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_QueueWindowEvent --
+ *
+ * Given an X-style window event, this procedure adds it to the
+ * Tcl event queue at the given position. This procedure also
+ * performs mouse motion event collapsing if possible.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Adds stuff to the event queue, which will eventually be
+ * processed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_QueueWindowEvent(eventPtr, position)
+ XEvent *eventPtr; /* Event to add to queue. This
+ * procedures copies it before adding
+ * it to the queue. */
+ Tcl_QueuePosition position; /* Where to put it on the queue:
+ * TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
+ * or TCL_QUEUE_MARK. */
+{
+ TkWindowEvent *wevPtr;
+ TkDisplay *dispPtr;
+
+ /*
+ * Find our display structure for the event's display.
+ */
+
+ for (dispPtr = tkDisplayList; ; dispPtr = dispPtr->nextPtr) {
+ if (dispPtr == NULL) {
+ return;
+ }
+ if (dispPtr->display == eventPtr->xany.display) {
+ break;
+ }
+ }
+
+ if ((dispPtr->delayedMotionPtr != NULL) && (position == TCL_QUEUE_TAIL)) {
+ if ((eventPtr->type == MotionNotify) && (eventPtr->xmotion.window
+ == dispPtr->delayedMotionPtr->event.xmotion.window)) {
+ /*
+ * The new event is a motion event in the same window as the
+ * saved motion event. Just replace the saved event with the
+ * new one.
+ */
+
+ dispPtr->delayedMotionPtr->event = *eventPtr;
+ return;
+ } else if ((eventPtr->type != GraphicsExpose)
+ && (eventPtr->type != NoExpose)
+ && (eventPtr->type != Expose)) {
+ /*
+ * The new event may conflict with the saved motion event. Queue
+ * the saved motion event now so that it will be processed before
+ * the new event.
+ */
+
+ Tcl_QueueEvent(&dispPtr->delayedMotionPtr->header, position);
+ dispPtr->delayedMotionPtr = NULL;
+ Tcl_CancelIdleCall(DelayedMotionProc, (ClientData) dispPtr);
+ }
+ }
+
+ wevPtr = (TkWindowEvent *) ckalloc(sizeof(TkWindowEvent));
+ wevPtr->header.proc = WindowEventProc;
+ wevPtr->event = *eventPtr;
+ if ((eventPtr->type == MotionNotify) && (position == TCL_QUEUE_TAIL)) {
+ /*
+ * The new event is a motion event so don't queue it immediately;
+ * save it around in case another motion event arrives that it can
+ * be collapsed with.
+ */
+
+ if (dispPtr->delayedMotionPtr != NULL) {
+ panic("Tk_QueueWindowEvent found unexpected delayed motion event");
+ }
+ dispPtr->delayedMotionPtr = wevPtr;
+ Tcl_DoWhenIdle(DelayedMotionProc, (ClientData) dispPtr);
+ } else {
+ Tcl_QueueEvent(&wevPtr->header, position);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkQueueEventForAllChildren --
+ *
+ * Given an XEvent, recursively queue the event for this window and
+ * all non-toplevel children of the given window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Events queued.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkQueueEventForAllChildren(winPtr, eventPtr)
+ TkWindow *winPtr; /* Window to which event is sent. */
+ XEvent *eventPtr; /* The event to be sent. */
+{
+ TkWindow *childPtr;
+
+ eventPtr->xany.window = winPtr->window;
+ Tk_QueueWindowEvent(eventPtr, TCL_QUEUE_TAIL);
+
+ childPtr = winPtr->childList;
+ while (childPtr != NULL) {
+ if (!Tk_IsTopLevel(childPtr)) {
+ TkQueueEventForAllChildren(childPtr, eventPtr);
+ }
+ childPtr = childPtr->nextPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WindowEventProc --
+ *
+ * This procedure is called by Tcl_DoOneEvent when a window event
+ * reaches the front of the event queue. This procedure is responsible
+ * for actually handling the event.
+ *
+ * Results:
+ * Returns 1 if the event was handled, meaning it should be removed
+ * from the queue. Returns 0 if the event was not handled, meaning
+ * it should stay on the queue. The event isn't handled if the
+ * TCL_WINDOW_EVENTS bit isn't set in flags, if a restrict proc
+ * prevents the event from being handled.
+ *
+ * Side effects:
+ * Whatever the event handlers for the event do.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WindowEventProc(evPtr, flags)
+ Tcl_Event *evPtr; /* Event to service. */
+ int flags; /* Flags that indicate what events to
+ * handle, such as TCL_WINDOW_EVENTS. */
+{
+ TkWindowEvent *wevPtr = (TkWindowEvent *) evPtr;
+ Tk_RestrictAction result;
+
+ if (!(flags & TCL_WINDOW_EVENTS)) {
+ return 0;
+ }
+ if (restrictProc != NULL) {
+ result = (*restrictProc)(restrictArg, &wevPtr->event);
+ if (result != TK_PROCESS_EVENT) {
+ if (result == TK_DEFER_EVENT) {
+ return 0;
+ } else {
+ /*
+ * TK_DELETE_EVENT: return and say we processed the event,
+ * even though we didn't do anything at all.
+ */
+ return 1;
+ }
+ }
+ }
+ Tk_HandleEvent(&wevPtr->event);
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DelayedMotionProc --
+ *
+ * This procedure is invoked as an idle handler when a mouse motion
+ * event has been delayed. It queues the delayed event so that it
+ * will finally be serviced.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The delayed mouse motion event gets added to the Tcl event
+ * queue for servicing.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DelayedMotionProc(clientData)
+ ClientData clientData; /* Pointer to display containing a delayed
+ * motion event to be serviced. */
+{
+ TkDisplay *dispPtr = (TkDisplay *) clientData;
+
+ if (dispPtr->delayedMotionPtr == NULL) {
+ panic("DelayedMotionProc found no delayed mouse motion event");
+ }
+ Tcl_QueueEvent(&dispPtr->delayedMotionPtr->header, TCL_QUEUE_TAIL);
+ dispPtr->delayedMotionPtr = NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_MainLoop --
+ *
+ * Call Tcl_DoOneEvent over and over again in an infinite
+ * loop as long as there exist any main windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arbitrary; depends on handlers for events.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_MainLoop()
+{
+ while (Tk_GetNumMainWindows() > 0) {
+ Tcl_DoOneEvent(0);
+ }
+}
diff --git a/generic/tkFileFilter.c b/generic/tkFileFilter.c
new file mode 100644
index 0000000..1b7e61a
--- /dev/null
+++ b/generic/tkFileFilter.c
@@ -0,0 +1,486 @@
+/*
+ * tkFileFilter.c --
+ *
+ * Process the -filetypes option for the file dialogs on Windows and the
+ * Mac.
+ *
+ * Copyright (c) 1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkFileFilter.c 1.6 97/04/30 15:55:35
+ *
+ */
+
+#include "tkInt.h"
+#include "tkFileFilter.h"
+
+static int AddClause _ANSI_ARGS_((
+ Tcl_Interp * interp, FileFilter * filterPtr,
+ char * patternsStr, char * ostypesStr,
+ int isWindows));
+static void FreeClauses _ANSI_ARGS_((FileFilter * filterPtr));
+static void FreeGlobPatterns _ANSI_ARGS_((
+ FileFilterClause * clausePtr));
+static void FreeMacFileTypes _ANSI_ARGS_((
+ FileFilterClause * clausePtr));
+static FileFilter * GetFilter _ANSI_ARGS_((FileFilterList * flistPtr,
+ char * name));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkInitFileFilters --
+ *
+ * Initializes a FileFilterList data structure. A FileFilterList
+ * must be initialized EXACTLY ONCE before any calls to
+ * TkGetFileFilters() is made. The usual flow of control is:
+ * TkInitFileFilters(&flist);
+ * TkGetFileFilters(&flist, ...);
+ * TkGetFileFilters(&flist, ...);
+ * ...
+ * TkFreeFileFilters(&flist);
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields in flistPtr are initialized.
+ *----------------------------------------------------------------------
+ */
+
+void
+TkInitFileFilters(flistPtr)
+ FileFilterList * flistPtr; /* The structure to be initialized. */
+{
+ flistPtr->filters = NULL;
+ flistPtr->filtersTail = NULL;
+ flistPtr->numFilters = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetFileFilters --
+ *
+ * This function is called by the Mac and Windows implementation
+ * of tk_getOpenFile and tk_getSaveFile to translate the string
+ * value of the -filetypes option of into an easy-to-parse C
+ * structure (flistPtr). The caller of this function will then use
+ * flistPtr to perform filetype matching in a platform specific way.
+ *
+ * flistPtr must be initialized (See comments in TkInitFileFilters).
+ *
+ * Results:
+ * A standard TCL return value.
+ *
+ * Side effects:
+ * The fields in flistPtr are changed according to string.
+ *----------------------------------------------------------------------
+ */
+int
+TkGetFileFilters(interp, flistPtr, string, isWindows)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ FileFilterList * flistPtr; /* Stores the list of file filters. */
+ char * string; /* Value of the -filetypes option. */
+ int isWindows; /* True if we are running on Windows. */
+{
+ int listArgc;
+ char ** listArgv = NULL;
+ char ** typeInfo = NULL;
+ int code = TCL_OK;
+ int i;
+
+ if (Tcl_SplitList(interp, string, &listArgc, &listArgv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (listArgc == 0) {
+ goto done;
+ }
+
+ /*
+ * Free the filter information that have been allocated the previous
+ * time -- the -filefilters option may have been used more than once in
+ * the command line.
+ */
+ TkFreeFileFilters(flistPtr);
+
+ for (i = 0; i<listArgc; i++) {
+ /*
+ * Each file type should have two or three elements: the first one
+ * is the name of the type and the second is the filter of the type.
+ * The third is the Mac OSType ID, but we don't care about them here.
+ */
+ int count;
+ FileFilter * filterPtr;
+
+ if (Tcl_SplitList(interp, listArgv[i], &count, &typeInfo) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ if (count != 2 && count != 3) {
+ Tcl_AppendResult(interp, "bad file type \"", listArgv[i], "\", ",
+ "should be \"typeName {extension ?extensions ...?} ",
+ "?{macType ?macTypes ...?}?\"", NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ filterPtr = GetFilter(flistPtr, typeInfo[0]);
+
+ if (count == 2) {
+ code = AddClause(interp, filterPtr, typeInfo[1], NULL,
+ isWindows);
+ } else {
+ code = AddClause(interp, filterPtr, typeInfo[1], typeInfo[2],
+ isWindows);
+ }
+ if (code != TCL_OK) {
+ goto done;
+ }
+
+ if (typeInfo) {
+ ckfree((char*)typeInfo);
+ }
+ typeInfo = NULL;
+ }
+
+ done:
+ if (typeInfo) {
+ ckfree((char*)typeInfo);
+ }
+ if (listArgv) {
+ ckfree((char*)listArgv);
+ }
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFreeFileFilters --
+ *
+ * Frees the malloc'ed file filter information.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields allocated by TkGetFileFilters() are freed.
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFreeFileFilters(flistPtr)
+ FileFilterList * flistPtr; /* List of file filters to free */
+{
+ FileFilter * filterPtr, *toFree;
+
+ filterPtr=flistPtr->filters;
+ while (filterPtr) {
+ toFree = filterPtr;
+ filterPtr=filterPtr->next;
+ FreeClauses(toFree);
+ ckfree((char*)toFree->name);
+ ckfree((char*)toFree);
+ }
+ flistPtr->filters = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AddClause --
+ *
+ * Add one FileFilterClause to filterPtr.
+ *
+ * Results:
+ * A standard TCL result.
+ *
+ * Side effects:
+ * The list of filter clauses are updated in filterPtr.
+ *----------------------------------------------------------------------
+ */
+
+static int AddClause(interp, filterPtr, patternsStr, ostypesStr, isWindows)
+ Tcl_Interp * interp; /* Interpreter to use for error reporting. */
+ FileFilter * filterPtr; /* Stores the new filter clause */
+ char * patternsStr; /* A TCL list of glob patterns. */
+ char * ostypesStr; /* A TCL list of Mac OSType strings. */
+ int isWindows; /* True if we are running on Windows; False
+ * if we are running on the Mac; Glob
+ * patterns need to be processed differently
+ * on these two platforms */
+{
+ char ** globList = NULL;
+ int globCount;
+ char ** ostypeList = NULL;
+ int ostypeCount;
+ FileFilterClause * clausePtr;
+ int i;
+ int code = TCL_OK;
+
+ if (Tcl_SplitList(interp, patternsStr, &globCount, &globList)!= TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ if (ostypesStr != NULL) {
+ if (Tcl_SplitList(interp, ostypesStr, &ostypeCount, &ostypeList)
+ != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ for (i=0; i<ostypeCount; i++) {
+ if (strlen(ostypeList[i]) != 4) {
+ Tcl_AppendResult(interp, "bad Macintosh file type \"",
+ ostypeList[i], "\"", NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+ }
+
+ /*
+ * Add the clause into the list of clauses
+ */
+
+ clausePtr = (FileFilterClause*)ckalloc(sizeof(FileFilterClause));
+ clausePtr->patterns = NULL;
+ clausePtr->patternsTail = NULL;
+ clausePtr->macTypes = NULL;
+ clausePtr->macTypesTail = NULL;
+
+ if (filterPtr->clauses == NULL) {
+ filterPtr->clauses = filterPtr->clausesTail = clausePtr;
+ } else {
+ filterPtr->clausesTail->next = clausePtr;
+ filterPtr->clausesTail = clausePtr;
+ }
+ clausePtr->next = NULL;
+
+ if (globCount > 0 && globList != NULL) {
+ for (i=0; i<globCount; i++) {
+ GlobPattern * globPtr = (GlobPattern*)ckalloc(sizeof(GlobPattern));
+ int len;
+
+ len = (strlen(globList[i]) + 1) * sizeof(char);
+
+ if (globList[i][0] && globList[i][0] != '*') {
+ /*
+ * Prepend a "*" to patterns that do not have a leading "*"
+ */
+ globPtr->pattern = (char*)ckalloc(len+1);
+ globPtr->pattern[0] = '*';
+ strcpy(globPtr->pattern+1, globList[i]);
+ }
+ else if (isWindows) {
+ if (strcmp(globList[i], "*") == 0) {
+ globPtr->pattern = (char*)ckalloc(4*sizeof(char));
+ strcpy(globPtr->pattern, "*.*");
+ }
+ else if (strcmp(globList[i], "") == 0) {
+ /*
+ * An empty string means "match all files with no
+ * extensions"
+ * BUG: "*." actually matches with all files on Win95
+ */
+ globPtr->pattern = (char*)ckalloc(3*sizeof(char));
+ strcpy(globPtr->pattern, "*.");
+ }
+ else {
+ globPtr->pattern = (char*)ckalloc(len);
+ strcpy(globPtr->pattern, globList[i]);
+ }
+ } else {
+ globPtr->pattern = (char*)ckalloc(len);
+ strcpy(globPtr->pattern, globList[i]);
+ }
+
+ /*
+ * Add the glob pattern into the list of patterns.
+ */
+
+ if (clausePtr->patterns == NULL) {
+ clausePtr->patterns = clausePtr->patternsTail = globPtr;
+ } else {
+ clausePtr->patternsTail->next = globPtr;
+ clausePtr->patternsTail = globPtr;
+ }
+ globPtr->next = NULL;
+ }
+ }
+ if (ostypeCount > 0 && ostypeList != NULL) {
+ for (i=0; i<ostypeCount; i++) {
+ MacFileType * mfPtr = (MacFileType*)ckalloc(sizeof(MacFileType));
+
+ memcpy(&mfPtr->type, ostypeList[i], sizeof(OSType));
+
+ /*
+ * Add the Mac type pattern into the list of Mac types
+ */
+ if (clausePtr->macTypes == NULL) {
+ clausePtr->macTypes = clausePtr->macTypesTail = mfPtr;
+ } else {
+ clausePtr->macTypesTail->next = mfPtr;
+ clausePtr->macTypesTail = mfPtr;
+ }
+ mfPtr->next = NULL;
+ }
+ }
+
+ done:
+ if (globList) {
+ ckfree((char*)globList);
+ }
+ if (ostypeList) {
+ ckfree((char*)ostypeList);
+ }
+
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetFilter --
+ *
+ * Add one FileFilter to flistPtr.
+ *
+ * Results:
+ * A standard TCL result.
+ *
+ * Side effects:
+ * The list of filters are updated in flistPtr.
+ *----------------------------------------------------------------------
+ */
+
+static FileFilter * GetFilter(flistPtr, name)
+ FileFilterList * flistPtr; /* The FileFilterList that contains the
+ * newly created filter */
+ char * name; /* Name of the filter. It is usually displayed
+ * in the "File Types" listbox in the file
+ * dialogs. */
+{
+ FileFilter * filterPtr;
+
+ for (filterPtr=flistPtr->filters; filterPtr; filterPtr=filterPtr->next) {
+ if (strcmp(filterPtr->name, name)==0) {
+ return filterPtr;
+ }
+ }
+
+ filterPtr = (FileFilter*)ckalloc(sizeof(FileFilter));
+ filterPtr->clauses = NULL;
+ filterPtr->clausesTail = NULL;
+ filterPtr->name = (char*)ckalloc((strlen(name)+1) * sizeof(char));
+ strcpy(filterPtr->name, name);
+
+ if (flistPtr->filters == NULL) {
+ flistPtr->filters = flistPtr->filtersTail = filterPtr;
+ } else {
+ flistPtr->filtersTail->next = filterPtr;
+ flistPtr->filtersTail = filterPtr;
+ }
+ filterPtr->next = NULL;
+
+ ++flistPtr->numFilters;
+ return filterPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeClauses --
+ *
+ * Frees the malloc'ed file type clause
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The list of clauses in filterPtr->clauses are freed.
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeClauses(filterPtr)
+ FileFilter * filterPtr; /* FileFilter whose clauses are to be freed */
+{
+ FileFilterClause * clausePtr, * toFree;
+
+ clausePtr = filterPtr->clauses;
+ while (clausePtr) {
+ toFree = clausePtr;
+ clausePtr=clausePtr->next;
+ FreeGlobPatterns(toFree);
+ FreeMacFileTypes(toFree);
+ ckfree((char*)toFree);
+ }
+ filterPtr->clauses = NULL;
+ filterPtr->clausesTail = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeGlobPatterns --
+ *
+ * Frees the malloc'ed glob patterns in a clause
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The list of glob patterns in clausePtr->patterns are freed.
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeGlobPatterns(clausePtr)
+ FileFilterClause * clausePtr;/* The clause whose patterns are to be freed*/
+{
+ GlobPattern * globPtr, * toFree;
+
+ globPtr = clausePtr->patterns;
+ while (globPtr) {
+ toFree = globPtr;
+ globPtr=globPtr->next;
+
+ ckfree((char*)toFree->pattern);
+ ckfree((char*)toFree);
+ }
+ clausePtr->patterns = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeMacFileTypes --
+ *
+ * Frees the malloc'ed Mac file types in a clause
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The list of Mac file types in clausePtr->macTypes are freed.
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeMacFileTypes(clausePtr)
+ FileFilterClause * clausePtr; /* The clause whose mac types are to be
+ * freed */
+{
+ MacFileType * mfPtr, * toFree;
+
+ mfPtr = clausePtr->macTypes;
+ while (mfPtr) {
+ toFree = mfPtr;
+ mfPtr=mfPtr->next;
+ ckfree((char*)toFree);
+ }
+ clausePtr->macTypes = NULL;
+}
diff --git a/generic/tkFileFilter.h b/generic/tkFileFilter.h
new file mode 100644
index 0000000..2b113fc
--- /dev/null
+++ b/generic/tkFileFilter.h
@@ -0,0 +1,83 @@
+/*
+ * tkFileFilter.h --
+ *
+ * Declarations for the file filter processing routines needed by
+ * the file selection dialogs.
+ *
+ * Copyright (c) 1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkFileFilter.h 1.1 96/08/27 15:05:38
+ *
+ */
+
+#ifndef _TK_FILE_FILTER
+#define _TK_FILE_FILTER
+
+#ifdef MAC_TCL
+#include <StandardFile.h>
+#else
+#define OSType long
+#endif
+
+typedef struct GlobPattern {
+ struct GlobPattern * next; /* Chains to the next glob pattern
+ * in a glob pattern list */
+ char * pattern; /* String value of the pattern, such
+ * as "*.txt" or "*.*"
+ */
+} GlobPattern;
+
+typedef struct MacFileType {
+ struct MacFileType * next; /* Chains to the next mac file type
+ * in a mac file type list */
+ OSType type; /* Mac file type, such as 'TEXT' or
+ * 'GIFF' */
+} MacFileType;
+
+typedef struct FileFilterClause {
+ struct FileFilterClause * next; /* Chains to the next clause in
+ * a clause list */
+ GlobPattern * patterns; /* Head of glob pattern type list */
+ GlobPattern * patternsTail; /* Tail of glob pattern type list */
+ MacFileType * macTypes; /* Head of mac file type list */
+ MacFileType * macTypesTail; /* Tail of mac file type list */
+} FileFilterClause;
+
+typedef struct FileFilter {
+ struct FileFilter * next; /* Chains to the next filter
+ * in a filter list */
+ char * name; /* Name of the file filter,
+ * such as "Text Documents" */
+ FileFilterClause * clauses; /* Head of the clauses list */
+ FileFilterClause * clausesTail; /* Tail of the clauses list */
+} FileFilter;
+
+/*----------------------------------------------------------------------
+ * FileFilterList --
+ *
+ * The routine TkGetFileFilters() translates the string value of the
+ * -filefilters option into a FileFilterList structure, which consists
+ * of a list of file filters.
+ *
+ * Each file filter consists of one or more clauses. Each clause has
+ * one or more glob patterns and/or one or more Mac file types
+ *----------------------------------------------------------------------
+ */
+
+typedef struct FileFilterList {
+ FileFilter * filters; /* Head of the filter list */
+ FileFilter * filtersTail; /* Tail of the filter list */
+ int numFilters; /* number of filters in the list */
+} FileFilterList;
+
+EXTERN void TkFreeFileFilters _ANSI_ARGS_((
+ FileFilterList * flistPtr));
+EXTERN void TkInitFileFilters _ANSI_ARGS_((
+ FileFilterList * flistPtr));
+EXTERN int TkGetFileFilters _ANSI_ARGS_ ((Tcl_Interp *interp,
+ FileFilterList * flistPtr, char * string,
+ int isWindows));
+#endif
diff --git a/generic/tkFocus.c b/generic/tkFocus.c
new file mode 100644
index 0000000..fe8f2c5
--- /dev/null
+++ b/generic/tkFocus.c
@@ -0,0 +1,998 @@
+/*
+ * tkFocus.c --
+ *
+ * This file contains procedures that manage the input
+ * focus for Tk.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkFocus.c 1.48 97/10/31 09:55:22
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+
+/*
+ * For each top-level window that has ever received the focus, there
+ * is a record of the following type:
+ */
+
+typedef struct TkToplevelFocusInfo {
+ TkWindow *topLevelPtr; /* Information about top-level window. */
+ TkWindow *focusWinPtr; /* The next time the focus comes to this
+ * top-level, it will be given to this
+ * window. */
+ struct TkToplevelFocusInfo *nextPtr;
+ /* Next in list of all toplevel focus records
+ * for a given application. */
+} ToplevelFocusInfo;
+
+/*
+ * One of the following structures exists for each display used by
+ * each application. These are linked together from the TkMainInfo
+ * structure. These structures are needed because it isn't
+ * sufficient to store a single piece of focus information in each
+ * display or in each application: we need the cross-product.
+ * There needs to be separate information for each display, because
+ * it's possible to have multiple focus windows active simultaneously
+ * on different displays. There also needs to be separate information
+ * for each application, because of embedding: if an embedded
+ * application has the focus, its container application also has
+ * the focus. Thus we keep a list of structures for each application:
+ * the same display can appear in structures for several applications
+ * at once.
+ */
+
+typedef struct TkDisplayFocusInfo {
+ TkDisplay *dispPtr; /* Display that this information pertains
+ * to. */
+ struct TkWindow *focusWinPtr;
+ /* Window that currently has the focus for
+ * this application on this display, or NULL
+ * if none. */
+ struct TkWindow *focusOnMapPtr;
+ /* This points to a toplevel window that is
+ * supposed to receive the X input focus as
+ * soon as it is mapped (needed to handle the
+ * fact that X won't allow the focus on an
+ * unmapped window). NULL means no delayed
+ * focus op in progress for this display. */
+ int forceFocus; /* Associated with focusOnMapPtr: non-zero
+ * means claim the focus even if some other
+ * application currently has it. */
+ unsigned long focusSerial; /* Serial number of last request this
+ * application made to change the focus on
+ * this display. Used to identify stale
+ * focus notifications coming from the
+ * X server. */
+ struct TkDisplayFocusInfo *nextPtr;
+ /* Next in list of all display focus
+ * records for a given application. */
+} DisplayFocusInfo;
+
+/*
+ * Global used for debugging.
+ */
+
+int tclFocusDebug = 0;
+
+/*
+ * The following magic value is stored in the "send_event" field of
+ * FocusIn and FocusOut events that are generated in this file. This
+ * allows us to separate "real" events coming from the server from
+ * those that we generated.
+ */
+
+#define GENERATED_EVENT_MAGIC ((Bool) 0x547321ac)
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+
+static DisplayFocusInfo *FindDisplayFocusInfo _ANSI_ARGS_((TkMainInfo *mainPtr,
+ TkDisplay *dispPtr));
+static void FocusMapProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void GenerateFocusEvents _ANSI_ARGS_((TkWindow *sourcePtr,
+ TkWindow *destPtr));
+static void SetFocus _ANSI_ARGS_((TkWindow *winPtr, int force));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_FocusCmd --
+ *
+ * This procedure is invoked to process the "focus" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_FocusCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ TkWindow *winPtr = (TkWindow *) clientData;
+ TkWindow *newPtr, *focusWinPtr, *topLevelPtr;
+ ToplevelFocusInfo *tlFocusPtr;
+ char c;
+ size_t length;
+
+ /*
+ * If invoked with no arguments, just return the current focus window.
+ */
+
+ if (argc == 1) {
+ focusWinPtr = TkGetFocusWin(winPtr);
+ if (focusWinPtr != NULL) {
+ interp->result = focusWinPtr->pathName;
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * If invoked with a single argument beginning with "." then focus
+ * on that window.
+ */
+
+ if (argc == 2) {
+ if (argv[1][0] == 0) {
+ return TCL_OK;
+ }
+ if (argv[1][0] == '.') {
+ newPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (!(newPtr->flags & TK_ALREADY_DEAD)) {
+ SetFocus(newPtr, 0);
+ }
+ return TCL_OK;
+ }
+ }
+
+ length = strlen(argv[1]);
+ c = argv[1][1];
+ if ((c == 'd') && (strncmp(argv[1], "-displayof", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " -displayof window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ newPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ newPtr = TkGetFocusWin(newPtr);
+ if (newPtr != NULL) {
+ interp->result = newPtr->pathName;
+ }
+ } else if ((c == 'f') && (strncmp(argv[1], "-force", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " -force window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argv[2][0] == 0) {
+ return TCL_OK;
+ }
+ newPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ SetFocus(newPtr, 1);
+ } else if ((c == 'l') && (strncmp(argv[1], "-lastfor", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " -lastfor window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ newPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ for (topLevelPtr = newPtr; topLevelPtr != NULL;
+ topLevelPtr = topLevelPtr->parentPtr) {
+ if (topLevelPtr->flags & TK_TOP_LEVEL) {
+ for (tlFocusPtr = newPtr->mainPtr->tlFocusPtr;
+ tlFocusPtr != NULL;
+ tlFocusPtr = tlFocusPtr->nextPtr) {
+ if (tlFocusPtr->topLevelPtr == topLevelPtr) {
+ interp->result = tlFocusPtr->focusWinPtr->pathName;
+ return TCL_OK;
+ }
+ }
+ interp->result = topLevelPtr->pathName;
+ return TCL_OK;
+ }
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be -displayof, -force, or -lastfor", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkFocusFilterEvent --
+ *
+ * This procedure is invoked by Tk_HandleEvent when it encounters
+ * a FocusIn, FocusOut, Enter, or Leave event.
+ *
+ * Results:
+ * A return value of 1 means that Tk_HandleEvent should process
+ * the event normally (i.e. event handlers should be invoked).
+ * A return value of 0 means that this event should be ignored.
+ *
+ * Side effects:
+ * Additional events may be generated, and the focus may switch.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkFocusFilterEvent(winPtr, eventPtr)
+ TkWindow *winPtr; /* Window that focus event is directed to. */
+ XEvent *eventPtr; /* FocusIn, FocusOut, Enter, or Leave
+ * event. */
+{
+ /*
+ * Design notes: the window manager and X server work together to
+ * transfer the focus among top-level windows. This procedure takes
+ * care of transferring the focus from a top-level or wrapper window
+ * to the actual window within that top-level that has the focus.
+ * We do this by synthesizing X events to move the focus around.
+ * None of the FocusIn and FocusOut events generated by X are ever
+ * used outside of this procedure; only the synthesized events get
+ * through to the rest of the application. At one point (e.g.
+ * Tk4.0b1) Tk used to call X to move the focus from a top-level to
+ * one of its descendants, then just pass through the events
+ * generated by X. This approach didn't work very well, for a
+ * variety of reasons. For example, if X generates the events they
+ * go at the back of the event queue, which could cause problems if
+ * other things have already happened, such as moving the focus to
+ * yet another window.
+ */
+
+ ToplevelFocusInfo *tlFocusPtr;
+ DisplayFocusInfo *displayFocusPtr;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkWindow *newFocusPtr;
+ int retValue, delta;
+
+ /*
+ * If this was a generated event, just turn off the generated
+ * flag and pass the event through to Tk bindings.
+ */
+
+ if (eventPtr->xfocus.send_event == GENERATED_EVENT_MAGIC) {
+ eventPtr->xfocus.send_event = 0;
+ return 1;
+ }
+
+ /*
+ * Check for special events generated by embedded applications to
+ * request the input focus. If this is one of those events, make
+ * the change in focus and return without any additional processing
+ * of the event (note: the "detail" field of the event indicates
+ * whether to claim the focus even if we don't already have it).
+ */
+
+ if ((eventPtr->xfocus.mode == EMBEDDED_APP_WANTS_FOCUS)
+ && (eventPtr->type == FocusIn)) {
+ SetFocus(winPtr, eventPtr->xfocus.detail);
+ return 0;
+ }
+
+ /*
+ * This was not a generated event. We'll return 1 (so that the
+ * event will be processed) if it's an Enter or Leave event, and
+ * 0 (so that the event won't be processed) if it's a FocusIn or
+ * FocusOut event.
+ */
+
+ retValue = 0;
+ displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);
+ if (eventPtr->type == FocusIn) {
+ /*
+ * Skip FocusIn events that cause confusion
+ * NotifyVirtual and NotifyNonlinearVirtual - Virtual events occur
+ * on windows in between the origin and destination of the
+ * focus change. For FocusIn we may see this when focus
+ * goes into an embedded child. We don't care about this,
+ * although we may end up getting a NotifyPointer later.
+ * NotifyInferior - focus is coming to us from an embedded child.
+ * When focus is on an embeded focus, we still think we have
+ * the focus, too, so this message doesn't change our state.
+ * NotifyPointerRoot - should never happen because this is sent
+ * to the root window.
+ *
+ * Interesting FocusIn events are
+ * NotifyAncestor - focus is coming from our parent, probably the root.
+ * NotifyNonlinear - focus is coming from a different branch, probably
+ * another toplevel.
+ * NotifyPointer - implicit focus because of the mouse position.
+ * This is only interesting on toplevels, when it means that the
+ * focus has been set to the root window but the mouse is over
+ * this toplevel. We take the focus implicitly (probably no
+ * window manager)
+ */
+
+ if ((eventPtr->xfocus.detail == NotifyVirtual)
+ || (eventPtr->xfocus.detail == NotifyNonlinearVirtual)
+ || (eventPtr->xfocus.detail == NotifyPointerRoot)
+ || (eventPtr->xfocus.detail == NotifyInferior)) {
+ return retValue;
+ }
+ } else if (eventPtr->type == FocusOut) {
+ /*
+ * Skip FocusOut events that cause confusion.
+ * NotifyPointer - the pointer is in us or a child, and we are losing
+ * focus because of an XSetInputFocus. Other focus events
+ * will set our state properly.
+ * NotifyPointerRoot - should never happen because this is sent
+ * to the root window.
+ * NotifyInferior - focus leaving us for an embedded child. We
+ * retain a notion of focus when an embedded child has focus.
+ *
+ * Interesting events are:
+ * NotifyAncestor - focus is going to root.
+ * NotifyNonlinear - focus is going to another branch, probably
+ * another toplevel.
+ * NotifyVirtual, NotifyNonlinearVirtual - focus is passing through,
+ * and we need to make sure we track this.
+ */
+
+ if ((eventPtr->xfocus.detail == NotifyPointer)
+ || (eventPtr->xfocus.detail == NotifyPointerRoot)
+ || (eventPtr->xfocus.detail == NotifyInferior)) {
+ return retValue;
+ }
+ } else {
+ retValue = 1;
+ if (eventPtr->xcrossing.detail == NotifyInferior) {
+ return retValue;
+ }
+ }
+
+ /*
+ * If winPtr isn't a top-level window than just ignore the event.
+ */
+
+ winPtr = TkWmFocusToplevel(winPtr);
+ if (winPtr == NULL) {
+ return retValue;
+ }
+
+ /*
+ * If there is a grab in effect and this window is outside the
+ * grabbed tree, then ignore the event.
+ */
+
+ if (TkGrabState(winPtr) == TK_GRAB_EXCLUDED) {
+ return retValue;
+ }
+
+ /*
+ * It is possible that there were outstanding FocusIn and FocusOut
+ * events on their way to us at the time the focus was changed
+ * internally with the "focus" command. If so, these events could
+ * potentially cause us to lose the focus (switch it to the window
+ * of the last FocusIn event) even though the focus change occurred
+ * after those events. The following code detects this and ignores
+ * the stale events.
+ *
+ * Note: the focusSerial is only generated by TkpChangeFocus,
+ * whereas in Tk 4.2 there was always a nop marker generated.
+ */
+
+ delta = eventPtr->xfocus.serial - displayFocusPtr->focusSerial;
+ if (delta < 0) {
+ return retValue;
+ }
+
+ /*
+ * Find the ToplevelFocusInfo structure for the window, and make a new one
+ * if there isn't one already.
+ */
+
+ for (tlFocusPtr = winPtr->mainPtr->tlFocusPtr; tlFocusPtr != NULL;
+ tlFocusPtr = tlFocusPtr->nextPtr) {
+ if (tlFocusPtr->topLevelPtr == winPtr) {
+ break;
+ }
+ }
+ if (tlFocusPtr == NULL) {
+ tlFocusPtr = (ToplevelFocusInfo *) ckalloc(sizeof(ToplevelFocusInfo));
+ tlFocusPtr->topLevelPtr = tlFocusPtr->focusWinPtr = winPtr;
+ tlFocusPtr->nextPtr = winPtr->mainPtr->tlFocusPtr;
+ winPtr->mainPtr->tlFocusPtr = tlFocusPtr;
+ }
+ newFocusPtr = tlFocusPtr->focusWinPtr;
+
+ if (eventPtr->type == FocusIn) {
+ GenerateFocusEvents(displayFocusPtr->focusWinPtr, newFocusPtr);
+ displayFocusPtr->focusWinPtr = newFocusPtr;
+ dispPtr->focusPtr = newFocusPtr;
+
+ /*
+ * NotifyPointer gets set when the focus has been set to the root window
+ * but we have the pointer. We'll treat this like an implicit
+ * focus in event so that upon Leave events we release focus.
+ */
+
+ if (!(winPtr->flags & TK_EMBEDDED)) {
+ if (eventPtr->xfocus.detail == NotifyPointer) {
+ dispPtr->implicitWinPtr = winPtr;
+ } else {
+ dispPtr->implicitWinPtr = NULL;
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ GenerateFocusEvents(displayFocusPtr->focusWinPtr, (TkWindow *) NULL);
+
+ /*
+ * Reset dispPtr->focusPtr, but only if it currently is the same
+ * as this application's focusWinPtr: this check is needed to
+ * handle embedded applications in the same process.
+ */
+
+ if (dispPtr->focusPtr == displayFocusPtr->focusWinPtr) {
+ dispPtr->focusPtr = NULL;
+ }
+ displayFocusPtr->focusWinPtr = NULL;
+ } else if (eventPtr->type == EnterNotify) {
+ /*
+ * If there is no window manager, or if the window manager isn't
+ * moving the focus around (e.g. the disgusting "NoTitleFocus"
+ * option has been selected in twm), then we won't get FocusIn
+ * or FocusOut events. Instead, the "focus" field will be set
+ * in an Enter event to indicate that we've already got the focus
+ * when the mouse enters the window (even though we didn't get
+ * a FocusIn event). Watch for this and grab the focus when it
+ * happens. Note: if this is an embedded application then don't
+ * accept the focus implicitly like this; the container
+ * application will give us the focus explicitly if it wants us
+ * to have it.
+ */
+
+ if (eventPtr->xcrossing.focus &&
+ (displayFocusPtr->focusWinPtr == NULL)
+ && !(winPtr->flags & TK_EMBEDDED)) {
+ if (tclFocusDebug) {
+ printf("Focussed implicitly on %s\n",
+ newFocusPtr->pathName);
+ }
+
+ GenerateFocusEvents(displayFocusPtr->focusWinPtr, newFocusPtr);
+ displayFocusPtr->focusWinPtr = newFocusPtr;
+ dispPtr->implicitWinPtr = winPtr;
+ dispPtr->focusPtr = newFocusPtr;
+ }
+ } else if (eventPtr->type == LeaveNotify) {
+ /*
+ * If the pointer just left a window for which we automatically
+ * claimed the focus on enter, move the focus back to the root
+ * window, where it was before we claimed it above. Note:
+ * dispPtr->implicitWinPtr may not be the same as
+ * displayFocusPtr->focusWinPtr (e.g. because the "focus"
+ * command was used to redirect the focus after it arrived at
+ * dispPtr->implicitWinPtr)!! In addition, we generate events
+ * because the window manager won't give us a FocusOut event when
+ * we focus on the root.
+ */
+
+ if ((dispPtr->implicitWinPtr != NULL)
+ && !(winPtr->flags & TK_EMBEDDED)) {
+ if (tclFocusDebug) {
+ printf("Defocussed implicit Async\n");
+ }
+ GenerateFocusEvents(displayFocusPtr->focusWinPtr,
+ (TkWindow *) NULL);
+ XSetInputFocus(dispPtr->display, PointerRoot, RevertToPointerRoot,
+ CurrentTime);
+ displayFocusPtr->focusWinPtr = NULL;
+ dispPtr->implicitWinPtr = NULL;
+ }
+ }
+ return retValue;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetFocus --
+ *
+ * This procedure is invoked to change the focus window for a
+ * given display in a given application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Event handlers may be invoked to process the change of
+ * focus.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SetFocus(winPtr, force)
+ TkWindow *winPtr; /* Window that is to be the new focus for
+ * its display and application. */
+ int force; /* If non-zero, set the X focus to this
+ * window even if the application doesn't
+ * currently have the X focus. */
+{
+ ToplevelFocusInfo *tlFocusPtr;
+ DisplayFocusInfo *displayFocusPtr;
+ TkWindow *topLevelPtr;
+ int allMapped, serial;
+
+ displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);
+ if (winPtr == displayFocusPtr->focusWinPtr) {
+ return;
+ }
+
+ /*
+ * Find the top-level window for winPtr, then find (or create)
+ * a record for the top-level. Also see whether winPtr and all its
+ * ancestors are mapped.
+ */
+
+ allMapped = 1;
+ for (topLevelPtr = winPtr; ; topLevelPtr = topLevelPtr->parentPtr) {
+ if (topLevelPtr == NULL) {
+ /*
+ * The window is being deleted. No point in worrying about
+ * giving it the focus.
+ */
+ return;
+ }
+ if (!(topLevelPtr->flags & TK_MAPPED)) {
+ allMapped = 0;
+ }
+ if (topLevelPtr->flags & TK_TOP_LEVEL) {
+ break;
+ }
+ }
+
+ /*
+ * If the new focus window isn't mapped, then we can't focus on it
+ * (X will generate an error, for example). Instead, create an
+ * event handler that will set the focus to this window once it gets
+ * mapped. At the same time, delete any old handler that might be
+ * around; it's no longer relevant.
+ */
+
+ if (displayFocusPtr->focusOnMapPtr != NULL) {
+ Tk_DeleteEventHandler(
+ (Tk_Window) displayFocusPtr->focusOnMapPtr,
+ StructureNotifyMask, FocusMapProc,
+ (ClientData) displayFocusPtr->focusOnMapPtr);
+ displayFocusPtr->focusOnMapPtr = NULL;
+ }
+ if (!allMapped) {
+ Tk_CreateEventHandler((Tk_Window) winPtr,
+ VisibilityChangeMask, FocusMapProc,
+ (ClientData) winPtr);
+ displayFocusPtr->focusOnMapPtr = winPtr;
+ displayFocusPtr->forceFocus = force;
+ return;
+ }
+
+ for (tlFocusPtr = winPtr->mainPtr->tlFocusPtr; tlFocusPtr != NULL;
+ tlFocusPtr = tlFocusPtr->nextPtr) {
+ if (tlFocusPtr->topLevelPtr == topLevelPtr) {
+ break;
+ }
+ }
+ if (tlFocusPtr == NULL) {
+ tlFocusPtr = (ToplevelFocusInfo *) ckalloc(sizeof(ToplevelFocusInfo));
+ tlFocusPtr->topLevelPtr = topLevelPtr;
+ tlFocusPtr->nextPtr = winPtr->mainPtr->tlFocusPtr;
+ winPtr->mainPtr->tlFocusPtr = tlFocusPtr;
+ }
+ tlFocusPtr->focusWinPtr = winPtr;
+
+ /*
+ * Reset the window system's focus window and generate focus events,
+ * with two special cases:
+ *
+ * 1. If the application is embedded and doesn't currently have the
+ * focus, don't set the focus directly. Instead, see if the
+ * embedding code can claim the focus from the enclosing
+ * container.
+ * 2. Otherwise, if the application doesn't currently have the
+ * focus, don't change the window system's focus unless it was
+ * already in this application or "force" was specified.
+ */
+
+ if ((topLevelPtr->flags & TK_EMBEDDED)
+ && (displayFocusPtr->focusWinPtr == NULL)) {
+ TkpClaimFocus(topLevelPtr, force);
+ } else if ((displayFocusPtr->focusWinPtr != NULL) || force) {
+ /*
+ * Generate events to shift focus between Tk windows.
+ * We do this regardless of what TkpChangeFocus does with
+ * the real X focus so that Tk widgets track focus commands
+ * when there is no window manager. GenerateFocusEvents will
+ * set up a serial number marker so we discard focus events
+ * that are triggered by the ChangeFocus.
+ */
+
+ serial = TkpChangeFocus(TkpGetWrapperWindow(topLevelPtr), force);
+ if (serial != 0) {
+ displayFocusPtr->focusSerial = serial;
+ }
+ GenerateFocusEvents(displayFocusPtr->focusWinPtr, winPtr);
+ displayFocusPtr->focusWinPtr = winPtr;
+ winPtr->dispPtr->focusPtr = winPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetFocusWin --
+ *
+ * Given a window, this procedure returns the current focus
+ * window for its application and display.
+ *
+ * Results:
+ * The return value is a pointer to the window that currently
+ * has the input focus for the specified application and
+ * display, or NULL if none.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow *
+TkGetFocusWin(winPtr)
+ TkWindow *winPtr; /* Window that selects an application
+ * and a display. */
+{
+ DisplayFocusInfo *displayFocusPtr;
+
+ if (winPtr == NULL) {
+ return (TkWindow *) NULL;
+ }
+
+ displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);
+ return displayFocusPtr->focusWinPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFocusKeyEvent --
+ *
+ * Given a window and a key press or release event that arrived for
+ * the window, use information about the keyboard focus to compute
+ * which window should really get the event. In addition, update
+ * the event to refer to its new window.
+ *
+ * Results:
+ * The return value is a pointer to the window that has the input
+ * focus in winPtr's application, or NULL if winPtr's application
+ * doesn't have the input focus. If a non-NULL value is returned,
+ * eventPtr will be updated to refer properly to the focus window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow *
+TkFocusKeyEvent(winPtr, eventPtr)
+ TkWindow *winPtr; /* Window that selects an application
+ * and a display. */
+ XEvent *eventPtr; /* X event to redirect (should be KeyPress
+ * or KeyRelease). */
+{
+ DisplayFocusInfo *displayFocusPtr;
+ TkWindow *focusWinPtr;
+ int focusX, focusY, vRootX, vRootY, vRootWidth, vRootHeight;
+
+ displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);
+ focusWinPtr = displayFocusPtr->focusWinPtr;
+
+ /*
+ * The code below is a debugging aid to make sure that dispPtr->focusPtr
+ * is kept properly in sync with the "truth", which is the value in
+ * displayFocusPtr->focusWinPtr.
+ */
+
+#ifdef TCL_MEM_DEBUG
+ if (focusWinPtr != winPtr->dispPtr->focusPtr) {
+ printf("TkFocusKeyEvent found dispPtr->focusPtr out of sync:\n");
+ printf("expected %s, got %s\n",
+ (focusWinPtr != NULL) ? focusWinPtr->pathName : "??",
+ (winPtr->dispPtr->focusPtr != NULL) ?
+ winPtr->dispPtr->focusPtr->pathName : "??");
+ }
+#endif
+
+ if ((focusWinPtr != NULL) && (focusWinPtr->mainPtr == winPtr->mainPtr)) {
+ /*
+ * Map the x and y coordinates to make sense in the context of
+ * the focus window, if possible (make both -1 if the map-from
+ * and map-to windows don't share the same screen).
+ */
+
+ if ((focusWinPtr->display != winPtr->display)
+ || (focusWinPtr->screenNum != winPtr->screenNum)) {
+ eventPtr->xkey.x = -1;
+ eventPtr->xkey.y = -1;
+ } else {
+ Tk_GetVRootGeometry((Tk_Window) focusWinPtr, &vRootX, &vRootY,
+ &vRootWidth, &vRootHeight);
+ Tk_GetRootCoords((Tk_Window) focusWinPtr, &focusX, &focusY);
+ eventPtr->xkey.x = eventPtr->xkey.x_root - vRootX - focusX;
+ eventPtr->xkey.y = eventPtr->xkey.y_root - vRootY - focusY;
+ }
+ eventPtr->xkey.window = focusWinPtr->window;
+ return focusWinPtr;
+ }
+
+ /*
+ * The event doesn't belong to us. Perhaps, due to embedding, it
+ * really belongs to someone else. Give the embedding code a chance
+ * to redirect the event.
+ */
+
+ TkpRedirectKeyEvent(winPtr, eventPtr);
+ return (TkWindow *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFocusDeadWindow --
+ *
+ * This procedure is invoked when it is determined that
+ * a window is dead. It cleans up focus-related information
+ * about the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Various things get cleaned up and recycled.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFocusDeadWindow(winPtr)
+ register TkWindow *winPtr; /* Information about the window
+ * that is being deleted. */
+{
+ ToplevelFocusInfo *tlFocusPtr, *prevPtr;
+ DisplayFocusInfo *displayFocusPtr;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+
+ /*
+ * Search for focus records that refer to this window either as
+ * the top-level window or the current focus window.
+ */
+
+ displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);
+ for (prevPtr = NULL, tlFocusPtr = winPtr->mainPtr->tlFocusPtr;
+ tlFocusPtr != NULL;
+ prevPtr = tlFocusPtr, tlFocusPtr = tlFocusPtr->nextPtr) {
+ if (winPtr == tlFocusPtr->topLevelPtr) {
+ /*
+ * The top-level window is the one being deleted: free
+ * the focus record and release the focus back to PointerRoot
+ * if we acquired it implicitly.
+ */
+
+ if (dispPtr->implicitWinPtr == winPtr) {
+ if (tclFocusDebug) {
+ printf("releasing focus to root after %s died\n",
+ tlFocusPtr->topLevelPtr->pathName);
+ }
+ dispPtr->implicitWinPtr = NULL;
+ displayFocusPtr->focusWinPtr = NULL;
+ dispPtr->focusPtr = NULL;
+ }
+ if (displayFocusPtr->focusWinPtr == tlFocusPtr->focusWinPtr) {
+ displayFocusPtr->focusWinPtr = NULL;
+ dispPtr->focusPtr = NULL;
+ }
+ if (prevPtr == NULL) {
+ winPtr->mainPtr->tlFocusPtr = tlFocusPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = tlFocusPtr->nextPtr;
+ }
+ ckfree((char *) tlFocusPtr);
+ break;
+ } else if (winPtr == tlFocusPtr->focusWinPtr) {
+ /*
+ * The deleted window had the focus for its top-level:
+ * move the focus to the top-level itself.
+ */
+
+ tlFocusPtr->focusWinPtr = tlFocusPtr->topLevelPtr;
+ if ((displayFocusPtr->focusWinPtr == winPtr)
+ && !(tlFocusPtr->topLevelPtr->flags & TK_ALREADY_DEAD)) {
+ if (tclFocusDebug) {
+ printf("forwarding focus to %s after %s died\n",
+ tlFocusPtr->topLevelPtr->pathName,
+ winPtr->pathName);
+ }
+ GenerateFocusEvents(displayFocusPtr->focusWinPtr,
+ tlFocusPtr->topLevelPtr);
+ displayFocusPtr->focusWinPtr = tlFocusPtr->topLevelPtr;
+ dispPtr->focusPtr = tlFocusPtr->topLevelPtr;
+ }
+ break;
+ }
+ }
+
+ if (displayFocusPtr->focusOnMapPtr == winPtr) {
+ displayFocusPtr->focusOnMapPtr = NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateFocusEvents --
+ *
+ * This procedure is called to create FocusIn and FocusOut events to
+ * move the input focus from one window to another.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * FocusIn and FocusOut events are generated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GenerateFocusEvents(sourcePtr, destPtr)
+ TkWindow *sourcePtr; /* Window that used to have the focus (may
+ * be NULL). */
+ TkWindow *destPtr; /* New window to have the focus (may be
+ * NULL). */
+
+{
+ XEvent event;
+ TkWindow *winPtr;
+
+ winPtr = sourcePtr;
+ if (winPtr == NULL) {
+ winPtr = destPtr;
+ if (winPtr == NULL) {
+ return;
+ }
+ }
+
+ event.xfocus.serial = LastKnownRequestProcessed(winPtr->display);
+ event.xfocus.send_event = GENERATED_EVENT_MAGIC;
+ event.xfocus.display = winPtr->display;
+ event.xfocus.mode = NotifyNormal;
+ TkInOutEvents(&event, sourcePtr, destPtr, FocusOut, FocusIn,
+ TCL_QUEUE_MARK);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FocusMapProc --
+ *
+ * This procedure is called as an event handler for VisibilityNotify
+ * events, if a window receives the focus at a time when its
+ * toplevel isn't mapped. The procedure is needed because X
+ * won't allow the focus to be set to an unmapped window; we
+ * detect when the toplevel is mapped and set the focus to it then.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If this is a map event, the focus gets set to the toplevel
+ * given by clientData.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FocusMapProc(clientData, eventPtr)
+ ClientData clientData; /* Toplevel window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TkWindow *winPtr = (TkWindow *) clientData;
+ DisplayFocusInfo *displayFocusPtr;
+
+ if (eventPtr->type == VisibilityNotify) {
+ displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr,
+ winPtr->dispPtr);
+ if (tclFocusDebug) {
+ printf("auto-focussing on %s, force %d\n", winPtr->pathName,
+ displayFocusPtr->forceFocus);
+ }
+ Tk_DeleteEventHandler((Tk_Window) winPtr, VisibilityChangeMask,
+ FocusMapProc, clientData);
+ displayFocusPtr->focusOnMapPtr = NULL;
+ SetFocus(winPtr, displayFocusPtr->forceFocus);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindDisplayFocusInfo --
+ *
+ * Given an application and a display, this procedure locate the
+ * focus record for that combination. If no such record exists,
+ * it creates a new record and initializes it.
+ *
+ * Results:
+ * The return value is a pointer to the record.
+ *
+ * Side effects:
+ * A new record will be allocated if there wasn't one already.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DisplayFocusInfo *
+FindDisplayFocusInfo(mainPtr, dispPtr)
+ TkMainInfo *mainPtr; /* Record that identifies a particular
+ * application. */
+ TkDisplay *dispPtr; /* Display whose focus information is
+ * needed. */
+{
+ DisplayFocusInfo *displayFocusPtr;
+
+ for (displayFocusPtr = mainPtr->displayFocusPtr;
+ displayFocusPtr != NULL;
+ displayFocusPtr = displayFocusPtr->nextPtr) {
+ if (displayFocusPtr->dispPtr == dispPtr) {
+ return displayFocusPtr;
+ }
+ }
+
+ /*
+ * The record doesn't exist yet. Make a new one.
+ */
+
+ displayFocusPtr = (DisplayFocusInfo *) ckalloc(sizeof(DisplayFocusInfo));
+ displayFocusPtr->dispPtr = dispPtr;
+ displayFocusPtr->focusWinPtr = NULL;
+ displayFocusPtr->focusOnMapPtr = NULL;
+ displayFocusPtr->forceFocus = 0;
+ displayFocusPtr->focusSerial = 0;
+ displayFocusPtr->nextPtr = mainPtr->displayFocusPtr;
+ mainPtr->displayFocusPtr = displayFocusPtr;
+ return displayFocusPtr;
+}
diff --git a/generic/tkFont.c b/generic/tkFont.c
new file mode 100644
index 0000000..11929b6
--- /dev/null
+++ b/generic/tkFont.c
@@ -0,0 +1,3008 @@
+/*
+ * tkFont.c --
+ *
+ * This file maintains a database of fonts for the Tk toolkit.
+ * It also provides several utility procedures for measuring and
+ * displaying text.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkFont.c 1.74 97/10/10 14:34:11
+ */
+
+#include "tkInt.h"
+#include "tkFont.h"
+
+/*
+ * The following structure is used to keep track of all the fonts that
+ * exist in the current application. It must be stored in the
+ * TkMainInfo for the application.
+ */
+
+typedef struct TkFontInfo {
+ Tcl_HashTable fontCache; /* Map a string to an existing Tk_Font.
+ * Keys are CachedFontKey structs, values are
+ * TkFont structs. */
+ Tcl_HashTable namedTable; /* Map a name to a set of attributes for a
+ * font, used when constructing a Tk_Font from
+ * a named font description. Keys are
+ * Tk_Uids, values are NamedFont structs. */
+ TkMainInfo *mainPtr; /* Application that owns this structure. */
+ int updatePending;
+} TkFontInfo;
+
+/*
+ * The following structure is used as a key in the fontCache.
+ */
+
+typedef struct CachedFontKey {
+ Display *display; /* Display for which font was constructed. */
+ Tk_Uid string; /* String that describes font. */
+} CachedFontKey;
+
+/*
+ * The following data structure is used to keep track of the font attributes
+ * for each named font that has been defined. The named font is only deleted
+ * when the last reference to it goes away.
+ */
+
+typedef struct NamedFont {
+ int refCount; /* Number of users of named font. */
+ int deletePending; /* Non-zero if font should be deleted when
+ * last reference goes away. */
+ TkFontAttributes fa; /* Desired attributes for named font. */
+} NamedFont;
+
+/*
+ * The following two structures are used to keep track of string
+ * measurement information when using the text layout facilities.
+ *
+ * A LayoutChunk represents a contiguous range of text that can be measured
+ * and displayed by low-level text calls. In general, chunks will be
+ * delimited by newlines and tabs. Low-level, platform-specific things
+ * like kerning and non-integer character widths may occur between the
+ * characters in a single chunk, but not between characters in different
+ * chunks.
+ *
+ * A TextLayout is a collection of LayoutChunks. It can be displayed with
+ * respect to any origin. It is the implementation of the Tk_TextLayout
+ * opaque token.
+ */
+
+typedef struct LayoutChunk {
+ CONST char *start; /* Pointer to simple string to be displayed.
+ * This is a pointer into the TkTextLayout's
+ * string. */
+ int numChars; /* The number of characters in this chunk. */
+ int numDisplayChars; /* The number of characters to display when
+ * this chunk is displayed. Can be less than
+ * numChars if extra space characters were
+ * absorbed by the end of the chunk. This
+ * will be < 0 if this is a chunk that is
+ * holding a tab or newline. */
+ int x, y; /* The origin of the first character in this
+ * chunk with respect to the upper-left hand
+ * corner of the TextLayout. */
+ int totalWidth; /* Width in pixels of this chunk. Used
+ * when hit testing the invisible spaces at
+ * the end of a chunk. */
+ int displayWidth; /* Width in pixels of the displayable
+ * characters in this chunk. Can be less than
+ * width if extra space characters were
+ * absorbed by the end of the chunk. */
+} LayoutChunk;
+
+typedef struct TextLayout {
+ Tk_Font tkfont; /* The font used when laying out the text. */
+ CONST char *string; /* The string that was layed out. */
+ int width; /* The maximum width of all lines in the
+ * text layout. */
+ int numChunks; /* Number of chunks actually used in
+ * following array. */
+ LayoutChunk chunks[1]; /* Array of chunks. The actual size will
+ * be maxChunks. THIS FIELD MUST BE THE LAST
+ * IN THE STRUCTURE. */
+} TextLayout;
+
+/*
+ * The following structures are used as two-way maps between the values for
+ * the fields in the TkFontAttributes structure and the strings used in
+ * Tcl, when parsing both option-value format and style-list format font
+ * name strings.
+ */
+
+static TkStateMap weightMap[] = {
+ {TK_FW_NORMAL, "normal"},
+ {TK_FW_BOLD, "bold"},
+ {TK_FW_UNKNOWN, NULL}
+};
+
+static TkStateMap slantMap[] = {
+ {TK_FS_ROMAN, "roman"},
+ {TK_FS_ITALIC, "italic"},
+ {TK_FS_UNKNOWN, NULL}
+};
+
+static TkStateMap underlineMap[] = {
+ {1, "underline"},
+ {0, NULL}
+};
+
+static TkStateMap overstrikeMap[] = {
+ {1, "overstrike"},
+ {0, NULL}
+};
+
+/*
+ * The following structures are used when parsing XLFD's into a set of
+ * TkFontAttributes.
+ */
+
+static TkStateMap xlfdWeightMap[] = {
+ {TK_FW_NORMAL, "normal"},
+ {TK_FW_NORMAL, "medium"},
+ {TK_FW_NORMAL, "book"},
+ {TK_FW_NORMAL, "light"},
+ {TK_FW_BOLD, "bold"},
+ {TK_FW_BOLD, "demi"},
+ {TK_FW_BOLD, "demibold"},
+ {TK_FW_NORMAL, NULL} /* Assume anything else is "normal". */
+};
+
+static TkStateMap xlfdSlantMap[] = {
+ {TK_FS_ROMAN, "r"},
+ {TK_FS_ITALIC, "i"},
+ {TK_FS_OBLIQUE, "o"},
+ {TK_FS_ROMAN, NULL} /* Assume anything else is "roman". */
+};
+
+static TkStateMap xlfdSetwidthMap[] = {
+ {TK_SW_NORMAL, "normal"},
+ {TK_SW_CONDENSE, "narrow"},
+ {TK_SW_CONDENSE, "semicondensed"},
+ {TK_SW_CONDENSE, "condensed"},
+ {TK_SW_UNKNOWN, NULL}
+};
+
+static TkStateMap xlfdCharsetMap[] = {
+ {TK_CS_NORMAL, "iso8859"},
+ {TK_CS_SYMBOL, "adobe"},
+ {TK_CS_SYMBOL, "sun"},
+ {TK_CS_OTHER, NULL}
+};
+
+/*
+ * The following structure and defines specify the valid builtin options
+ * when configuring a set of font attributes.
+ */
+
+static char *fontOpt[] = {
+ "-family",
+ "-size",
+ "-weight",
+ "-slant",
+ "-underline",
+ "-overstrike",
+ NULL
+};
+
+#define FONT_FAMILY 0
+#define FONT_SIZE 1
+#define FONT_WEIGHT 2
+#define FONT_SLANT 3
+#define FONT_UNDERLINE 4
+#define FONT_OVERSTRIKE 5
+#define FONT_NUMFIELDS 6 /* Length of fontOpt array. */
+
+#define GetFontAttributes(tkfont) \
+ ((CONST TkFontAttributes *) &((TkFont *) (tkfont))->fa)
+
+#define GetFontMetrics(tkfont) \
+ ((CONST TkFontMetrics *) &((TkFont *) (tkfont))->fm)
+
+
+static int ConfigAttributesObj _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, int objc, Tcl_Obj *CONST objv[],
+ TkFontAttributes *faPtr));
+static int FieldSpecified _ANSI_ARGS_((CONST char *field));
+static int GetAttributeInfoObj _ANSI_ARGS_((Tcl_Interp *interp,
+ CONST TkFontAttributes *faPtr, Tcl_Obj *objPtr));
+static LayoutChunk * NewChunk _ANSI_ARGS_((TextLayout **layoutPtrPtr,
+ int *maxPtr, CONST char *start, int numChars,
+ int curX, int newX, int y));
+static int ParseFontNameObj _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Tcl_Obj *objPtr,
+ TkFontAttributes *faPtr));
+static void RecomputeWidgets _ANSI_ARGS_((TkWindow *winPtr));
+static void TheWorldHasChanged _ANSI_ARGS_((
+ ClientData clientData));
+static void UpdateDependantFonts _ANSI_ARGS_((TkFontInfo *fiPtr,
+ Tk_Window tkwin, Tcl_HashEntry *namedHashPtr));
+
+
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkFontPkgInit --
+ *
+ * This procedure is called when an application is created. It
+ * initializes all the structures that are used by the font
+ * package on a per application basis.
+ *
+ * Results:
+ * Returns a token that must be stored in the TkMainInfo for this
+ * application.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+void
+TkFontPkgInit(mainPtr)
+ TkMainInfo *mainPtr; /* The application being created. */
+{
+ TkFontInfo *fiPtr;
+
+ fiPtr = (TkFontInfo *) ckalloc(sizeof(TkFontInfo));
+ Tcl_InitHashTable(&fiPtr->fontCache, sizeof(CachedFontKey) / sizeof(int));
+ Tcl_InitHashTable(&fiPtr->namedTable, TCL_ONE_WORD_KEYS);
+ fiPtr->mainPtr = mainPtr;
+ fiPtr->updatePending = 0;
+ mainPtr->fontInfoPtr = fiPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkFontPkgFree --
+ *
+ * This procedure is called when an application is deleted. It
+ * deletes all the structures that were used by the font package
+ * for this application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkFontPkgFree(mainPtr)
+ TkMainInfo *mainPtr; /* The application being deleted. */
+{
+ TkFontInfo *fiPtr;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+
+ fiPtr = mainPtr->fontInfoPtr;
+
+ if (fiPtr->fontCache.numEntries != 0) {
+ panic("TkFontPkgFree: all fonts should have been freed already");
+ }
+ Tcl_DeleteHashTable(&fiPtr->fontCache);
+
+ hPtr = Tcl_FirstHashEntry(&fiPtr->namedTable, &search);
+ while (hPtr != NULL) {
+ ckfree((char *) Tcl_GetHashValue(hPtr));
+ hPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&fiPtr->namedTable);
+ if (fiPtr->updatePending != 0) {
+ Tcl_CancelIdleCall(TheWorldHasChanged, (ClientData) fiPtr);
+ }
+ ckfree((char *) fiPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_FontObjCmd --
+ *
+ * This procedure is implemented to process the "font" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_FontObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ int index;
+ Tk_Window tkwin;
+ TkFontInfo *fiPtr;
+ static char *optionStrings[] = {
+ "actual", "configure", "create", "delete",
+ "families", "measure", "metrics", "names",
+ NULL
+ };
+ enum options {
+ FONT_ACTUAL, FONT_CONFIGURE, FONT_CREATE, FONT_DELETE,
+ FONT_FAMILIES, FONT_MEASURE, FONT_METRICS, FONT_NAMES
+ };
+
+ tkwin = (Tk_Window) clientData;
+ fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case FONT_ACTUAL: {
+ int skip, result;
+ Tk_Font tkfont;
+ Tcl_Obj *objPtr;
+ CONST TkFontAttributes *faPtr;
+
+ skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if ((objc < 3) || (objc - skip > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "font ?-displayof window? ?option?");
+ return TCL_ERROR;
+ }
+ tkfont = Tk_GetFontFromObj(interp, tkwin, objv[2]);
+ if (tkfont == NULL) {
+ return TCL_ERROR;
+ }
+ objc -= skip;
+ objv += skip;
+ faPtr = GetFontAttributes(tkfont);
+ objPtr = NULL;
+ if (objc > 3) {
+ objPtr = objv[3];
+ }
+ result = GetAttributeInfoObj(interp, faPtr, objPtr);
+ Tk_FreeFont(tkfont);
+ return result;
+ }
+ case FONT_CONFIGURE: {
+ int result;
+ char *string;
+ Tcl_Obj *objPtr;
+ NamedFont *nfPtr;
+ Tcl_HashEntry *namedHashPtr;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "fontname ?options?");
+ return TCL_ERROR;
+ }
+ string = Tk_GetUid(Tcl_GetStringFromObj(objv[2], NULL));
+ namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string);
+ nfPtr = NULL; /* lint. */
+ if (namedHashPtr != NULL) {
+ nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
+ }
+ if ((namedHashPtr == NULL) || (nfPtr->deletePending != 0)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "named font \"", string,
+ "\" doesn't exist", NULL);
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ objPtr = NULL;
+ } else if (objc == 4) {
+ objPtr = objv[3];
+ } else {
+ result = ConfigAttributesObj(interp, tkwin, objc - 3,
+ objv + 3, &nfPtr->fa);
+ UpdateDependantFonts(fiPtr, tkwin, namedHashPtr);
+ return result;
+ }
+ return GetAttributeInfoObj(interp, &nfPtr->fa, objPtr);
+ }
+ case FONT_CREATE: {
+ int skip, i;
+ char *name;
+ char buf[32];
+ TkFontAttributes fa;
+ Tcl_HashEntry *namedHashPtr;
+
+ skip = 3;
+ if (objc < 3) {
+ name = NULL;
+ } else {
+ name = Tcl_GetStringFromObj(objv[2], NULL);
+ if (name[0] == '-') {
+ name = NULL;
+ }
+ }
+ if (name == NULL) {
+ /*
+ * No font name specified. Generate one of the form "fontX".
+ */
+
+ for (i = 1; ; i++) {
+ sprintf(buf, "font%d", i);
+ namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable,
+ Tk_GetUid(buf));
+ if (namedHashPtr == NULL) {
+ break;
+ }
+ }
+ name = buf;
+ skip = 2;
+ }
+ TkInitFontAttributes(&fa);
+ if (ConfigAttributesObj(interp, tkwin, objc - skip, objv + skip,
+ &fa) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (TkCreateNamedFont(interp, tkwin, name, &fa) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), name, -1);
+ break;
+ }
+ case FONT_DELETE: {
+ int i;
+ char *string;
+ NamedFont *nfPtr;
+ Tcl_HashEntry *namedHashPtr;
+
+ /*
+ * Delete the named font. If there are still widgets using this
+ * font, then it isn't deleted right away.
+ */
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "fontname ?fontname ...?");
+ return TCL_ERROR;
+ }
+ for (i = 2; i < objc; i++) {
+ string = Tk_GetUid(Tcl_GetStringFromObj(objv[i], NULL));
+ namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string);
+ if (namedHashPtr == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "named font \"", string,
+ "\" doesn't exist", (char *) NULL);
+ return TCL_ERROR;
+ }
+ nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
+ if (nfPtr->refCount != 0) {
+ nfPtr->deletePending = 1;
+ } else {
+ Tcl_DeleteHashEntry(namedHashPtr);
+ ckfree((char *) nfPtr);
+ }
+ }
+ break;
+ }
+ case FONT_FAMILIES: {
+ int skip;
+
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");
+ return TCL_ERROR;
+ }
+ TkpGetFontFamilies(interp, tkwin);
+ break;
+ }
+ case FONT_MEASURE: {
+ char *string;
+ Tk_Font tkfont;
+ int length, skip;
+
+ skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "font ?-displayof window? text");
+ return TCL_ERROR;
+ }
+ tkfont = Tk_GetFontFromObj(interp, tkwin, objv[2]);
+ if (tkfont == NULL) {
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[3 + skip], &length);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_TextWidth(tkfont, string, length));
+ Tk_FreeFont(tkfont);
+ break;
+ }
+ case FONT_METRICS: {
+ char buf[64];
+ Tk_Font tkfont;
+ int skip, index, i;
+ CONST TkFontMetrics *fmPtr;
+ static char *switches[] = {
+ "-ascent", "-descent", "-linespace", "-fixed", NULL
+ };
+
+ skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if ((objc < 3) || ((objc - skip) > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "font ?-displayof window? ?option?");
+ return TCL_ERROR;
+ }
+ tkfont = Tk_GetFontFromObj(interp, tkwin, objv[2]);
+ if (tkfont == NULL) {
+ return TCL_ERROR;
+ }
+ objc -= skip;
+ objv += skip;
+ fmPtr = GetFontMetrics(tkfont);
+ if (objc == 3) {
+ sprintf(buf, "-ascent %d -descent %d -linespace %d -fixed %d",
+ fmPtr->ascent, fmPtr->descent,
+ fmPtr->ascent + fmPtr->descent,
+ fmPtr->fixed);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
+ } else {
+ if (Tcl_GetIndexFromObj(interp, objv[3], switches,
+ "metric", 0, &index) != TCL_OK) {
+ Tk_FreeFont(tkfont);
+ return TCL_ERROR;
+ }
+ i = 0; /* Needed only to prevent compiler
+ * warning. */
+ switch (index) {
+ case 0: i = fmPtr->ascent; break;
+ case 1: i = fmPtr->descent; break;
+ case 2: i = fmPtr->ascent + fmPtr->descent; break;
+ case 3: i = fmPtr->fixed; break;
+ }
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), i);
+ }
+ Tk_FreeFont(tkfont);
+ break;
+ }
+ case FONT_NAMES: {
+ char *string;
+ Tcl_Obj *strPtr;
+ NamedFont *nfPtr;
+ Tcl_HashSearch search;
+ Tcl_HashEntry *namedHashPtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "names");
+ return TCL_ERROR;
+ }
+ namedHashPtr = Tcl_FirstHashEntry(&fiPtr->namedTable, &search);
+ while (namedHashPtr != NULL) {
+ nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
+ if (nfPtr->deletePending == 0) {
+ string = Tcl_GetHashKey(&fiPtr->namedTable, namedHashPtr);
+ strPtr = Tcl_NewStringObj(string, -1);
+ Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), strPtr);
+ }
+ namedHashPtr = Tcl_NextHashEntry(&search);
+ }
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * UpdateDependantFonts, TheWorldHasChanged, RecomputeWidgets --
+ *
+ * Called when the attributes of a named font changes. Updates all
+ * the instantiated fonts that depend on that named font and then
+ * uses the brute force approach and prepares every widget to
+ * recompute its geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Things get queued for redisplay.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+UpdateDependantFonts(fiPtr, tkwin, namedHashPtr)
+ TkFontInfo *fiPtr; /* Info about application's fonts. */
+ Tk_Window tkwin; /* A window in the application. */
+ Tcl_HashEntry *namedHashPtr;/* The named font that is changing. */
+{
+ Tcl_HashEntry *cacheHashPtr;
+ Tcl_HashSearch search;
+ TkFont *fontPtr;
+ NamedFont *nfPtr;
+
+ nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
+ if (nfPtr->refCount == 0) {
+ /*
+ * Well nobody's using this named font, so don't have to tell
+ * any widgets to recompute themselves.
+ */
+
+ return;
+ }
+
+
+ cacheHashPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search);
+ while (cacheHashPtr != NULL) {
+ fontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr);
+ if (fontPtr->namedHashPtr == namedHashPtr) {
+ TkpGetFontFromAttributes(fontPtr, tkwin, &nfPtr->fa);
+ if (fiPtr->updatePending == 0) {
+ fiPtr->updatePending = 1;
+ Tcl_DoWhenIdle(TheWorldHasChanged, (ClientData) fiPtr);
+ }
+ }
+ cacheHashPtr = Tcl_NextHashEntry(&search);
+ }
+}
+
+static void
+TheWorldHasChanged(clientData)
+ ClientData clientData; /* Info about application's fonts. */
+{
+ TkFontInfo *fiPtr;
+
+ fiPtr = (TkFontInfo *) clientData;
+ fiPtr->updatePending = 0;
+
+ RecomputeWidgets(fiPtr->mainPtr->winPtr);
+}
+
+static void
+RecomputeWidgets(winPtr)
+ TkWindow *winPtr; /* Window to which command is sent. */
+{
+ if ((winPtr->classProcsPtr != NULL)
+ && (winPtr->classProcsPtr->geometryProc != NULL)) {
+ (*winPtr->classProcsPtr->geometryProc)(winPtr->instanceData);
+ }
+ for (winPtr = winPtr->childList; winPtr != NULL; winPtr = winPtr->nextPtr) {
+ RecomputeWidgets(winPtr);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkCreateNamedFont --
+ *
+ * Create the specified named font with the given attributes in the
+ * named font table associated with the interp.
+ *
+ * Results:
+ * Returns TCL_OK if the font was successfully created, or TCL_ERROR
+ * if the named font already existed. If TCL_ERROR is returned, an
+ * error message is left in interp->result.
+ *
+ * Side effects:
+ * Assume there used to exist a named font by the specified name, and
+ * that the named font had been deleted, but there were still some
+ * widgets using the named font at the time it was deleted. If a
+ * new named font is created with the same name, all those widgets
+ * that were using the old named font will be redisplayed using
+ * the new named font's attributes.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkCreateNamedFont(interp, tkwin, name, faPtr)
+ Tcl_Interp *interp; /* Interp for error return. */
+ Tk_Window tkwin; /* A window associated with interp. */
+ CONST char *name; /* Name for the new named font. */
+ TkFontAttributes *faPtr; /* Attributes for the new named font. */
+{
+ TkFontInfo *fiPtr;
+ Tcl_HashEntry *namedHashPtr;
+ int new;
+ NamedFont *nfPtr;
+
+ fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
+
+ name = Tk_GetUid(name);
+ namedHashPtr = Tcl_CreateHashEntry(&fiPtr->namedTable, name, &new);
+
+ if (new == 0) {
+ nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
+ if (nfPtr->deletePending == 0) {
+ interp->result[0] = '\0';
+ Tcl_AppendResult(interp, "font \"", name,
+ "\" already exists", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Recreating a named font with the same name as a previous
+ * named font. Some widgets were still using that named
+ * font, so they need to get redisplayed.
+ */
+
+ nfPtr->fa = *faPtr;
+ nfPtr->deletePending = 0;
+ UpdateDependantFonts(fiPtr, tkwin, namedHashPtr);
+ return TCL_OK;
+ }
+
+ nfPtr = (NamedFont *) ckalloc(sizeof(NamedFont));
+ nfPtr->deletePending = 0;
+ Tcl_SetHashValue(namedHashPtr, nfPtr);
+ nfPtr->fa = *faPtr;
+ nfPtr->refCount = 0;
+ nfPtr->deletePending = 0;
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetFont --
+ *
+ * Given a string description of a font, map the description to a
+ * corresponding Tk_Font that represents the font.
+ *
+ * Results:
+ * The return value is token for the font, or NULL if an error
+ * prevented the font from being created. If NULL is returned, an
+ * error message will be left in interp->result.
+ *
+ * Side effects:
+ * Calls Tk_GetFontFromObj(), which modifies interp's result object,
+ * then copies the string from the result object into interp->result.
+ * This procedure will go away when Tk_ConfigureWidget() is
+ * made into an object command.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_Font
+Tk_GetFont(interp, tkwin, string)
+ Tcl_Interp *interp; /* Interp for database and error return. */
+ Tk_Window tkwin; /* For display on which font will be used. */
+ CONST char *string; /* String describing font, as: named font,
+ * native format, or parseable string. */
+{
+ Tcl_Obj *strPtr;
+ Tk_Font tkfont;
+
+ strPtr = Tcl_NewStringObj((char *) string, -1);
+
+ tkfont = Tk_GetFontFromObj(interp, tkwin, strPtr);
+ if (tkfont == NULL) {
+ Tcl_SetResult(interp,
+ Tcl_GetStringFromObj(Tcl_GetObjResult(interp), NULL),
+ TCL_VOLATILE);
+ }
+
+ Tcl_DecrRefCount(strPtr); /* done with object */
+ return tkfont;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetFontFromObj --
+ *
+ * Given a string description of a font, map the description to a
+ * corresponding Tk_Font that represents the font.
+ *
+ * Results:
+ * The return value is token for the font, or NULL if an error
+ * prevented the font from being created. If NULL is returned, an
+ * error message will be left in interp's result object.
+ *
+ * Side effects:
+ * The font is added to an internal database with a reference
+ * count. For each call to this procedure, there should eventually
+ * be a call to Tk_FreeFont() so that the database is cleaned up when
+ * fonts aren't in use anymore.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_Font
+Tk_GetFontFromObj(interp, tkwin, objPtr)
+ Tcl_Interp *interp; /* Interp for database and error return. */
+ Tk_Window tkwin; /* For display on which font will be used. */
+ Tcl_Obj *objPtr; /* Object describing font, as: named font,
+ * native format, or parseable string. */
+{
+ TkFontInfo *fiPtr;
+ CachedFontKey key;
+ Tcl_HashEntry *cacheHashPtr, *namedHashPtr;
+ TkFont *fontPtr;
+ int new, descent;
+ NamedFont *nfPtr;
+ char *string;
+
+ fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
+ string = Tcl_GetStringFromObj(objPtr, NULL);
+
+ key.display = Tk_Display(tkwin);
+ key.string = Tk_GetUid(string);
+ cacheHashPtr = Tcl_CreateHashEntry(&fiPtr->fontCache, (char *) &key, &new);
+
+ if (new == 0) {
+ /*
+ * We have already constructed a font with this description for
+ * this display. Bump the reference count of the cached font.
+ */
+
+ fontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr);
+ fontPtr->refCount++;
+ return (Tk_Font) fontPtr;
+ }
+
+ namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, key.string);
+ if (namedHashPtr != NULL) {
+ /*
+ * Construct a font based on a named font.
+ */
+
+ nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
+ nfPtr->refCount++;
+
+ fontPtr = TkpGetFontFromAttributes(NULL, tkwin, &nfPtr->fa);
+ } else {
+ /*
+ * Native font?
+ */
+
+ fontPtr = TkpGetNativeFont(tkwin, string);
+ if (fontPtr == NULL) {
+ TkFontAttributes fa;
+
+ TkInitFontAttributes(&fa);
+ if (ParseFontNameObj(interp, tkwin, objPtr, &fa) != TCL_OK) {
+ Tcl_DeleteHashEntry(cacheHashPtr);
+ return NULL;
+ }
+
+ /*
+ * String contained the attributes inline.
+ */
+
+ fontPtr = TkpGetFontFromAttributes(NULL, tkwin, &fa);
+ }
+ }
+ Tcl_SetHashValue(cacheHashPtr, fontPtr);
+
+ fontPtr->refCount = 1;
+ fontPtr->cacheHashPtr = cacheHashPtr;
+ fontPtr->namedHashPtr = namedHashPtr;
+
+ Tk_MeasureChars((Tk_Font) fontPtr, "0", 1, 0, 0, &fontPtr->tabWidth);
+ if (fontPtr->tabWidth == 0) {
+ fontPtr->tabWidth = fontPtr->fm.maxWidth;
+ }
+ fontPtr->tabWidth *= 8;
+
+ /*
+ * Make sure the tab width isn't zero (some fonts may not have enough
+ * information to set a reasonable tab width).
+ */
+
+ if (fontPtr->tabWidth == 0) {
+ fontPtr->tabWidth = 1;
+ }
+
+ /*
+ * Get information used for drawing underlines in generic code on a
+ * non-underlined font.
+ */
+
+ descent = fontPtr->fm.descent;
+ fontPtr->underlinePos = descent / 2;
+ fontPtr->underlineHeight = fontPtr->fa.pointsize / 10;
+ if (fontPtr->underlineHeight == 0) {
+ fontPtr->underlineHeight = 1;
+ }
+ if (fontPtr->underlinePos + fontPtr->underlineHeight > descent) {
+ /*
+ * If this set of values would cause the bottom of the underline
+ * bar to stick below the descent of the font, jack the underline
+ * up a bit higher.
+ */
+
+ fontPtr->underlineHeight = descent - fontPtr->underlinePos;
+ if (fontPtr->underlineHeight == 0) {
+ fontPtr->underlinePos--;
+ fontPtr->underlineHeight = 1;
+ }
+ }
+
+ return (Tk_Font) fontPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_NameOfFont --
+ *
+ * Given a font, return a textual string identifying it.
+ *
+ * Results:
+ * The return value is the description that was passed to
+ * Tk_GetFont() to create the font. The storage for the returned
+ * string is only guaranteed to persist until the font is deleted.
+ * The caller should not modify this string.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+char *
+Tk_NameOfFont(tkfont)
+ Tk_Font tkfont; /* Font whose name is desired. */
+{
+ TkFont *fontPtr;
+ Tcl_HashEntry *hPtr;
+ CachedFontKey *keyPtr;
+
+ fontPtr = (TkFont *) tkfont;
+ hPtr = fontPtr->cacheHashPtr;
+
+ keyPtr = (CachedFontKey *) Tcl_GetHashKey(hPtr->tablePtr, hPtr);
+ return (char *) keyPtr->string;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_FreeFont --
+ *
+ * Called to release a font allocated by Tk_GetFont().
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with font is decremented, and
+ * only deallocated when no one is using it.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_FreeFont(tkfont)
+ Tk_Font tkfont; /* Font to be released. */
+{
+ TkFont *fontPtr;
+ NamedFont *nfPtr;
+
+ if (tkfont == NULL) {
+ return;
+ }
+ fontPtr = (TkFont *) tkfont;
+ fontPtr->refCount--;
+ if (fontPtr->refCount == 0) {
+ if (fontPtr->namedHashPtr != NULL) {
+ /*
+ * The font is being deleted. Determine if the associated named
+ * font definition should and/or can be deleted too.
+ */
+
+ nfPtr = (NamedFont *) Tcl_GetHashValue(fontPtr->namedHashPtr);
+ nfPtr->refCount--;
+ if ((nfPtr->refCount == 0) && (nfPtr->deletePending != 0)) {
+ Tcl_DeleteHashEntry(fontPtr->namedHashPtr);
+ ckfree((char *) nfPtr);
+ }
+ }
+ Tcl_DeleteHashEntry(fontPtr->cacheHashPtr);
+ TkpDeleteFont(fontPtr);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_FontId --
+ *
+ * Given a font, return an opaque handle that should be selected
+ * into the XGCValues structure in order to get the constructed
+ * gc to use this font. This procedure would go away if the
+ * XGCValues structure were replaced with a TkGCValues structure.
+ *
+ * Results:
+ * As above.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Font
+Tk_FontId(tkfont)
+ Tk_Font tkfont; /* Font that is going to be selected into GC. */
+{
+ TkFont *fontPtr;
+
+ fontPtr = (TkFont *) tkfont;
+ return fontPtr->fid;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetFontMetrics --
+ *
+ * Returns overall ascent and descent metrics for the given font.
+ * These values can be used to space multiple lines of text and
+ * to align the baselines of text in different fonts.
+ *
+ * Results:
+ * If *heightPtr is non-NULL, it is filled with the overall height
+ * of the font, which is the sum of the ascent and descent.
+ * If *ascentPtr or *descentPtr is non-NULL, they are filled with
+ * the ascent and/or descent information for the font.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+void
+Tk_GetFontMetrics(tkfont, fmPtr)
+ Tk_Font tkfont; /* Font in which metrics are calculated. */
+ Tk_FontMetrics *fmPtr; /* Pointer to structure in which font
+ * metrics for tkfont will be stored. */
+{
+ TkFont *fontPtr;
+
+ fontPtr = (TkFont *) tkfont;
+ fmPtr->ascent = fontPtr->fm.ascent;
+ fmPtr->descent = fontPtr->fm.descent;
+ fmPtr->linespace = fontPtr->fm.ascent + fontPtr->fm.descent;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_PostscriptFontName --
+ *
+ * Given a Tk_Font, return the name of the corresponding Postscript
+ * font.
+ *
+ * Results:
+ * The return value is the pointsize of the given Tk_Font.
+ * The name of the Postscript font is appended to dsPtr.
+ *
+ * Side effects:
+ * If the font does not exist on the printer, the print job will
+ * fail at print time. Given a "reasonable" Postscript printer,
+ * the following Tk_Font font families should print correctly:
+ *
+ * Avant Garde, Arial, Bookman, Courier, Courier New, Geneva,
+ * Helvetica, Monaco, New Century Schoolbook, New York,
+ * Palatino, Symbol, Times, Times New Roman, Zapf Chancery,
+ * and Zapf Dingbats.
+ *
+ * Any other Tk_Font font families may not print correctly
+ * because the computed Postscript font name may be incorrect.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+
+int
+Tk_PostscriptFontName(tkfont, dsPtr)
+ Tk_Font tkfont; /* Font in which text will be printed. */
+ Tcl_DString *dsPtr; /* Pointer to an initialized Tcl_DString to
+ * which the name of the Postscript font that
+ * corresponds to tkfont will be appended. */
+{
+ TkFont *fontPtr;
+ char *family, *weightString, *slantString;
+ char *src, *dest;
+ int upper, len;
+
+ len = Tcl_DStringLength(dsPtr);
+ fontPtr = (TkFont *) tkfont;
+
+ /*
+ * Convert the case-insensitive Tk_Font family name to the
+ * case-sensitive Postscript family name. Take out any spaces and
+ * capitalize the first letter of each word.
+ */
+
+ family = fontPtr->fa.family;
+ if (strncasecmp(family, "itc ", 4) == 0) {
+ family = family + 4;
+ }
+ if ((strcasecmp(family, "Arial") == 0)
+ || (strcasecmp(family, "Geneva") == 0)) {
+ family = "Helvetica";
+ } else if ((strcasecmp(family, "Times New Roman") == 0)
+ || (strcasecmp(family, "New York") == 0)) {
+ family = "Times";
+ } else if ((strcasecmp(family, "Courier New") == 0)
+ || (strcasecmp(family, "Monaco") == 0)) {
+ family = "Courier";
+ } else if (strcasecmp(family, "AvantGarde") == 0) {
+ family = "AvantGarde";
+ } else if (strcasecmp(family, "ZapfChancery") == 0) {
+ family = "ZapfChancery";
+ } else if (strcasecmp(family, "ZapfDingbats") == 0) {
+ family = "ZapfDingbats";
+ } else {
+ /*
+ * Inline, capitalize the first letter of each word, lowercase the
+ * rest of the letters in each word, and then take out the spaces
+ * between the words. This may make the DString shorter, which is
+ * safe to do.
+ */
+
+ Tcl_DStringAppend(dsPtr, family, -1);
+
+ src = dest = Tcl_DStringValue(dsPtr) + len;
+ upper = 1;
+ for (; *src != '\0'; src++, dest++) {
+ while (isspace(UCHAR(*src))) {
+ src++;
+ upper = 1;
+ }
+ *dest = *src;
+ if ((upper != 0) && (islower(UCHAR(*src)))) {
+ *dest = toupper(UCHAR(*src));
+ }
+ upper = 0;
+ }
+ *dest = '\0';
+ Tcl_DStringSetLength(dsPtr, dest - Tcl_DStringValue(dsPtr));
+ family = Tcl_DStringValue(dsPtr) + len;
+ }
+ if (family != Tcl_DStringValue(dsPtr) + len) {
+ Tcl_DStringAppend(dsPtr, family, -1);
+ family = Tcl_DStringValue(dsPtr) + len;
+ }
+
+ if (strcasecmp(family, "NewCenturySchoolbook") == 0) {
+ Tcl_DStringSetLength(dsPtr, len);
+ Tcl_DStringAppend(dsPtr, "NewCenturySchlbk", -1);
+ family = Tcl_DStringValue(dsPtr) + len;
+ }
+
+ /*
+ * Get the string to use for the weight.
+ */
+
+ weightString = NULL;
+ if (fontPtr->fa.weight == TK_FW_NORMAL) {
+ if (strcmp(family, "Bookman") == 0) {
+ weightString = "Light";
+ } else if (strcmp(family, "AvantGarde") == 0) {
+ weightString = "Book";
+ } else if (strcmp(family, "ZapfChancery") == 0) {
+ weightString = "Medium";
+ }
+ } else {
+ if ((strcmp(family, "Bookman") == 0)
+ || (strcmp(family, "AvantGarde") == 0)) {
+ weightString = "Demi";
+ } else {
+ weightString = "Bold";
+ }
+ }
+
+ /*
+ * Get the string to use for the slant.
+ */
+
+ slantString = NULL;
+ if (fontPtr->fa.slant == TK_FS_ROMAN) {
+ ;
+ } else {
+ if ((strcmp(family, "Helvetica") == 0)
+ || (strcmp(family, "Courier") == 0)
+ || (strcmp(family, "AvantGarde") == 0)) {
+ slantString = "Oblique";
+ } else {
+ slantString = "Italic";
+ }
+ }
+
+ /*
+ * The string "Roman" needs to be added to some fonts that are not bold
+ * and not italic.
+ */
+
+ if ((slantString == NULL) && (weightString == NULL)) {
+ if ((strcmp(family, "Times") == 0)
+ || (strcmp(family, "NewCenturySchlbk") == 0)
+ || (strcmp(family, "Palatino") == 0)) {
+ Tcl_DStringAppend(dsPtr, "-Roman", -1);
+ }
+ } else {
+ Tcl_DStringAppend(dsPtr, "-", -1);
+ if (weightString != NULL) {
+ Tcl_DStringAppend(dsPtr, weightString, -1);
+ }
+ if (slantString != NULL) {
+ Tcl_DStringAppend(dsPtr, slantString, -1);
+ }
+ }
+
+ return fontPtr->fa.pointsize;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_TextWidth --
+ *
+ * A wrapper function for the more complicated interface of
+ * Tk_MeasureChars. Computes how much space the given
+ * simple string needs.
+ *
+ * Results:
+ * The return value is the width (in pixels) of the given string.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_TextWidth(tkfont, string, numChars)
+ Tk_Font tkfont; /* Font in which text will be measured. */
+ CONST char *string; /* String whose width will be computed. */
+ int numChars; /* Number of characters to consider from
+ * string, or < 0 for strlen(). */
+{
+ int width;
+
+ if (numChars < 0) {
+ numChars = strlen(string);
+ }
+ Tk_MeasureChars(tkfont, string, numChars, 0, 0, &width);
+ return width;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_UnderlineChars --
+ *
+ * This procedure draws an underline for a given range of characters
+ * in a given string. It doesn't draw the characters (which are
+ * assumed to have been displayed previously); it just draws the
+ * underline. This procedure would mainly be used to quickly
+ * underline a few characters without having to construct an
+ * underlined font. To produce properly underlined text, the
+ * appropriate underlined font should be constructed and used.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets displayed in "drawable".
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_UnderlineChars(display, drawable, gc, tkfont, string, x, y, firstChar,
+ lastChar)
+ Display *display; /* Display on which to draw. */
+ Drawable drawable; /* Window or pixmap in which to draw. */
+ GC gc; /* Graphics context for actually drawing
+ * line. */
+ Tk_Font tkfont; /* Font used in GC; must have been allocated
+ * by Tk_GetFont(). Used for character
+ * dimensions, etc. */
+ CONST char *string; /* String containing characters to be
+ * underlined or overstruck. */
+ int x, y; /* Coordinates at which first character of
+ * string is drawn. */
+ int firstChar; /* Index of first character. */
+ int lastChar; /* Index of one after the last character. */
+{
+ TkFont *fontPtr;
+ int startX, endX;
+
+ fontPtr = (TkFont *) tkfont;
+
+ Tk_MeasureChars(tkfont, string, firstChar, 0, 0, &startX);
+ Tk_MeasureChars(tkfont, string, lastChar, 0, 0, &endX);
+
+ XFillRectangle(display, drawable, gc, x + startX,
+ y + fontPtr->underlinePos, (unsigned int) (endX - startX),
+ (unsigned int) fontPtr->underlineHeight);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_ComputeTextLayout --
+ *
+ * Computes the amount of screen space needed to display a
+ * multi-line, justified string of text. Records all the
+ * measurements that were done to determine to size and
+ * positioning of the individual lines of text; this information
+ * can be used by the Tk_DrawTextLayout() procedure to
+ * display the text quickly (without remeasuring it).
+ *
+ * This procedure is useful for simple widgets that want to
+ * display single-font, multi-line text and want Tk to handle the
+ * details.
+ *
+ * Results:
+ * The return value is a Tk_TextLayout token that holds the
+ * measurement information for the given string. The token is
+ * only valid for the given string. If the string is freed,
+ * the token is no longer valid and must also be freed. To free
+ * the token, call Tk_FreeTextLayout().
+ *
+ * The dimensions of the screen area needed to display the text
+ * are stored in *widthPtr and *heightPtr.
+ *
+ * Side effects:
+ * Memory is allocated to hold the measurement information.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_TextLayout
+Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags,
+ widthPtr, heightPtr)
+ Tk_Font tkfont; /* Font that will be used to display text. */
+ CONST char *string; /* String whose dimensions are to be
+ * computed. */
+ int numChars; /* Number of characters to consider from
+ * string, or < 0 for strlen(). */
+ int wrapLength; /* Longest permissible line length, in
+ * pixels. <= 0 means no automatic wrapping:
+ * just let lines get as long as needed. */
+ Tk_Justify justify; /* How to justify lines. */
+ int flags; /* Flag bits OR-ed together.
+ * TK_IGNORE_TABS means that tab characters
+ * should not be expanded. TK_IGNORE_NEWLINES
+ * means that newline characters should not
+ * cause a line break. */
+ int *widthPtr; /* Filled with width of string. */
+ int *heightPtr; /* Filled with height of string. */
+{
+ TkFont *fontPtr;
+ CONST char *start, *end, *special;
+ int n, y, charsThisChunk, maxChunks;
+ int baseline, height, curX, newX, maxWidth;
+ TextLayout *layoutPtr;
+ LayoutChunk *chunkPtr;
+ CONST TkFontMetrics *fmPtr;
+#define MAX_LINES 50
+ int staticLineLengths[MAX_LINES];
+ int *lineLengths;
+ int maxLines, curLine, layoutHeight;
+
+ lineLengths = staticLineLengths;
+ maxLines = MAX_LINES;
+
+ fontPtr = (TkFont *) tkfont;
+ fmPtr = &fontPtr->fm;
+
+ height = fmPtr->ascent + fmPtr->descent;
+
+ if (numChars < 0) {
+ numChars = strlen(string);
+ }
+
+ maxChunks = 1;
+
+ layoutPtr = (TextLayout *) ckalloc(sizeof(TextLayout)
+ + (maxChunks - 1) * sizeof(LayoutChunk));
+ layoutPtr->tkfont = tkfont;
+ layoutPtr->string = string;
+ layoutPtr->numChunks = 0;
+
+ baseline = fmPtr->ascent;
+ maxWidth = 0;
+
+ /*
+ * Divide the string up into simple strings and measure each string.
+ */
+
+ curX = 0;
+
+ end = string + numChars;
+ special = string;
+
+ flags &= TK_IGNORE_TABS | TK_IGNORE_NEWLINES;
+ flags |= TK_WHOLE_WORDS | TK_AT_LEAST_ONE;
+ curLine = 0;
+ for (start = string; start < end; ) {
+ if (start >= special) {
+ /*
+ * Find the next special character in the string.
+ */
+
+ for (special = start; special < end; special++) {
+ if (!(flags & TK_IGNORE_NEWLINES)) {
+ if ((*special == '\n') || (*special == '\r')) {
+ break;
+ }
+ }
+ if (!(flags & TK_IGNORE_TABS)) {
+ if (*special == '\t') {
+ break;
+ }
+ }
+ }
+ }
+
+ /*
+ * Special points at the next special character (or the end of the
+ * string). Process characters between start and special.
+ */
+
+ chunkPtr = NULL;
+ if (start < special) {
+ charsThisChunk = Tk_MeasureChars(tkfont, start, special - start,
+ wrapLength - curX, flags, &newX);
+ newX += curX;
+ flags &= ~TK_AT_LEAST_ONE;
+ if (charsThisChunk > 0) {
+ chunkPtr = NewChunk(&layoutPtr, &maxChunks, start,
+ charsThisChunk, curX, newX, baseline);
+
+ start += charsThisChunk;
+ curX = newX;
+ }
+ }
+
+ if ((start == special) && (special < end)) {
+ /*
+ * Handle the special character.
+ */
+
+ chunkPtr = NULL;
+ if (*special == '\t') {
+ newX = curX + fontPtr->tabWidth;
+ newX -= newX % fontPtr->tabWidth;
+ NewChunk(&layoutPtr, &maxChunks, start, 1, curX, newX,
+ baseline)->numDisplayChars = -1;
+ start++;
+ if ((start < end) &&
+ ((wrapLength <= 0) || (newX <= wrapLength))) {
+ /*
+ * More chars can still fit on this line.
+ */
+
+ curX = newX;
+ flags &= ~TK_AT_LEAST_ONE;
+ continue;
+ }
+ } else {
+ NewChunk(&layoutPtr, &maxChunks, start, 1, curX, 1000000000,
+ baseline)->numDisplayChars = -1;
+ start++;
+ goto wrapLine;
+ }
+ }
+
+ /*
+ * No more characters are going to go on this line, either because
+ * no more characters can fit or there are no more characters left.
+ * Consume all extra spaces at end of line.
+ */
+
+ while ((start < end) && isspace(UCHAR(*start))) {
+ if (!(flags & TK_IGNORE_NEWLINES)) {
+ if ((*start == '\n') || (*start == '\r')) {
+ break;
+ }
+ }
+ if (!(flags & TK_IGNORE_TABS)) {
+ if (*start == '\t') {
+ break;
+ }
+ }
+ start++;
+ }
+ if (chunkPtr != NULL) {
+ /*
+ * Append all the extra spaces on this line to the end of the
+ * last text chunk.
+ */
+ charsThisChunk = start - (chunkPtr->start + chunkPtr->numChars);
+ if (charsThisChunk > 0) {
+ chunkPtr->numChars += Tk_MeasureChars(tkfont,
+ chunkPtr->start + chunkPtr->numChars, charsThisChunk,
+ 0, 0, &chunkPtr->totalWidth);
+ chunkPtr->totalWidth += curX;
+ }
+ }
+
+ wrapLine:
+ flags |= TK_AT_LEAST_ONE;
+
+ /*
+ * Save current line length, then move current position to start of
+ * next line.
+ */
+
+ if (curX > maxWidth) {
+ maxWidth = curX;
+ }
+
+ /*
+ * Remember width of this line, so that all chunks on this line
+ * can be centered or right justified, if necessary.
+ */
+
+ if (curLine >= maxLines) {
+ int *newLengths;
+
+ newLengths = (int *) ckalloc(2 * maxLines * sizeof(int));
+ memcpy((void *) newLengths, lineLengths, maxLines * sizeof(int));
+ if (lineLengths != staticLineLengths) {
+ ckfree((char *) lineLengths);
+ }
+ lineLengths = newLengths;
+ maxLines *= 2;
+ }
+ lineLengths[curLine] = curX;
+ curLine++;
+
+ curX = 0;
+ baseline += height;
+ }
+
+ /*
+ * If last line ends with a newline, then we need to make a 0 width
+ * chunk on the next line. Otherwise "Hello" and "Hello\n" are the
+ * same height.
+ */
+
+ if ((layoutPtr->numChunks > 0) && ((flags & TK_IGNORE_NEWLINES) == 0)) {
+ if (layoutPtr->chunks[layoutPtr->numChunks - 1].start[0] == '\n') {
+ chunkPtr = NewChunk(&layoutPtr, &maxChunks, start, 0, curX,
+ 1000000000, baseline);
+ chunkPtr->numDisplayChars = -1;
+ baseline += height;
+ }
+ }
+
+ /*
+ * Using maximum line length, shift all the chunks so that the lines are
+ * all justified correctly.
+ */
+
+ curLine = 0;
+ chunkPtr = layoutPtr->chunks;
+ y = chunkPtr->y;
+ for (n = 0; n < layoutPtr->numChunks; n++) {
+ int extra;
+
+ if (chunkPtr->y != y) {
+ curLine++;
+ y = chunkPtr->y;
+ }
+ extra = maxWidth - lineLengths[curLine];
+ if (justify == TK_JUSTIFY_CENTER) {
+ chunkPtr->x += extra / 2;
+ } else if (justify == TK_JUSTIFY_RIGHT) {
+ chunkPtr->x += extra;
+ }
+ chunkPtr++;
+ }
+
+ layoutPtr->width = maxWidth;
+ layoutHeight = baseline - fmPtr->ascent;
+ if (layoutPtr->numChunks == 0) {
+ layoutHeight = height;
+
+ /*
+ * This fake chunk is used by the other procedures so that they can
+ * pretend that there is a chunk with no chars in it, which makes
+ * the coding simpler.
+ */
+
+ layoutPtr->numChunks = 1;
+ layoutPtr->chunks[0].start = string;
+ layoutPtr->chunks[0].numChars = 0;
+ layoutPtr->chunks[0].numDisplayChars = -1;
+ layoutPtr->chunks[0].x = 0;
+ layoutPtr->chunks[0].y = fmPtr->ascent;
+ layoutPtr->chunks[0].totalWidth = 0;
+ layoutPtr->chunks[0].displayWidth = 0;
+ }
+
+ if (widthPtr != NULL) {
+ *widthPtr = layoutPtr->width;
+ }
+ if (heightPtr != NULL) {
+ *heightPtr = layoutHeight;
+ }
+ if (lineLengths != staticLineLengths) {
+ ckfree((char *) lineLengths);
+ }
+
+ return (Tk_TextLayout) layoutPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_FreeTextLayout --
+ *
+ * This procedure is called to release the storage associated with
+ * a Tk_TextLayout when it is no longer needed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_FreeTextLayout(textLayout)
+ Tk_TextLayout textLayout; /* The text layout to be released. */
+{
+ TextLayout *layoutPtr;
+
+ layoutPtr = (TextLayout *) textLayout;
+ if (layoutPtr != NULL) {
+ ckfree((char *) layoutPtr);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_DrawTextLayout --
+ *
+ * Use the information in the Tk_TextLayout token to display a
+ * multi-line, justified string of text.
+ *
+ * This procedure is useful for simple widgets that need to
+ * display single-font, multi-line text and want Tk to handle
+ * the details.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Text drawn on the screen.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_DrawTextLayout(display, drawable, gc, layout, x, y, firstChar, lastChar)
+ Display *display; /* Display on which to draw. */
+ Drawable drawable; /* Window or pixmap in which to draw. */
+ GC gc; /* Graphics context to use for drawing text. */
+ Tk_TextLayout layout; /* Layout information, from a previous call
+ * to Tk_ComputeTextLayout(). */
+ int x, y; /* Upper-left hand corner of rectangle in
+ * which to draw (pixels). */
+ int firstChar; /* The index of the first character to draw
+ * from the given text item. 0 specfies the
+ * beginning. */
+ int lastChar; /* The index just after the last character
+ * to draw from the given text item. A number
+ * < 0 means to draw all characters. */
+{
+ TextLayout *layoutPtr;
+ int i, numDisplayChars, drawX;
+ LayoutChunk *chunkPtr;
+
+ layoutPtr = (TextLayout *) layout;
+ if (layoutPtr == NULL) {
+ return;
+ }
+
+ if (lastChar < 0) {
+ lastChar = 100000000;
+ }
+ chunkPtr = layoutPtr->chunks;
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ numDisplayChars = chunkPtr->numDisplayChars;
+ if ((numDisplayChars > 0) && (firstChar < numDisplayChars)) {
+ if (firstChar <= 0) {
+ drawX = 0;
+ firstChar = 0;
+ } else {
+ Tk_MeasureChars(layoutPtr->tkfont, chunkPtr->start, firstChar,
+ 0, 0, &drawX);
+ }
+ if (lastChar < numDisplayChars) {
+ numDisplayChars = lastChar;
+ }
+ Tk_DrawChars(display, drawable, gc, layoutPtr->tkfont,
+ chunkPtr->start + firstChar, numDisplayChars - firstChar,
+ x + chunkPtr->x + drawX, y + chunkPtr->y);
+ }
+ firstChar -= chunkPtr->numChars;
+ lastChar -= chunkPtr->numChars;
+ if (lastChar <= 0) {
+ break;
+ }
+ chunkPtr++;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_UnderlineTextLayout --
+ *
+ * Use the information in the Tk_TextLayout token to display an
+ * underline below an individual character. This procedure does
+ * not draw the text, just the underline.
+ *
+ * This procedure is useful for simple widgets that need to
+ * display single-font, multi-line text with an individual
+ * character underlined and want Tk to handle the details.
+ * To display larger amounts of underlined text, construct
+ * and use an underlined font.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Underline drawn on the screen.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_UnderlineTextLayout(display, drawable, gc, layout, x, y, underline)
+ Display *display; /* Display on which to draw. */
+ Drawable drawable; /* Window or pixmap in which to draw. */
+ GC gc; /* Graphics context to use for drawing text. */
+ Tk_TextLayout layout; /* Layout information, from a previous call
+ * to Tk_ComputeTextLayout(). */
+ int x, y; /* Upper-left hand corner of rectangle in
+ * which to draw (pixels). */
+ int underline; /* Index of the single character to
+ * underline, or -1 for no underline. */
+{
+ TextLayout *layoutPtr;
+ TkFont *fontPtr;
+ int xx, yy, width, height;
+
+ if ((Tk_CharBbox(layout, underline, &xx, &yy, &width, &height) != 0)
+ && (width != 0)) {
+ layoutPtr = (TextLayout *) layout;
+ fontPtr = (TkFont *) layoutPtr->tkfont;
+
+ XFillRectangle(display, drawable, gc, x + xx,
+ y + yy + fontPtr->fm.ascent + fontPtr->underlinePos,
+ (unsigned int) width, (unsigned int) fontPtr->underlineHeight);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_PointToChar --
+ *
+ * Use the information in the Tk_TextLayout token to determine the
+ * character closest to the given point. The point must be
+ * specified with respect to the upper-left hand corner of the
+ * text layout, which is considered to be located at (0, 0).
+ *
+ * Any point whose y-value is less that 0 will be considered closest
+ * to the first character in the text layout; any point whose y-value
+ * is greater than the height of the text layout will be considered
+ * closest to the last character in the text layout.
+ *
+ * Any point whose x-value is less than 0 will be considered closest
+ * to the first character on that line; any point whose x-value is
+ * greater than the width of the text layout will be considered
+ * closest to the last character on that line.
+ *
+ * Results:
+ * The return value is the index of the character that was
+ * closest to the point. Given a text layout with no characters,
+ * the value 0 will always be returned, referring to a hypothetical
+ * zero-width placeholder character.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_PointToChar(layout, x, y)
+ Tk_TextLayout layout; /* Layout information, from a previous call
+ * to Tk_ComputeTextLayout(). */
+ int x, y; /* Coordinates of point to check, with
+ * respect to the upper-left corner of the
+ * text layout. */
+{
+ TextLayout *layoutPtr;
+ LayoutChunk *chunkPtr, *lastPtr;
+ TkFont *fontPtr;
+ int i, n, dummy, baseline, pos;
+
+ if (y < 0) {
+ /*
+ * Point lies above any line in this layout. Return the index of
+ * the first char.
+ */
+
+ return 0;
+ }
+
+ /*
+ * Find which line contains the point.
+ */
+
+ layoutPtr = (TextLayout *) layout;
+ fontPtr = (TkFont *) layoutPtr->tkfont;
+ lastPtr = chunkPtr = layoutPtr->chunks;
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ baseline = chunkPtr->y;
+ if (y < baseline + fontPtr->fm.descent) {
+ if (x < chunkPtr->x) {
+ /*
+ * Point is to the left of all chunks on this line. Return
+ * the index of the first character on this line.
+ */
+
+ return chunkPtr->start - layoutPtr->string;
+ }
+ if (x >= layoutPtr->width) {
+ /*
+ * If point lies off right side of the text layout, return
+ * the last char in the last chunk on this line. Without
+ * this, it might return the index of the first char that
+ * was located outside of the text layout.
+ */
+
+ x = INT_MAX;
+ }
+
+ /*
+ * Examine all chunks on this line to see which one contains
+ * the specified point.
+ */
+
+ lastPtr = chunkPtr;
+ while ((i < layoutPtr->numChunks) && (chunkPtr->y == baseline)) {
+ if (x < chunkPtr->x + chunkPtr->totalWidth) {
+ /*
+ * Point falls on one of the characters in this chunk.
+ */
+
+ if (chunkPtr->numDisplayChars < 0) {
+ /*
+ * This is a special chunk that encapsulates a single
+ * tab or newline char.
+ */
+
+ return chunkPtr->start - layoutPtr->string;
+ }
+ n = Tk_MeasureChars((Tk_Font) fontPtr, chunkPtr->start,
+ chunkPtr->numChars, x + 1 - chunkPtr->x,
+ TK_PARTIAL_OK, &dummy);
+ return (chunkPtr->start + n - 1) - layoutPtr->string;
+ }
+ lastPtr = chunkPtr;
+ chunkPtr++;
+ i++;
+ }
+
+ /*
+ * Point is to the right of all chars in all the chunks on this
+ * line. Return the index just past the last char in the last
+ * chunk on this line.
+ */
+
+ pos = (lastPtr->start + lastPtr->numChars) - layoutPtr->string;
+ if (i < layoutPtr->numChunks) {
+ pos--;
+ }
+ return pos;
+ }
+ lastPtr = chunkPtr;
+ chunkPtr++;
+ }
+
+ /*
+ * Point lies below any line in this text layout. Return the index
+ * just past the last char.
+ */
+
+ return (lastPtr->start + lastPtr->numChars) - layoutPtr->string;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_CharBbox --
+ *
+ * Use the information in the Tk_TextLayout token to return the
+ * bounding box for the character specified by index.
+ *
+ * The width of the bounding box is the advance width of the
+ * character, and does not include and left- or right-bearing.
+ * Any character that extends partially outside of the
+ * text layout is considered to be truncated at the edge. Any
+ * character which is located completely outside of the text
+ * layout is considered to be zero-width and pegged against
+ * the edge.
+ *
+ * The height of the bounding box is the line height for this font,
+ * extending from the top of the ascent to the bottom of the
+ * descent. Information about the actual height of the individual
+ * letter is not available.
+ *
+ * A text layout that contains no characters is considered to
+ * contain a single zero-width placeholder character.
+ *
+ * Results:
+ * The return value is 0 if the index did not specify a character
+ * in the text layout, or non-zero otherwise. In that case,
+ * *bbox is filled with the bounding box of the character.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_CharBbox(layout, index, xPtr, yPtr, widthPtr, heightPtr)
+ Tk_TextLayout layout; /* Layout information, from a previous call to
+ * Tk_ComputeTextLayout(). */
+ int index; /* The index of the character whose bbox is
+ * desired. */
+ int *xPtr, *yPtr; /* Filled with the upper-left hand corner, in
+ * pixels, of the bounding box for the character
+ * specified by index, if non-NULL. */
+ int *widthPtr, *heightPtr;
+ /* Filled with the width and height of the
+ * bounding box for the character specified by
+ * index, if non-NULL. */
+{
+ TextLayout *layoutPtr;
+ LayoutChunk *chunkPtr;
+ int i, x, w;
+ Tk_Font tkfont;
+ TkFont *fontPtr;
+
+ if (index < 0) {
+ return 0;
+ }
+
+ layoutPtr = (TextLayout *) layout;
+ chunkPtr = layoutPtr->chunks;
+ tkfont = layoutPtr->tkfont;
+ fontPtr = (TkFont *) tkfont;
+
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ if (chunkPtr->numDisplayChars < 0) {
+ if (index == 0) {
+ x = chunkPtr->x;
+ w = chunkPtr->totalWidth;
+ goto check;
+ }
+ } else if (index < chunkPtr->numChars) {
+ if (xPtr != NULL) {
+ Tk_MeasureChars(tkfont, chunkPtr->start, index, 0, 0, &x);
+ x += chunkPtr->x;
+ }
+ if (widthPtr != NULL) {
+ Tk_MeasureChars(tkfont, chunkPtr->start + index, 1, 0, 0, &w);
+ }
+ goto check;
+ }
+ index -= chunkPtr->numChars;
+ chunkPtr++;
+ }
+ if (index == 0) {
+ /*
+ * Special case to get location just past last char in layout.
+ */
+
+ chunkPtr--;
+ x = chunkPtr->x + chunkPtr->totalWidth;
+ w = 0;
+ } else {
+ return 0;
+ }
+
+ /*
+ * Ensure that the bbox lies within the text layout. This forces all
+ * chars that extend off the right edge of the text layout to have
+ * truncated widths, and all chars that are completely off the right
+ * edge of the text layout to peg to the edge and have 0 width.
+ */
+ check:
+ if (yPtr != NULL) {
+ *yPtr = chunkPtr->y - fontPtr->fm.ascent;
+ }
+ if (heightPtr != NULL) {
+ *heightPtr = fontPtr->fm.ascent + fontPtr->fm.descent;
+ }
+
+ if (x > layoutPtr->width) {
+ x = layoutPtr->width;
+ }
+ if (xPtr != NULL) {
+ *xPtr = x;
+ }
+ if (widthPtr != NULL) {
+ if (x + w > layoutPtr->width) {
+ w = layoutPtr->width - x;
+ }
+ *widthPtr = w;
+ }
+
+ return 1;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_DistanceToTextLayout --
+ *
+ * Computes the distance in pixels from the given point to the
+ * given text layout. Non-displaying space characters that occur
+ * at the end of individual lines in the text layout are ignored
+ * for hit detection purposes.
+ *
+ * Results:
+ * The return value is 0 if the point (x, y) is inside the text
+ * layout. If the point isn't inside the text layout then the
+ * return value is the distance in pixels from the point to the
+ * text item.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_DistanceToTextLayout(layout, x, y)
+ Tk_TextLayout layout; /* Layout information, from a previous call
+ * to Tk_ComputeTextLayout(). */
+ int x, y; /* Coordinates of point to check, with
+ * respect to the upper-left corner of the
+ * text layout (in pixels). */
+{
+ int i, x1, x2, y1, y2, xDiff, yDiff, dist, minDist, ascent, descent;
+ LayoutChunk *chunkPtr;
+ TextLayout *layoutPtr;
+ TkFont *fontPtr;
+
+ layoutPtr = (TextLayout *) layout;
+ fontPtr = (TkFont *) layoutPtr->tkfont;
+ ascent = fontPtr->fm.ascent;
+ descent = fontPtr->fm.descent;
+
+ minDist = 0;
+ chunkPtr = layoutPtr->chunks;
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ if (chunkPtr->start[0] == '\n') {
+ /*
+ * Newline characters are not counted when computing distance
+ * (but tab characters would still be considered).
+ */
+
+ chunkPtr++;
+ continue;
+ }
+
+ x1 = chunkPtr->x;
+ y1 = chunkPtr->y - ascent;
+ x2 = chunkPtr->x + chunkPtr->displayWidth;
+ y2 = chunkPtr->y + descent;
+
+ if (x < x1) {
+ xDiff = x1 - x;
+ } else if (x >= x2) {
+ xDiff = x - x2 + 1;
+ } else {
+ xDiff = 0;
+ }
+
+ if (y < y1) {
+ yDiff = y1 - y;
+ } else if (y >= y2) {
+ yDiff = y - y2 + 1;
+ } else {
+ yDiff = 0;
+ }
+ if ((xDiff == 0) && (yDiff == 0)) {
+ return 0;
+ }
+ dist = (int) hypot((double) xDiff, (double) yDiff);
+ if ((dist < minDist) || (minDist == 0)) {
+ minDist = dist;
+ }
+ chunkPtr++;
+ }
+ return minDist;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_IntersectTextLayout --
+ *
+ * Determines whether a text layout lies entirely inside,
+ * entirely outside, or overlaps a given rectangle. Non-displaying
+ * space characters that occur at the end of individual lines in
+ * the text layout are ignored for intersection calculations.
+ *
+ * Results:
+ * The return value is -1 if the text layout is entirely outside of
+ * the rectangle, 0 if it overlaps, and 1 if it is entirely inside
+ * of the rectangle.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_IntersectTextLayout(layout, x, y, width, height)
+ Tk_TextLayout layout; /* Layout information, from a previous call
+ * to Tk_ComputeTextLayout(). */
+ int x, y; /* Upper-left hand corner, in pixels, of
+ * rectangular area to compare with text
+ * layout. Coordinates are with respect to
+ * the upper-left hand corner of the text
+ * layout itself. */
+ int width, height; /* The width and height of the above
+ * rectangular area, in pixels. */
+{
+ int result, i, x1, y1, x2, y2;
+ TextLayout *layoutPtr;
+ LayoutChunk *chunkPtr;
+ TkFont *fontPtr;
+ int left, top, right, bottom;
+
+ /*
+ * Scan the chunks one at a time, seeing whether each is entirely in,
+ * entirely out, or overlapping the rectangle. If an overlap is
+ * detected, return immediately; otherwise wait until all chunks have
+ * been processed and see if they were all inside or all outside.
+ */
+
+ layoutPtr = (TextLayout *) layout;
+ chunkPtr = layoutPtr->chunks;
+ fontPtr = (TkFont *) layoutPtr->tkfont;
+
+ left = x;
+ top = y;
+ right = x + width;
+ bottom = y + height;
+
+ result = 0;
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ if (chunkPtr->start[0] == '\n') {
+ /*
+ * Newline characters are not counted when computing area
+ * intersection (but tab characters would still be considered).
+ */
+
+ chunkPtr++;
+ continue;
+ }
+
+ x1 = chunkPtr->x;
+ y1 = chunkPtr->y - fontPtr->fm.ascent;
+ x2 = chunkPtr->x + chunkPtr->displayWidth;
+ y2 = chunkPtr->y + fontPtr->fm.descent;
+
+ if ((right < x1) || (left >= x2)
+ || (bottom < y1) || (top >= y2)) {
+ if (result == 1) {
+ return 0;
+ }
+ result = -1;
+ } else if ((x1 < left) || (x2 >= right)
+ || (y1 < top) || (y2 >= bottom)) {
+ return 0;
+ } else if (result == -1) {
+ return 0;
+ } else {
+ result = 1;
+ }
+ chunkPtr++;
+ }
+ return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_TextLayoutToPostscript --
+ *
+ * Outputs the contents of a text layout in Postscript format.
+ * The set of lines in the text layout will be rendered by the user
+ * supplied Postscript function. The function should be of the form:
+ *
+ * justify x y string function --
+ *
+ * Justify is -1, 0, or 1, depending on whether the following string
+ * should be left, center, or right justified, x and y is the
+ * location for the origin of the string, string is the sequence
+ * of characters to be printed, and function is the name of the
+ * caller-provided function; the function should leave nothing
+ * on the stack.
+ *
+ * The meaning of the origin of the string (x and y) depends on
+ * the justification. For left justification, x is where the
+ * left edge of the string should appear. For center justification,
+ * x is where the center of the string should appear. And for right
+ * justification, x is where the right edge of the string should
+ * appear. This behavior is necessary because, for example, right
+ * justified text on the screen is justified with screen metrics.
+ * The same string needs to be justified with printer metrics on
+ * the printer to appear in the correct place with respect to other
+ * similarly justified strings. In all circumstances, y is the
+ * location of the baseline for the string.
+ *
+ * Results:
+ * Interp->result is modified to hold the Postscript code that
+ * will render the text layout.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_TextLayoutToPostscript(interp, layout)
+ Tcl_Interp *interp; /* Filled with Postscript code. */
+ Tk_TextLayout layout; /* The layout to be rendered. */
+{
+#define MAXUSE 128
+ char buf[MAXUSE+10];
+ LayoutChunk *chunkPtr;
+ int i, j, used, c, baseline;
+ TextLayout *layoutPtr;
+
+ layoutPtr = (TextLayout *) layout;
+ chunkPtr = layoutPtr->chunks;
+ baseline = chunkPtr->y;
+ used = 0;
+ buf[used++] = '(';
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ if (baseline != chunkPtr->y) {
+ buf[used++] = ')';
+ buf[used++] = '\n';
+ buf[used++] = '(';
+ baseline = chunkPtr->y;
+ }
+ if (chunkPtr->numDisplayChars <= 0) {
+ if (chunkPtr->start[0] == '\t') {
+ buf[used++] = '\\';
+ buf[used++] = 't';
+ }
+ } else {
+ for (j = 0; j < chunkPtr->numDisplayChars; j++) {
+ c = UCHAR(chunkPtr->start[j]);
+ if ((c == '(') || (c == ')') || (c == '\\') || (c < 0x20)
+ || (c >= UCHAR(0x7f))) {
+ /*
+ * Tricky point: the "03" is necessary in the sprintf
+ * below, so that a full three digits of octal are
+ * always generated. Without the "03", a number
+ * following this sequence could be interpreted by
+ * Postscript as part of this sequence.
+ */
+
+ sprintf(buf + used, "\\%03o", c);
+ used += 4;
+ } else {
+ buf[used++] = c;
+ }
+ if (used >= MAXUSE) {
+ buf[used] = '\0';
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ used = 0;
+ }
+ }
+ }
+ if (used >= MAXUSE) {
+ /*
+ * If there are a whole bunch of returns or tabs in a row,
+ * then buf[] could get filled up.
+ */
+
+ buf[used] = '\0';
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ used = 0;
+ }
+ chunkPtr++;
+ }
+ buf[used++] = ')';
+ buf[used++] = '\n';
+ buf[used] = '\0';
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkInitFontAttributes --
+ *
+ * Initialize the font attributes structure to contain sensible
+ * values. This must be called before using any other font
+ * attributes functions.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects.
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkInitFontAttributes(faPtr)
+ TkFontAttributes *faPtr; /* The attributes structure to initialize. */
+{
+ faPtr->family = NULL;
+ faPtr->pointsize = 0;
+ faPtr->weight = TK_FW_NORMAL;
+ faPtr->slant = TK_FS_ROMAN;
+ faPtr->underline = 0;
+ faPtr->overstrike = 0;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ConfigAttributesObj --
+ *
+ * Process command line options to fill in fields of a properly
+ * initialized font attributes structure.
+ *
+ * Results:
+ * A standard Tcl return value. If TCL_ERROR is returned, an
+ * error message will be left in interp's result object.
+ *
+ * Side effects:
+ * The fields of the font attributes structure get filled in with
+ * information from argc/argv. If an error occurs while parsing,
+ * the font attributes structure will contain all modifications
+ * specified in the command line options up to the point of the
+ * error.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+ConfigAttributesObj(interp, tkwin, objc, objv, faPtr)
+ Tcl_Interp *interp; /* Interp for error return. */
+ Tk_Window tkwin; /* For display on which font will be used. */
+ int objc; /* Number of elements in argv. */
+ Tcl_Obj *CONST objv[]; /* Command line options. */
+ TkFontAttributes *faPtr; /* Font attributes structure whose fields
+ * are to be modified. Structure must already
+ * be properly initialized. */
+{
+ int i, n, index;
+ Tcl_Obj *value;
+ char *option, *string;
+
+ if (objc & 1) {
+ string = Tcl_GetStringFromObj(objv[objc - 1], NULL);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "missing value for \"",
+ string, "\" option", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ for (i = 0; i < objc; i += 2) {
+ option = Tcl_GetStringFromObj(objv[i], NULL);
+ value = objv[i + 1];
+
+ if (Tcl_GetIndexFromObj(interp, objv[i], fontOpt, "option", 1,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch (index) {
+ case FONT_FAMILY:
+ string = Tcl_GetStringFromObj(value, NULL);
+ faPtr->family = Tk_GetUid(string);
+ break;
+
+ case FONT_SIZE:
+ if (Tcl_GetIntFromObj(interp, value, &n) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ faPtr->pointsize = n;
+ break;
+
+ case FONT_WEIGHT:
+ string = Tcl_GetStringFromObj(value, NULL);
+ n = TkFindStateNum(interp, option, weightMap, string);
+ if (n == TK_FW_UNKNOWN) {
+ return TCL_ERROR;
+ }
+ faPtr->weight = n;
+ break;
+
+ case FONT_SLANT:
+ string = Tcl_GetStringFromObj(value, NULL);
+ n = TkFindStateNum(interp, option, slantMap, string);
+ if (n == TK_FS_UNKNOWN) {
+ return TCL_ERROR;
+ }
+ faPtr->slant = n;
+ break;
+
+ case FONT_UNDERLINE:
+ if (Tcl_GetBooleanFromObj(interp, value, &n) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ faPtr->underline = n;
+ break;
+
+ case FONT_OVERSTRIKE:
+ if (Tcl_GetBooleanFromObj(interp, value, &n) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ faPtr->overstrike = n;
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetAttributeInfoObj --
+ *
+ * Return information about the font attributes as a Tcl list.
+ *
+ * Results:
+ * The return value is TCL_OK if the objPtr was non-NULL and
+ * specified a valid font attribute, TCL_ERROR otherwise. If TCL_OK
+ * is returned, the interp's result object is modified to hold a
+ * description of either the current value of a single option, or a
+ * list of all options and their current values for the given font
+ * attributes. If TCL_ERROR is returned, the interp's result is
+ * set to an error message describing that the objPtr did not refer
+ * to a valid option.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+GetAttributeInfoObj(interp, faPtr, objPtr)
+ Tcl_Interp *interp; /* Interp to hold result. */
+ CONST TkFontAttributes *faPtr; /* The font attributes to inspect. */
+ Tcl_Obj *objPtr; /* If non-NULL, indicates the single
+ * option whose value is to be
+ * returned. Otherwise
+ * information is returned for
+ * all options. */
+{
+ int i, index, start, end, num;
+ char *str;
+ Tcl_Obj *newPtr;
+
+ start = 0;
+ end = FONT_NUMFIELDS;
+ if (objPtr != NULL) {
+ if (Tcl_GetIndexFromObj(interp, objPtr, fontOpt, "option", 1,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ start = index;
+ end = index + 1;
+ }
+
+ for (i = start; i < end; i++) {
+ str = NULL;
+ num = 0; /* Needed only to prevent compiler
+ * warning. */
+ switch (i) {
+ case FONT_FAMILY:
+ str = faPtr->family;
+ if (str == NULL) {
+ str = "";
+ }
+ break;
+
+ case FONT_SIZE:
+ num = faPtr->pointsize;
+ break;
+
+ case FONT_WEIGHT:
+ str = TkFindStateString(weightMap, faPtr->weight);
+ break;
+
+ case FONT_SLANT:
+ str = TkFindStateString(slantMap, faPtr->slant);
+ break;
+
+ case FONT_UNDERLINE:
+ num = faPtr->underline;
+ break;
+
+ case FONT_OVERSTRIKE:
+ num = faPtr->overstrike;
+ break;
+ }
+ if (objPtr == NULL) {
+ Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+ Tcl_NewStringObj(fontOpt[i], -1));
+ if (str != NULL) {
+ newPtr = Tcl_NewStringObj(str, -1);
+ } else {
+ newPtr = Tcl_NewIntObj(num);
+ }
+ Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+ newPtr);
+ } else {
+ if (str != NULL) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), str, -1);
+ } else {
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), num);
+ }
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ParseFontNameObj --
+ *
+ * Converts a object into a set of font attributes that can be used
+ * to construct a font.
+ *
+ * The string rep of the object can be one of the following forms:
+ * XLFD (see X documentation)
+ * "Family [size [style] [style ...]]"
+ * "-option value [-option value ...]"
+ *
+ * Results:
+ * The return value is TCL_ERROR if the object was syntactically
+ * invalid. In that case an error message is left in interp's
+ * result object. Otherwise, fills the font attribute buffer with
+ * the values parsed from the string and returns TCL_OK;
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+ParseFontNameObj(interp, tkwin, objPtr, faPtr)
+ Tcl_Interp *interp; /* Interp for error return. */
+ Tk_Window tkwin; /* For display on which font is used. */
+ Tcl_Obj *objPtr; /* Parseable font description object. */
+ TkFontAttributes *faPtr; /* Font attributes structure whose fields
+ * are to be modified. Structure must already
+ * be properly initialized. */
+{
+ char *dash;
+ int objc, result, i, n;
+ Tcl_Obj **objv;
+ TkXLFDAttributes xa;
+ char *string;
+
+ string = Tcl_GetStringFromObj(objPtr, NULL);
+ if (*string == '-') {
+ /*
+ * This may be an XLFD or an "-option value" string.
+ *
+ * If the string begins with "-*" or a "-foundry-family-*" pattern,
+ * then consider it an XLFD.
+ */
+
+ if (string[1] == '*') {
+ goto xlfd;
+ }
+ dash = strchr(string + 1, '-');
+ if ((dash != NULL) && (!isspace(UCHAR(dash[-1])))) {
+ goto xlfd;
+ }
+
+ if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ return ConfigAttributesObj(interp, tkwin, objc, objv, faPtr);
+ }
+
+ if (*string == '*') {
+ /*
+ * This appears to be an XLFD.
+ */
+
+ xlfd:
+ xa.fa = *faPtr;
+ result = TkParseXLFD(string, &xa);
+ if (result == TCL_OK) {
+ *faPtr = xa.fa;
+ return result;
+ }
+ }
+
+ /*
+ * Wasn't an XLFD or "-option value" string. Try it as a
+ * "font size style" list.
+ */
+
+ if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc < 1) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "font \"", string,
+ "\" doesn't exist", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ faPtr->family = Tk_GetUid(Tcl_GetStringFromObj(objv[0], NULL));
+ if (objc > 1) {
+ if (Tcl_GetIntFromObj(interp, objv[1], &n) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ faPtr->pointsize = n;
+ }
+
+ i = 2;
+ if (objc == 3) {
+ if (Tcl_ListObjGetElements(interp, objv[2], &objc, &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ i = 0;
+ }
+ for ( ; i < objc; i++) {
+ string = Tcl_GetStringFromObj(objv[i], NULL);
+ n = TkFindStateNum(NULL, NULL, weightMap, string);
+ if (n != TK_FW_UNKNOWN) {
+ faPtr->weight = n;
+ continue;
+ }
+ n = TkFindStateNum(NULL, NULL, slantMap, string);
+ if (n != TK_FS_UNKNOWN) {
+ faPtr->slant = n;
+ continue;
+ }
+ n = TkFindStateNum(NULL, NULL, underlineMap, string);
+ if (n != 0) {
+ faPtr->underline = n;
+ continue;
+ }
+ n = TkFindStateNum(NULL, NULL, overstrikeMap, string);
+ if (n != 0) {
+ faPtr->overstrike = n;
+ continue;
+ }
+
+ /*
+ * Unknown style.
+ */
+
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "unknown font style \"", string, "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkParseXLFD --
+ *
+ * Break up a fully specified XLFD into a set of font attributes.
+ *
+ * Results:
+ * Return value is TCL_ERROR if string was not a fully specified XLFD.
+ * Otherwise, fills font attribute buffer with the values parsed
+ * from the XLFD and returns TCL_OK.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkParseXLFD(string, xaPtr)
+ CONST char *string; /* Parseable font description string. */
+ TkXLFDAttributes *xaPtr; /* XLFD attributes structure whose fields
+ * are to be modified. Structure must already
+ * be properly initialized. */
+{
+ char *src;
+ CONST char *str;
+ int i, j;
+ char *field[XLFD_NUMFIELDS + 2];
+ Tcl_DString ds;
+
+ memset(field, '\0', sizeof(field));
+
+ str = string;
+ if (*str == '-') {
+ str++;
+ }
+
+ Tcl_DStringInit(&ds);
+ Tcl_DStringAppend(&ds, (char *) str, -1);
+ src = Tcl_DStringValue(&ds);
+
+ field[0] = src;
+ for (i = 0; *src != '\0'; src++) {
+ if (isupper(UCHAR(*src))) {
+ *src = tolower(UCHAR(*src));
+ }
+ if (*src == '-') {
+ i++;
+ if (i > XLFD_NUMFIELDS) {
+ break;
+ }
+ *src = '\0';
+ field[i] = src + 1;
+ }
+ }
+
+ /*
+ * An XLFD of the form -adobe-times-medium-r-*-12-*-* is pretty common,
+ * but it is (strictly) malformed, because the first * is eliding both
+ * the Setwidth and the Addstyle fields. If the Addstyle field is a
+ * number, then assume the above incorrect form was used and shift all
+ * the rest of the fields up by one, so the number gets interpreted
+ * as a pixelsize. This fix is so that we don't get a million reports
+ * that "it works under X, but gives a syntax error under Windows".
+ */
+
+ if ((i > XLFD_ADD_STYLE) && (FieldSpecified(field[XLFD_ADD_STYLE]))) {
+ if (atoi(field[XLFD_ADD_STYLE]) != 0) {
+ for (j = XLFD_NUMFIELDS - 1; j >= XLFD_ADD_STYLE; j--) {
+ field[j + 1] = field[j];
+ }
+ field[XLFD_ADD_STYLE] = NULL;
+ i++;
+ }
+ }
+
+ /*
+ * Bail if we don't have enough of the fields (up to pointsize).
+ */
+
+ if (i < XLFD_FAMILY) {
+ Tcl_DStringFree(&ds);
+ return TCL_ERROR;
+ }
+
+ if (FieldSpecified(field[XLFD_FOUNDRY])) {
+ xaPtr->foundry = Tk_GetUid(field[XLFD_FOUNDRY]);
+ }
+
+ if (FieldSpecified(field[XLFD_FAMILY])) {
+ xaPtr->fa.family = Tk_GetUid(field[XLFD_FAMILY]);
+ }
+ if (FieldSpecified(field[XLFD_WEIGHT])) {
+ xaPtr->fa.weight = TkFindStateNum(NULL, NULL, xlfdWeightMap,
+ field[XLFD_WEIGHT]);
+ }
+ if (FieldSpecified(field[XLFD_SLANT])) {
+ xaPtr->slant = TkFindStateNum(NULL, NULL, xlfdSlantMap,
+ field[XLFD_SLANT]);
+ if (xaPtr->slant == TK_FS_ROMAN) {
+ xaPtr->fa.slant = TK_FS_ROMAN;
+ } else {
+ xaPtr->fa.slant = TK_FS_ITALIC;
+ }
+ }
+ if (FieldSpecified(field[XLFD_SETWIDTH])) {
+ xaPtr->setwidth = TkFindStateNum(NULL, NULL, xlfdSetwidthMap,
+ field[XLFD_SETWIDTH]);
+ }
+
+ /* XLFD_ADD_STYLE ignored. */
+
+ /*
+ * Pointsize in tenths of a point, but treat it as tenths of a pixel.
+ */
+
+ if (FieldSpecified(field[XLFD_POINT_SIZE])) {
+ if (field[XLFD_POINT_SIZE][0] == '[') {
+ /*
+ * Some X fonts have the point size specified as follows:
+ *
+ * [ N1 N2 N3 N4 ]
+ *
+ * where N1 is the point size (in points, not decipoints!), and
+ * N2, N3, and N4 are some additional numbers that I don't know
+ * the purpose of, so I ignore them.
+ */
+
+ xaPtr->fa.pointsize = atoi(field[XLFD_POINT_SIZE] + 1);
+ } else if (Tcl_GetInt(NULL, field[XLFD_POINT_SIZE],
+ &xaPtr->fa.pointsize) == TCL_OK) {
+ xaPtr->fa.pointsize /= 10;
+ } else {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Pixel height of font. If specified, overrides pointsize.
+ */
+
+ if (FieldSpecified(field[XLFD_PIXEL_SIZE])) {
+ if (field[XLFD_PIXEL_SIZE][0] == '[') {
+ /*
+ * Some X fonts have the pixel size specified as follows:
+ *
+ * [ N1 N2 N3 N4 ]
+ *
+ * where N1 is the pixel size, and where N2, N3, and N4
+ * are some additional numbers that I don't know
+ * the purpose of, so I ignore them.
+ */
+
+ xaPtr->fa.pointsize = atoi(field[XLFD_PIXEL_SIZE] + 1);
+ } else if (Tcl_GetInt(NULL, field[XLFD_PIXEL_SIZE],
+ &xaPtr->fa.pointsize) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ xaPtr->fa.pointsize = -xaPtr->fa.pointsize;
+
+ /* XLFD_RESOLUTION_X ignored. */
+
+ /* XLFD_RESOLUTION_Y ignored. */
+
+ /* XLFD_SPACING ignored. */
+
+ /* XLFD_AVERAGE_WIDTH ignored. */
+
+ if (FieldSpecified(field[XLFD_REGISTRY])) {
+ xaPtr->charset = TkFindStateNum(NULL, NULL, xlfdCharsetMap,
+ field[XLFD_REGISTRY]);
+ }
+ if (FieldSpecified(field[XLFD_ENCODING])) {
+ xaPtr->encoding = atoi(field[XLFD_ENCODING]);
+ }
+
+ Tcl_DStringFree(&ds);
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FieldSpecified --
+ *
+ * Helper function for TkParseXLFD(). Determines if a field in the
+ * XLFD was set to a non-null, non-don't-care value.
+ *
+ * Results:
+ * The return value is 0 if the field in the XLFD was not set and
+ * should be ignored, non-zero otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+FieldSpecified(field)
+ CONST char *field; /* The field of the XLFD to check. Strictly
+ * speaking, only when the string is "*" does it mean
+ * don't-care. However, an unspecified or question
+ * mark is also interpreted as don't-care. */
+{
+ char ch;
+
+ if (field == NULL) {
+ return 0;
+ }
+ ch = field[0];
+ return (ch != '*' && ch != '?');
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * NewChunk --
+ *
+ * Helper function for Tk_ComputeTextLayout(). Encapsulates a
+ * measured set of characters in a chunk that can be quickly
+ * drawn.
+ *
+ * Results:
+ * A pointer to the new chunk in the text layout.
+ *
+ * Side effects:
+ * The text layout is reallocated to hold more chunks as necessary.
+ *
+ * Currently, Tk_ComputeTextLayout() stores contiguous ranges of
+ * "normal" characters in a chunk, along with individual tab
+ * and newline chars in their own chunks. All characters in the
+ * text layout are accounted for.
+ *
+ *---------------------------------------------------------------------------
+ */
+static LayoutChunk *
+NewChunk(layoutPtrPtr, maxPtr, start, numChars, curX, newX, y)
+ TextLayout **layoutPtrPtr;
+ int *maxPtr;
+ CONST char *start;
+ int numChars;
+ int curX;
+ int newX;
+ int y;
+{
+ TextLayout *layoutPtr;
+ LayoutChunk *chunkPtr;
+ int maxChunks;
+ size_t s;
+
+ layoutPtr = *layoutPtrPtr;
+ maxChunks = *maxPtr;
+ if (layoutPtr->numChunks == maxChunks) {
+ maxChunks *= 2;
+ s = sizeof(TextLayout) + ((maxChunks - 1) * sizeof(LayoutChunk));
+ layoutPtr = (TextLayout *) ckrealloc((char *) layoutPtr, s);
+
+ *layoutPtrPtr = layoutPtr;
+ *maxPtr = maxChunks;
+ }
+ chunkPtr = &layoutPtr->chunks[layoutPtr->numChunks];
+ chunkPtr->start = start;
+ chunkPtr->numChars = numChars;
+ chunkPtr->numDisplayChars = numChars;
+ chunkPtr->x = curX;
+ chunkPtr->y = y;
+ chunkPtr->totalWidth = newX - curX;
+ chunkPtr->displayWidth = newX - curX;
+ layoutPtr->numChunks++;
+
+ return chunkPtr;
+}
+
diff --git a/generic/tkFont.h b/generic/tkFont.h
new file mode 100644
index 0000000..758c329
--- /dev/null
+++ b/generic/tkFont.h
@@ -0,0 +1,208 @@
+/*
+ * tkFont.h --
+ *
+ * Declarations for interfaces between the generic and platform-
+ * specific parts of the font package. This information is not
+ * visible outside of the font package.
+ *
+ * Copyright (c) 1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkFont.h 1.11 97/05/07 14:44:13
+ */
+
+#ifndef _TKFONT
+#define _TKFONT
+
+/*
+ * The following structure keeps track of the attributes of a font. It can
+ * be used to keep track of either the desired attributes or the actual
+ * attributes gotten when the font was instantiated.
+ */
+
+typedef struct TkFontAttributes {
+ Tk_Uid family; /* Font family. The most important field. */
+ int pointsize; /* Pointsize of font, 0 for default size, or
+ * negative number meaning pixel size. */
+ int weight; /* Weight flag; see below for def'n. */
+ int slant; /* Slant flag; see below for def'n. */
+ int underline; /* Non-zero for underline font. */
+ int overstrike; /* Non-zero for overstrike font. */
+} TkFontAttributes;
+
+/*
+ * Possible values for the "weight" field in a TkFontAttributes structure.
+ * Weight is a subjective term and depends on what the company that created
+ * the font considers bold.
+ */
+
+#define TK_FW_NORMAL 0
+#define TK_FW_BOLD 1
+
+#define TK_FW_UNKNOWN -1 /* Unknown weight. This value is used for
+ * error checking and is never actually stored
+ * in the weight field. */
+
+/*
+ * Possible values for the "slant" field in a TkFontAttributes structure.
+ */
+
+#define TK_FS_ROMAN 0
+#define TK_FS_ITALIC 1
+#define TK_FS_OBLIQUE 2 /* This value is only used when parsing X
+ * font names to determine the closest
+ * match. It is only stored in the
+ * XLFDAttributes structure, never in the
+ * slant field of the TkFontAttributes. */
+
+#define TK_FS_UNKNOWN -1 /* Unknown slant. This value is used for
+ * error checking and is never actually stored
+ * in the slant field. */
+
+/*
+ * The following structure keeps track of the metrics for an instantiated
+ * font. The metrics are the physical properties of the font itself.
+ */
+
+typedef struct TkFontMetrics {
+ int ascent; /* From baseline to top of font. */
+ int descent; /* From baseline to bottom of font. */
+ int maxWidth; /* Width of widest character in font. */
+ int fixed; /* Non-zero if this is a fixed-width font,
+ * 0 otherwise. */
+} TkFontMetrics;
+
+/*
+ * The following structure is used to keep track of the generic information
+ * about a font. Each platform-specific font is represented by a structure
+ * with the following structure at its beginning, plus any platform-
+ * specific stuff after that.
+ */
+
+typedef struct TkFont {
+ /*
+ * Fields used and maintained exclusively by generic code.
+ */
+
+ int refCount; /* Number of users of the TkFont. */
+ Tcl_HashEntry *cacheHashPtr;/* Entry in font cache for this structure,
+ * used when deleting it. */
+ Tcl_HashEntry *namedHashPtr;/* Pointer to hash table entry that
+ * corresponds to the named font that the
+ * tkfont was based on, or NULL if the tkfont
+ * was not based on a named font. */
+ int tabWidth; /* Width of tabs in this font (pixels). */
+ int underlinePos; /* Offset from baseline to origin of
+ * underline bar (used for drawing underlines
+ * on a non-underlined font). */
+ int underlineHeight; /* Height of underline bar (used for drawing
+ * underlines on a non-underlined font). */
+
+ /*
+ * Fields in the generic font structure that are filled in by
+ * platform-specific code.
+ */
+
+ Font fid; /* For backwards compatibility with XGCValues
+ * structures. Remove when TkGCValues is
+ * implemented. */
+ TkFontAttributes fa; /* Actual font attributes obtained when the
+ * the font was created, as opposed to the
+ * desired attributes passed in to
+ * TkpGetFontFromAttributes(). The desired
+ * metrics can be determined from the string
+ * that was used to create this font. */
+ TkFontMetrics fm; /* Font metrics determined when font was
+ * created. */
+} TkFont;
+
+/*
+ * The following structure is used to return attributes when parsing an
+ * XLFD. The extra information is of interest to the Unix-specific code
+ * when attempting to find the closest matching font.
+ */
+
+typedef struct TkXLFDAttributes {
+ TkFontAttributes fa; /* Standard set of font attributes. */
+ Tk_Uid foundry; /* The foundry of the font. */
+ int slant; /* The tristate value for the slant, which
+ * is significant under X. */
+ int setwidth; /* The proportionate width, see below for
+ * definition. */
+ int charset; /* The character set encoding (the glyph
+ * family), see below for definition. */
+ int encoding; /* Variations within a charset for the
+ * glyphs above character 127. */
+} TkXLFDAttributes;
+
+/*
+ * Possible values for the "setwidth" field in a TkXLFDAttributes structure.
+ * The setwidth is whether characters are considered wider or narrower than
+ * normal.
+ */
+
+#define TK_SW_NORMAL 0
+#define TK_SW_CONDENSE 1
+#define TK_SW_EXPAND 2
+#define TK_SW_UNKNOWN 3 /* Unknown setwidth. This value may be
+ * stored in the setwidth field. */
+
+/*
+ * Possible values for the "charset" field in a TkXLFDAttributes structure.
+ * The charset is the set of glyphs that are used in the font.
+ */
+
+#define TK_CS_NORMAL 0
+#define TK_CS_SYMBOL 1
+#define TK_CS_OTHER 2
+
+/*
+ * The following defines specify the meaning of the fields in a fully
+ * qualified XLFD.
+ */
+
+#define XLFD_FOUNDRY 0
+#define XLFD_FAMILY 1
+#define XLFD_WEIGHT 2
+#define XLFD_SLANT 3
+#define XLFD_SETWIDTH 4
+#define XLFD_ADD_STYLE 5
+#define XLFD_PIXEL_SIZE 6
+#define XLFD_POINT_SIZE 7
+#define XLFD_RESOLUTION_X 8
+#define XLFD_RESOLUTION_Y 9
+#define XLFD_SPACING 10
+#define XLFD_AVERAGE_WIDTH 11
+#define XLFD_REGISTRY 12
+#define XLFD_ENCODING 13
+#define XLFD_NUMFIELDS 14 /* Number of fields in XLFD. */
+
+/*
+ * Exported from generic code to platform-specific code.
+ */
+
+EXTERN int TkCreateNamedFont _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, CONST char *name,
+ TkFontAttributes *faPtr));
+EXTERN void TkInitFontAttributes _ANSI_ARGS_((
+ TkFontAttributes *faPtr));
+EXTERN int TkParseXLFD _ANSI_ARGS_((CONST char *string,
+ TkXLFDAttributes *xaPtr));
+
+/*
+ * Common APIs exported to tkFont.c from all platform-specific
+ * implementations.
+ */
+
+EXTERN void TkpDeleteFont _ANSI_ARGS_((TkFont *tkFontPtr));
+EXTERN TkFont * TkpGetFontFromAttributes _ANSI_ARGS_((
+ TkFont *tkFontPtr, Tk_Window tkwin,
+ CONST TkFontAttributes *faPtr));
+EXTERN void TkpGetFontFamilies _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin));
+EXTERN TkFont * TkpGetNativeFont _ANSI_ARGS_((Tk_Window tkwin,
+ CONST char *name));
+
+#endif /* _TKFONT */
diff --git a/generic/tkFrame.c b/generic/tkFrame.c
new file mode 100644
index 0000000..a11f566
--- /dev/null
+++ b/generic/tkFrame.c
@@ -0,0 +1,939 @@
+/*
+ * tkFrame.c --
+ *
+ * This module implements "frame" and "toplevel" widgets for
+ * the Tk toolkit. Frames are windows with a background color
+ * and possibly a 3-D effect, but not much else in the way of
+ * attributes.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkFrame.c 1.82 97/08/08 17:26:26
+ */
+
+#include "default.h"
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * A data structure of the following type is kept for each
+ * frame that currently exists for this process:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the frame. NULL
+ * means that the window has been destroyed
+ * but the data structures haven't yet been
+ * cleaned up. */
+ Display *display; /* Display containing widget. Used, among
+ * other things, so that resources can be
+ * freed even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with widget. Used
+ * to delete widget command. */
+ Tcl_Command widgetCmd; /* Token for frame's widget command. */
+ char *className; /* Class name for widget (from configuration
+ * option). Malloc-ed. */
+ int mask; /* Either FRAME or TOPLEVEL; used to select
+ * which configuration options are valid for
+ * widget. */
+ char *screenName; /* Screen on which widget is created. Non-null
+ * only for top-levels. Malloc-ed, may be
+ * NULL. */
+ char *visualName; /* Textual description of visual for window,
+ * from -visual option. Malloc-ed, may be
+ * NULL. */
+ char *colormapName; /* Textual description of colormap for window,
+ * from -colormap option. Malloc-ed, may be
+ * NULL. */
+ char *menuName; /* Textual description of menu to use for
+ * menubar. Malloc-ed, may be NULL. */
+ Colormap colormap; /* If not None, identifies a colormap
+ * allocated for this window, which must be
+ * freed when the window is deleted. */
+ Tk_3DBorder border; /* Structure used to draw 3-D border and
+ * background. NULL means no background
+ * or border. */
+ int borderWidth; /* Width of 3-D border (if any). */
+ int relief; /* 3-d effect: TK_RELIEF_RAISED etc. */
+ int highlightWidth; /* Width in pixels of highlight to draw
+ * around widget when it has the focus.
+ * 0 means don't draw a highlight. */
+ XColor *highlightBgColorPtr;
+ /* Color for drawing traversal highlight
+ * area when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ int width; /* Width to request for window. <= 0 means
+ * don't request any size. */
+ int height; /* Height to request for window. <= 0 means
+ * don't request any size. */
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ char *takeFocus; /* Value of -takefocus option; not used in
+ * the C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+ int isContainer; /* 1 means this window is a container, 0 means
+ * that it isn't. */
+ char *useThis; /* If the window is embedded, this points to
+ * the name of the window in which it is
+ * embedded (malloc'ed). For non-embedded
+ * windows this is NULL. */
+ int flags; /* Various flags; see below for
+ * definitions. */
+} Frame;
+
+/*
+ * Flag bits for frames:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler
+ * has already been queued to redraw
+ * this window.
+ * GOT_FOCUS: Non-zero means this widget currently
+ * has the input focus.
+ */
+
+#define REDRAW_PENDING 1
+#define GOT_FOCUS 4
+
+/*
+ * The following flag bits are used so that there can be separate
+ * defaults for some configuration options for frames and toplevels.
+ */
+
+#define FRAME TK_CONFIG_USER_BIT
+#define TOPLEVEL (TK_CONFIG_USER_BIT << 1)
+#define BOTH (FRAME | TOPLEVEL)
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_FRAME_BG_COLOR, Tk_Offset(Frame, border),
+ BOTH|TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_FRAME_BG_MONO, Tk_Offset(Frame, border),
+ BOTH|TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
+ (char *) NULL, 0, BOTH},
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
+ (char *) NULL, 0, BOTH},
+ {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_FRAME_BORDER_WIDTH, Tk_Offset(Frame, borderWidth), BOTH},
+ {TK_CONFIG_STRING, "-class", "class", "Class",
+ DEF_FRAME_CLASS, Tk_Offset(Frame, className), FRAME},
+ {TK_CONFIG_STRING, "-class", "class", "Class",
+ DEF_TOPLEVEL_CLASS, Tk_Offset(Frame, className), TOPLEVEL},
+ {TK_CONFIG_STRING, "-colormap", "colormap", "Colormap",
+ DEF_FRAME_COLORMAP, Tk_Offset(Frame, colormapName),
+ BOTH|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BOOLEAN, "-container", "container", "Container",
+ DEF_FRAME_CONTAINER, Tk_Offset(Frame, isContainer), BOTH},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_FRAME_CURSOR, Tk_Offset(Frame, cursor), BOTH|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-height", "height", "Height",
+ DEF_FRAME_HEIGHT, Tk_Offset(Frame, height), BOTH},
+ {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_FRAME_HIGHLIGHT_BG,
+ Tk_Offset(Frame, highlightBgColorPtr), BOTH},
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_FRAME_HIGHLIGHT, Tk_Offset(Frame, highlightColorPtr), BOTH},
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_FRAME_HIGHLIGHT_WIDTH, Tk_Offset(Frame, highlightWidth), BOTH},
+ {TK_CONFIG_STRING, "-menu", "menu", "Menu",
+ DEF_TOPLEVEL_MENU, Tk_Offset(Frame, menuName),
+ TOPLEVEL|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_FRAME_RELIEF, Tk_Offset(Frame, relief), BOTH},
+ {TK_CONFIG_STRING, "-screen", "screen", "Screen",
+ DEF_TOPLEVEL_SCREEN, Tk_Offset(Frame, screenName),
+ TOPLEVEL|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_FRAME_TAKE_FOCUS, Tk_Offset(Frame, takeFocus),
+ BOTH|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-use", "use", "Use",
+ DEF_FRAME_USE, Tk_Offset(Frame, useThis), TOPLEVEL|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-visual", "visual", "Visual",
+ DEF_FRAME_VISUAL, Tk_Offset(Frame, visualName),
+ BOTH|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-width", "width", "Width",
+ DEF_FRAME_WIDTH, Tk_Offset(Frame, width), BOTH},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int ConfigureFrame _ANSI_ARGS_((Tcl_Interp *interp,
+ Frame *framePtr, int argc, char **argv,
+ int flags));
+static void DestroyFrame _ANSI_ARGS_((char *memPtr));
+static void DisplayFrame _ANSI_ARGS_((ClientData clientData));
+static void FrameCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void FrameEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int FrameWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void MapFrame _ANSI_ARGS_((ClientData clientData));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_FrameCmd, Tk_ToplevelCmd --
+ *
+ * These procedures are invoked to process the "frame" and
+ * "toplevel" Tcl commands. See the user documentation for
+ * details on what they do.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation. These procedures are just wrappers;
+ * they call ButtonCreate to do all of the real work.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_FrameCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ return TkCreateFrame(clientData, interp, argc, argv, 0, (char *) NULL);
+}
+
+int
+Tk_ToplevelCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ return TkCreateFrame(clientData, interp, argc, argv, 1, (char *) NULL);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkFrameCreate --
+ *
+ * This procedure is invoked to process the "frame" and "toplevel"
+ * Tcl commands; it is also invoked directly by Tk_Init to create
+ * a new main window. See the user documentation for the "frame"
+ * and "toplevel" commands for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkCreateFrame(clientData, interp, argc, argv, toplevel, appName)
+ ClientData clientData; /* Main window associated with interpreter.
+ * If we're called by Tk_Init to create a
+ * new application, then this is NULL. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+ int toplevel; /* Non-zero means create a toplevel window,
+ * zero means create a frame. */
+ char *appName; /* Should only be non-NULL if clientData is
+ * NULL: gives the base name to use for the
+ * new application. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ Frame *framePtr;
+ Tk_Window new;
+ char *className, *screenName, *visualName, *colormapName, *arg, *useOption;
+ int i, c, length, depth;
+ unsigned int mask;
+ Colormap colormap;
+ Visual *visual;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " pathName ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Pre-process the argument list. Scan through it to find any
+ * "-class", "-screen", "-visual", and "-colormap" options. These
+ * arguments need to be processed specially, before the window
+ * is configured using the usual Tk mechanisms.
+ */
+
+ className = colormapName = screenName = visualName = useOption = NULL;
+ colormap = None;
+ for (i = 2; i < argc; i += 2) {
+ arg = argv[i];
+ length = strlen(arg);
+ if (length < 2) {
+ continue;
+ }
+ c = arg[1];
+ if ((c == 'c') && (strncmp(arg, "-class", strlen(arg)) == 0)
+ && (length >= 3)) {
+ className = argv[i+1];
+ } else if ((c == 'c')
+ && (strncmp(arg, "-colormap", strlen(arg)) == 0)) {
+ colormapName = argv[i+1];
+ } else if ((c == 's') && toplevel
+ && (strncmp(arg, "-screen", strlen(arg)) == 0)) {
+ screenName = argv[i+1];
+ } else if ((c == 'u') && toplevel
+ && (strncmp(arg, "-use", strlen(arg)) == 0)) {
+ useOption = argv[i+1];
+ } else if ((c == 'v')
+ && (strncmp(arg, "-visual", strlen(arg)) == 0)) {
+ visualName = argv[i+1];
+ }
+ }
+
+ /*
+ * Create the window, and deal with the special options -use,
+ * -classname, -colormap, -screenname, and -visual. These options
+ * must be handle before calling ConfigureFrame below, and they must
+ * also be processed in a particular order, for the following
+ * reasons:
+ * 1. Must set the window's class before calling ConfigureFrame,
+ * so that unspecified options are looked up in the option
+ * database using the correct class.
+ * 2. Must set visual information before calling ConfigureFrame
+ * so that colors are allocated in a proper colormap.
+ * 3. Must call TkpUseWindow before setting non-default visual
+ * information, since TkpUseWindow changes the defaults.
+ */
+
+ if (screenName == NULL) {
+ screenName = (toplevel) ? "" : NULL;
+ }
+ if (tkwin != NULL) {
+ new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], screenName);
+ } else {
+ /*
+ * We were called from Tk_Init; create a new application.
+ */
+
+ if (appName == NULL) {
+ panic("TkCreateFrame didn't get application name");
+ }
+ new = TkCreateMainWindow(interp, screenName, appName);
+ }
+ if (new == NULL) {
+ goto error;
+ }
+ if (className == NULL) {
+ className = Tk_GetOption(new, "class", "Class");
+ if (className == NULL) {
+ className = (toplevel) ? "Toplevel" : "Frame";
+ }
+ }
+ Tk_SetClass(new, className);
+ if (useOption == NULL) {
+ useOption = Tk_GetOption(new, "use", "Use");
+ }
+ if (useOption != NULL) {
+ if (TkpUseWindow(interp, new, useOption) != TCL_OK) {
+ goto error;
+ }
+ }
+ if (visualName == NULL) {
+ visualName = Tk_GetOption(new, "visual", "Visual");
+ }
+ if (colormapName == NULL) {
+ colormapName = Tk_GetOption(new, "colormap", "Colormap");
+ }
+ if (visualName != NULL) {
+ visual = Tk_GetVisual(interp, new, visualName, &depth,
+ (colormapName == NULL) ? &colormap : (Colormap *) NULL);
+ if (visual == NULL) {
+ goto error;
+ }
+ Tk_SetWindowVisual(new, visual, depth, colormap);
+ }
+ if (colormapName != NULL) {
+ colormap = Tk_GetColormap(interp, new, colormapName);
+ if (colormap == None) {
+ goto error;
+ }
+ Tk_SetWindowColormap(new, colormap);
+ }
+
+ /*
+ * For top-level windows, provide an initial geometry request of
+ * 200x200, just so the window looks nicer on the screen if it
+ * doesn't request a size for itself.
+ */
+
+ if (toplevel) {
+ Tk_GeometryRequest(new, 200, 200);
+ }
+
+ /*
+ * Create the widget record, process configuration options, and
+ * create event handlers. Then fill in a few additional fields
+ * in the widget record from the special options.
+ */
+
+ framePtr = (Frame *) ckalloc(sizeof(Frame));
+ framePtr->tkwin = new;
+ framePtr->display = Tk_Display(new);
+ framePtr->interp = interp;
+ framePtr->widgetCmd = Tcl_CreateCommand(interp,
+ Tk_PathName(new), FrameWidgetCmd,
+ (ClientData) framePtr, FrameCmdDeletedProc);
+ framePtr->className = NULL;
+ framePtr->mask = (toplevel) ? TOPLEVEL : FRAME;
+ framePtr->screenName = NULL;
+ framePtr->visualName = NULL;
+ framePtr->colormapName = NULL;
+ framePtr->colormap = colormap;
+ framePtr->border = NULL;
+ framePtr->borderWidth = 0;
+ framePtr->relief = TK_RELIEF_FLAT;
+ framePtr->highlightWidth = 0;
+ framePtr->highlightBgColorPtr = NULL;
+ framePtr->highlightColorPtr = NULL;
+ framePtr->width = 0;
+ framePtr->height = 0;
+ framePtr->cursor = None;
+ framePtr->takeFocus = NULL;
+ framePtr->isContainer = 0;
+ framePtr->useThis = NULL;
+ framePtr->flags = 0;
+ framePtr->menuName = NULL;
+
+ /*
+ * Store backreference to frame widget in window structure.
+ */
+ TkSetClassProcs(new, NULL, (ClientData) framePtr);
+
+ mask = ExposureMask | StructureNotifyMask | FocusChangeMask;
+ if (toplevel) {
+ mask |= ActivateMask;
+ }
+ Tk_CreateEventHandler(new, mask, FrameEventProc, (ClientData) framePtr);
+ if (ConfigureFrame(interp, framePtr, argc-2, argv+2, 0) != TCL_OK) {
+ goto error;
+ }
+ if ((framePtr->isContainer)) {
+ if (framePtr->useThis == NULL) {
+ TkpMakeContainer(framePtr->tkwin);
+ } else {
+ Tcl_AppendResult(interp,"A window cannot have both the -use ",
+ "and the -container option set.");
+ return TCL_ERROR;
+ }
+ }
+ if (toplevel) {
+ Tcl_DoWhenIdle(MapFrame, (ClientData) framePtr);
+ }
+ interp->result = Tk_PathName(new);
+ return TCL_OK;
+
+ error:
+ if (new != NULL) {
+ Tk_DestroyWindow(new);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FrameWidgetCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to a frame widget. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+FrameWidgetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about frame widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ register Frame *framePtr = (Frame *) clientData;
+ int result;
+ size_t length;
+ int c, i;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_Preserve((ClientData) framePtr);
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
+ && (length >= 2)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " cget option\"",
+ (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ result = Tk_ConfigureValue(interp, framePtr->tkwin, configSpecs,
+ (char *) framePtr, argv[2], framePtr->mask);
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
+ && (length >= 2)) {
+ if (argc == 2) {
+ result = Tk_ConfigureInfo(interp, framePtr->tkwin, configSpecs,
+ (char *) framePtr, (char *) NULL, framePtr->mask);
+ } else if (argc == 3) {
+ result = Tk_ConfigureInfo(interp, framePtr->tkwin, configSpecs,
+ (char *) framePtr, argv[2], framePtr->mask);
+ } else {
+ /*
+ * Don't allow the options -class, -colormap, -container,
+ * -newcmap, -screen, -use, or -visual to be changed.
+ */
+
+ for (i = 2; i < argc; i++) {
+ length = strlen(argv[i]);
+ if (length < 2) {
+ continue;
+ }
+ c = argv[i][1];
+ if (((c == 'c') && (strncmp(argv[i], "-class", length) == 0)
+ && (length >= 2))
+ || ((c == 'c') && (framePtr->mask == TOPLEVEL)
+ && (strncmp(argv[i], "-colormap", length) == 0)
+ && (length >= 3))
+ || ((c == 'c')
+ && (strncmp(argv[i], "-container", length) == 0)
+ && (length >= 3))
+ || ((c == 's') && (framePtr->mask == TOPLEVEL)
+ && (strncmp(argv[i], "-screen", length) == 0))
+ || ((c == 'u') && (framePtr->mask == TOPLEVEL)
+ && (strncmp(argv[i], "-use", length) == 0))
+ || ((c == 'v') && (framePtr->mask == TOPLEVEL)
+ && (strncmp(argv[i], "-visual", length) == 0))) {
+ Tcl_AppendResult(interp, "can't modify ", argv[i],
+ " option after widget is created", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ }
+ result = ConfigureFrame(interp, framePtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be cget or configure", (char *) NULL);
+ result = TCL_ERROR;
+ }
+
+ done:
+ Tcl_Release((ClientData) framePtr);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyFrame --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a frame at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the frame is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyFrame(memPtr)
+ char *memPtr; /* Info about frame widget. */
+{
+ register Frame *framePtr = (Frame *) memPtr;
+
+ Tk_FreeOptions(configSpecs, (char *) framePtr, framePtr->display,
+ framePtr->mask);
+ if (framePtr->colormap != None) {
+ Tk_FreeColormap(framePtr->display, framePtr->colormap);
+ }
+ ckfree((char *) framePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureFrame --
+ *
+ * This procedure is called to process an argv/argc list, plus
+ * the Tk option database, in order to configure (or
+ * reconfigure) a frame widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then interp->result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as text string, colors, font,
+ * etc. get set for framePtr; old resources get freed, if there
+ * were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureFrame(interp, framePtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register Frame *framePtr; /* Information about widget; may or may
+ * not already have values for some fields. */
+ int argc; /* Number of valid entries in argv. */
+ char **argv; /* Arguments. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ char *oldMenuName;
+
+ /*
+ * Need the old menubar name for the menu code to delete it.
+ */
+
+ if (framePtr->menuName == NULL) {
+ oldMenuName = NULL;
+ } else {
+ oldMenuName = ckalloc(strlen(framePtr->menuName) + 1);
+ strcpy(oldMenuName, framePtr->menuName);
+ }
+
+ if (Tk_ConfigureWidget(interp, framePtr->tkwin, configSpecs,
+ argc, argv, (char *) framePtr, flags | framePtr->mask) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (((oldMenuName == NULL) && (framePtr->menuName != NULL))
+ || ((oldMenuName != NULL) && (framePtr->menuName == NULL))
+ || ((oldMenuName != NULL) && (framePtr->menuName != NULL)
+ && strcmp(oldMenuName, framePtr->menuName) != 0)) {
+ TkSetWindowMenuBar(interp, framePtr->tkwin, oldMenuName,
+ framePtr->menuName);
+ }
+
+ if (framePtr->border != NULL) {
+ Tk_SetBackgroundFromBorder(framePtr->tkwin, framePtr->border);
+ } else {
+ Tk_SetWindowBackgroundPixmap(framePtr->tkwin, None);
+ }
+
+ if (framePtr->highlightWidth < 0) {
+ framePtr->highlightWidth = 0;
+ }
+ Tk_SetInternalBorder(framePtr->tkwin,
+ framePtr->borderWidth + framePtr->highlightWidth);
+ if ((framePtr->width > 0) || (framePtr->height > 0)) {
+ Tk_GeometryRequest(framePtr->tkwin, framePtr->width,
+ framePtr->height);
+ }
+
+ if (oldMenuName != NULL) {
+ ckfree(oldMenuName);
+ }
+
+ if (Tk_IsMapped(framePtr->tkwin)) {
+ if (!(framePtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayFrame, (ClientData) framePtr);
+ }
+ framePtr->flags |= REDRAW_PENDING;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplayFrame --
+ *
+ * This procedure is invoked to display a frame widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the frame in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplayFrame(clientData)
+ ClientData clientData; /* Information about widget. */
+{
+ register Frame *framePtr = (Frame *) clientData;
+ register Tk_Window tkwin = framePtr->tkwin;
+ GC gc;
+
+ framePtr->flags &= ~REDRAW_PENDING;
+ if ((framePtr->tkwin == NULL) || !Tk_IsMapped(tkwin)
+ || framePtr->isContainer) {
+ return;
+ }
+
+ if (framePtr->border != NULL) {
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin),
+ framePtr->border, framePtr->highlightWidth,
+ framePtr->highlightWidth,
+ Tk_Width(tkwin) - 2*framePtr->highlightWidth,
+ Tk_Height(tkwin) - 2*framePtr->highlightWidth,
+ framePtr->borderWidth, framePtr->relief);
+ }
+ if (framePtr->highlightWidth != 0) {
+ if (framePtr->flags & GOT_FOCUS) {
+ gc = Tk_GCForColor(framePtr->highlightColorPtr,
+ Tk_WindowId(tkwin));
+ } else {
+ gc = Tk_GCForColor(framePtr->highlightBgColorPtr,
+ Tk_WindowId(tkwin));
+ }
+ Tk_DrawFocusHighlight(tkwin, gc, framePtr->highlightWidth,
+ Tk_WindowId(tkwin));
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FrameEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher on
+ * structure changes to a frame. For frames with 3D
+ * borders, this procedure is also invoked for exposures.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+FrameEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ register XEvent *eventPtr; /* Information about event. */
+{
+ register Frame *framePtr = (Frame *) clientData;
+
+ if (((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0))
+ || (eventPtr->type == ConfigureNotify)) {
+ goto redraw;
+ } else if (eventPtr->type == DestroyNotify) {
+ if (framePtr->menuName != NULL) {
+ TkSetWindowMenuBar(framePtr->interp, framePtr->tkwin,
+ framePtr->menuName, NULL);
+ ckfree(framePtr->menuName);
+ framePtr->menuName = NULL;
+ }
+ if (framePtr->tkwin != NULL) {
+
+ /*
+ * If this window is a container, then this event could be
+ * coming from the embedded application, in which case
+ * Tk_DestroyWindow hasn't been called yet. When Tk_DestroyWindow
+ * is called later, then another destroy event will be generated.
+ * We need to be sure we ignore the second event, since the frame
+ * could be gone by then. To do so, delete the event handler
+ * explicitly (normally it's done implicitly by Tk_DestroyWindow).
+ */
+
+ Tk_DeleteEventHandler(framePtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ FrameEventProc, (ClientData) framePtr);
+ framePtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(framePtr->interp, framePtr->widgetCmd);
+ }
+ if (framePtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayFrame, (ClientData) framePtr);
+ }
+ Tcl_CancelIdleCall(MapFrame, (ClientData) framePtr);
+ Tcl_EventuallyFree((ClientData) framePtr, DestroyFrame);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ framePtr->flags |= GOT_FOCUS;
+ if (framePtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ framePtr->flags &= ~GOT_FOCUS;
+ if (framePtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ } else if (eventPtr->type == ActivateNotify) {
+ TkpSetMainMenubar(framePtr->interp, framePtr->tkwin,
+ framePtr->menuName);
+ }
+ return;
+
+ redraw:
+ if ((framePtr->tkwin != NULL) && !(framePtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayFrame, (ClientData) framePtr);
+ framePtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FrameCmdDeletedProc --
+ *
+ * This procedure is invoked when a widget command is deleted. If
+ * the widget isn't already in the process of being destroyed,
+ * this command destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FrameCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ Frame *framePtr = (Frame *) clientData;
+ Tk_Window tkwin = framePtr->tkwin;
+
+ if (framePtr->menuName != NULL) {
+ TkSetWindowMenuBar(framePtr->interp, framePtr->tkwin,
+ framePtr->menuName, NULL);
+ ckfree(framePtr->menuName);
+ framePtr->menuName = NULL;
+ }
+
+ /*
+ * This procedure could be invoked either because the window was
+ * destroyed and the command was then deleted (in which case tkwin
+ * is NULL) or because the command was deleted, and then this procedure
+ * destroys the widget.
+ */
+
+ if (tkwin != NULL) {
+ framePtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MapFrame --
+ *
+ * This procedure is invoked as a when-idle handler to map a
+ * newly-created top-level frame.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The frame given by the clientData argument is mapped.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MapFrame(clientData)
+ ClientData clientData; /* Pointer to frame structure. */
+{
+ Frame *framePtr = (Frame *) clientData;
+
+ /*
+ * Wait for all other background events to be processed before
+ * mapping window. This ensures that the window's correct geometry
+ * will have been determined before it is first mapped, so that the
+ * window manager doesn't get a false idea of its desired geometry.
+ */
+
+ Tcl_Preserve((ClientData) framePtr);
+ while (1) {
+ if (Tcl_DoOneEvent(TCL_IDLE_EVENTS) == 0) {
+ break;
+ }
+
+ /*
+ * After each event, make sure that the window still exists
+ * and quit if the window has been destroyed.
+ */
+
+ if (framePtr->tkwin == NULL) {
+ Tcl_Release((ClientData) framePtr);
+ return;
+ }
+ }
+ Tk_MapWindow(framePtr->tkwin);
+ Tcl_Release((ClientData) framePtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkInstallFrameMenu --
+ *
+ * This function is needed when a Windows HWND is created
+ * and a menubar has been set to the window with a system
+ * menu. It notifies the menu package so that the system
+ * menu can be rebuilt.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The system menu (if any) is created for the menubar
+ * associated with this frame.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkInstallFrameMenu(tkwin)
+ Tk_Window tkwin; /* The window that was just created. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if (winPtr->mainPtr != NULL) {
+ Frame *framePtr;
+ framePtr = (Frame*) winPtr->instanceData;
+ TkpMenuNotifyToplevelCreate(winPtr->mainPtr->interp,
+ framePtr->menuName);
+ }
+}
diff --git a/generic/tkGC.c b/generic/tkGC.c
new file mode 100644
index 0000000..f68db12
--- /dev/null
+++ b/generic/tkGC.c
@@ -0,0 +1,363 @@
+/*
+ * tkGC.c --
+ *
+ * This file maintains a database of read-only graphics contexts
+ * for the Tk toolkit, in order to allow GC's to be shared.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkGC.c 1.18 96/02/15 18:53:32
+ */
+
+#include "tkPort.h"
+#include "tk.h"
+
+/*
+ * One of the following data structures exists for each GC that is
+ * currently active. The structure is indexed with two hash tables,
+ * one based on the values in the graphics context and the other
+ * based on the display and GC identifier.
+ */
+
+typedef struct {
+ GC gc; /* Graphics context. */
+ Display *display; /* Display to which gc belongs. */
+ int refCount; /* Number of active uses of gc. */
+ Tcl_HashEntry *valueHashPtr;/* Entry in valueTable (needed when deleting
+ * this structure). */
+} TkGC;
+
+/*
+ * Hash table to map from a GC's values to a TkGC structure describing
+ * a GC with those values (used by Tk_GetGC).
+ */
+
+static Tcl_HashTable valueTable;
+typedef struct {
+ XGCValues values; /* Desired values for GC. */
+ Display *display; /* Display for which GC is valid. */
+ int screenNum; /* screen number of display */
+ int depth; /* and depth for which GC is valid. */
+} ValueKey;
+
+/*
+ * Hash table for <display + GC> -> TkGC mapping. This table is used by
+ * Tk_FreeGC.
+ */
+
+static Tcl_HashTable idTable;
+typedef struct {
+ Display *display; /* Display for which GC was allocated. */
+ GC gc; /* X's identifier for GC. */
+} IdKey;
+
+static int initialized = 0; /* 0 means static structures haven't been
+ * initialized yet. */
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void GCInit _ANSI_ARGS_((void));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetGC --
+ *
+ * Given a desired set of values for a graphics context, find
+ * a read-only graphics context with the desired values.
+ *
+ * Results:
+ * The return value is the X identifer for the desired graphics
+ * context. The caller should never modify this GC, and should
+ * call Tk_FreeGC when the GC is no longer needed.
+ *
+ * Side effects:
+ * The GC is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeGC, so that the database can be cleaned up when GC's
+ * aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+GC
+Tk_GetGC(tkwin, valueMask, valuePtr)
+ Tk_Window tkwin; /* Window in which GC will be used. */
+ register unsigned long valueMask;
+ /* 1 bits correspond to values specified
+ * in *valuesPtr; other values are set
+ * from defaults. */
+ register XGCValues *valuePtr;
+ /* Values are specified here for bits set
+ * in valueMask. */
+{
+ ValueKey valueKey;
+ IdKey idKey;
+ Tcl_HashEntry *valueHashPtr, *idHashPtr;
+ register TkGC *gcPtr;
+ int new;
+ Drawable d, freeDrawable;
+
+ if (!initialized) {
+ GCInit();
+ }
+
+ /*
+ * Must zero valueKey at start to clear out pad bytes that may be
+ * part of structure on some systems.
+ */
+
+ memset((VOID *) &valueKey, 0, sizeof(valueKey));
+
+ /*
+ * First, check to see if there's already a GC that will work
+ * for this request (exact matches only, sorry).
+ */
+
+ if (valueMask & GCFunction) {
+ valueKey.values.function = valuePtr->function;
+ } else {
+ valueKey.values.function = GXcopy;
+ }
+ if (valueMask & GCPlaneMask) {
+ valueKey.values.plane_mask = valuePtr->plane_mask;
+ } else {
+ valueKey.values.plane_mask = (unsigned) ~0;
+ }
+ if (valueMask & GCForeground) {
+ valueKey.values.foreground = valuePtr->foreground;
+ } else {
+ valueKey.values.foreground = 0;
+ }
+ if (valueMask & GCBackground) {
+ valueKey.values.background = valuePtr->background;
+ } else {
+ valueKey.values.background = 1;
+ }
+ if (valueMask & GCLineWidth) {
+ valueKey.values.line_width = valuePtr->line_width;
+ } else {
+ valueKey.values.line_width = 0;
+ }
+ if (valueMask & GCLineStyle) {
+ valueKey.values.line_style = valuePtr->line_style;
+ } else {
+ valueKey.values.line_style = LineSolid;
+ }
+ if (valueMask & GCCapStyle) {
+ valueKey.values.cap_style = valuePtr->cap_style;
+ } else {
+ valueKey.values.cap_style = CapButt;
+ }
+ if (valueMask & GCJoinStyle) {
+ valueKey.values.join_style = valuePtr->join_style;
+ } else {
+ valueKey.values.join_style = JoinMiter;
+ }
+ if (valueMask & GCFillStyle) {
+ valueKey.values.fill_style = valuePtr->fill_style;
+ } else {
+ valueKey.values.fill_style = FillSolid;
+ }
+ if (valueMask & GCFillRule) {
+ valueKey.values.fill_rule = valuePtr->fill_rule;
+ } else {
+ valueKey.values.fill_rule = EvenOddRule;
+ }
+ if (valueMask & GCArcMode) {
+ valueKey.values.arc_mode = valuePtr->arc_mode;
+ } else {
+ valueKey.values.arc_mode = ArcPieSlice;
+ }
+ if (valueMask & GCTile) {
+ valueKey.values.tile = valuePtr->tile;
+ } else {
+ valueKey.values.tile = None;
+ }
+ if (valueMask & GCStipple) {
+ valueKey.values.stipple = valuePtr->stipple;
+ } else {
+ valueKey.values.stipple = None;
+ }
+ if (valueMask & GCTileStipXOrigin) {
+ valueKey.values.ts_x_origin = valuePtr->ts_x_origin;
+ } else {
+ valueKey.values.ts_x_origin = 0;
+ }
+ if (valueMask & GCTileStipYOrigin) {
+ valueKey.values.ts_y_origin = valuePtr->ts_y_origin;
+ } else {
+ valueKey.values.ts_y_origin = 0;
+ }
+ if (valueMask & GCFont) {
+ valueKey.values.font = valuePtr->font;
+ } else {
+ valueKey.values.font = None;
+ }
+ if (valueMask & GCSubwindowMode) {
+ valueKey.values.subwindow_mode = valuePtr->subwindow_mode;
+ } else {
+ valueKey.values.subwindow_mode = ClipByChildren;
+ }
+ if (valueMask & GCGraphicsExposures) {
+ valueKey.values.graphics_exposures = valuePtr->graphics_exposures;
+ } else {
+ valueKey.values.graphics_exposures = True;
+ }
+ if (valueMask & GCClipXOrigin) {
+ valueKey.values.clip_x_origin = valuePtr->clip_x_origin;
+ } else {
+ valueKey.values.clip_x_origin = 0;
+ }
+ if (valueMask & GCClipYOrigin) {
+ valueKey.values.clip_y_origin = valuePtr->clip_y_origin;
+ } else {
+ valueKey.values.clip_y_origin = 0;
+ }
+ if (valueMask & GCClipMask) {
+ valueKey.values.clip_mask = valuePtr->clip_mask;
+ } else {
+ valueKey.values.clip_mask = None;
+ }
+ if (valueMask & GCDashOffset) {
+ valueKey.values.dash_offset = valuePtr->dash_offset;
+ } else {
+ valueKey.values.dash_offset = 0;
+ }
+ if (valueMask & GCDashList) {
+ valueKey.values.dashes = valuePtr->dashes;
+ } else {
+ valueKey.values.dashes = 4;
+ }
+ valueKey.display = Tk_Display(tkwin);
+ valueKey.screenNum = Tk_ScreenNumber(tkwin);
+ valueKey.depth = Tk_Depth(tkwin);
+ valueHashPtr = Tcl_CreateHashEntry(&valueTable, (char *) &valueKey, &new);
+ if (!new) {
+ gcPtr = (TkGC *) Tcl_GetHashValue(valueHashPtr);
+ gcPtr->refCount++;
+ return gcPtr->gc;
+ }
+
+ /*
+ * No GC is currently available for this set of values. Allocate a
+ * new GC and add a new structure to the database.
+ */
+
+ gcPtr = (TkGC *) ckalloc(sizeof(TkGC));
+
+ /*
+ * Find or make a drawable to use to specify the screen and depth
+ * of the GC. We may have to make a small pixmap, to avoid doing
+ * Tk_MakeWindowExist on the window.
+ */
+
+ freeDrawable = None;
+ if (Tk_WindowId(tkwin) != None) {
+ d = Tk_WindowId(tkwin);
+ } else if (valueKey.depth ==
+ DefaultDepth(valueKey.display, valueKey.screenNum)) {
+ d = RootWindow(valueKey.display, valueKey.screenNum);
+ } else {
+ d = Tk_GetPixmap(valueKey.display,
+ RootWindow(valueKey.display, valueKey.screenNum),
+ 1, 1, valueKey.depth);
+ freeDrawable = d;
+ }
+
+ gcPtr->gc = XCreateGC(valueKey.display, d, valueMask, &valueKey.values);
+ gcPtr->display = valueKey.display;
+ gcPtr->refCount = 1;
+ gcPtr->valueHashPtr = valueHashPtr;
+ idKey.display = valueKey.display;
+ idKey.gc = gcPtr->gc;
+ idHashPtr = Tcl_CreateHashEntry(&idTable, (char *) &idKey, &new);
+ if (!new) {
+ panic("GC already registered in Tk_GetGC");
+ }
+ Tcl_SetHashValue(valueHashPtr, gcPtr);
+ Tcl_SetHashValue(idHashPtr, gcPtr);
+ if (freeDrawable != None) {
+ Tk_FreePixmap(valueKey.display, freeDrawable);
+ }
+
+ return gcPtr->gc;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeGC --
+ *
+ * This procedure is called to release a graphics context allocated by
+ * Tk_GetGC.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with gc is decremented, and
+ * gc is officially deallocated if no-one is using it anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeGC(display, gc)
+ Display *display; /* Display for which gc was allocated. */
+ GC gc; /* Graphics context to be released. */
+{
+ IdKey idKey;
+ Tcl_HashEntry *idHashPtr;
+ register TkGC *gcPtr;
+
+ if (!initialized) {
+ panic("Tk_FreeGC called before Tk_GetGC");
+ }
+
+ idKey.display = display;
+ idKey.gc = gc;
+ idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey);
+ if (idHashPtr == NULL) {
+ panic("Tk_FreeGC received unknown gc argument");
+ }
+ gcPtr = (TkGC *) Tcl_GetHashValue(idHashPtr);
+ gcPtr->refCount--;
+ if (gcPtr->refCount == 0) {
+ Tk_FreeXId(gcPtr->display, (XID) XGContextFromGC(gcPtr->gc));
+ XFreeGC(gcPtr->display, gcPtr->gc);
+ Tcl_DeleteHashEntry(gcPtr->valueHashPtr);
+ Tcl_DeleteHashEntry(idHashPtr);
+ ckfree((char *) gcPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GCInit --
+ *
+ * Initialize the structures used for GC management.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Read the code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GCInit()
+{
+ initialized = 1;
+ Tcl_InitHashTable(&valueTable, sizeof(ValueKey)/sizeof(int));
+ Tcl_InitHashTable(&idTable, sizeof(IdKey)/sizeof(int));
+}
diff --git a/generic/tkGeometry.c b/generic/tkGeometry.c
new file mode 100644
index 0000000..ec2c959
--- /dev/null
+++ b/generic/tkGeometry.c
@@ -0,0 +1,582 @@
+/*
+ * tkGeometry.c --
+ *
+ * This file contains generic Tk code for geometry management
+ * (stuff that's used by all geometry managers).
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkGeometry.c 1.31 96/02/15 18:53:32
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * Data structures of the following type are used by Tk_MaintainGeometry.
+ * For each slave managed by Tk_MaintainGeometry, there is one of these
+ * structures associated with its master.
+ */
+
+typedef struct MaintainSlave {
+ Tk_Window slave; /* The slave window being positioned. */
+ Tk_Window master; /* The master that determines slave's
+ * position; it must be a descendant of
+ * slave's parent. */
+ int x, y; /* Desired position of slave relative to
+ * master. */
+ int width, height; /* Desired dimensions of slave. */
+ struct MaintainSlave *nextPtr;
+ /* Next in list of Maintains associated
+ * with master. */
+} MaintainSlave;
+
+/*
+ * For each window that has been specified as a master to
+ * Tk_MaintainGeometry, there is a structure of the following type:
+ */
+
+typedef struct MaintainMaster {
+ Tk_Window ancestor; /* The lowest ancestor of this window
+ * for which we have *not* created a
+ * StructureNotify handler. May be the
+ * same as the window itself. */
+ int checkScheduled; /* Non-zero means that there is already a
+ * call to MaintainCheckProc scheduled as
+ * an idle handler. */
+ MaintainSlave *slavePtr; /* First in list of all slaves associated
+ * with this master. */
+} MaintainMaster;
+
+/*
+ * Hash table that maps from a master's Tk_Window token to a list of
+ * Maintains for that master:
+ */
+
+static Tcl_HashTable maintainHashTable;
+
+/*
+ * Has maintainHashTable been initialized yet?
+ */
+
+static int initialized = 0;
+
+/*
+ * Prototypes for static procedures in this file:
+ */
+
+static void MaintainCheckProc _ANSI_ARGS_((ClientData clientData));
+static void MaintainMasterProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void MaintainSlaveProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ManageGeometry --
+ *
+ * Arrange for a particular procedure to manage the geometry
+ * of a given slave window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Proc becomes the new geometry manager for tkwin, replacing
+ * any previous geometry manager. The geometry manager will
+ * be notified (by calling procedures in *mgrPtr) when interesting
+ * things happen in the future. If there was an existing geometry
+ * manager for tkwin different from the new one, it is notified
+ * by calling its lostSlaveProc.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_ManageGeometry(tkwin, mgrPtr, clientData)
+ Tk_Window tkwin; /* Window whose geometry is to
+ * be managed by proc. */
+ Tk_GeomMgr *mgrPtr; /* Static structure describing the
+ * geometry manager. This structure
+ * must never go away. */
+ ClientData clientData; /* Arbitrary one-word argument to
+ * pass to geometry manager procedures. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if ((winPtr->geomMgrPtr != NULL) && (mgrPtr != NULL)
+ && ((winPtr->geomMgrPtr != mgrPtr)
+ || (winPtr->geomData != clientData))
+ && (winPtr->geomMgrPtr->lostSlaveProc != NULL)) {
+ (*winPtr->geomMgrPtr->lostSlaveProc)(winPtr->geomData, tkwin);
+ }
+
+ winPtr->geomMgrPtr = mgrPtr;
+ winPtr->geomData = clientData;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GeometryRequest --
+ *
+ * This procedure is invoked by widget code to indicate
+ * its preferences about the size of a window it manages.
+ * In general, widget code should call this procedure
+ * rather than Tk_ResizeWindow.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The geometry manager for tkwin (if any) is invoked to
+ * handle the request. If possible, it will reconfigure
+ * tkwin and/or other windows to satisfy the request. The
+ * caller gets no indication of success or failure, but it
+ * will get X events if the window size was actually
+ * changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_GeometryRequest(tkwin, reqWidth, reqHeight)
+ Tk_Window tkwin; /* Window that geometry information
+ * pertains to. */
+ int reqWidth, reqHeight; /* Minimum desired dimensions for
+ * window, in pixels. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ /*
+ * X gets very upset if a window requests a width or height of
+ * zero, so rounds requested sizes up to at least 1.
+ */
+
+ if (reqWidth <= 0) {
+ reqWidth = 1;
+ }
+ if (reqHeight <= 0) {
+ reqHeight = 1;
+ }
+ if ((reqWidth == winPtr->reqWidth) && (reqHeight == winPtr->reqHeight)) {
+ return;
+ }
+ winPtr->reqWidth = reqWidth;
+ winPtr->reqHeight = reqHeight;
+ if ((winPtr->geomMgrPtr != NULL)
+ && (winPtr->geomMgrPtr->requestProc != NULL)) {
+ (*winPtr->geomMgrPtr->requestProc)(winPtr->geomData, tkwin);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetInternalBorder --
+ *
+ * Notify relevant geometry managers that a window has an internal
+ * border of a given width and that child windows should not be
+ * placed on that border.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The border width is recorded for the window, and all geometry
+ * managers of all children are notified so that can re-layout, if
+ * necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetInternalBorder(tkwin, width)
+ Tk_Window tkwin; /* Window that will have internal border. */
+ int width; /* Width of internal border, in pixels. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if (width == winPtr->internalBorderWidth) {
+ return;
+ }
+ if (width < 0) {
+ width = 0;
+ }
+ winPtr->internalBorderWidth = width;
+
+ /*
+ * All the slaves for which this is the master window must now be
+ * repositioned to take account of the new internal border width.
+ * To signal all the geometry managers to do this, just resize the
+ * window to its current size. The ConfigureNotify event will
+ * cause geometry managers to recompute everything.
+ */
+
+ Tk_ResizeWindow(tkwin, Tk_Width(tkwin), Tk_Height(tkwin));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_MaintainGeometry --
+ *
+ * This procedure is invoked by geometry managers to handle slaves
+ * whose master's are not their parents. It translates the desired
+ * geometry for the slave into the coordinate system of the parent
+ * and respositions the slave if it isn't already at the right place.
+ * Furthermore, it sets up event handlers so that if the master (or
+ * any of its ancestors up to the slave's parent) is mapped, unmapped,
+ * or moved, then the slave will be adjusted to match.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Event handlers are created and state is allocated to keep track
+ * of slave. Note: if slave was already managed for master by
+ * Tk_MaintainGeometry, then the previous information is replaced
+ * with the new information. The caller must eventually call
+ * Tk_UnmaintainGeometry to eliminate the correspondence (or, the
+ * state is automatically freed when either window is destroyed).
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_MaintainGeometry(slave, master, x, y, width, height)
+ Tk_Window slave; /* Slave for geometry management. */
+ Tk_Window master; /* Master for slave; must be a descendant
+ * of slave's parent. */
+ int x, y; /* Desired position of slave within master. */
+ int width, height; /* Desired dimensions for slave. */
+{
+ Tcl_HashEntry *hPtr;
+ MaintainMaster *masterPtr;
+ register MaintainSlave *slavePtr;
+ int new, map;
+ Tk_Window ancestor, parent;
+
+ if (!initialized) {
+ initialized = 1;
+ Tcl_InitHashTable(&maintainHashTable, TCL_ONE_WORD_KEYS);
+ }
+
+ /*
+ * See if there is already a MaintainMaster structure for the master;
+ * if not, then create one.
+ */
+
+ parent = Tk_Parent(slave);
+ hPtr = Tcl_CreateHashEntry(&maintainHashTable, (char *) master, &new);
+ if (!new) {
+ masterPtr = (MaintainMaster *) Tcl_GetHashValue(hPtr);
+ } else {
+ masterPtr = (MaintainMaster *) ckalloc(sizeof(MaintainMaster));
+ masterPtr->ancestor = master;
+ masterPtr->checkScheduled = 0;
+ masterPtr->slavePtr = NULL;
+ Tcl_SetHashValue(hPtr, masterPtr);
+ }
+
+ /*
+ * Create a MaintainSlave structure for the slave if there isn't
+ * already one.
+ */
+
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ if (slavePtr->slave == slave) {
+ goto gotSlave;
+ }
+ }
+ slavePtr = (MaintainSlave *) ckalloc(sizeof(MaintainSlave));
+ slavePtr->slave = slave;
+ slavePtr->master = master;
+ slavePtr->nextPtr = masterPtr->slavePtr;
+ masterPtr->slavePtr = slavePtr;
+ Tk_CreateEventHandler(slave, StructureNotifyMask, MaintainSlaveProc,
+ (ClientData) slavePtr);
+
+ /*
+ * Make sure that there are event handlers registered for all
+ * the windows between master and slave's parent (including master
+ * but not slave's parent). There may already be handlers for master
+ * and some of its ancestors (masterPtr->ancestor tells how many).
+ */
+
+ for (ancestor = master; ancestor != parent;
+ ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == masterPtr->ancestor) {
+ Tk_CreateEventHandler(ancestor, StructureNotifyMask,
+ MaintainMasterProc, (ClientData) masterPtr);
+ masterPtr->ancestor = Tk_Parent(ancestor);
+ }
+ }
+
+ /*
+ * Fill in up-to-date information in the structure, then update the
+ * window if it's not currently in the right place or state.
+ */
+
+ gotSlave:
+ slavePtr->x = x;
+ slavePtr->y = y;
+ slavePtr->width = width;
+ slavePtr->height = height;
+ map = 1;
+ for (ancestor = slavePtr->master; ; ancestor = Tk_Parent(ancestor)) {
+ if (!Tk_IsMapped(ancestor) && (ancestor != parent)) {
+ map = 0;
+ }
+ if (ancestor == parent) {
+ if ((x != Tk_X(slavePtr->slave))
+ || (y != Tk_Y(slavePtr->slave))
+ || (width != Tk_Width(slavePtr->slave))
+ || (height != Tk_Height(slavePtr->slave))) {
+ Tk_MoveResizeWindow(slavePtr->slave, x, y, width, height);
+ }
+ if (map) {
+ Tk_MapWindow(slavePtr->slave);
+ } else {
+ Tk_UnmapWindow(slavePtr->slave);
+ }
+ break;
+ }
+ x += Tk_X(ancestor) + Tk_Changes(ancestor)->border_width;
+ y += Tk_Y(ancestor) + Tk_Changes(ancestor)->border_width;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_UnmaintainGeometry --
+ *
+ * This procedure cancels a previous Tk_MaintainGeometry call,
+ * so that the relationship between slave and master is no longer
+ * maintained.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The slave is unmapped and state is released, so that slave won't
+ * track master any more. If we weren't previously managing slave
+ * relative to master, then this procedure has no effect.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_UnmaintainGeometry(slave, master)
+ Tk_Window slave; /* Slave for geometry management. */
+ Tk_Window master; /* Master for slave; must be a descendant
+ * of slave's parent. */
+{
+ Tcl_HashEntry *hPtr;
+ MaintainMaster *masterPtr;
+ register MaintainSlave *slavePtr, *prevPtr;
+ Tk_Window ancestor;
+
+ if (!initialized) {
+ initialized = 1;
+ Tcl_InitHashTable(&maintainHashTable, TCL_ONE_WORD_KEYS);
+ }
+
+ if (!(((TkWindow *) slave)->flags & TK_ALREADY_DEAD)) {
+ Tk_UnmapWindow(slave);
+ }
+ hPtr = Tcl_FindHashEntry(&maintainHashTable, (char *) master);
+ if (hPtr == NULL) {
+ return;
+ }
+ masterPtr = (MaintainMaster *) Tcl_GetHashValue(hPtr);
+ slavePtr = masterPtr->slavePtr;
+ if (slavePtr->slave == slave) {
+ masterPtr->slavePtr = slavePtr->nextPtr;
+ } else {
+ for (prevPtr = slavePtr, slavePtr = slavePtr->nextPtr; ;
+ prevPtr = slavePtr, slavePtr = slavePtr->nextPtr) {
+ if (slavePtr == NULL) {
+ return;
+ }
+ if (slavePtr->slave == slave) {
+ prevPtr->nextPtr = slavePtr->nextPtr;
+ break;
+ }
+ }
+ }
+ Tk_DeleteEventHandler(slavePtr->slave, StructureNotifyMask,
+ MaintainSlaveProc, (ClientData) slavePtr);
+ ckfree((char *) slavePtr);
+ if (masterPtr->slavePtr == NULL) {
+ if (masterPtr->ancestor != NULL) {
+ for (ancestor = master; ; ancestor = Tk_Parent(ancestor)) {
+ Tk_DeleteEventHandler(ancestor, StructureNotifyMask,
+ MaintainMasterProc, (ClientData) masterPtr);
+ if (ancestor == masterPtr->ancestor) {
+ break;
+ }
+ }
+ }
+ if (masterPtr->checkScheduled) {
+ Tcl_CancelIdleCall(MaintainCheckProc, (ClientData) masterPtr);
+ }
+ Tcl_DeleteHashEntry(hPtr);
+ ckfree((char *) masterPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MaintainMasterProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher in
+ * response to StructureNotify events on the master or one
+ * of its ancestors, on behalf of Tk_MaintainGeometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * It schedules a call to MaintainCheckProc, which will eventually
+ * caused the postions and mapped states to be recalculated for all
+ * the maintained slaves of the master. Or, if the master window is
+ * being deleted then state is cleaned up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MaintainMasterProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to MaintainMaster structure
+ * for the master window. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ MaintainMaster *masterPtr = (MaintainMaster *) clientData;
+ MaintainSlave *slavePtr;
+ int done;
+
+ if ((eventPtr->type == ConfigureNotify)
+ || (eventPtr->type == MapNotify)
+ || (eventPtr->type == UnmapNotify)) {
+ if (!masterPtr->checkScheduled) {
+ masterPtr->checkScheduled = 1;
+ Tcl_DoWhenIdle(MaintainCheckProc, (ClientData) masterPtr);
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ /*
+ * Delete all of the state associated with this master, but
+ * be careful not to use masterPtr after the last slave is
+ * deleted, since its memory will have been freed.
+ */
+
+ done = 0;
+ do {
+ slavePtr = masterPtr->slavePtr;
+ if (slavePtr->nextPtr == NULL) {
+ done = 1;
+ }
+ Tk_UnmaintainGeometry(slavePtr->slave, slavePtr->master);
+ } while (!done);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MaintainSlaveProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher in
+ * response to StructureNotify events on a slave being managed
+ * by Tk_MaintainGeometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If the event is a DestroyNotify event then the Maintain state
+ * and event handlers for this slave are deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MaintainSlaveProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to MaintainSlave structure
+ * for master-slave pair. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ MaintainSlave *slavePtr = (MaintainSlave *) clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ Tk_UnmaintainGeometry(slavePtr->slave, slavePtr->master);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MaintainCheckProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher as an
+ * idle handler, when a master or one of its ancestors has been
+ * reconfigured, mapped, or unmapped. Its job is to scan all of
+ * the slaves for the master and reposition them, map them, or
+ * unmap them as needed to maintain their geometry relative to
+ * the master.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Slaves can get repositioned, mapped, or unmapped.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MaintainCheckProc(clientData)
+ ClientData clientData; /* Pointer to MaintainMaster structure
+ * for the master window. */
+{
+ MaintainMaster *masterPtr = (MaintainMaster *) clientData;
+ MaintainSlave *slavePtr;
+ Tk_Window ancestor, parent;
+ int x, y, map;
+
+ masterPtr->checkScheduled = 0;
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ parent = Tk_Parent(slavePtr->slave);
+ x = slavePtr->x;
+ y = slavePtr->y;
+ map = 1;
+ for (ancestor = slavePtr->master; ; ancestor = Tk_Parent(ancestor)) {
+ if (!Tk_IsMapped(ancestor) && (ancestor != parent)) {
+ map = 0;
+ }
+ if (ancestor == parent) {
+ if ((x != Tk_X(slavePtr->slave))
+ || (y != Tk_Y(slavePtr->slave))) {
+ Tk_MoveWindow(slavePtr->slave, x, y);
+ }
+ if (map) {
+ Tk_MapWindow(slavePtr->slave);
+ } else {
+ Tk_UnmapWindow(slavePtr->slave);
+ }
+ break;
+ }
+ x += Tk_X(ancestor) + Tk_Changes(ancestor)->border_width;
+ y += Tk_Y(ancestor) + Tk_Changes(ancestor)->border_width;
+ }
+ }
+}
diff --git a/generic/tkGet.c b/generic/tkGet.c
new file mode 100644
index 0000000..56258a6
--- /dev/null
+++ b/generic/tkGet.c
@@ -0,0 +1,586 @@
+/*
+ * tkGet.c --
+ *
+ * This file contains a number of "Tk_GetXXX" procedures, which
+ * parse text strings into useful forms for Tk. This file has
+ * the simpler procedures, like Tk_GetDirection and Tk_GetUid.
+ * The more complex procedures like Tk_GetColor are in separate
+ * files.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkGet.c 1.13 96/04/26 10:25:46
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * The hash table below is used to keep track of all the Tk_Uids created
+ * so far.
+ */
+
+static Tcl_HashTable uidTable;
+static int initialized = 0;
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetAnchor --
+ *
+ * Given a string, return the corresponding Tk_Anchor.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If
+ * TCL_OK is returned, then everything went well and the
+ * position is stored at *anchorPtr; otherwise TCL_ERROR
+ * is returned and an error message is left in
+ * interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetAnchor(interp, string, anchorPtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ char *string; /* String describing a direction. */
+ Tk_Anchor *anchorPtr; /* Where to store Tk_Anchor corresponding
+ * to string. */
+{
+ switch (string[0]) {
+ case 'n':
+ if (string[1] == 0) {
+ *anchorPtr = TK_ANCHOR_N;
+ return TCL_OK;
+ } else if ((string[1] == 'e') && (string[2] == 0)) {
+ *anchorPtr = TK_ANCHOR_NE;
+ return TCL_OK;
+ } else if ((string[1] == 'w') && (string[2] == 0)) {
+ *anchorPtr = TK_ANCHOR_NW;
+ return TCL_OK;
+ }
+ goto error;
+ case 's':
+ if (string[1] == 0) {
+ *anchorPtr = TK_ANCHOR_S;
+ return TCL_OK;
+ } else if ((string[1] == 'e') && (string[2] == 0)) {
+ *anchorPtr = TK_ANCHOR_SE;
+ return TCL_OK;
+ } else if ((string[1] == 'w') && (string[2] == 0)) {
+ *anchorPtr = TK_ANCHOR_SW;
+ return TCL_OK;
+ } else {
+ goto error;
+ }
+ case 'e':
+ if (string[1] == 0) {
+ *anchorPtr = TK_ANCHOR_E;
+ return TCL_OK;
+ }
+ goto error;
+ case 'w':
+ if (string[1] == 0) {
+ *anchorPtr = TK_ANCHOR_W;
+ return TCL_OK;
+ }
+ goto error;
+ case 'c':
+ if (strncmp(string, "center", strlen(string)) == 0) {
+ *anchorPtr = TK_ANCHOR_CENTER;
+ return TCL_OK;
+ }
+ goto error;
+ }
+
+ error:
+ Tcl_AppendResult(interp, "bad anchor position \"", string,
+ "\": must be n, ne, e, se, s, sw, w, nw, or center",
+ (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfAnchor --
+ *
+ * Given a Tk_Anchor, return the string that corresponds
+ * to it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_NameOfAnchor(anchor)
+ Tk_Anchor anchor; /* Anchor for which identifying string
+ * is desired. */
+{
+ switch (anchor) {
+ case TK_ANCHOR_N: return "n";
+ case TK_ANCHOR_NE: return "ne";
+ case TK_ANCHOR_E: return "e";
+ case TK_ANCHOR_SE: return "se";
+ case TK_ANCHOR_S: return "s";
+ case TK_ANCHOR_SW: return "sw";
+ case TK_ANCHOR_W: return "w";
+ case TK_ANCHOR_NW: return "nw";
+ case TK_ANCHOR_CENTER: return "center";
+ }
+ return "unknown anchor position";
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetJoinStyle --
+ *
+ * Given a string, return the corresponding Tk_JoinStyle.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If
+ * TCL_OK is returned, then everything went well and the
+ * justification is stored at *joinPtr; otherwise
+ * TCL_ERROR is returned and an error message is left in
+ * interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetJoinStyle(interp, string, joinPtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ char *string; /* String describing a justification style. */
+ int *joinPtr; /* Where to store join style corresponding
+ * to string. */
+{
+ int c;
+ size_t length;
+
+ c = string[0];
+ length = strlen(string);
+
+ if ((c == 'b') && (strncmp(string, "bevel", length) == 0)) {
+ *joinPtr = JoinBevel;
+ return TCL_OK;
+ }
+ if ((c == 'm') && (strncmp(string, "miter", length) == 0)) {
+ *joinPtr = JoinMiter;
+ return TCL_OK;
+ }
+ if ((c == 'r') && (strncmp(string, "round", length) == 0)) {
+ *joinPtr = JoinRound;
+ return TCL_OK;
+ }
+
+ Tcl_AppendResult(interp, "bad join style \"", string,
+ "\": must be bevel, miter, or round",
+ (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfJoinStyle --
+ *
+ * Given a Tk_JoinStyle, return the string that corresponds
+ * to it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_NameOfJoinStyle(join)
+ int join; /* Join style for which identifying string
+ * is desired. */
+{
+ switch (join) {
+ case JoinBevel: return "bevel";
+ case JoinMiter: return "miter";
+ case JoinRound: return "round";
+ }
+ return "unknown join style";
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetCapStyle --
+ *
+ * Given a string, return the corresponding Tk_CapStyle.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If
+ * TCL_OK is returned, then everything went well and the
+ * justification is stored at *capPtr; otherwise
+ * TCL_ERROR is returned and an error message is left in
+ * interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetCapStyle(interp, string, capPtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ char *string; /* String describing a justification style. */
+ int *capPtr; /* Where to store cap style corresponding
+ * to string. */
+{
+ int c;
+ size_t length;
+
+ c = string[0];
+ length = strlen(string);
+
+ if ((c == 'b') && (strncmp(string, "butt", length) == 0)) {
+ *capPtr = CapButt;
+ return TCL_OK;
+ }
+ if ((c == 'p') && (strncmp(string, "projecting", length) == 0)) {
+ *capPtr = CapProjecting;
+ return TCL_OK;
+ }
+ if ((c == 'r') && (strncmp(string, "round", length) == 0)) {
+ *capPtr = CapRound;
+ return TCL_OK;
+ }
+
+ Tcl_AppendResult(interp, "bad cap style \"", string,
+ "\": must be butt, projecting, or round",
+ (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfCapStyle --
+ *
+ * Given a Tk_CapStyle, return the string that corresponds
+ * to it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_NameOfCapStyle(cap)
+ int cap; /* Cap style for which identifying string
+ * is desired. */
+{
+ switch (cap) {
+ case CapButt: return "butt";
+ case CapProjecting: return "projecting";
+ case CapRound: return "round";
+ }
+ return "unknown cap style";
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetJustify --
+ *
+ * Given a string, return the corresponding Tk_Justify.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If
+ * TCL_OK is returned, then everything went well and the
+ * justification is stored at *justifyPtr; otherwise
+ * TCL_ERROR is returned and an error message is left in
+ * interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetJustify(interp, string, justifyPtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ char *string; /* String describing a justification style. */
+ Tk_Justify *justifyPtr; /* Where to store Tk_Justify corresponding
+ * to string. */
+{
+ int c;
+ size_t length;
+
+ c = string[0];
+ length = strlen(string);
+
+ if ((c == 'l') && (strncmp(string, "left", length) == 0)) {
+ *justifyPtr = TK_JUSTIFY_LEFT;
+ return TCL_OK;
+ }
+ if ((c == 'r') && (strncmp(string, "right", length) == 0)) {
+ *justifyPtr = TK_JUSTIFY_RIGHT;
+ return TCL_OK;
+ }
+ if ((c == 'c') && (strncmp(string, "center", length) == 0)) {
+ *justifyPtr = TK_JUSTIFY_CENTER;
+ return TCL_OK;
+ }
+
+ Tcl_AppendResult(interp, "bad justification \"", string,
+ "\": must be left, right, or center",
+ (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfJustify --
+ *
+ * Given a Tk_Justify, return the string that corresponds
+ * to it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_NameOfJustify(justify)
+ Tk_Justify justify; /* Justification style for which
+ * identifying string is desired. */
+{
+ switch (justify) {
+ case TK_JUSTIFY_LEFT: return "left";
+ case TK_JUSTIFY_RIGHT: return "right";
+ case TK_JUSTIFY_CENTER: return "center";
+ }
+ return "unknown justification style";
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetUid --
+ *
+ * Given a string, this procedure returns a unique identifier
+ * for the string.
+ *
+ * Results:
+ * This procedure returns a Tk_Uid corresponding to the "string"
+ * argument. The Tk_Uid has a string value identical to string
+ * (strcmp will return 0), but it's guaranteed that any other
+ * calls to this procedure with a string equal to "string" will
+ * return exactly the same result (i.e. can compare Tk_Uid
+ * *values* directly, without having to call strcmp on what they
+ * point to).
+ *
+ * Side effects:
+ * New information may be entered into the identifier table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Uid
+Tk_GetUid(string)
+ CONST char *string; /* String to convert. */
+{
+ int dummy;
+
+ if (!initialized) {
+ Tcl_InitHashTable(&uidTable, TCL_STRING_KEYS);
+ initialized = 1;
+ }
+ return (Tk_Uid) Tcl_GetHashKey(&uidTable,
+ Tcl_CreateHashEntry(&uidTable, string, &dummy));
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetScreenMM --
+ *
+ * Given a string, returns the number of screen millimeters
+ * corresponding to that string.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If
+ * TCL_OK is returned, then everything went well and the
+ * screen distance is stored at *doublePtr; otherwise
+ * TCL_ERROR is returned and an error message is left in
+ * interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetScreenMM(interp, tkwin, string, doublePtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ Tk_Window tkwin; /* Window whose screen determines conversion
+ * from centimeters and other absolute
+ * units. */
+ char *string; /* String describing a screen distance. */
+ double *doublePtr; /* Place to store converted result. */
+{
+ char *end;
+ double d;
+
+ d = strtod(string, &end);
+ if (end == string) {
+ error:
+ Tcl_AppendResult(interp, "bad screen distance \"", string,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ switch (*end) {
+ case 0:
+ d /= WidthOfScreen(Tk_Screen(tkwin));
+ d *= WidthMMOfScreen(Tk_Screen(tkwin));
+ break;
+ case 'c':
+ d *= 10;
+ end++;
+ break;
+ case 'i':
+ d *= 25.4;
+ end++;
+ break;
+ case 'm':
+ end++;
+ break;
+ case 'p':
+ d *= 25.4/72.0;
+ end++;
+ break;
+ default:
+ goto error;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ if (*end != 0) {
+ goto error;
+ }
+ *doublePtr = d;
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetPixels --
+ *
+ * Given a string, returns the number of pixels corresponding
+ * to that string.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If
+ * TCL_OK is returned, then everything went well and the
+ * rounded pixel distance is stored at *intPtr; otherwise
+ * TCL_ERROR is returned and an error message is left in
+ * interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetPixels(interp, tkwin, string, intPtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ Tk_Window tkwin; /* Window whose screen determines conversion
+ * from centimeters and other absolute
+ * units. */
+ char *string; /* String describing a justification style. */
+ int *intPtr; /* Place to store converted result. */
+{
+ char *end;
+ double d;
+
+ d = strtod(string, &end);
+ if (end == string) {
+ error:
+ Tcl_AppendResult(interp, "bad screen distance \"", string,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ switch (*end) {
+ case 0:
+ break;
+ case 'c':
+ d *= 10*WidthOfScreen(Tk_Screen(tkwin));
+ d /= WidthMMOfScreen(Tk_Screen(tkwin));
+ end++;
+ break;
+ case 'i':
+ d *= 25.4*WidthOfScreen(Tk_Screen(tkwin));
+ d /= WidthMMOfScreen(Tk_Screen(tkwin));
+ end++;
+ break;
+ case 'm':
+ d *= WidthOfScreen(Tk_Screen(tkwin));
+ d /= WidthMMOfScreen(Tk_Screen(tkwin));
+ end++;
+ break;
+ case 'p':
+ d *= (25.4/72.0)*WidthOfScreen(Tk_Screen(tkwin));
+ d /= WidthMMOfScreen(Tk_Screen(tkwin));
+ end++;
+ break;
+ default:
+ goto error;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ if (*end != 0) {
+ goto error;
+ }
+ if (d < 0) {
+ *intPtr = (int) (d - 0.5);
+ } else {
+ *intPtr = (int) (d + 0.5);
+ }
+ return TCL_OK;
+}
diff --git a/generic/tkGrab.c b/generic/tkGrab.c
new file mode 100644
index 0000000..869e0b3
--- /dev/null
+++ b/generic/tkGrab.c
@@ -0,0 +1,1535 @@
+/*
+ * tkGrab.c --
+ *
+ * This file provides procedures that implement grabs for Tk.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkGrab.c 1.52 97/03/21 11:14:34
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * The grab state machine has four states: ungrabbed, button pressed,
+ * grabbed, and button pressed while grabbed. In addition, there are
+ * three pieces of grab state information: the current grab window,
+ * the current restrict window, and whether the mouse is captured.
+ *
+ * The current grab window specifies the point in the Tk window
+ * heirarchy above which pointer events will not be reported. Any
+ * window within the subtree below the grab window will continue to
+ * receive events as normal. Events outside of the grab tree will be
+ * reported to the grab window.
+ *
+ * If the current restrict window is set, then all pointer events will
+ * be reported only to the restrict window. The restrict window is
+ * normally set during an automatic button grab.
+ *
+ * The mouse capture state specifies whether the window system will
+ * report mouse events outside of any Tk toplevels. This is set
+ * during a global grab or an automatic button grab.
+ *
+ * The transitions between different states is given in the following
+ * table:
+ *
+ * Event\State U B G GB
+ * ----------- -- -- -- --
+ * FirstPress B B GB GB
+ * Press B B G GB
+ * Release U B G GB
+ * LastRelease U U G G
+ * Grab G G G G
+ * Ungrab U B U U
+ *
+ * Note: U=Ungrabbed, B=Button, G=Grabbed, GB=Grab and Button
+ *
+ * In addition, the following conditions are always true:
+ *
+ * State\Variable Grab Restrict Capture
+ * -------------- ---- -------- -------
+ * Ungrabbed 0 0 0
+ * Button 0 1 1
+ * Grabbed 1 0 b/g
+ * Grab and Button 1 1 1
+ *
+ * Note: 0 means variable is set to NULL, 1 means variable is set to
+ * some window, b/g means the variable is set to a window if a button
+ * is currently down or a global grab is in effect.
+ *
+ * The final complication to all of this is enter and leave events.
+ * In order to correctly handle all of the various cases, Tk cannot
+ * rely on X enter/leave events in all situations. The following
+ * describes the correct sequence of enter and leave events that
+ * should be observed by Tk scripts:
+ *
+ * Event(state) Enter/Leave From -> To
+ * ------------ ----------------------
+ * LastRelease(B | GB): restrict window -> anc(grab window, event window)
+ * Grab(U | B): event window -> anc(grab window, event window)
+ * Grab(G): anc(old grab window, event window) ->
+ * anc(new grab window, event window)
+ * Grab(GB): restrict window -> anc(new grab window, event window)
+ * Ungrab(G): anc(grab window, event window) -> event window
+ * Ungrab(GB): restrict window -> event window
+ *
+ * Note: anc(x,y) returns the least ancestor of y that is in the tree
+ * of x, terminating at toplevels.
+ */
+
+/*
+ * The following structure is used to pass information to
+ * GrabRestrictProc from EatGrabEvents.
+ */
+
+typedef struct {
+ Display *display; /* Display from which to discard events. */
+ unsigned int serial; /* Serial number with which to compare. */
+} GrabInfo;
+
+/*
+ * Bit definitions for grabFlags field of TkDisplay structures:
+ *
+ * GRAB_GLOBAL 1 means this is a global grab (we grabbed via
+ * the server so all applications are locked out).
+ * 0 means this is a local grab that affects
+ * only this application.
+ * GRAB_TEMP_GLOBAL 1 means we've temporarily grabbed via the
+ * server because a button is down and we want
+ * to make sure that we get the button-up
+ * event. The grab will be released when the
+ * last mouse button goes up.
+ */
+
+#define GRAB_GLOBAL 1
+#define GRAB_TEMP_GLOBAL 4
+
+/*
+ * The following structure is a Tcl_Event that triggers a change in
+ * the grabWinPtr field of a display. This event guarantees that
+ * the change occurs in the proper order relative to enter and leave
+ * events.
+ */
+
+typedef struct NewGrabWinEvent {
+ Tcl_Event header; /* Standard information for all Tcl events. */
+ TkDisplay *dispPtr; /* Display whose grab window is to change. */
+ Window grabWindow; /* New grab window for display. This is
+ * recorded instead of a (TkWindow *) because
+ * it will allow us to detect cases where
+ * the window is destroyed before this event
+ * is processed. */
+} NewGrabWinEvent;
+
+/*
+ * The following magic value is stored in the "send_event" field of
+ * EnterNotify and LeaveNotify events that are generated in this
+ * file. This allows us to separate "real" events coming from the
+ * server from those that we generated.
+ */
+
+#define GENERATED_EVENT_MAGIC ((Bool) 0x147321ac)
+
+/*
+ * Mask that selects any of the state bits corresponding to buttons,
+ * plus masks that select individual buttons' bits:
+ */
+
+#define ALL_BUTTONS \
+ (Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask)
+static unsigned int buttonStates[] = {
+ Button1Mask, Button2Mask, Button3Mask, Button4Mask, Button5Mask
+};
+
+/*
+ * Forward declarations for procedures declared later in this file:
+ */
+
+static void EatGrabEvents _ANSI_ARGS_((TkDisplay *dispPtr,
+ unsigned int serial));
+static TkWindow * FindCommonAncestor _ANSI_ARGS_((TkWindow *winPtr1,
+ TkWindow *winPtr2, int *countPtr1,
+ int *countPtr2));
+static Tk_RestrictAction GrabRestrictProc _ANSI_ARGS_((ClientData arg,
+ XEvent *eventPtr));
+static int GrabWinEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
+ int flags));
+static void MovePointer2 _ANSI_ARGS_((TkWindow *sourcePtr,
+ TkWindow *destPtr, int mode, int leaveEvents,
+ int EnterEvents));
+static void QueueGrabWindowChange _ANSI_ARGS_((TkDisplay *dispPtr,
+ TkWindow *grabWinPtr));
+static void ReleaseButtonGrab _ANSI_ARGS_((TkDisplay *dispPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GrabCmd --
+ *
+ * This procedure is invoked to process the "grab" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tk_GrabCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ int globalGrab, c;
+ Tk_Window tkwin;
+ TkDisplay *dispPtr;
+ size_t length;
+
+ if (argc < 2) {
+ badArgs:
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " ?-global? window\" or \"", argv[0],
+ " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if (c == '.') {
+ if (argc != 2) {
+ goto badArgs;
+ }
+ tkwin = Tk_NameToWindow(interp, argv[1], (Tk_Window) clientData);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ return Tk_Grab(interp, tkwin, 0);
+ } else if ((c == '-') && (strncmp(argv[1], "-global", length) == 0)
+ && (length >= 2)) {
+ if (argc != 3) {
+ goto badArgs;
+ }
+ tkwin = Tk_NameToWindow(interp, argv[2], (Tk_Window) clientData);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ return Tk_Grab(interp, tkwin, 1);
+ } else if ((c == 'c') && (strncmp(argv[1], "current", length) == 0)) {
+ if (argc > 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " current ?window?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc == 3) {
+ tkwin = Tk_NameToWindow(interp, argv[2], (Tk_Window) clientData);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ if (dispPtr->eventualGrabWinPtr != NULL) {
+ interp->result = dispPtr->eventualGrabWinPtr->pathName;
+ }
+ } else {
+ for (dispPtr = tkDisplayList; dispPtr != NULL;
+ dispPtr = dispPtr->nextPtr) {
+ if (dispPtr->eventualGrabWinPtr != NULL) {
+ Tcl_AppendElement(interp,
+ dispPtr->eventualGrabWinPtr->pathName);
+ }
+ }
+ }
+ return TCL_OK;
+ } else if ((c == 'r') && (strncmp(argv[1], "release", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " release window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp, argv[2], (Tk_Window) clientData);
+ if (tkwin == NULL) {
+ Tcl_ResetResult(interp);
+ } else {
+ Tk_Ungrab(tkwin);
+ }
+ } else if ((c == 's') && (strncmp(argv[1], "set", length) == 0)
+ && (length >= 2)) {
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " set ?-global? window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc == 3) {
+ globalGrab = 0;
+ tkwin = Tk_NameToWindow(interp, argv[2], (Tk_Window) clientData);
+ } else {
+ globalGrab = 1;
+ length = strlen(argv[2]);
+ if ((strncmp(argv[2], "-global", length) != 0) || (length < 2)) {
+ Tcl_AppendResult(interp, "bad argument \"", argv[2],
+ "\": must be \"", argv[0], " set ?-global? window\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp, argv[3], (Tk_Window) clientData);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ return Tk_Grab(interp, tkwin, globalGrab);
+ } else if ((c == 's') && (strncmp(argv[1], "status", length) == 0)
+ && (length >= 2)) {
+ TkWindow *winPtr;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " status window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2],
+ (Tk_Window) clientData);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ dispPtr = winPtr->dispPtr;
+ if (dispPtr->eventualGrabWinPtr != winPtr) {
+ interp->result = "none";
+ } else if (dispPtr->grabFlags & GRAB_GLOBAL) {
+ interp->result = "global";
+ } else {
+ interp->result = "local";
+ }
+ } else {
+ Tcl_AppendResult(interp, "unknown or ambiguous option \"", argv[1],
+ "\": must be current, release, set, or status",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Grab --
+ *
+ * Grabs the pointer and keyboard, so that mouse-related events are
+ * only reported relative to a given window and its descendants.
+ *
+ * Results:
+ * A standard Tcl result is returned. TCL_OK is the normal return
+ * value; if the grab could not be set then TCL_ERROR is returned
+ * and interp->result will hold an error message.
+ *
+ * Side effects:
+ * Once this call completes successfully, no window outside the
+ * tree rooted at tkwin will receive pointer- or keyboard-related
+ * events until the next call to Tk_Ungrab. If a previous grab was
+ * in effect within this application, then it is replaced with a new
+ * one.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_Grab(interp, tkwin, grabGlobal)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Window tkwin; /* Window on whose behalf the pointer
+ * is to be grabbed. */
+ int grabGlobal; /* Non-zero means issue a grab to the
+ * server so that no other application
+ * gets mouse or keyboard events.
+ * Zero means the grab only applies
+ * within this application. */
+{
+ int grabResult, numTries;
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkWindow *winPtr2;
+ unsigned int serial;
+
+ ReleaseButtonGrab(dispPtr);
+ if (dispPtr->eventualGrabWinPtr != NULL) {
+ if ((dispPtr->eventualGrabWinPtr == winPtr)
+ && (grabGlobal == ((dispPtr->grabFlags & GRAB_GLOBAL) != 0))) {
+ return TCL_OK;
+ }
+ if (dispPtr->eventualGrabWinPtr->mainPtr != winPtr->mainPtr) {
+ alreadyGrabbed:
+ interp->result = "grab failed: another application has grab";
+ return TCL_ERROR;
+ }
+ Tk_Ungrab((Tk_Window) dispPtr->eventualGrabWinPtr);
+ }
+
+ Tk_MakeWindowExist(tkwin);
+ if (!grabGlobal) {
+ Window dummy1, dummy2;
+ int dummy3, dummy4, dummy5, dummy6;
+ unsigned int state;
+
+ /*
+ * Local grab. However, if any mouse buttons are down, turn
+ * it into a global grab temporarily, until the last button
+ * goes up. This does two things: (a) it makes sure that we
+ * see the button-up event; and (b) it allows us to track mouse
+ * motion among all of the windows of this application.
+ */
+
+ dispPtr->grabFlags &= ~(GRAB_GLOBAL|GRAB_TEMP_GLOBAL);
+ XQueryPointer(dispPtr->display, winPtr->window, &dummy1,
+ &dummy2, &dummy3, &dummy4, &dummy5, &dummy6, &state);
+ if ((state & ALL_BUTTONS) != 0) {
+ dispPtr->grabFlags |= GRAB_TEMP_GLOBAL;
+ goto setGlobalGrab;
+ }
+ } else {
+ dispPtr->grabFlags |= GRAB_GLOBAL;
+ setGlobalGrab:
+
+ /*
+ * Tricky point: must ungrab before grabbing. This is needed
+ * in case there is a button auto-grab already in effect. If
+ * there is, and the mouse has moved to a different window, X
+ * won't generate enter and leave events to move the mouse if
+ * we grab without ungrabbing.
+ */
+
+ XUngrabPointer(dispPtr->display, CurrentTime);
+ serial = NextRequest(dispPtr->display);
+
+ /*
+ * Another tricky point: there are races with some window
+ * managers that can cause grabs to fail because the window
+ * manager hasn't released its grab quickly enough. To work
+ * around this problem, retry a few times after AlreadyGrabbed
+ * errors to give the grab release enough time to register with
+ * the server.
+ */
+
+ grabResult = 0; /* Needed only to prevent gcc
+ * compiler warnings. */
+ for (numTries = 0; numTries < 10; numTries++) {
+ grabResult = XGrabPointer(dispPtr->display, winPtr->window,
+ True, ButtonPressMask|ButtonReleaseMask|ButtonMotionMask
+ |PointerMotionMask, GrabModeAsync, GrabModeAsync, None,
+ None, CurrentTime);
+ if (grabResult != AlreadyGrabbed) {
+ break;
+ }
+ Tcl_Sleep(100);
+ }
+ if (grabResult != 0) {
+ grabError:
+ if (grabResult == GrabNotViewable) {
+ interp->result = "grab failed: window not viewable";
+ } else if (grabResult == AlreadyGrabbed) {
+ goto alreadyGrabbed;
+ } else if (grabResult == GrabFrozen) {
+ interp->result = "grab failed: keyboard or pointer frozen";
+ } else if (grabResult == GrabInvalidTime) {
+ interp->result = "grab failed: invalid time";
+ } else {
+ char msg[100];
+
+ sprintf(msg, "grab failed for unknown reason (code %d)",
+ grabResult);
+ Tcl_AppendResult(interp, msg, (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ grabResult = XGrabKeyboard(dispPtr->display, Tk_WindowId(tkwin),
+ False, GrabModeAsync, GrabModeAsync, CurrentTime);
+ if (grabResult != 0) {
+ XUngrabPointer(dispPtr->display, CurrentTime);
+ goto grabError;
+ }
+
+ /*
+ * Eat up any grab-related events generated by the server for the
+ * grab. There are several reasons for doing this:
+ *
+ * 1. We have to synthesize the events for local grabs anyway, since
+ * the server doesn't participate in them.
+ * 2. The server doesn't always generate the right events for global
+ * grabs (e.g. it generates events even if the current window is
+ * in the grab tree, which we don't want).
+ * 3. We want all the grab-related events to be processed immediately
+ * (before other events that are already queued); events coming
+ * from the server will be in the wrong place, but events we
+ * synthesize here will go to the front of the queue.
+ */
+
+ EatGrabEvents(dispPtr, serial);
+ }
+
+ /*
+ * Synthesize leave events to move the pointer from its current window
+ * up to the lowest ancestor that it has in common with the grab window.
+ * However, only do this if the pointer is outside the grab window's
+ * subtree but inside the grab window's application.
+ */
+
+ if ((dispPtr->serverWinPtr != NULL)
+ && (dispPtr->serverWinPtr->mainPtr == winPtr->mainPtr)) {
+ for (winPtr2 = dispPtr->serverWinPtr; ; winPtr2 = winPtr2->parentPtr) {
+ if (winPtr2 == winPtr) {
+ break;
+ }
+ if (winPtr2 == NULL) {
+ MovePointer2(dispPtr->serverWinPtr, winPtr, NotifyGrab, 1, 0);
+ break;
+ }
+ }
+ }
+ QueueGrabWindowChange(dispPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Ungrab --
+ *
+ * Releases a grab on the mouse pointer and keyboard, if there
+ * is one set on the specified window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Pointer and keyboard events will start being delivered to other
+ * windows again.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_Ungrab(tkwin)
+ Tk_Window tkwin; /* Window whose grab should be
+ * released. */
+{
+ TkDisplay *dispPtr;
+ TkWindow *grabWinPtr, *winPtr;
+ unsigned int serial;
+
+ grabWinPtr = (TkWindow *) tkwin;
+ dispPtr = grabWinPtr->dispPtr;
+ if (grabWinPtr != dispPtr->eventualGrabWinPtr) {
+ return;
+ }
+ ReleaseButtonGrab(dispPtr);
+ QueueGrabWindowChange(dispPtr, (TkWindow *) NULL);
+ if (dispPtr->grabFlags & (GRAB_GLOBAL|GRAB_TEMP_GLOBAL)) {
+ dispPtr->grabFlags &= ~(GRAB_GLOBAL|GRAB_TEMP_GLOBAL);
+ serial = NextRequest(dispPtr->display);
+ XUngrabPointer(dispPtr->display, CurrentTime);
+ XUngrabKeyboard(dispPtr->display, CurrentTime);
+ EatGrabEvents(dispPtr, serial);
+ }
+
+ /*
+ * Generate events to move the pointer back to the window where it
+ * really is. Some notes:
+ * 1. As with grabs, only do this if the "real" window is not a
+ * descendant of the grab window, since in this case the pointer
+ * is already where it's supposed to be.
+ * 2. If the "real" window is in some other application then don't
+ * generate any events at all, since everything's already been
+ * reported correctly.
+ * 3. Only generate enter events. Don't generate leave events,
+ * because we never told the lower-level windows that they
+ * had the pointer in the first place.
+ */
+
+ for (winPtr = dispPtr->serverWinPtr; ; winPtr = winPtr->parentPtr) {
+ if (winPtr == grabWinPtr) {
+ break;
+ }
+ if (winPtr == NULL) {
+ if ((dispPtr->serverWinPtr == NULL) ||
+ (dispPtr->serverWinPtr->mainPtr == grabWinPtr->mainPtr)) {
+ MovePointer2(grabWinPtr, dispPtr->serverWinPtr,
+ NotifyUngrab, 0, 1);
+ }
+ break;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReleaseButtonGrab --
+ *
+ * This procedure is called to release a simulated button grab, if
+ * there is one in effect. A button grab is present whenever
+ * dispPtr->buttonWinPtr is non-NULL or when the GRAB_TEMP_GLOBAL
+ * flag is set.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * DispPtr->buttonWinPtr is reset to NULL, and enter and leave
+ * events are generated if necessary to move the pointer from
+ * the button grab window to its current window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ReleaseButtonGrab(dispPtr)
+ register TkDisplay *dispPtr; /* Display whose button grab is to be
+ * released. */
+{
+ unsigned int serial;
+
+ if (dispPtr->buttonWinPtr != NULL) {
+ if (dispPtr->buttonWinPtr != dispPtr->serverWinPtr) {
+ MovePointer2(dispPtr->buttonWinPtr, dispPtr->serverWinPtr,
+ NotifyUngrab, 1, 1);
+ }
+ dispPtr->buttonWinPtr = NULL;
+ }
+ if (dispPtr->grabFlags & GRAB_TEMP_GLOBAL) {
+ dispPtr->grabFlags &= ~GRAB_TEMP_GLOBAL;
+ serial = NextRequest(dispPtr->display);
+ XUngrabPointer(dispPtr->display, CurrentTime);
+ XUngrabKeyboard(dispPtr->display, CurrentTime);
+ EatGrabEvents(dispPtr, serial);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPointerEvent --
+ *
+ * This procedure is called for each pointer-related event, before
+ * the event has been processed. It does various things to make
+ * grabs work correctly.
+ *
+ * Results:
+ * If the return value is 1 it means the event should be processed
+ * (event handlers should be invoked). If the return value is 0
+ * it means the event should be ignored in order to make grabs
+ * work correctly. In some cases this procedure modifies the event.
+ *
+ * Side effects:
+ * Grab state information may be updated. New events may also be
+ * pushed back onto the event queue to replace or augment the
+ * one passed in here.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkPointerEvent(eventPtr, winPtr)
+ register XEvent *eventPtr; /* Pointer to the event. */
+ TkWindow *winPtr; /* Tk's information for window
+ * where event was reported. */
+{
+ register TkWindow *winPtr2;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ unsigned int serial;
+ int outsideGrabTree = 0;
+ int ancestorOfGrab = 0;
+ int appGrabbed = 0; /* Non-zero means event is being
+ * reported to an application that is
+ * affected by the grab. */
+
+ /*
+ * Collect information about the grab (if any).
+ */
+
+ switch (TkGrabState(winPtr)) {
+ case TK_GRAB_IN_TREE:
+ appGrabbed = 1;
+ break;
+ case TK_GRAB_ANCESTOR:
+ appGrabbed = 1;
+ outsideGrabTree = 1;
+ ancestorOfGrab = 1;
+ break;
+ case TK_GRAB_EXCLUDED:
+ appGrabbed = 1;
+ outsideGrabTree = 1;
+ break;
+ }
+
+ if ((eventPtr->type == EnterNotify) || (eventPtr->type == LeaveNotify)) {
+ /*
+ * Keep track of what window the mouse is *really* over.
+ * Any events that we generate have a special send_event value,
+ * which is detected below and used to ignore the event for
+ * purposes of setting serverWinPtr.
+ */
+
+ if (eventPtr->xcrossing.send_event != GENERATED_EVENT_MAGIC) {
+ if ((eventPtr->type == LeaveNotify) &&
+ (winPtr->flags & TK_TOP_LEVEL)) {
+ dispPtr->serverWinPtr = NULL;
+ } else {
+ dispPtr->serverWinPtr = winPtr;
+ }
+ }
+
+ /*
+ * When a grab is active, X continues to report enter and leave
+ * events for windows outside the tree of the grab window:
+ * 1. Detect these events and ignore them except for
+ * windows above the grab window.
+ * 2. Allow Enter and Leave events to pass through the
+ * windows above the grab window, but never let them
+ * end up with the pointer *in* one of those windows.
+ */
+
+ if (dispPtr->grabWinPtr != NULL) {
+ if (outsideGrabTree && appGrabbed) {
+ if (!ancestorOfGrab) {
+ return 0;
+ }
+ switch (eventPtr->xcrossing.detail) {
+ case NotifyInferior:
+ return 0;
+ case NotifyAncestor:
+ eventPtr->xcrossing.detail = NotifyVirtual;
+ break;
+ case NotifyNonlinear:
+ eventPtr->xcrossing.detail = NotifyNonlinearVirtual;
+ break;
+ }
+ }
+
+ /*
+ * Make buttons have the same grab-like behavior inside a grab
+ * as they do outside a grab: do this by ignoring enter and
+ * leave events except for the window in which the button was
+ * pressed.
+ */
+
+ if ((dispPtr->buttonWinPtr != NULL)
+ && (winPtr != dispPtr->buttonWinPtr)) {
+ return 0;
+ }
+ }
+ return 1;
+ }
+
+ if (!appGrabbed) {
+ return 1;
+ }
+
+ if (eventPtr->type == MotionNotify) {
+ /*
+ * When grabs are active, X reports motion events relative to the
+ * window under the pointer. Instead, it should report the events
+ * relative to the window the button went down in, if there is a
+ * button down. Otherwise, if the pointer window is outside the
+ * subtree of the grab window, the events should be reported
+ * relative to the grab window. Otherwise, the event should be
+ * reported to the pointer window.
+ */
+
+ winPtr2 = winPtr;
+ if (dispPtr->buttonWinPtr != NULL) {
+ winPtr2 = dispPtr->buttonWinPtr;
+ } else if (outsideGrabTree || (dispPtr->serverWinPtr == NULL)) {
+ winPtr2 = dispPtr->grabWinPtr;
+ }
+ if (winPtr2 != winPtr) {
+ TkChangeEventWindow(eventPtr, winPtr2);
+ Tk_QueueWindowEvent(eventPtr, TCL_QUEUE_HEAD);
+ return 0;
+ }
+ return 1;
+ }
+
+ /*
+ * Process ButtonPress and ButtonRelease events:
+ * 1. Keep track of whether a button is down and what window it
+ * went down in.
+ * 2. If the first button goes down outside the grab tree, pretend
+ * it went down in the grab window. Note: it's important to
+ * redirect events to the grab window like this in order to make
+ * things like menus work, where button presses outside the
+ * grabbed menu need to be seen. An application can always
+ * ignore the events if they occur outside its window.
+ * 3. If a button press or release occurs outside the window where
+ * the first button was pressed, retarget the event so it's reported
+ * to the window where the first button was pressed.
+ * 4. If the last button is released in a window different than where
+ * the first button was pressed, generate Enter/Leave events to
+ * move the mouse from the button window to its current window.
+ * 5. If the grab is set at a time when a button is already down, or
+ * if the window where the button was pressed was deleted, then
+ * dispPtr->buttonWinPtr will stay NULL. Just forget about the
+ * auto-grab for the button press; events will go to whatever
+ * window contains the pointer. If this window isn't in the grab
+ * tree then redirect events to the grab window.
+ * 6. When a button is pressed during a local grab, the X server sets
+ * a grab of its own, since it doesn't even know about our local
+ * grab. This causes enter and leave events no longer to be
+ * generated in the same way as for global grabs. To eliminate this
+ * problem, set a temporary global grab when the first button goes
+ * down and release it when the last button comes up.
+ */
+
+ if ((eventPtr->type == ButtonPress) || (eventPtr->type == ButtonRelease)) {
+ winPtr2 = dispPtr->buttonWinPtr;
+ if (winPtr2 == NULL) {
+ if (outsideGrabTree) {
+ winPtr2 = dispPtr->grabWinPtr; /* Note 5. */
+ } else {
+ winPtr2 = winPtr; /* Note 5. */
+ }
+ }
+ if (eventPtr->type == ButtonPress) {
+ if ((eventPtr->xbutton.state & ALL_BUTTONS) == 0) {
+ if (outsideGrabTree) {
+ TkChangeEventWindow(eventPtr, dispPtr->grabWinPtr);
+ Tk_QueueWindowEvent(eventPtr, TCL_QUEUE_HEAD);
+ return 0; /* Note 2. */
+ }
+ if (!(dispPtr->grabFlags & GRAB_GLOBAL)) { /* Note 6. */
+ serial = NextRequest(dispPtr->display);
+ if (XGrabPointer(dispPtr->display,
+ dispPtr->grabWinPtr->window, True,
+ ButtonPressMask|ButtonReleaseMask|ButtonMotionMask,
+ GrabModeAsync, GrabModeAsync, None, None,
+ CurrentTime) == 0) {
+ EatGrabEvents(dispPtr, serial);
+ if (XGrabKeyboard(dispPtr->display, winPtr->window,
+ False, GrabModeAsync, GrabModeAsync,
+ CurrentTime) == 0) {
+ dispPtr->grabFlags |= GRAB_TEMP_GLOBAL;
+ } else {
+ XUngrabPointer(dispPtr->display, CurrentTime);
+ }
+ }
+ }
+ dispPtr->buttonWinPtr = winPtr;
+ return 1;
+ }
+ } else {
+ if ((eventPtr->xbutton.state & ALL_BUTTONS)
+ == buttonStates[eventPtr->xbutton.button - Button1]) {
+ ReleaseButtonGrab(dispPtr); /* Note 4. */
+ }
+ }
+ if (winPtr2 != winPtr) {
+ TkChangeEventWindow(eventPtr, winPtr2);
+ Tk_QueueWindowEvent(eventPtr, TCL_QUEUE_HEAD);
+ return 0; /* Note 3. */
+ }
+ }
+
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkChangeEventWindow --
+ *
+ * Given an event and a new window to which the event should be
+ * retargeted, modify fields of the event so that the event is
+ * properly retargeted to the new window.
+ *
+ * Results:
+ * The following fields of eventPtr are modified: window,
+ * subwindow, x, y, same_screen.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkChangeEventWindow(eventPtr, winPtr)
+ register XEvent *eventPtr; /* Event to retarget. Must have
+ * type ButtonPress, ButtonRelease, KeyPress,
+ * KeyRelease, MotionNotify, EnterNotify,
+ * or LeaveNotify. */
+ TkWindow *winPtr; /* New target window for event. */
+{
+ int x, y, sameScreen, bd;
+ register TkWindow *childPtr;
+
+ eventPtr->xmotion.window = Tk_WindowId(winPtr);
+ if (eventPtr->xmotion.root ==
+ RootWindow(winPtr->display, winPtr->screenNum)) {
+ Tk_GetRootCoords((Tk_Window) winPtr, &x, &y);
+ eventPtr->xmotion.x = eventPtr->xmotion.x_root - x;
+ eventPtr->xmotion.y = eventPtr->xmotion.y_root - y;
+ eventPtr->xmotion.subwindow = None;
+ for (childPtr = winPtr->childList; childPtr != NULL;
+ childPtr = childPtr->nextPtr) {
+ if (childPtr->flags & TK_TOP_LEVEL) {
+ continue;
+ }
+ x = eventPtr->xmotion.x - childPtr->changes.x;
+ y = eventPtr->xmotion.y - childPtr->changes.y;
+ bd = childPtr->changes.border_width;
+ if ((x >= -bd) && (y >= -bd)
+ && (x < (childPtr->changes.width + bd))
+ && (y < (childPtr->changes.height + bd))) {
+ eventPtr->xmotion.subwindow = childPtr->window;
+ }
+ }
+ sameScreen = 1;
+ } else {
+ eventPtr->xmotion.x = 0;
+ eventPtr->xmotion.y = 0;
+ eventPtr->xmotion.subwindow = None;
+ sameScreen = 0;
+ }
+ if (eventPtr->type == MotionNotify) {
+ eventPtr->xmotion.same_screen = sameScreen;
+ } else {
+ eventPtr->xbutton.same_screen = sameScreen;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkInOutEvents --
+ *
+ * This procedure synthesizes EnterNotify and LeaveNotify events
+ * to correctly transfer the pointer from one window to another.
+ * It can also be used to generate FocusIn and FocusOut events
+ * to move the input focus.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Synthesized events may be pushed back onto the event queue.
+ * The event pointed to by eventPtr is modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkInOutEvents(eventPtr, sourcePtr, destPtr, leaveType, enterType, position)
+ XEvent *eventPtr; /* A template X event. Must have all fields
+ * properly set except for type, window,
+ * subwindow, x, y, detail, and same_screen
+ * (Not all of these fields are valid for
+ * FocusIn/FocusOut events; x_root and y_root
+ * must be valid for Enter/Leave events, even
+ * though x and y needn't be valid). */
+ TkWindow *sourcePtr; /* Window that used to have the pointer or
+ * focus (NULL means it was not in a window
+ * managed by this process). */
+ TkWindow *destPtr; /* Window that is to end up with the pointer
+ * or focus (NULL means it's not one managed
+ * by this process). */
+ int leaveType; /* Type of events to generate for windows
+ * being left (LeaveNotify or FocusOut). 0
+ * means don't generate leave events. */
+ int enterType; /* Type of events to generate for windows
+ * being entered (EnterNotify or FocusIn). 0
+ * means don't generate enter events. */
+ Tcl_QueuePosition position; /* Position at which events are added to
+ * the system event queue. */
+{
+ register TkWindow *winPtr;
+ int upLevels, downLevels, i, j, focus;
+
+ /*
+ * There are four possible cases to deal with:
+ *
+ * 1. SourcePtr and destPtr are the same. There's nothing to do in
+ * this case.
+ * 2. SourcePtr is an ancestor of destPtr in the same top-level
+ * window. Must generate events down the window tree from source
+ * to dest.
+ * 3. DestPtr is an ancestor of sourcePtr in the same top-level
+ * window. Must generate events up the window tree from sourcePtr
+ * to destPtr.
+ * 4. All other cases. Must first generate events up the window tree
+ * from sourcePtr to its top-level, then down from destPtr's
+ * top-level to destPtr. This form is called "non-linear."
+ *
+ * The call to FindCommonAncestor separates these four cases and decides
+ * how many levels up and down events have to be generated for.
+ */
+
+ if (sourcePtr == destPtr) {
+ return;
+ }
+ if ((leaveType == FocusOut) || (enterType == FocusIn)) {
+ focus = 1;
+ } else {
+ focus = 0;
+ }
+ FindCommonAncestor(sourcePtr, destPtr, &upLevels, &downLevels);
+
+ /*
+ * Generate enter/leave events and add them to the grab event queue.
+ */
+
+
+#define QUEUE(w, t, d) \
+ if (w->window != None) { \
+ eventPtr->type = t; \
+ if (focus) { \
+ eventPtr->xfocus.window = w->window; \
+ eventPtr->xfocus.detail = d; \
+ } else { \
+ eventPtr->xcrossing.detail = d; \
+ TkChangeEventWindow(eventPtr, w); \
+ } \
+ Tk_QueueWindowEvent(eventPtr, position); \
+ }
+
+ if (downLevels == 0) {
+
+ /*
+ * SourcePtr is an inferior of destPtr.
+ */
+
+ if (leaveType != 0) {
+ QUEUE(sourcePtr, leaveType, NotifyAncestor);
+ for (winPtr = sourcePtr->parentPtr, i = upLevels-1; i > 0;
+ winPtr = winPtr->parentPtr, i--) {
+ QUEUE(winPtr, leaveType, NotifyVirtual);
+ }
+ }
+ if ((enterType != 0) && (destPtr != NULL)) {
+ QUEUE(destPtr, enterType, NotifyInferior);
+ }
+ } else if (upLevels == 0) {
+
+ /*
+ * DestPtr is an inferior of sourcePtr.
+ */
+
+ if ((leaveType != 0) && (sourcePtr != NULL)) {
+ QUEUE(sourcePtr, leaveType, NotifyInferior);
+ }
+ if (enterType != 0) {
+ for (i = downLevels-1; i > 0; i--) {
+ for (winPtr = destPtr->parentPtr, j = 1; j < i;
+ winPtr = winPtr->parentPtr, j++) {
+ }
+ QUEUE(winPtr, enterType, NotifyVirtual);
+ }
+ if (destPtr != NULL) {
+ QUEUE(destPtr, enterType, NotifyAncestor);
+ }
+ }
+ } else {
+
+ /*
+ * Non-linear: neither window is an inferior of the other.
+ */
+
+ if (leaveType != 0) {
+ QUEUE(sourcePtr, leaveType, NotifyNonlinear);
+ for (winPtr = sourcePtr->parentPtr, i = upLevels-1; i > 0;
+ winPtr = winPtr->parentPtr, i--) {
+ QUEUE(winPtr, leaveType, NotifyNonlinearVirtual);
+ }
+ }
+ if (enterType != 0) {
+ for (i = downLevels-1; i > 0; i--) {
+ for (winPtr = destPtr->parentPtr, j = 1; j < i;
+ winPtr = winPtr->parentPtr, j++) {
+ }
+ QUEUE(winPtr, enterType, NotifyNonlinearVirtual);
+ }
+ if (destPtr != NULL) {
+ QUEUE(destPtr, enterType, NotifyNonlinear);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MovePointer2 --
+ *
+ * This procedure synthesizes EnterNotify and LeaveNotify events
+ * to correctly transfer the pointer from one window to another.
+ * It is different from TkInOutEvents in that no template X event
+ * needs to be supplied; this procedure generates the template
+ * event and calls TkInOutEvents.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Synthesized events may be pushed back onto the event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MovePointer2(sourcePtr, destPtr, mode, leaveEvents, enterEvents)
+ TkWindow *sourcePtr; /* Window currently containing pointer (NULL
+ * means it's not one managed by this
+ * process). */
+ TkWindow *destPtr; /* Window that is to end up containing the
+ * pointer (NULL means it's not one managed
+ * by this process). */
+ int mode; /* Mode for enter/leave events, such as
+ * NotifyNormal or NotifyUngrab. */
+ int leaveEvents; /* Non-zero means generate leave events for the
+ * windows being left. Zero means don't
+ * generate leave events. */
+ int enterEvents; /* Non-zero means generate enter events for the
+ * windows being entered. Zero means don't
+ * generate enter events. */
+{
+ XEvent event;
+ Window dummy1, dummy2;
+ int dummy3, dummy4;
+ TkWindow *winPtr;
+
+ winPtr = sourcePtr;
+ if ((winPtr == NULL) || (winPtr->window == None)) {
+ winPtr = destPtr;
+ if ((winPtr == NULL) || (winPtr->window == None)) {
+ return;
+ }
+ }
+
+ event.xcrossing.serial = LastKnownRequestProcessed(
+ winPtr->display);
+ event.xcrossing.send_event = GENERATED_EVENT_MAGIC;
+ event.xcrossing.display = winPtr->display;
+ event.xcrossing.root = RootWindow(winPtr->display,
+ winPtr->screenNum);
+ event.xcrossing.time = TkCurrentTime(winPtr->dispPtr);
+ XQueryPointer(winPtr->display, winPtr->window, &dummy1, &dummy2,
+ &event.xcrossing.x_root, &event.xcrossing.y_root,
+ &dummy3, &dummy4, &event.xcrossing.state);
+ event.xcrossing.mode = mode;
+ event.xcrossing.focus = False;
+ TkInOutEvents(&event, sourcePtr, destPtr, (leaveEvents) ? LeaveNotify : 0,
+ (enterEvents) ? EnterNotify : 0, TCL_QUEUE_MARK);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGrabDeadWindow --
+ *
+ * This procedure is invoked whenever a window is deleted, so that
+ * grab-related cleanup can be performed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Various cleanups happen, such as generating events to move the
+ * pointer back to its "natural" window as if an ungrab had been
+ * done. See the code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkGrabDeadWindow(winPtr)
+ register TkWindow *winPtr; /* Window that is in the process
+ * of being deleted. */
+{
+ TkDisplay *dispPtr = winPtr->dispPtr;
+
+ if (dispPtr->eventualGrabWinPtr == winPtr) {
+ /*
+ * Grab window was deleted. Release the grab.
+ */
+
+ Tk_Ungrab((Tk_Window) dispPtr->eventualGrabWinPtr);
+ } else if (dispPtr->buttonWinPtr == winPtr) {
+ ReleaseButtonGrab(dispPtr);
+ }
+ if (dispPtr->serverWinPtr == winPtr) {
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ dispPtr->serverWinPtr = NULL;
+ } else {
+ dispPtr->serverWinPtr = winPtr->parentPtr;
+ }
+ }
+ if (dispPtr->grabWinPtr == winPtr) {
+ dispPtr->grabWinPtr = NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EatGrabEvents --
+ *
+ * This procedure is called to eliminate any Enter, Leave,
+ * FocusIn, or FocusOut events in the event queue for a
+ * display that have mode NotifyGrab or NotifyUngrab and
+ * have a serial number no less than a given value and are not
+ * generated by the grab module.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * DispPtr's display gets sync-ed, and some of the events get
+ * removed from the Tk event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EatGrabEvents(dispPtr, serial)
+ TkDisplay *dispPtr; /* Display from which to consume events. */
+ unsigned int serial; /* Only discard events that have a serial
+ * number at least this great. */
+{
+ Tk_RestrictProc *oldProc;
+ GrabInfo info;
+ ClientData oldArg, dummy;
+
+ info.display = dispPtr->display;
+ info.serial = serial;
+ TkpSync(info.display);
+ oldProc = Tk_RestrictEvents(GrabRestrictProc, (ClientData)&info, &oldArg);
+ while (Tcl_ServiceEvent(TCL_WINDOW_EVENTS)) {
+ }
+ Tk_RestrictEvents(oldProc, oldArg, &dummy);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GrabRestrictProc --
+ *
+ * A Tk_RestrictProc used by EatGrabEvents to eliminate any
+ * Enter, Leave, FocusIn, or FocusOut events in the event queue
+ * for a display that has mode NotifyGrab or NotifyUngrab and
+ * have a serial number no less than a given value.
+ *
+ * Results:
+ * Returns either TK_DISCARD_EVENT or TK_DEFER_EVENT.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tk_RestrictAction
+GrabRestrictProc(arg, eventPtr)
+ ClientData arg;
+ XEvent *eventPtr;
+{
+ GrabInfo *info = (GrabInfo *) arg;
+ int mode, diff;
+
+ /*
+ * The diff caculation is trickier than it may seem. Don't forget
+ * that serial numbers can wrap around, so can't compare the two
+ * serial numbers directly.
+ */
+
+ diff = eventPtr->xany.serial - info->serial;
+ if ((eventPtr->type == EnterNotify)
+ || (eventPtr->type == LeaveNotify)) {
+ mode = eventPtr->xcrossing.mode;
+ } else if ((eventPtr->type == FocusIn)
+ || (eventPtr->type == FocusOut)) {
+ mode = eventPtr->xfocus.mode;
+ } else {
+ mode = NotifyNormal;
+ }
+ if ((info->display != eventPtr->xany.display) || (mode == NotifyNormal)
+ || (diff < 0)) {
+ return TK_DEFER_EVENT;
+ } else {
+ return TK_DISCARD_EVENT;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * QueueGrabWindowChange --
+ *
+ * This procedure queues a special event in the Tcl event queue,
+ * which will cause the "grabWinPtr" field for the display to get
+ * modified when the event is processed. This is needed to make
+ * sure that the grab window changes at the proper time relative
+ * to grab-related enter and leave events that are also in the
+ * queue. In particular, this approach works even when multiple
+ * grabs and ungrabs happen back-to-back.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * DispPtr->grabWinPtr will be modified later (by GrabWinEventProc)
+ * when the event is removed from the grab event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+QueueGrabWindowChange(dispPtr, grabWinPtr)
+ TkDisplay *dispPtr; /* Display on which to change the grab
+ * window. */
+ TkWindow *grabWinPtr; /* Window that is to become the new grab
+ * window (may be NULL). */
+{
+ NewGrabWinEvent *grabEvPtr;
+
+ grabEvPtr = (NewGrabWinEvent *) ckalloc(sizeof(NewGrabWinEvent));
+ grabEvPtr->header.proc = GrabWinEventProc;
+ grabEvPtr->dispPtr = dispPtr;
+ if (grabWinPtr == NULL) {
+ grabEvPtr->grabWindow = None;
+ } else {
+ grabEvPtr->grabWindow = grabWinPtr->window;
+ }
+ Tcl_QueueEvent(&grabEvPtr->header, TCL_QUEUE_MARK);
+ dispPtr->eventualGrabWinPtr = grabWinPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GrabWinEventProc --
+ *
+ * This procedure is invoked as a handler for Tcl_Events of type
+ * NewGrabWinEvent. It updates the current grab window field in
+ * a display.
+ *
+ * Results:
+ * Returns 1 if the event was processed, 0 if it should be deferred
+ * for processing later.
+ *
+ * Side effects:
+ * The grabWinPtr field is modified in the display associated with
+ * the event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GrabWinEventProc(evPtr, flags)
+ Tcl_Event *evPtr; /* Event of type NewGrabWinEvent. */
+ int flags; /* Flags argument to Tk_DoOneEvent: indicates
+ * what kinds of events are being processed
+ * right now. */
+{
+ NewGrabWinEvent *grabEvPtr = (NewGrabWinEvent *) evPtr;
+
+ grabEvPtr->dispPtr->grabWinPtr = (TkWindow *) Tk_IdToWindow(
+ grabEvPtr->dispPtr->display, grabEvPtr->grabWindow);
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindCommonAncestor --
+ *
+ * Given two windows, this procedure finds their least common
+ * ancestor and also computes how many levels up this ancestor
+ * is from each of the original windows.
+ *
+ * Results:
+ * If the windows are in different applications or top-level
+ * windows, then NULL is returned and *countPtr1 and *countPtr2
+ * are set to the depths of the two windows in their respective
+ * top-level windows (1 means the window is a top-level, 2 means
+ * its parent is a top-level, and so on). Otherwise, the return
+ * value is a pointer to the common ancestor and the counts are
+ * set to the distance of winPtr1 and winPtr2 from this ancestor
+ * (1 means they're children, 2 means grand-children, etc.).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkWindow *
+FindCommonAncestor(winPtr1, winPtr2, countPtr1, countPtr2)
+ TkWindow *winPtr1; /* First window. May be NULL. */
+ TkWindow *winPtr2; /* Second window. May be NULL. */
+ int *countPtr1; /* Store nesting level of winPtr1 within
+ * common ancestor here. */
+ int *countPtr2; /* Store nesting level of winPtr2 within
+ * common ancestor here. */
+{
+ register TkWindow *winPtr;
+ TkWindow *ancestorPtr;
+ int count1, count2, i;
+
+ /*
+ * Mark winPtr1 and all of its ancestors with a special flag bit.
+ */
+
+ if (winPtr1 != NULL) {
+ for (winPtr = winPtr1; winPtr != NULL; winPtr = winPtr->parentPtr) {
+ winPtr->flags |= TK_GRAB_FLAG;
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ break;
+ }
+ }
+ }
+
+ /*
+ * Search upwards from winPtr2 until an ancestor of winPtr1 is
+ * found or a top-level window is reached.
+ */
+
+ winPtr = winPtr2;
+ count2 = 0;
+ ancestorPtr = NULL;
+ if (winPtr2 != NULL) {
+ for (; winPtr != NULL; count2++, winPtr = winPtr->parentPtr) {
+ if (winPtr->flags & TK_GRAB_FLAG) {
+ ancestorPtr = winPtr;
+ break;
+ }
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ count2++;
+ break;
+ }
+ }
+ }
+
+ /*
+ * Search upwards from winPtr1 again, clearing the flag bits and
+ * remembering how many levels up we had to go.
+ */
+
+ if (winPtr1 == NULL) {
+ count1 = 0;
+ } else {
+ count1 = -1;
+ for (i = 0, winPtr = winPtr1; winPtr != NULL;
+ i++, winPtr = winPtr->parentPtr) {
+ winPtr->flags &= ~TK_GRAB_FLAG;
+ if (winPtr == ancestorPtr) {
+ count1 = i;
+ }
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ if (count1 == -1) {
+ count1 = i+1;
+ }
+ break;
+ }
+ }
+ }
+
+ *countPtr1 = count1;
+ *countPtr2 = count2;
+ return ancestorPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPositionInTree --
+ *
+ * Compute where the given window is relative to a particular
+ * subtree of the window hierarchy.
+ *
+ * Results:
+ *
+ * Returns TK_GRAB_IN_TREE if the window is contained in the
+ * subtree. Returns TK_GRAB_ANCESTOR if the window is an
+ * ancestor of the subtree, in the same toplevel. Otherwise
+ * it returns TK_GRAB_EXCLUDED.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkPositionInTree(winPtr, treePtr)
+ TkWindow *winPtr; /* Window to be checked. */
+ TkWindow *treePtr; /* Root of tree to compare against. */
+{
+ TkWindow *winPtr2;
+
+ for (winPtr2 = winPtr; winPtr2 != treePtr;
+ winPtr2 = winPtr2->parentPtr) {
+ if (winPtr2 == NULL) {
+ for (winPtr2 = treePtr; winPtr2 != NULL;
+ winPtr2 = winPtr2->parentPtr) {
+ if (winPtr2 == winPtr) {
+ return TK_GRAB_ANCESTOR;
+ }
+ if (winPtr2->flags & TK_TOP_LEVEL) {
+ break;
+ }
+ }
+ return TK_GRAB_EXCLUDED;
+ }
+ }
+ return TK_GRAB_IN_TREE;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGrabState --
+ *
+ * Given a window, this procedure returns a value that indicates
+ * the grab state of the application relative to the window.
+ *
+ * Results:
+ * The return value is one of three things:
+ * TK_GRAB_NONE - no grab is in effect.
+ * TK_GRAB_IN_TREE - there is a grab in effect, and winPtr
+ * is in the grabbed subtree.
+ * TK_GRAB_ANCESTOR - there is a grab in effect; winPtr is
+ * an ancestor of the grabbed window, in
+ * the same toplevel.
+ * TK_GRAB_EXCLUDED - there is a grab in effect; winPtr is
+ * outside the tree of the grab and is not
+ * an ancestor of the grabbed window in the
+ * same toplevel.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkGrabState(winPtr)
+ TkWindow *winPtr; /* Window for which grab information is
+ * needed. */
+{
+ TkWindow *grabWinPtr = winPtr->dispPtr->grabWinPtr;
+
+ if (grabWinPtr == NULL) {
+ return TK_GRAB_NONE;
+ }
+ if ((winPtr->mainPtr != grabWinPtr->mainPtr)
+ && !(winPtr->dispPtr->grabFlags & GRAB_GLOBAL)) {
+ return TK_GRAB_NONE;
+ }
+
+ return TkPositionInTree(winPtr, grabWinPtr);
+}
diff --git a/generic/tkGrid.c b/generic/tkGrid.c
new file mode 100644
index 0000000..ea11a01
--- /dev/null
+++ b/generic/tkGrid.c
@@ -0,0 +1,2615 @@
+/*
+ * tkGrid.c --
+ *
+ * Grid based geometry manager.
+ *
+ * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkGrid.c 1.39 97/10/10 10:12:03
+ */
+
+#include "tkInt.h"
+
+/*
+ * Convenience Macros
+ */
+
+#ifdef MAX
+# undef MAX
+#endif
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+#ifdef MIN
+# undef MIN
+#endif
+#define MIN(x,y) ((x) > (y) ? (y) : (x))
+
+#define COLUMN (1) /* working on column offsets */
+#define ROW (2) /* working on row offsets */
+
+#define CHECK_ONLY (1) /* check max slot constraint */
+#define CHECK_SPACE (2) /* alloc more space, don't change max */
+
+/*
+ * Pre-allocate enough row and column slots for "typical" sized tables
+ * this value should be chosen so by the time the extra malloc's are
+ * required, the layout calculations overwehlm them. [A "slot" contains
+ * information for either a row or column, depending upon the context.]
+ */
+
+#define TYPICAL_SIZE 25 /* (arbitrary guess) */
+#define PREALLOC 10 /* extra slots to allocate */
+
+/*
+ * Data structures are allocated dynamically to support arbitrary sized tables.
+ * However, the space is proportional to the highest numbered slot with
+ * some non-default property. This limit is used to head off mistakes and
+ * denial of service attacks by limiting the amount of storage required.
+ */
+
+#define MAX_ELEMENT 10000
+
+/*
+ * Special characters to support relative layouts.
+ */
+
+#define REL_SKIP 'x' /* Skip this column. */
+#define REL_HORIZ '-' /* Extend previous widget horizontally. */
+#define REL_VERT '^' /* Extend widget from row above. */
+
+/*
+ * Structure to hold information for grid masters. A slot is either
+ * a row or column.
+ */
+
+typedef struct SlotInfo {
+ int minSize; /* The minimum size of this slot (in pixels).
+ * It is set via the rowconfigure or
+ * columnconfigure commands. */
+ int weight; /* The resize weight of this slot. (0) means
+ * this slot doesn't resize. Extra space in
+ * the layout is given distributed among slots
+ * inproportion to their weights. */
+ int pad; /* Extra padding, in pixels, required for
+ * this slot. This amount is "added" to the
+ * largest slave in the slot. */
+ int offset; /* This is a cached value used for
+ * introspection. It is the pixel
+ * offset of the right or bottom edge
+ * of this slot from the beginning of the
+ * layout. */
+ int temp; /* This is a temporary value used for
+ * calculating adjusted weights when
+ * shrinking the layout below its
+ * nominal size. */
+} SlotInfo;
+
+/*
+ * Structure to hold information during layout calculations. There
+ * is one of these for each slot, an array for each of the rows or columns.
+ */
+
+typedef struct GridLayout {
+ struct Gridder *binNextPtr; /* The next slave window in this bin.
+ * Each bin contains a list of all
+ * slaves whose spans are >1 and whose
+ * right edges fall in this slot. */
+ int minSize; /* Minimum size needed for this slot,
+ * in pixels. This is the space required
+ * to hold any slaves contained entirely
+ * in this slot, adjusted for any slot
+ * constrants, such as size or padding. */
+ int pad; /* Padding needed for this slot */
+ int weight; /* Slot weight, controls resizing. */
+ int minOffset; /* The minimum offset, in pixels, from
+ * the beginning of the layout to the
+ * right/bottom edge of the slot calculated
+ * from top/left to bottom/right. */
+ int maxOffset; /* The maximum offset, in pixels, from
+ * the beginning of the layout to the
+ * right-or-bottom edge of the slot calculated
+ * from bottom-or-right to top-or-left. */
+} GridLayout;
+
+/*
+ * Keep one of these for each geometry master.
+ */
+
+typedef struct {
+ SlotInfo *columnPtr; /* Pointer to array of column constraints. */
+ SlotInfo *rowPtr; /* Pointer to array of row constraints. */
+ int columnEnd; /* The last column occupied by any slave. */
+ int columnMax; /* The number of columns with constraints. */
+ int columnSpace; /* The number of slots currently allocated for
+ * column constraints. */
+ int rowEnd; /* The last row occupied by any slave. */
+ int rowMax; /* The number of rows with constraints. */
+ int rowSpace; /* The number of slots currently allocated
+ * for row constraints. */
+ int startX; /* Pixel offset of this layout within its
+ * parent. */
+ int startY; /* Pixel offset of this layout within its
+ * parent. */
+} GridMaster;
+
+/*
+ * For each window that the grid cares about (either because
+ * the window is managed by the grid or because the window
+ * has slaves that are managed by the grid), there is a
+ * structure of the following type:
+ */
+
+typedef struct Gridder {
+ Tk_Window tkwin; /* Tk token for window. NULL means that
+ * the window has been deleted, but the
+ * gridder hasn't had a chance to clean up
+ * yet because the structure is still in
+ * use. */
+ struct Gridder *masterPtr; /* Master window within which this window
+ * is managed (NULL means this window
+ * isn't managed by the gridder). */
+ struct Gridder *nextPtr; /* Next window managed within same
+ * parent. List order doesn't matter. */
+ struct Gridder *slavePtr; /* First in list of slaves managed
+ * inside this window (NULL means
+ * no grid slaves). */
+ GridMaster *masterDataPtr; /* Additional data for geometry master. */
+ int column, row; /* Location in the grid (starting
+ * from zero). */
+ int numCols, numRows; /* Number of columns or rows this slave spans.
+ * Should be at least 1. */
+ int padX, padY; /* Total additional pixels to leave around the
+ * window (half of this space is left on each
+ * side). This is space *outside* the window:
+ * we'll allocate extra space in frame but
+ * won't enlarge window). */
+ int iPadX, iPadY; /* Total extra pixels to allocate inside the
+ * window (half this amount will appear on
+ * each side). */
+ int sticky; /* which sides of its cavity this window
+ * sticks to. See below for definitions */
+ int doubleBw; /* Twice the window's last known border
+ * width. If this changes, the window
+ * must be re-arranged within its parent. */
+ int *abortPtr; /* If non-NULL, it means that there is a nested
+ * call to ArrangeGrid already working on
+ * this window. *abortPtr may be set to 1 to
+ * abort that nested call. This happens, for
+ * example, if tkwin or any of its slaves
+ * is deleted. */
+ int flags; /* Miscellaneous flags; see below
+ * for definitions. */
+
+ /*
+ * These fields are used temporarily for layout calculations only.
+ */
+
+ struct Gridder *binNextPtr; /* Link to next span>1 slave in this bin. */
+ int size; /* Nominal size (width or height) in pixels
+ * of the slave. This includes the padding. */
+} Gridder;
+
+/* Flag values for "sticky"ness The 16 combinations subsume the packer's
+ * notion of anchor and fill.
+ *
+ * STICK_NORTH This window sticks to the top of its cavity.
+ * STICK_EAST This window sticks to the right edge of its cavity.
+ * STICK_SOUTH This window sticks to the bottom of its cavity.
+ * STICK_WEST This window sticks to the left edge of its cavity.
+ */
+
+#define STICK_NORTH 1
+#define STICK_EAST 2
+#define STICK_SOUTH 4
+#define STICK_WEST 8
+
+/*
+ * Flag values for Grid structures:
+ *
+ * REQUESTED_RELAYOUT: 1 means a Tcl_DoWhenIdle request
+ * has already been made to re-arrange
+ * all the slaves of this window.
+ *
+ * DONT_PROPAGATE: 1 means don't set this window's requested
+ * size. 0 means if this window is a master
+ * then Tk will set its requested size to fit
+ * the needs of its slaves.
+ */
+
+#define REQUESTED_RELAYOUT 1
+#define DONT_PROPAGATE 2
+
+/*
+ * Hash table used to map from Tk_Window tokens to corresponding
+ * Grid structures:
+ */
+
+static Tcl_HashTable gridHashTable;
+static int initialized = 0;
+
+/*
+ * Prototypes for procedures used only in this file:
+ */
+
+static void AdjustForSticky _ANSI_ARGS_((Gridder *slavePtr, int *xPtr,
+ int *yPtr, int *widthPtr, int *heightPtr));
+static int AdjustOffsets _ANSI_ARGS_((int width,
+ int elements, SlotInfo *slotPtr));
+static void ArrangeGrid _ANSI_ARGS_((ClientData clientData));
+static int CheckSlotData _ANSI_ARGS_((Gridder *masterPtr, int slot,
+ int slotType, int checkOnly));
+static int ConfigureSlaves _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, int argc, char *argv[]));
+static void DestroyGrid _ANSI_ARGS_((char *memPtr));
+static Gridder *GetGrid _ANSI_ARGS_((Tk_Window tkwin));
+static void GridStructureProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+static void GridLostSlaveProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+static void GridReqProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+static void InitMasterData _ANSI_ARGS_((Gridder *masterPtr));
+static int ResolveConstraints _ANSI_ARGS_((Gridder *gridPtr,
+ int rowOrColumn, int maxOffset));
+static void SetGridSize _ANSI_ARGS_((Gridder *gridPtr));
+static void StickyToString _ANSI_ARGS_((int flags, char *result));
+static int StringToSticky _ANSI_ARGS_((char *string));
+static void Unlink _ANSI_ARGS_((Gridder *gridPtr));
+
+static Tk_GeomMgr gridMgrType = {
+ "grid", /* name */
+ GridReqProc, /* requestProc */
+ GridLostSlaveProc, /* lostSlaveProc */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GridCmd --
+ *
+ * This procedure is invoked to process the "grid" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GridCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ Gridder *masterPtr; /* master grid record */
+ GridMaster *gridPtr; /* pointer to grid data */
+ size_t length; /* streing length of argument */
+ char c; /* 1st character of argument */
+
+ if ((argc >= 2) && ((argv[1][0] == '.') || (argv[1][0] == REL_SKIP) ||
+ (argv[1][0] == REL_VERT))) {
+ return ConfigureSlaves(interp, tkwin, argc-1, argv+1);
+ }
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " option arg ?arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = argv[1][0];
+ length = strlen(argv[1]);
+
+ if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0)) {
+ Tk_Window master;
+ int row, column; /* origin for bounding box */
+ int row2, column2; /* end of bounding box */
+ int endX, endY; /* last column/row in the layout */
+ int x=0, y=0; /* starting pixels for this bounding box */
+ int width, height; /* size of the bounding box */
+
+ if (argc!=3 && argc != 5 && argc != 7) {
+ Tcl_AppendResult(interp, "wrong number of arguments: ",
+ "must be \"",argv[0],
+ " bbox master ?column row ?column row??\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ master = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (master == NULL) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetGrid(master);
+
+ if (argc >= 5) {
+ if (Tcl_GetInt(interp, argv[3], &column) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[4], &row) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ column2 = column;
+ row2 = row;
+ }
+
+ if (argc == 7) {
+ if (Tcl_GetInt(interp, argv[5], &column2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[6], &row2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ gridPtr = masterPtr->masterDataPtr;
+ if (gridPtr == NULL) {
+ sprintf(interp->result, "%d %d %d %d",0,0,0,0);
+ return(TCL_OK);
+ }
+
+ SetGridSize(masterPtr);
+ endX = MAX(gridPtr->columnEnd, gridPtr->columnMax);
+ endY = MAX(gridPtr->rowEnd, gridPtr->rowMax);
+
+ if ((endX == 0) || (endY == 0)) {
+ sprintf(interp->result, "%d %d %d %d",0,0,0,0);
+ return(TCL_OK);
+ }
+ if (argc == 3) {
+ row = column = 0;
+ row2 = endY;
+ column2 = endX;
+ }
+
+ if (column > column2) {
+ int temp = column;
+ column = column2, column2 = temp;
+ }
+ if (row > row2) {
+ int temp = row;
+ row = row2, row2 = temp;
+ }
+
+ if (column > 0 && column < endX) {
+ x = gridPtr->columnPtr[column-1].offset;
+ } else if (column > 0) {
+ x = gridPtr->columnPtr[endX-1].offset;
+ }
+
+ if (row > 0 && row < endY) {
+ y = gridPtr->rowPtr[row-1].offset;
+ } else if (row > 0) {
+ y = gridPtr->rowPtr[endY-1].offset;
+ }
+
+ if (column2 < 0) {
+ width = 0;
+ } else if (column2 >= endX) {
+ width = gridPtr->columnPtr[endX-1].offset - x;
+ } else {
+ width = gridPtr->columnPtr[column2].offset - x;
+ }
+
+ if (row2 < 0) {
+ height = 0;
+ } else if (row2 >= endY) {
+ height = gridPtr->rowPtr[endY-1].offset - y;
+ } else {
+ height = gridPtr->rowPtr[row2].offset - y;
+ }
+
+ sprintf(interp->result, "%d %d %d %d",
+ x + gridPtr->startX, y + gridPtr->startY, width, height);
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)) {
+ if (argv[2][0] != '.') {
+ Tcl_AppendResult(interp, "bad argument \"", argv[2],
+ "\": must be name of window", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return ConfigureSlaves(interp, tkwin, argc-2, argv+2);
+ } else if (((c == 'f') && (strncmp(argv[1], "forget", length) == 0)) ||
+ ((c == 'r') && (strncmp(argv[1], "remove", length) == 0))) {
+ Tk_Window slave;
+ Gridder *slavePtr;
+ int i;
+
+ for (i = 2; i < argc; i++) {
+ slave = Tk_NameToWindow(interp, argv[i], tkwin);
+ if (slave == NULL) {
+ return TCL_ERROR;
+ }
+ slavePtr = GetGrid(slave);
+ if (slavePtr->masterPtr != NULL) {
+
+ /*
+ * For "forget", reset all the settings to their defaults
+ */
+
+ if (c == 'f') {
+ slavePtr->column = slavePtr->row = -1;
+ slavePtr->numCols = 1;
+ slavePtr->numRows = 1;
+ slavePtr->padX = slavePtr->padY = 0;
+ slavePtr->iPadX = slavePtr->iPadY = 0;
+ slavePtr->doubleBw = 2*Tk_Changes(tkwin)->border_width;
+ slavePtr->flags = 0;
+ slavePtr->sticky = 0;
+ }
+ Tk_ManageGeometry(slave, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin,
+ slavePtr->masterPtr->tkwin);
+ }
+ Unlink(slavePtr);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ }
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "info", length) == 0)) {
+ register Gridder *slavePtr;
+ Tk_Window slave;
+ char buffer[70];
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " info window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ slave = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (slave == NULL) {
+ return TCL_ERROR;
+ }
+ slavePtr = GetGrid(slave);
+ if (slavePtr->masterPtr == NULL) {
+ interp->result[0] = '\0';
+ return TCL_OK;
+ }
+
+ Tcl_AppendElement(interp, "-in");
+ Tcl_AppendElement(interp, Tk_PathName(slavePtr->masterPtr->tkwin));
+ sprintf(buffer, " -column %d -row %d -columnspan %d -rowspan %d",
+ slavePtr->column, slavePtr->row,
+ slavePtr->numCols, slavePtr->numRows);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ sprintf(buffer, " -ipadx %d -ipady %d -padx %d -pady %d",
+ slavePtr->iPadX/2, slavePtr->iPadY/2, slavePtr->padX/2,
+ slavePtr->padY/2);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ StickyToString(slavePtr->sticky,buffer);
+ Tcl_AppendResult(interp, " -sticky ", buffer, (char *) NULL);
+ } else if((c == 'l') && (strncmp(argv[1], "location", length) == 0)) {
+ Tk_Window master;
+ register SlotInfo *slotPtr;
+ int x, y; /* Offset in pixels, from edge of parent. */
+ int i, j; /* Corresponding column and row indeces. */
+ int endX, endY; /* end of grid */
+
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " location master x y\"", (char *)NULL);
+ return TCL_ERROR;
+ }
+
+ master = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (master == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (Tk_GetPixels(interp, master, argv[3], &x) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tk_GetPixels(interp, master, argv[4], &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ masterPtr = GetGrid(master);
+ if (masterPtr->masterDataPtr == NULL) {
+ sprintf(interp->result, "%d %d", -1, -1);
+ return TCL_OK;
+ }
+ gridPtr = masterPtr->masterDataPtr;
+
+ /*
+ * Update any pending requests. This is not always the
+ * steady state value, as more configure events could be in
+ * the pipeline, but its as close as its easy to get.
+ */
+
+ while (masterPtr->flags & REQUESTED_RELAYOUT) {
+ Tk_CancelIdleCall(ArrangeGrid, (ClientData) masterPtr);
+ ArrangeGrid ((ClientData) masterPtr);
+ }
+ SetGridSize(masterPtr);
+ endX = MAX(gridPtr->columnEnd, gridPtr->columnMax);
+ endY = MAX(gridPtr->rowEnd, gridPtr->rowMax);
+
+ slotPtr = masterPtr->masterDataPtr->columnPtr;
+ if (x < masterPtr->masterDataPtr->startX) {
+ i = -1;
+ } else {
+ x -= masterPtr->masterDataPtr->startX;
+ for (i=0;slotPtr[i].offset < x && i < endX; i++) {
+ /* null body */
+ }
+ }
+
+ slotPtr = masterPtr->masterDataPtr->rowPtr;
+ if (y < masterPtr->masterDataPtr->startY) {
+ j = -1;
+ } else {
+ y -= masterPtr->masterDataPtr->startY;
+ for (j=0;slotPtr[j].offset < y && j < endY; j++) {
+ /* null body */
+ }
+ }
+
+ sprintf(interp->result, "%d %d", i, j);
+ } else if ((c == 'p') && (strncmp(argv[1], "propagate", length) == 0)) {
+ Tk_Window master;
+ int propagate;
+
+ if (argc > 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " propagate window ?boolean?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ master = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (master == NULL) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetGrid(master);
+ if (argc == 3) {
+ interp->result = (masterPtr->flags & DONT_PROPAGATE) ? "0" : "1";
+ return TCL_OK;
+ }
+ if (Tcl_GetBoolean(interp, argv[3], &propagate) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((!propagate) ^ (masterPtr->flags&DONT_PROPAGATE)) {
+ masterPtr->flags ^= DONT_PROPAGATE;
+
+ /*
+ * Re-arrange the master to allow new geometry information to
+ * propagate upwards to the master's master.
+ */
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ if (!(masterPtr->flags & REQUESTED_RELAYOUT)) {
+ masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr);
+ }
+ }
+ } else if ((c == 's') && (strncmp(argv[1], "size", length) == 0)
+ && (length > 1)) {
+ Tk_Window master;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " size window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ master = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (master == NULL) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetGrid(master);
+
+ if (masterPtr->masterDataPtr != NULL) {
+ SetGridSize(masterPtr);
+ gridPtr = masterPtr->masterDataPtr;
+ sprintf(interp->result, "%d %d",
+ MAX(gridPtr->columnEnd, gridPtr->columnMax),
+ MAX(gridPtr->rowEnd, gridPtr->rowMax));
+ } else {
+ sprintf(interp->result, "%d %d",0, 0);
+ }
+ } else if ((c == 's') && (strncmp(argv[1], "slaves", length) == 0)
+ && (length > 1)) {
+ Tk_Window master;
+ Gridder *slavePtr;
+ int i, value;
+ int row = -1, column = -1;
+
+ if ((argc < 3) || ((argc%2) == 0)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " slaves window ?-option value...?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ for (i=3; i<argc; i+=2) {
+ length = strlen(argv[i]);
+ if ((*argv[i] != '-') || (length < 2)) {
+ Tcl_AppendResult(interp, "invalid args: should be \"",
+ argv[0], " slaves window ?-option value...?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[i+1], &value) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (value < 0) {
+ Tcl_AppendResult(interp, argv[i],
+ " is an invalid value: should NOT be < 0",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (strncmp(argv[i], "-column", length) == 0) {
+ column = value;
+ } else if (strncmp(argv[i], "-row", length) == 0) {
+ row = value;
+ } else {
+ Tcl_AppendResult(interp, argv[i],
+ " is an invalid option: should be \"",
+ "-row, -column\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ master = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (master == NULL) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetGrid(master);
+
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ if (column>=0 && (slavePtr->column > column
+ || slavePtr->column+slavePtr->numCols-1 < column)) {
+ continue;
+ }
+ if (row>=0 && (slavePtr->row > row ||
+ slavePtr->row+slavePtr->numRows-1 < row)) {
+ continue;
+ }
+ Tcl_AppendElement(interp, Tk_PathName(slavePtr->tkwin));
+ }
+
+ /*
+ * Sample argument combinations:
+ * grid columnconfigure <master> <index> -option
+ * grid columnconfigure <master> <index> -option value -option value
+ * grid rowconfigure <master> <index>
+ * grid rowconfigure <master> <index> -option
+ * grid rowconfigure <master> <index> -option value -option value.
+ */
+
+ } else if(((c == 'c') && (strncmp(argv[1], "columnconfigure", length) == 0)
+ && (length >= 3)) ||
+ ((c == 'r') && (strncmp(argv[1], "rowconfigure", length) == 0)
+ && (length >=2))) {
+ Tk_Window master;
+ SlotInfo *slotPtr = NULL;
+ int slot; /* the column or row number */
+ size_t length; /* the # of chars in the "-option" string */
+ int slotType; /* COLUMN or ROW */
+ int size; /* the configuration value */
+ int checkOnly; /* check the size only */
+ int argcPtr; /* Number of items in index list */
+ char **argvPtr; /* array of indeces */
+ char **indexP; /* String value of current index list item. */
+ int ok; /* temporary TCL result code */
+ int i;
+
+ if (((argc%2 != 0) && (argc>6)) || (argc < 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " ", argv[1], " master index ?-option value...?\"",
+ (char *)NULL);
+ return TCL_ERROR;
+ }
+
+ master = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (master == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_SplitList(interp, argv[3], &argcPtr, &argvPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ checkOnly = ((argc == 4) || (argc == 5));
+ masterPtr = GetGrid(master);
+ slotType = (c == 'c') ? COLUMN : ROW;
+ if (checkOnly && argcPtr > 1) {
+ Tcl_AppendResult(interp, argv[3],
+ " must be a single element.", (char *) NULL);
+ Tcl_Free((char *)argvPtr);
+ return TCL_ERROR;
+ }
+ for (indexP=argvPtr; *indexP != NULL; indexP++) {
+ if (Tcl_GetInt(interp, *indexP, &slot) != TCL_OK) {
+ Tcl_Free((char *)argvPtr);
+ return TCL_ERROR;
+ }
+ ok = CheckSlotData(masterPtr, slot, slotType, checkOnly);
+ if ((ok!=TCL_OK) && ((argc<4) || (argc>5))) {
+ Tcl_AppendResult(interp, argv[0],
+ " ", argv[1], ": \"", *argvPtr,"\" is out of range",
+ (char *) NULL);
+ Tcl_Free((char *)argvPtr);
+ return TCL_ERROR;
+ } else if (ok == TCL_OK) {
+ slotPtr = (slotType == COLUMN) ?
+ masterPtr->masterDataPtr->columnPtr :
+ masterPtr->masterDataPtr->rowPtr;
+ }
+
+ /*
+ * Return all of the options for this row or column. If the
+ * request is out of range, return all 0's.
+ */
+
+ if (argc == 4) {
+ Tcl_Free((char *)argvPtr);
+ }
+ if ((argc == 4) && (ok == TCL_OK)) {
+ sprintf(interp->result,"-minsize %d -pad %d -weight %d",
+ slotPtr[slot].minSize,slotPtr[slot].pad,
+ slotPtr[slot].weight);
+ return (TCL_OK);
+ } else if (argc == 4) {
+ sprintf(interp->result,"-minsize %d -pad %d -weight %d", 0,0,0);
+ return (TCL_OK);
+ }
+
+ /*
+ * Loop through each option value pair, setting the values as required.
+ * If only one option is given, with no value, the current value is
+ * returned.
+ */
+
+ for (i=4; i<argc; i+=2) {
+ length = strlen(argv[i]);
+ if ((*argv[i] != '-') || length < 2) {
+ Tcl_AppendResult(interp, "invalid arg \"",
+ argv[i], "\" :expecting -minsize, -pad, or -weight.",
+ (char *) NULL);
+ Tcl_Free((char *)argvPtr);
+ return TCL_ERROR;
+ }
+ if (strncmp(argv[i], "-minsize", length) == 0) {
+ if (argc == 5) {
+ int value = ok == TCL_OK ? slotPtr[slot].minSize : 0;
+ sprintf(interp->result,"%d",value);
+ } else if (Tk_GetPixels(interp, master, argv[i+1], &size)
+ != TCL_OK) {
+ Tcl_Free((char *)argvPtr);
+ return TCL_ERROR;
+ } else {
+ slotPtr[slot].minSize = size;
+ }
+ }
+ else if (strncmp(argv[i], "-weight", length) == 0) {
+ int wt;
+ if (argc == 5) {
+ int value = ok == TCL_OK ? slotPtr[slot].weight : 0;
+ sprintf(interp->result,"%d",value);
+ } else if (Tcl_GetInt(interp, argv[i+1], &wt) != TCL_OK) {
+ Tcl_Free((char *)argvPtr);
+ return TCL_ERROR;
+ } else if (wt < 0) {
+ Tcl_AppendResult(interp, "invalid arg \"", argv[i],
+ "\": should be non-negative", (char *) NULL);
+ Tcl_Free((char *)argvPtr);
+ return TCL_ERROR;
+ } else {
+ slotPtr[slot].weight = wt;
+ }
+ }
+ else if (strncmp(argv[i], "-pad", length) == 0) {
+ if (argc == 5) {
+ int value = ok == TCL_OK ? slotPtr[slot].pad : 0;
+ sprintf(interp->result,"%d",value);
+ } else if (Tk_GetPixels(interp, master, argv[i+1], &size)
+ != TCL_OK) {
+ Tcl_Free((char *)argvPtr);
+ return TCL_ERROR;
+ } else if (size < 0) {
+ Tcl_AppendResult(interp, "invalid arg \"", argv[i],
+ "\": should be non-negative", (char *) NULL);
+ Tcl_Free((char *)argvPtr);
+ return TCL_ERROR;
+ } else {
+ slotPtr[slot].pad = size;
+ }
+ } else {
+ Tcl_AppendResult(interp, "invalid arg \"",
+ argv[i], "\": expecting -minsize, -pad, or -weight.",
+ (char *) NULL);
+ Tcl_Free((char *)argvPtr);
+ return TCL_ERROR;
+ }
+ }
+ }
+ Tcl_Free((char *)argvPtr);
+
+ /*
+ * If we changed a property, re-arrange the table,
+ * and check for constraint shrinkage.
+ */
+
+ if (argc != 5) {
+ if (slotType == ROW) {
+ int last = masterPtr->masterDataPtr->rowMax - 1;
+ while ((last >= 0) && (slotPtr[last].weight == 0)
+ && (slotPtr[last].pad == 0)
+ && (slotPtr[last].minSize == 0)) {
+ last--;
+ }
+ masterPtr->masterDataPtr->rowMax = last+1;
+ } else {
+ int last = masterPtr->masterDataPtr->columnMax - 1;
+ while ((last >= 0) && (slotPtr[last].weight == 0)
+ && (slotPtr[last].pad == 0)
+ && (slotPtr[last].minSize == 0)) {
+ last--;
+ }
+ masterPtr->masterDataPtr->columnMax = last + 1;
+ }
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ if (!(masterPtr->flags & REQUESTED_RELAYOUT)) {
+ masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr);
+ }
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be bbox, columnconfigure, configure, forget, info, ",
+ "location, propagate, remove, rowconfigure, size, or slaves.",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GridReqProc --
+ *
+ * This procedure is invoked by Tk_GeometryRequest for
+ * windows managed by the grid.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for tkwin, and all its managed siblings, to
+ * be re-arranged at the next idle point.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+GridReqProc(clientData, tkwin)
+ ClientData clientData; /* Grid's information about
+ * window that got new preferred
+ * geometry. */
+ Tk_Window tkwin; /* Other Tk-related information
+ * about the window. */
+{
+ register Gridder *gridPtr = (Gridder *) clientData;
+
+ gridPtr = gridPtr->masterPtr;
+ if (!(gridPtr->flags & REQUESTED_RELAYOUT)) {
+ gridPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) gridPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GridLostSlaveProc --
+ *
+ * This procedure is invoked by Tk whenever some other geometry
+ * claims control over a slave that used to be managed by us.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Forgets all grid-related information about the slave.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+GridLostSlaveProc(clientData, tkwin)
+ ClientData clientData; /* Grid structure for slave window that
+ * was stolen away. */
+ Tk_Window tkwin; /* Tk's handle for the slave window. */
+{
+ register Gridder *slavePtr = (Gridder *) clientData;
+
+ if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, slavePtr->masterPtr->tkwin);
+ }
+ Unlink(slavePtr);
+ Tk_UnmapWindow(slavePtr->tkwin);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * AdjustOffsets --
+ *
+ * This procedure adjusts the size of the layout to fit in the
+ * space provided. If it needs more space, the extra is added
+ * according to the weights. If it needs less, the space is removed
+ * according to the weights, but at no time does the size drop below
+ * the minsize specified for that slot.
+ *
+ * Results:
+ * The initial offset of the layout,
+ * if all the weights are zero, else 0.
+ *
+ * Side effects:
+ * The slot offsets are modified to shrink the layout.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+AdjustOffsets(size, slots, slotPtr)
+ int size; /* The total layout size (in pixels). */
+ int slots; /* Number of slots. */
+ register SlotInfo *slotPtr; /* Pointer to slot array. */
+{
+ register int slot; /* Current slot. */
+ int diff; /* Extra pixels needed to add to the layout. */
+ int totalWeight = 0; /* Sum of the weights for all the slots. */
+ int weight = 0; /* Sum of the weights so far. */
+ int minSize = 0; /* Minimum possible layout size. */
+ int newDiff; /* The most pixels that can be added on
+ * the current pass. */
+
+ diff = size - slotPtr[slots-1].offset;
+
+ /*
+ * The layout is already the correct size; all done.
+ */
+
+ if (diff == 0) {
+ return(0);
+ }
+
+ /*
+ * If all the weights are zero, center the layout in its parent if
+ * there is extra space, else clip on the bottom/right.
+ */
+
+ for (slot=0; slot < slots; slot++) {
+ totalWeight += slotPtr[slot].weight;
+ }
+
+ if (totalWeight == 0 ) {
+ return(diff > 0 ? diff/2 : 0);
+ }
+
+ /*
+ * Add extra space according to the slot weights. This is done
+ * cumulatively to prevent round-off error accumulation.
+ */
+
+ if (diff > 0) {
+ for (weight=slot=0; slot < slots; slot++) {
+ weight += slotPtr[slot].weight;
+ slotPtr[slot].offset += diff * weight / totalWeight;
+ }
+ return(0);
+ }
+
+ /*
+ * The layout must shrink below its requested size. Compute the
+ * minimum possible size by looking at the slot minSizes.
+ */
+
+ for (slot=0; slot < slots; slot++) {
+ if (slotPtr[slot].weight > 0) {
+ minSize += slotPtr[slot].minSize;
+ } else if (slot > 0) {
+ minSize += slotPtr[slot].offset - slotPtr[slot-1].offset;
+ } else {
+ minSize += slotPtr[slot].offset;
+ }
+ }
+
+ /*
+ * If the requested size is less than the minimum required size,
+ * set the slot sizes to their minimum values, then clip on the
+ * bottom/right.
+ */
+
+ if (size <= minSize) {
+ int offset = 0;
+ for (slot=0; slot < slots; slot++) {
+ if (slotPtr[slot].weight > 0) {
+ offset += slotPtr[slot].minSize;
+ } else if (slot > 0) {
+ offset += slotPtr[slot].offset - slotPtr[slot-1].offset;
+ } else {
+ offset += slotPtr[slot].offset;
+ }
+ slotPtr[slot].offset = offset;
+ }
+ return(0);
+ }
+
+ /*
+ * Remove space from slots according to their weights. The weights
+ * get renormalized anytime a slot shrinks to its minimum size.
+ */
+
+ while (diff < 0) {
+
+ /*
+ * Find the total weight for the shrinkable slots.
+ */
+
+ for (totalWeight=slot=0; slot < slots; slot++) {
+ int current = (slot == 0) ? slotPtr[slot].offset :
+ slotPtr[slot].offset - slotPtr[slot-1].offset;
+ if (current > slotPtr[slot].minSize) {
+ totalWeight += slotPtr[slot].weight;
+ slotPtr[slot].temp = slotPtr[slot].weight;
+ } else {
+ slotPtr[slot].temp = 0;
+ }
+ }
+ if (totalWeight == 0) {
+ break;
+ }
+
+ /*
+ * Find the maximum amount of space we can distribute this pass.
+ */
+
+ newDiff = diff;
+ for (slot = 0; slot < slots; slot++) {
+ int current; /* current size of this slot */
+ int maxDiff; /* max diff that would cause
+ * this slot to equal its minsize */
+ if (slotPtr[slot].temp == 0) {
+ continue;
+ }
+ current = (slot == 0) ? slotPtr[slot].offset :
+ slotPtr[slot].offset - slotPtr[slot-1].offset;
+ maxDiff = totalWeight * (slotPtr[slot].minSize - current)
+ / slotPtr[slot].temp;
+ if (maxDiff > newDiff) {
+ newDiff = maxDiff;
+ }
+ }
+
+ /*
+ * Now distribute the space.
+ */
+
+ for (weight=slot=0; slot < slots; slot++) {
+ weight += slotPtr[slot].temp;
+ slotPtr[slot].offset += newDiff * weight / totalWeight;
+ }
+ diff -= newDiff;
+ }
+ return(0);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * AdjustForSticky --
+ *
+ * This procedure adjusts the size of a slave in its cavity based
+ * on its "sticky" flags.
+ *
+ * Results:
+ * The input x, y, width, and height are changed to represent the
+ * desired coordinates of the slave.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+AdjustForSticky(slavePtr, xPtr, yPtr, widthPtr, heightPtr)
+ Gridder *slavePtr; /* Slave window to arrange in its cavity. */
+ int *xPtr; /* Pixel location of the left edge of the cavity. */
+ int *yPtr; /* Pixel location of the top edge of the cavity. */
+ int *widthPtr; /* Width of the cavity (in pixels). */
+ int *heightPtr; /* Height of the cavity (in pixels). */
+{
+ int diffx=0; /* Cavity width - slave width. */
+ int diffy=0; /* Cavity hight - slave height. */
+ int sticky = slavePtr->sticky;
+
+ *xPtr += slavePtr->padX/2;
+ *widthPtr -= slavePtr->padX;
+ *yPtr += slavePtr->padY/2;
+ *heightPtr -= slavePtr->padY;
+
+ if (*widthPtr > (Tk_ReqWidth(slavePtr->tkwin) + slavePtr->iPadX)) {
+ diffx = *widthPtr - (Tk_ReqWidth(slavePtr->tkwin) + slavePtr->iPadX);
+ *widthPtr = Tk_ReqWidth(slavePtr->tkwin) + slavePtr->iPadX;
+ }
+
+ if (*heightPtr > (Tk_ReqHeight(slavePtr->tkwin) + slavePtr->iPadY)) {
+ diffy = *heightPtr - (Tk_ReqHeight(slavePtr->tkwin) + slavePtr->iPadY);
+ *heightPtr = Tk_ReqHeight(slavePtr->tkwin) + slavePtr->iPadY;
+ }
+
+ if (sticky&STICK_EAST && sticky&STICK_WEST) {
+ *widthPtr += diffx;
+ }
+ if (sticky&STICK_NORTH && sticky&STICK_SOUTH) {
+ *heightPtr += diffy;
+ }
+ if (!(sticky&STICK_WEST)) {
+ *xPtr += (sticky&STICK_EAST) ? diffx : diffx/2;
+ }
+ if (!(sticky&STICK_NORTH)) {
+ *yPtr += (sticky&STICK_SOUTH) ? diffy : diffy/2;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArrangeGrid --
+ *
+ * This procedure is invoked (using the Tcl_DoWhenIdle
+ * mechanism) to re-layout a set of windows managed by
+ * the grid. It is invoked at idle time so that a
+ * series of grid requests can be merged into a single
+ * layout operation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The slaves of masterPtr may get resized or moved.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ArrangeGrid(clientData)
+ ClientData clientData; /* Structure describing parent whose slaves
+ * are to be re-layed out. */
+{
+ register Gridder *masterPtr = (Gridder *) clientData;
+ register Gridder *slavePtr;
+ GridMaster *slotPtr = masterPtr->masterDataPtr;
+ int abort;
+ int width, height; /* requested size of layout, in pixels */
+ int realWidth, realHeight; /* actual size layout should take-up */
+
+ masterPtr->flags &= ~REQUESTED_RELAYOUT;
+
+ /*
+ * If the parent has no slaves anymore, then don't do anything
+ * at all: just leave the parent's size as-is. Otherwise there is
+ * no way to "relinquish" control over the parent so another geometry
+ * manager can take over.
+ */
+
+ if (masterPtr->slavePtr == NULL) {
+ return;
+ }
+
+ if (masterPtr->masterDataPtr == NULL) {
+ return;
+ }
+
+ /*
+ * Abort any nested call to ArrangeGrid for this window, since
+ * we'll do everything necessary here, and set up so this call
+ * can be aborted if necessary.
+ */
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ masterPtr->abortPtr = &abort;
+ abort = 0;
+ Tcl_Preserve((ClientData) masterPtr);
+
+ /*
+ * Call the constraint engine to fill in the row and column offsets.
+ */
+
+ SetGridSize(masterPtr);
+ width = ResolveConstraints(masterPtr, COLUMN, 0);
+ height = ResolveConstraints(masterPtr, ROW, 0);
+ width += 2*Tk_InternalBorderWidth(masterPtr->tkwin);
+ height += 2*Tk_InternalBorderWidth(masterPtr->tkwin);
+
+ if (((width != Tk_ReqWidth(masterPtr->tkwin))
+ || (height != Tk_ReqHeight(masterPtr->tkwin)))
+ && !(masterPtr->flags & DONT_PROPAGATE)) {
+ Tk_GeometryRequest(masterPtr->tkwin, width, height);
+ if (width>1 && height>1) {
+ masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr);
+ }
+ masterPtr->abortPtr = NULL;
+ Tcl_Release((ClientData) masterPtr);
+ return;
+ }
+
+ /*
+ * If the currently requested layout size doesn't match the parent's
+ * window size, then adjust the slot offsets according to the
+ * weights. If all of the weights are zero, center the layout in
+ * its parent. I haven't decided what to do if the parent is smaller
+ * than the requested size.
+ */
+
+ realWidth = Tk_Width(masterPtr->tkwin) -
+ 2*Tk_InternalBorderWidth(masterPtr->tkwin);
+ realHeight = Tk_Height(masterPtr->tkwin) -
+ 2*Tk_InternalBorderWidth(masterPtr->tkwin);
+ slotPtr->startX = AdjustOffsets(realWidth,
+ MAX(slotPtr->columnEnd,slotPtr->columnMax), slotPtr->columnPtr);
+ slotPtr->startY = AdjustOffsets(realHeight,
+ MAX(slotPtr->rowEnd,slotPtr->rowMax), slotPtr->rowPtr);
+ slotPtr->startX += Tk_InternalBorderWidth(masterPtr->tkwin);
+ slotPtr->startY += Tk_InternalBorderWidth(masterPtr->tkwin);
+
+ /*
+ * Now adjust the actual size of the slave to its cavity by
+ * computing the cavity size, and adjusting the widget according
+ * to its stickyness.
+ */
+
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL && !abort;
+ slavePtr = slavePtr->nextPtr) {
+ int x, y; /* top left coordinate */
+ int width, height; /* slot or slave size */
+ int col = slavePtr->column;
+ int row = slavePtr->row;
+
+ x = (col>0) ? slotPtr->columnPtr[col-1].offset : 0;
+ y = (row>0) ? slotPtr->rowPtr[row-1].offset : 0;
+
+ width = slotPtr->columnPtr[slavePtr->numCols+col-1].offset - x;
+ height = slotPtr->rowPtr[slavePtr->numRows+row-1].offset - y;
+
+ x += slotPtr->startX;
+ y += slotPtr->startY;
+
+ AdjustForSticky(slavePtr, &x, &y, &width, &height);
+
+ /*
+ * Now put the window in the proper spot. (This was taken directly
+ * from tkPack.c.) If the slave is a child of the master, then
+ * do this here. Otherwise let Tk_MaintainGeometry do the work.
+ */
+
+ if (masterPtr->tkwin == Tk_Parent(slavePtr->tkwin)) {
+ if ((width <= 0) || (height <= 0)) {
+ Tk_UnmapWindow(slavePtr->tkwin);
+ } else {
+ if ((x != Tk_X(slavePtr->tkwin))
+ || (y != Tk_Y(slavePtr->tkwin))
+ || (width != Tk_Width(slavePtr->tkwin))
+ || (height != Tk_Height(slavePtr->tkwin))) {
+ Tk_MoveResizeWindow(slavePtr->tkwin, x, y, width, height);
+ }
+ if (abort) {
+ break;
+ }
+
+ /*
+ * Don't map the slave if the master isn't mapped: wait
+ * until the master gets mapped later.
+ */
+
+ if (Tk_IsMapped(masterPtr->tkwin)) {
+ Tk_MapWindow(slavePtr->tkwin);
+ }
+ }
+ } else {
+ if ((width <= 0) || (height <= 0)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, masterPtr->tkwin);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ } else {
+ Tk_MaintainGeometry(slavePtr->tkwin, masterPtr->tkwin,
+ x, y, width, height);
+ }
+ }
+ }
+
+ masterPtr->abortPtr = NULL;
+ Tcl_Release((ClientData) masterPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ResolveConstraints --
+ *
+ * Resolve all of the column and row boundaries. Most of
+ * the calculations are identical for rows and columns, so this procedure
+ * is called twice, once for rows, and again for columns.
+ *
+ * Results:
+ * The offset (in pixels) from the left/top edge of this layout is
+ * returned.
+ *
+ * Side effects:
+ * The slot offsets are copied into the SlotInfo structure for the
+ * geometry master.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ResolveConstraints(masterPtr, slotType, maxOffset)
+ Gridder *masterPtr; /* The geometry master for this grid. */
+ int slotType; /* Either ROW or COLUMN. */
+ int maxOffset; /* The actual maximum size of this layout
+ * in pixels, or 0 (not currently used). */
+{
+ register SlotInfo *slotPtr; /* Pointer to row/col constraints. */
+ register Gridder *slavePtr; /* List of slave windows in this grid. */
+ int constraintCount; /* Count of rows or columns that have
+ * constraints. */
+ int slotCount; /* Last occupied row or column. */
+ int gridCount; /* The larger of slotCount and constraintCount.
+ */
+ GridLayout *layoutPtr; /* Temporary layout structure. */
+ int requiredSize; /* The natural size of the grid (pixels).
+ * This is the minimum size needed to
+ * accomodate all of the slaves at their
+ * requested sizes. */
+ int offset; /* The pixel offset of the right edge of the
+ * current slot from the beginning of the
+ * layout. */
+ int slot; /* The current slot. */
+ int start; /* The first slot of a contiguous set whose
+ * constraints are not yet fully resolved. */
+ int end; /* The Last slot of a contiguous set whose
+ * constraints are not yet fully resolved. */
+
+ /*
+ * For typical sized tables, we'll use stack space for the layout data
+ * to avoid the overhead of a malloc and free for every layout.
+ */
+
+ GridLayout layoutData[TYPICAL_SIZE + 1];
+
+ if (slotType == COLUMN) {
+ constraintCount = masterPtr->masterDataPtr->columnMax;
+ slotCount = masterPtr->masterDataPtr->columnEnd;
+ slotPtr = masterPtr->masterDataPtr->columnPtr;
+ } else {
+ constraintCount = masterPtr->masterDataPtr->rowMax;
+ slotCount = masterPtr->masterDataPtr->rowEnd;
+ slotPtr = masterPtr->masterDataPtr->rowPtr;
+ }
+
+ /*
+ * Make sure there is enough memory for the layout.
+ */
+
+ gridCount = MAX(constraintCount,slotCount);
+ if (gridCount >= TYPICAL_SIZE) {
+ layoutPtr = (GridLayout *) Tcl_Alloc(sizeof(GridLayout) * (1+gridCount));
+ } else {
+ layoutPtr = layoutData;
+ }
+
+ /*
+ * Allocate an extra layout slot to represent the left/top edge of
+ * the 0th slot to make it easier to calculate slot widths from
+ * offsets without special case code.
+ * Initialize the "dummy" slot to the left/top of the table.
+ * This slot avoids special casing the first slot.
+ */
+
+ layoutPtr->minOffset = 0;
+ layoutPtr->maxOffset = 0;
+ layoutPtr++;
+
+ /*
+ * Step 1.
+ * Copy the slot constraints into the layout structure,
+ * and initialize the rest of the fields.
+ */
+
+ for (slot=0; slot < constraintCount; slot++) {
+ layoutPtr[slot].minSize = slotPtr[slot].minSize;
+ layoutPtr[slot].weight = slotPtr[slot].weight;
+ layoutPtr[slot].pad = slotPtr[slot].pad;
+ layoutPtr[slot].binNextPtr = NULL;
+ }
+ for(;slot<gridCount;slot++) {
+ layoutPtr[slot].minSize = 0;
+ layoutPtr[slot].weight = 0;
+ layoutPtr[slot].pad = 0;
+ layoutPtr[slot].binNextPtr = NULL;
+ }
+
+ /*
+ * Step 2.
+ * Slaves with a span of 1 are used to determine the minimum size of
+ * each slot. Slaves whose span is two or more slots don't
+ * contribute to the minimum size of each slot directly, but can cause
+ * slots to grow if their size exceeds the the sizes of the slots they
+ * span.
+ *
+ * Bin all slaves whose spans are > 1 by their right edges. This
+ * allows the computation on minimum and maximum possible layout
+ * sizes at each slot boundary, without the need to re-sort the slaves.
+ */
+
+ switch (slotType) {
+ case COLUMN:
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ int rightEdge = slavePtr->column + slavePtr->numCols - 1;
+ slavePtr->size = Tk_ReqWidth(slavePtr->tkwin) +
+ slavePtr->padX + slavePtr->iPadX + slavePtr->doubleBw;
+ if (slavePtr->numCols > 1) {
+ slavePtr->binNextPtr = layoutPtr[rightEdge].binNextPtr;
+ layoutPtr[rightEdge].binNextPtr = slavePtr;
+ } else {
+ int size = slavePtr->size + layoutPtr[rightEdge].pad;
+ if (size > layoutPtr[rightEdge].minSize) {
+ layoutPtr[rightEdge].minSize = size;
+ }
+ }
+ }
+ break;
+ case ROW:
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ int rightEdge = slavePtr->row + slavePtr->numRows - 1;
+ slavePtr->size = Tk_ReqHeight(slavePtr->tkwin) +
+ slavePtr->padY + slavePtr->iPadY + slavePtr->doubleBw;
+ if (slavePtr->numRows > 1) {
+ slavePtr->binNextPtr = layoutPtr[rightEdge].binNextPtr;
+ layoutPtr[rightEdge].binNextPtr = slavePtr;
+ } else {
+ int size = slavePtr->size + layoutPtr[rightEdge].pad;
+ if (size > layoutPtr[rightEdge].minSize) {
+ layoutPtr[rightEdge].minSize = size;
+ }
+ }
+ }
+ break;
+ }
+
+ /*
+ * Step 3.
+ * Determine the minimum slot offsets going from left to right
+ * that would fit all of the slaves. This determines the minimum
+ */
+
+ for (offset=slot=0; slot < gridCount; slot++) {
+ layoutPtr[slot].minOffset = layoutPtr[slot].minSize + offset;
+ for (slavePtr = layoutPtr[slot].binNextPtr; slavePtr != NULL;
+ slavePtr = slavePtr->binNextPtr) {
+ int span = (slotType == COLUMN) ? slavePtr->numCols : slavePtr->numRows;
+ int required = slavePtr->size + layoutPtr[slot - span].minOffset;
+ if (required > layoutPtr[slot].minOffset) {
+ layoutPtr[slot].minOffset = required;
+ }
+ }
+ offset = layoutPtr[slot].minOffset;
+ }
+
+ /*
+ * At this point, we know the minimum required size of the entire layout.
+ * It might be prudent to stop here if our "master" will resize itself
+ * to this size.
+ */
+
+ requiredSize = offset;
+ if (maxOffset > offset) {
+ offset=maxOffset;
+ }
+
+ /*
+ * Step 4.
+ * Determine the minimum slot offsets going from right to left,
+ * bounding the pixel range of each slot boundary.
+ * Pre-fill all of the right offsets with the actual size of the table;
+ * they will be reduced as required.
+ */
+
+ for (slot=0; slot < gridCount; slot++) {
+ layoutPtr[slot].maxOffset = offset;
+ }
+ for (slot=gridCount-1; slot > 0;) {
+ for (slavePtr = layoutPtr[slot].binNextPtr; slavePtr != NULL;
+ slavePtr = slavePtr->binNextPtr) {
+ int span = (slotType == COLUMN) ? slavePtr->numCols : slavePtr->numRows;
+ int require = offset - slavePtr->size;
+ int startSlot = slot - span;
+ if (startSlot >=0 && require < layoutPtr[startSlot].maxOffset) {
+ layoutPtr[startSlot].maxOffset = require;
+ }
+ }
+ offset -= layoutPtr[slot].minSize;
+ slot--;
+ if (layoutPtr[slot].maxOffset < offset) {
+ offset = layoutPtr[slot].maxOffset;
+ } else {
+ layoutPtr[slot].maxOffset = offset;
+ }
+ }
+
+ /*
+ * Step 5.
+ * At this point, each slot boundary has a range of values that
+ * will satisfy the overall layout size.
+ * Make repeated passes over the layout structure looking for
+ * spans of slot boundaries where the minOffsets are less than
+ * the maxOffsets, and adjust the offsets according to the slot
+ * weights. At each pass, at least one slot boundary will have
+ * its range of possible values fixed at a single value.
+ */
+
+ for (start=0; start < gridCount;) {
+ int totalWeight = 0; /* Sum of the weights for all of the
+ * slots in this span. */
+ int need = 0; /* The minimum space needed to layout
+ * this span. */
+ int have; /* The actual amount of space that will
+ * be taken up by this span. */
+ int weight; /* Cumulative weights of the columns in
+ * this span. */
+ int noWeights = 0; /* True if the span has no weights. */
+
+ /*
+ * Find a span by identifying ranges of slots whose edges are
+ * already constrained at fixed offsets, but whose internal
+ * slot boundaries have a range of possible positions.
+ */
+
+ if (layoutPtr[start].minOffset == layoutPtr[start].maxOffset) {
+ start++;
+ continue;
+ }
+
+ for (end=start+1; end<gridCount; end++) {
+ if (layoutPtr[end].minOffset == layoutPtr[end].maxOffset) {
+ break;
+ }
+ }
+
+ /*
+ * We found a span. Compute the total weight, minumum space required,
+ * for this span, and the actual amount of space the span should
+ * use.
+ */
+
+ for (slot=start; slot<=end; slot++) {
+ totalWeight += layoutPtr[slot].weight;
+ need += layoutPtr[slot].minSize;
+ }
+ have = layoutPtr[end].maxOffset - layoutPtr[start-1].minOffset;
+
+ /*
+ * If all the weights in the span are zero, then distribute the
+ * extra space evenly.
+ */
+
+ if (totalWeight == 0) {
+ noWeights++;
+ totalWeight = end - start + 1;
+ }
+
+ /*
+ * It might not be possible to give the span all of the space
+ * available on this pass without violating the size constraints
+ * of one or more of the internal slot boundaries.
+ * Determine the maximum amount of space that when added to the
+ * entire span, would cause a slot boundary to have its possible
+ * range reduced to one value, and reduce the amount of extra
+ * space allocated on this pass accordingly.
+ *
+ * The calculation is done cumulatively to avoid accumulating
+ * roundoff errors.
+ */
+
+ for (weight=0,slot=start; slot<end; slot++) {
+ int diff = layoutPtr[slot].maxOffset - layoutPtr[slot].minOffset;
+ weight += noWeights ? 1 : layoutPtr[slot].weight;
+ if ((noWeights || layoutPtr[slot].weight>0) &&
+ (diff*totalWeight/weight) < (have-need)) {
+ have = diff * totalWeight / weight + need;
+ }
+ }
+
+ /*
+ * Now distribute the extra space among the slots by
+ * adjusting the minSizes and minOffsets.
+ */
+
+ for (weight=0,slot=start; slot<end; slot++) {
+ weight += noWeights ? 1 : layoutPtr[slot].weight;
+ layoutPtr[slot].minOffset +=
+ (int)((double) (have-need) * weight/totalWeight + 0.5);
+ layoutPtr[slot].minSize = layoutPtr[slot].minOffset
+ - layoutPtr[slot-1].minOffset;
+ }
+ layoutPtr[slot].minSize = layoutPtr[slot].minOffset
+ - layoutPtr[slot-1].minOffset;
+
+ /*
+ * Having pushed the top/left boundaries of the slots to
+ * take up extra space, the bottom/right space is recalculated
+ * to propagate the new space allocation.
+ */
+
+ for (slot=end; slot > start; slot--) {
+ layoutPtr[slot-1].maxOffset =
+ layoutPtr[slot].maxOffset-layoutPtr[slot].minSize;
+ }
+ }
+
+
+ /*
+ * Step 6.
+ * All of the space has been apportioned; copy the
+ * layout information back into the master.
+ */
+
+ for (slot=0; slot < gridCount; slot++) {
+ slotPtr[slot].offset = layoutPtr[slot].minOffset;
+ }
+
+ --layoutPtr;
+ if (layoutPtr != layoutData) {
+ Tcl_Free((char *)layoutPtr);
+ }
+ return requiredSize;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetGrid --
+ *
+ * This internal procedure is used to locate a Grid
+ * structure for a given window, creating one if one
+ * doesn't exist already.
+ *
+ * Results:
+ * The return value is a pointer to the Grid structure
+ * corresponding to tkwin.
+ *
+ * Side effects:
+ * A new grid structure may be created. If so, then
+ * a callback is set up to clean things up when the
+ * window is deleted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Gridder *
+GetGrid(tkwin)
+ Tk_Window tkwin; /* Token for window for which
+ * grid structure is desired. */
+{
+ register Gridder *gridPtr;
+ Tcl_HashEntry *hPtr;
+ int new;
+
+ if (!initialized) {
+ initialized = 1;
+ Tcl_InitHashTable(&gridHashTable, TCL_ONE_WORD_KEYS);
+ }
+
+ /*
+ * See if there's already grid for this window. If not,
+ * then create a new one.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&gridHashTable, (char *) tkwin, &new);
+ if (!new) {
+ return (Gridder *) Tcl_GetHashValue(hPtr);
+ }
+ gridPtr = (Gridder *) Tcl_Alloc(sizeof(Gridder));
+ gridPtr->tkwin = tkwin;
+ gridPtr->masterPtr = NULL;
+ gridPtr->masterDataPtr = NULL;
+ gridPtr->nextPtr = NULL;
+ gridPtr->slavePtr = NULL;
+ gridPtr->binNextPtr = NULL;
+
+ gridPtr->column = gridPtr->row = -1;
+ gridPtr->numCols = 1;
+ gridPtr->numRows = 1;
+
+ gridPtr->padX = gridPtr->padY = 0;
+ gridPtr->iPadX = gridPtr->iPadY = 0;
+ gridPtr->doubleBw = 2*Tk_Changes(tkwin)->border_width;
+ gridPtr->abortPtr = NULL;
+ gridPtr->flags = 0;
+ gridPtr->sticky = 0;
+ gridPtr->size = 0;
+ gridPtr->masterDataPtr = NULL;
+ Tcl_SetHashValue(hPtr, gridPtr);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ GridStructureProc, (ClientData) gridPtr);
+ return gridPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SetGridSize --
+ *
+ * This internal procedure sets the size of the grid occupied
+ * by slaves.
+ *
+ * Results:
+ * none
+ *
+ * Side effects:
+ * The width and height arguments are filled in the master data structure.
+ * Additional space is allocated for the constraints to accomodate
+ * the offsets.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+SetGridSize(masterPtr)
+ Gridder *masterPtr; /* The geometry master for this grid. */
+{
+ register Gridder *slavePtr; /* Current slave window. */
+ int maxX = 0, maxY = 0;
+
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ maxX = MAX(maxX,slavePtr->numCols + slavePtr->column);
+ maxY = MAX(maxY,slavePtr->numRows + slavePtr->row);
+ }
+ masterPtr->masterDataPtr->columnEnd = maxX;
+ masterPtr->masterDataPtr->rowEnd = maxY;
+ CheckSlotData(masterPtr, maxX, COLUMN, CHECK_SPACE);
+ CheckSlotData(masterPtr, maxY, ROW, CHECK_SPACE);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CheckSlotData --
+ *
+ * This internal procedure is used to manage the storage for
+ * row and column (slot) constraints.
+ *
+ * Results:
+ * TRUE if the index is OK, False otherwise.
+ *
+ * Side effects:
+ * A new master grid structure may be created. If so, then
+ * it is initialized. In addition, additional storage for
+ * a row or column constraints may be allocated, and the constraint
+ * maximums are adjusted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CheckSlotData(masterPtr, slot, slotType, checkOnly)
+ Gridder *masterPtr; /* the geometry master for this grid */
+ int slot; /* which slot to look at */
+ int slotType; /* ROW or COLUMN */
+ int checkOnly; /* don't allocate new space if true */
+{
+ int numSlot; /* number of slots already allocated (Space) */
+ int end; /* last used constraint */
+
+ /*
+ * If slot is out of bounds, return immediately.
+ */
+
+ if (slot < 0 || slot >= MAX_ELEMENT) {
+ return TCL_ERROR;
+ }
+
+ if ((checkOnly == CHECK_ONLY) && (masterPtr->masterDataPtr == NULL)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If we need to allocate more space, allocate a little extra to avoid
+ * repeated re-alloc's for large tables. We need enough space to
+ * hold all of the offsets as well.
+ */
+
+ InitMasterData(masterPtr);
+ end = (slotType == ROW) ? masterPtr->masterDataPtr->rowMax :
+ masterPtr->masterDataPtr->columnMax;
+ if (checkOnly == CHECK_ONLY) {
+ return (end < slot) ? TCL_ERROR : TCL_OK;
+ } else {
+ numSlot = (slotType == ROW) ? masterPtr->masterDataPtr->rowSpace
+ : masterPtr->masterDataPtr->columnSpace;
+ if (slot >= numSlot) {
+ int newNumSlot = slot + PREALLOC ;
+ size_t oldSize = numSlot * sizeof(SlotInfo) ;
+ size_t newSize = newNumSlot * sizeof(SlotInfo) ;
+ SlotInfo *new = (SlotInfo *) Tcl_Alloc(newSize);
+ SlotInfo *old = (slotType == ROW) ?
+ masterPtr->masterDataPtr->rowPtr :
+ masterPtr->masterDataPtr->columnPtr;
+ memcpy((VOID *) new, (VOID *) old, oldSize );
+ memset((VOID *) (new+numSlot), 0, newSize - oldSize );
+ Tcl_Free((char *) old);
+ if (slotType == ROW) {
+ masterPtr->masterDataPtr->rowPtr = new ;
+ masterPtr->masterDataPtr->rowSpace = newNumSlot ;
+ } else {
+ masterPtr->masterDataPtr->columnPtr = new;
+ masterPtr->masterDataPtr->columnSpace = newNumSlot ;
+ }
+ }
+ if (slot >= end && checkOnly != CHECK_SPACE) {
+ if (slotType == ROW) {
+ masterPtr->masterDataPtr->rowMax = slot+1;
+ } else {
+ masterPtr->masterDataPtr->columnMax = slot+1;
+ }
+ }
+ return TCL_OK;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * InitMasterData --
+ *
+ * This internal procedure is used to allocate and initialize
+ * the data for a geometry master, if the data
+ * doesn't exist already.
+ *
+ * Results:
+ * none
+ *
+ * Side effects:
+ * A new master grid structure may be created. If so, then
+ * it is initialized.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+InitMasterData(masterPtr)
+ Gridder *masterPtr;
+{
+ size_t size;
+ if (masterPtr->masterDataPtr == NULL) {
+ GridMaster *gridPtr = masterPtr->masterDataPtr =
+ (GridMaster *) Tcl_Alloc(sizeof(GridMaster));
+ size = sizeof(SlotInfo) * TYPICAL_SIZE;
+
+ gridPtr->columnEnd = 0;
+ gridPtr->columnMax = 0;
+ gridPtr->columnPtr = (SlotInfo *) Tcl_Alloc(size);
+ gridPtr->columnSpace = 0;
+ gridPtr->columnSpace = TYPICAL_SIZE;
+ gridPtr->rowEnd = 0;
+ gridPtr->rowMax = 0;
+ gridPtr->rowPtr = (SlotInfo *) Tcl_Alloc(size);
+ gridPtr->rowSpace = 0;
+ gridPtr->rowSpace = TYPICAL_SIZE;
+
+ memset((VOID *) gridPtr->columnPtr, 0, size);
+ memset((VOID *) gridPtr->rowPtr, 0, size);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Unlink --
+ *
+ * Remove a grid from its parent's list of slaves.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The parent will be scheduled for re-arranging, and the size of the
+ * grid will be adjusted accordingly
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+Unlink(slavePtr)
+ register Gridder *slavePtr; /* Window to unlink. */
+{
+ register Gridder *masterPtr, *slavePtr2;
+ GridMaster *gridPtr; /* pointer to grid data */
+
+ masterPtr = slavePtr->masterPtr;
+ if (masterPtr == NULL) {
+ return;
+ }
+
+ gridPtr = masterPtr->masterDataPtr;
+ if (masterPtr->slavePtr == slavePtr) {
+ masterPtr->slavePtr = slavePtr->nextPtr;
+ }
+ else {
+ for (slavePtr2 = masterPtr->slavePtr; ; slavePtr2 = slavePtr2->nextPtr) {
+ if (slavePtr2 == NULL) {
+ panic("Unlink couldn't find previous window");
+ }
+ if (slavePtr2->nextPtr == slavePtr) {
+ slavePtr2->nextPtr = slavePtr->nextPtr;
+ break;
+ }
+ }
+ }
+ if (!(masterPtr->flags & REQUESTED_RELAYOUT)) {
+ masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr);
+ }
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+
+ if ((slavePtr->numCols+slavePtr->column == gridPtr->columnMax)
+ || (slavePtr->numRows+slavePtr->row == gridPtr->rowMax)) {
+ }
+ slavePtr->masterPtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyGrid --
+ *
+ * This procedure is invoked by Tk_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a grid at a safe time
+ * (when no-one is using it anymore). Cleaning up the grid involves
+ * freeing the main structure for all windows. and the master structure
+ * for geometry managers.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the grid is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyGrid(memPtr)
+ char *memPtr; /* Info about window that is now dead. */
+{
+ register Gridder *gridPtr = (Gridder *) memPtr;
+
+ if (gridPtr->masterDataPtr != NULL) {
+ if (gridPtr->masterDataPtr->rowPtr != NULL) {
+ Tcl_Free((char *) gridPtr->masterDataPtr -> rowPtr);
+ }
+ if (gridPtr->masterDataPtr->columnPtr != NULL) {
+ Tcl_Free((char *) gridPtr->masterDataPtr -> columnPtr);
+ }
+ Tcl_Free((char *) gridPtr->masterDataPtr);
+ }
+ Tcl_Free((char *) gridPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridStructureProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher in response
+ * to StructureNotify events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If a window was just deleted, clean up all its grid-related
+ * information. If it was just resized, re-configure its slaves, if
+ * any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GridStructureProc(clientData, eventPtr)
+ ClientData clientData; /* Our information about window
+ * referred to by eventPtr. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ register Gridder *gridPtr = (Gridder *) clientData;
+
+ if (eventPtr->type == ConfigureNotify) {
+ if (!(gridPtr->flags & REQUESTED_RELAYOUT)) {
+ gridPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) gridPtr);
+ }
+ if (gridPtr->doubleBw != 2*Tk_Changes(gridPtr->tkwin)->border_width) {
+ if ((gridPtr->masterPtr != NULL) &&
+ !(gridPtr->masterPtr->flags & REQUESTED_RELAYOUT)) {
+ gridPtr->doubleBw = 2*Tk_Changes(gridPtr->tkwin)->border_width;
+ gridPtr->masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) gridPtr->masterPtr);
+ }
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ register Gridder *gridPtr2, *nextPtr;
+
+ if (gridPtr->masterPtr != NULL) {
+ Unlink(gridPtr);
+ }
+ for (gridPtr2 = gridPtr->slavePtr; gridPtr2 != NULL;
+ gridPtr2 = nextPtr) {
+ Tk_UnmapWindow(gridPtr2->tkwin);
+ gridPtr2->masterPtr = NULL;
+ nextPtr = gridPtr2->nextPtr;
+ gridPtr2->nextPtr = NULL;
+ }
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&gridHashTable,
+ (char *) gridPtr->tkwin));
+ if (gridPtr->flags & REQUESTED_RELAYOUT) {
+ Tk_CancelIdleCall(ArrangeGrid, (ClientData) gridPtr);
+ }
+ gridPtr->tkwin = NULL;
+ Tk_EventuallyFree((ClientData) gridPtr, DestroyGrid);
+ } else if (eventPtr->type == MapNotify) {
+ if (!(gridPtr->flags & REQUESTED_RELAYOUT)) {
+ gridPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) gridPtr);
+ }
+ } else if (eventPtr->type == UnmapNotify) {
+ register Gridder *gridPtr2;
+
+ for (gridPtr2 = gridPtr->slavePtr; gridPtr2 != NULL;
+ gridPtr2 = gridPtr2->nextPtr) {
+ Tk_UnmapWindow(gridPtr2->tkwin);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureSlaves --
+ *
+ * This implements the guts of the "grid configure" command. Given
+ * a list of slaves and configuration options, it arranges for the
+ * grid to manage the slaves and sets the specified options.
+ * arguments consist of windows or window shortcuts followed by
+ * "-option value" pairs.
+ *
+ * Results:
+ * TCL_OK is returned if all went well. Otherwise, TCL_ERROR is
+ * returned and interp->result is set to contain an error message.
+ *
+ * Side effects:
+ * Slave windows get taken over by the grid.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureSlaves(interp, tkwin, argc, argv)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Window tkwin; /* Any window in application containing
+ * slaves. Used to look up slave names. */
+ int argc; /* Number of elements in argv. */
+ char *argv[]; /* Argument strings: contains one or more
+ * window names followed by any number
+ * of "option value" pairs. Caller must
+ * make sure that there is at least one
+ * window name. */
+{
+ Gridder *masterPtr;
+ Gridder *slavePtr;
+ Tk_Window other, slave, parent, ancestor;
+ int i, j, c, tmp;
+ size_t length;
+ int numWindows;
+ int width;
+ int defaultColumn = 0; /* default column number */
+ int defaultColumnSpan = 1; /* default number of columns */
+ char *lastWindow; /* use this window to base current
+ * Row/col on */
+
+ /*
+ * Count the number of windows, or window short-cuts.
+ */
+
+ for(numWindows=i=0;i<argc;i++) {
+ char firstChar = *argv[i];
+ if (firstChar == '.') {
+ numWindows++;
+ continue;
+ }
+ length = strlen(argv[i]);
+ if (length > 1 && firstChar == '-') {
+ break;
+ }
+ if (length > 1) {
+ Tcl_AppendResult(interp, "unexpected parameter, \"",
+ argv[i], "\", in configure list. ",
+ "Should be window name or option", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if ((firstChar == REL_HORIZ) && ((numWindows == 0) ||
+ (*argv[i-1] == REL_SKIP) || (*argv[i-1] == REL_VERT))) {
+ Tcl_AppendResult(interp,
+ "Must specify window before shortcut '-'.",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if ((firstChar == REL_VERT) || (firstChar == REL_SKIP)
+ || (firstChar == REL_HORIZ)) {
+ continue;
+ }
+
+ Tcl_AppendResult(interp, "invalid window shortcut, \"",
+ argv[i], "\" should be '-', 'x', or '^'", (char *) NULL);
+ return TCL_ERROR;
+ }
+ numWindows = i;
+
+ if ((argc-numWindows)&1) {
+ Tcl_AppendResult(interp, "extra option or",
+ " option with no value", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Iterate over all of the slave windows and short-cuts, parsing
+ * options for each slave. It's a bit wasteful to re-parse the
+ * options for each slave, but things get too messy if we try to
+ * parse the arguments just once at the beginning. For example,
+ * if a slave already is managed we want to just change a few
+ * existing values without resetting everything. If there are
+ * multiple windows, the -in option only gets processed for the
+ * first window.
+ */
+
+ masterPtr = NULL;
+ for (j = 0; j < numWindows; j++) {
+ char firstChar = *argv[j];
+
+ /*
+ * '^' and 'x' cause us to skip a column. '-' is processed
+ * as part of its preceeding slave.
+ */
+
+ if ((firstChar == REL_VERT) || (firstChar == REL_SKIP)) {
+ defaultColumn++;
+ continue;
+ }
+ if (firstChar == REL_HORIZ) {
+ continue;
+ }
+
+ for (defaultColumnSpan=1;
+ j + defaultColumnSpan < numWindows &&
+ (*argv[j+defaultColumnSpan] == REL_HORIZ);
+ defaultColumnSpan++) {
+ /* null body */
+ }
+
+ slave = Tk_NameToWindow(interp, argv[j], tkwin);
+ if (slave == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tk_IsTopLevel(slave)) {
+ Tcl_AppendResult(interp, "can't manage \"", argv[j],
+ "\": it's a top-level window", (char *) NULL);
+ return TCL_ERROR;
+ }
+ slavePtr = GetGrid(slave);
+
+ /*
+ * The following statement is taken from tkPack.c:
+ *
+ * "If the slave isn't currently managed, reset all of its
+ * configuration information to default values (there could
+ * be old values left from a previous packer)."
+ *
+ * I [D.S.] disagree with this statement. If a slave is disabled (using
+ * "forget") and then re-enabled, I submit that 90% of the time the
+ * programmer will want it to retain its old configuration information.
+ * If the programmer doesn't want this behavior, then the
+ * defaults can be reestablished by hand, without having to worry
+ * about keeping track of the old state.
+ */
+
+ for (i = numWindows; i < argc; i+=2) {
+ length = strlen(argv[i]);
+ c = argv[i][1];
+
+ if (length < 2) {
+ Tcl_AppendResult(interp, "unknown or ambiguous option \"",
+ argv[i], "\": must be ",
+ "-column, -columnspan, -in, -ipadx, -ipady, ",
+ "-padx, -pady, -row, -rowspan, or -sticky",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ((c == 'c') && (strncmp(argv[i], "-column", length) == 0)) {
+ if (Tcl_GetInt(interp, argv[i+1], &tmp) != TCL_OK || tmp<0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad column value \"", argv[i+1],
+ "\": must be a non-negative integer", (char *)NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->column = tmp;
+ } else if ((c == 'c')
+ && (strncmp(argv[i], "-columnspan", length) == 0)) {
+ if (Tcl_GetInt(interp, argv[i+1], &tmp) != TCL_OK || tmp <= 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad columnspan value \"", argv[i+1],
+ "\": must be a positive integer", (char *)NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->numCols = tmp;
+ } else if ((c == 'i') && (strncmp(argv[i], "-in", length) == 0)) {
+ other = Tk_NameToWindow(interp, argv[i+1], tkwin);
+ if (other == NULL) {
+ return TCL_ERROR;
+ }
+ if (other == slave) {
+ sprintf(interp->result,"Window can't be managed in itself");
+ return TCL_ERROR;
+ }
+ masterPtr = GetGrid(other);
+ InitMasterData(masterPtr);
+ } else if ((c == 'i')
+ && (strncmp(argv[i], "-ipadx", length) == 0)) {
+ if ((Tk_GetPixels(interp, slave, argv[i+1], &tmp) != TCL_OK)
+ || (tmp < 0)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad ipadx value \"", argv[i+1],
+ "\": must be positive screen distance",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->iPadX = tmp*2;
+ } else if ((c == 'i')
+ && (strncmp(argv[i], "-ipady", length) == 0)) {
+ if ((Tk_GetPixels(interp, slave, argv[i+1], &tmp) != TCL_OK)
+ || (tmp< 0)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad ipady value \"", argv[i+1],
+ "\": must be positive screen distance",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->iPadY = tmp*2;
+ } else if ((c == 'p')
+ && (strncmp(argv[i], "-padx", length) == 0)) {
+ if ((Tk_GetPixels(interp, slave, argv[i+1], &tmp) != TCL_OK)
+ || (tmp< 0)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad padx value \"", argv[i+1],
+ "\": must be positive screen distance",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->padX = tmp*2;
+ } else if ((c == 'p')
+ && (strncmp(argv[i], "-pady", length) == 0)) {
+ if ((Tk_GetPixels(interp, slave, argv[i+1], &tmp) != TCL_OK)
+ || (tmp< 0)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad pady value \"", argv[i+1],
+ "\": must be positive screen distance",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->padY = tmp*2;
+ } else if ((c == 'r') && (strncmp(argv[i], "-row", length) == 0)) {
+ if (Tcl_GetInt(interp, argv[i+1], &tmp) != TCL_OK || tmp<0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad grid value \"", argv[i+1],
+ "\": must be a non-negative integer", (char *)NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->row = tmp;
+ } else if ((c == 'r')
+ && (strncmp(argv[i], "-rowspan", length) == 0)) {
+ if ((Tcl_GetInt(interp, argv[i+1], &tmp) != TCL_OK) || tmp<=0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad rowspan value \"", argv[i+1],
+ "\": must be a positive integer", (char *)NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->numRows = tmp;
+ } else if ((c == 's')
+ && strncmp(argv[i], "-sticky", length) == 0) {
+ int sticky = StringToSticky(argv[i+1]);
+ if (sticky == -1) {
+ Tcl_AppendResult(interp, "bad stickyness value \"", argv[i+1],
+ "\": must be a string containing n, e, s, and/or w",
+ (char *)NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->sticky = sticky;
+ } else {
+ Tcl_AppendResult(interp, "unknown or ambiguous option \"",
+ argv[i], "\": must be ",
+ "-column, -columnspan, -in, -ipadx, -ipady, ",
+ "-padx, -pady, -row, -rowspan, or -sticky",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Make sure we have a geometry master. We look at:
+ * 1) the -in flag
+ * 2) the geometry master of the first slave (if specified)
+ * 3) the parent of the first slave.
+ */
+
+ if (masterPtr == NULL) {
+ masterPtr = slavePtr->masterPtr;
+ }
+ parent = Tk_Parent(slave);
+ if (masterPtr == NULL) {
+ masterPtr = GetGrid(parent);
+ InitMasterData(masterPtr);
+ }
+
+ if (slavePtr->masterPtr != NULL && slavePtr->masterPtr != masterPtr) {
+ Unlink(slavePtr);
+ slavePtr->masterPtr = NULL;
+ }
+
+ if (slavePtr->masterPtr == NULL) {
+ Gridder *tempPtr = masterPtr->slavePtr;
+ slavePtr->masterPtr = masterPtr;
+ masterPtr->slavePtr = slavePtr;
+ slavePtr->nextPtr = tempPtr;
+ }
+
+ /*
+ * Make sure that the slave's parent is either the master or
+ * an ancestor of the master, and that the master and slave
+ * aren't the same.
+ */
+
+ for (ancestor = masterPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ if (Tk_IsTopLevel(ancestor)) {
+ Tcl_AppendResult(interp, "can't put ", argv[j],
+ " inside ", Tk_PathName(masterPtr->tkwin),
+ (char *) NULL);
+ Unlink(slavePtr);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Try to make sure our master isn't managed by us.
+ */
+
+ if (masterPtr->masterPtr == slavePtr) {
+ Tcl_AppendResult(interp, "can't put ", argv[j],
+ " inside ", Tk_PathName(masterPtr->tkwin),
+ ", would cause management loop.",
+ (char *) NULL);
+ Unlink(slavePtr);
+ return TCL_ERROR;
+ }
+
+ Tk_ManageGeometry(slave, &gridMgrType, (ClientData) slavePtr);
+
+ /*
+ * Assign default position information.
+ */
+
+ if (slavePtr->column == -1) {
+ slavePtr->column = defaultColumn;
+ }
+ slavePtr->numCols += defaultColumnSpan - 1;
+ if (slavePtr->row == -1) {
+ if (masterPtr->masterDataPtr == NULL) {
+ slavePtr->row = 0;
+ } else {
+ slavePtr->row = masterPtr->masterDataPtr->rowEnd;
+ }
+ }
+ defaultColumn += slavePtr->numCols;
+ defaultColumnSpan = 1;
+
+ /*
+ * Arrange for the parent to be re-arranged at the first
+ * idle moment.
+ */
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ if (!(masterPtr->flags & REQUESTED_RELAYOUT)) {
+ masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr);
+ }
+ }
+
+ /* Now look for all the "^"'s. */
+
+ lastWindow = NULL;
+ for (j = 0; j < numWindows; j++) {
+ struct Gridder *otherPtr;
+ int match; /* found a match for the ^ */
+ int lastRow, lastColumn; /* implied end of table */
+
+ if (*argv[j] == '.') {
+ lastWindow = argv[j];
+ }
+ if (*argv[j] != REL_VERT) {
+ continue;
+ }
+
+ if (masterPtr == NULL) {
+ Tcl_AppendResult(interp, "can't use '^', cant find master",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ for (width=1; width+j < numWindows && *argv[j+width] == REL_VERT;
+ width++) {
+ /* Null Body */
+ }
+
+ /*
+ * Find the implied grid location of the ^
+ */
+
+ if (lastWindow == NULL) {
+ if (masterPtr->masterDataPtr != NULL) {
+ SetGridSize(masterPtr);
+ lastRow = masterPtr->masterDataPtr->rowEnd - 1;
+ } else {
+ lastRow = 0;
+ }
+ lastColumn = 0;
+ } else {
+ other = Tk_NameToWindow(interp, lastWindow, tkwin);
+ otherPtr = GetGrid(other);
+ lastRow = otherPtr->row;
+ lastColumn = otherPtr->column + otherPtr->numCols;
+ }
+
+ for (match=0, slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+
+ if (slavePtr->numCols == width
+ && slavePtr->column == lastColumn
+ && slavePtr->row + slavePtr->numRows == lastRow) {
+ slavePtr->numRows++;
+ match++;
+ }
+ lastWindow = Tk_PathName(slavePtr->tkwin);
+ }
+ if (!match) {
+ Tcl_AppendResult(interp, "can't find slave to extend with \"^\".",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ j += width - 1;
+ }
+
+ if (masterPtr == NULL) {
+ Tcl_AppendResult(interp, "can't determine master window",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ SetGridSize(masterPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StickyToString
+ *
+ * Converts the internal boolean combination of "sticky" bits onto
+ * a TCL list element containing zero or mor of n, s, e, or w.
+ *
+ * Results:
+ * A string is placed into the "result" pointer.
+ *
+ * Side effects:
+ * none.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+StickyToString(flags, result)
+ int flags; /* the sticky flags */
+ char *result; /* where to put the result */
+{
+ int count = 0;
+ if (flags&STICK_NORTH) {
+ result[count++] = 'n';
+ }
+ if (flags&STICK_EAST) {
+ result[count++] = 'e';
+ }
+ if (flags&STICK_SOUTH) {
+ result[count++] = 's';
+ }
+ if (flags&STICK_WEST) {
+ result[count++] = 'w';
+ }
+ if (count) {
+ result[count] = '\0';
+ } else {
+ sprintf(result,"{}");
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringToSticky --
+ *
+ * Converts an ascii string representing a widgets stickyness
+ * into the boolean result.
+ *
+ * Results:
+ * The boolean combination of the "sticky" bits is retuned. If an
+ * error occurs, such as an invalid character, -1 is returned instead.
+ *
+ * Side effects:
+ * none
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringToSticky(string)
+ char *string;
+{
+ int sticky = 0;
+ char c;
+
+ while ((c = *string++) != '\0') {
+ switch (c) {
+ case 'n': case 'N': sticky |= STICK_NORTH; break;
+ case 'e': case 'E': sticky |= STICK_EAST; break;
+ case 's': case 'S': sticky |= STICK_SOUTH; break;
+ case 'w': case 'W': sticky |= STICK_WEST; break;
+ case ' ': case ',': case '\t': case '\r': case '\n': break;
+ default: return -1;
+ }
+ }
+ return sticky;
+}
diff --git a/generic/tkImage.c b/generic/tkImage.c
new file mode 100644
index 0000000..251fe30
--- /dev/null
+++ b/generic/tkImage.c
@@ -0,0 +1,789 @@
+/*
+ * tkImage.c --
+ *
+ * This module implements the image protocol, which allows lots
+ * of different kinds of images to be used in lots of different
+ * widgets.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkImage.c 1.15 97/10/09 09:57:50
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * Each call to Tk_GetImage returns a pointer to one of the following
+ * structures, which is used as a token by clients (widgets) that
+ * display images.
+ */
+
+typedef struct Image {
+ Tk_Window tkwin; /* Window passed to Tk_GetImage (needed to
+ * "re-get" the image later if the manager
+ * changes). */
+ Display *display; /* Display for tkwin. Needed because when
+ * the image is eventually freed tkwin may
+ * not exist anymore. */
+ struct ImageMaster *masterPtr;
+ /* Master for this image (identifiers image
+ * manager, for example). */
+ ClientData instanceData;
+ /* One word argument to pass to image manager
+ * when dealing with this image instance. */
+ Tk_ImageChangedProc *changeProc;
+ /* Code in widget to call when image changes
+ * in a way that affects redisplay. */
+ ClientData widgetClientData;
+ /* Argument to pass to changeProc. */
+ struct Image *nextPtr; /* Next in list of all image instances
+ * associated with the same name. */
+
+} Image;
+
+/*
+ * For each image master there is one of the following structures,
+ * which represents a name in the image table and all of the images
+ * instantiated from it. Entries in mainPtr->imageTable point to
+ * these structures.
+ */
+
+typedef struct ImageMaster {
+ Tk_ImageType *typePtr; /* Information about image type. NULL means
+ * that no image manager owns this image: the
+ * image was deleted. */
+ ClientData masterData; /* One-word argument to pass to image mgr
+ * when dealing with the master, as opposed
+ * to instances. */
+ int width, height; /* Last known dimensions for image. */
+ Tcl_HashTable *tablePtr; /* Pointer to hash table containing image
+ * (the imageTable field in some TkMainInfo
+ * structure). */
+ Tcl_HashEntry *hPtr; /* Hash entry in mainPtr->imageTable for
+ * this structure (used to delete the hash
+ * entry). */
+ Image *instancePtr; /* Pointer to first in list of instances
+ * derived from this name. */
+} ImageMaster;
+
+/*
+ * The following variable points to the first in a list of all known
+ * image types.
+ */
+
+static Tk_ImageType *imageTypeList = NULL;
+
+/*
+ * Prototypes for local procedures:
+ */
+
+static void DeleteImage _ANSI_ARGS_((ImageMaster *masterPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CreateImageType --
+ *
+ * This procedure is invoked by an image manager to tell Tk about
+ * a new kind of image and the procedures that manage the new type.
+ * The procedure is typically invoked during Tcl_AppInit.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The new image type is entered into a table used in the "image
+ * create" command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CreateImageType(typePtr)
+ Tk_ImageType *typePtr; /* Structure describing the type. All of
+ * the fields except "nextPtr" must be filled
+ * in by caller. Must not have been passed
+ * to Tk_CreateImageType previously. */
+{
+ typePtr->nextPtr = imageTypeList;
+ imageTypeList = typePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ImageCmd --
+ *
+ * This procedure is invoked to process the "image" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ImageCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ TkWindow *winPtr = (TkWindow *) clientData;
+ int c, i, new, firstOption;
+ size_t length;
+ Tk_ImageType *typePtr;
+ ImageMaster *masterPtr;
+ Image *imagePtr;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ char idString[30], *name;
+ static int id = 0;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " option ?args?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'c') && (strncmp(argv[1], "create", length) == 0)) {
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " create type ?name? ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = argv[2][0];
+
+ /*
+ * Look up the image type.
+ */
+
+ for (typePtr = imageTypeList; typePtr != NULL;
+ typePtr = typePtr->nextPtr) {
+ if ((c == typePtr->name[0])
+ && (strcmp(argv[2], typePtr->name) == 0)) {
+ break;
+ }
+ }
+ if (typePtr == NULL) {
+ Tcl_AppendResult(interp, "image type \"", argv[2],
+ "\" doesn't exist", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Figure out a name to use for the new image.
+ */
+
+ if ((argc == 3) || (argv[3][0] == '-')) {
+ id++;
+ sprintf(idString, "image%d", id);
+ name = idString;
+ firstOption = 3;
+ } else {
+ name = argv[3];
+ firstOption = 4;
+ }
+
+ /*
+ * Create the data structure for the new image.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&winPtr->mainPtr->imageTable, name, &new);
+ if (new) {
+ masterPtr = (ImageMaster *) ckalloc(sizeof(ImageMaster));
+ masterPtr->typePtr = NULL;
+ masterPtr->masterData = NULL;
+ masterPtr->width = masterPtr->height = 1;
+ masterPtr->tablePtr = &winPtr->mainPtr->imageTable;
+ masterPtr->hPtr = hPtr;
+ masterPtr->instancePtr = NULL;
+ Tcl_SetHashValue(hPtr, masterPtr);
+ } else {
+ /*
+ * An image already exists by this name. Disconnect the
+ * instances from the master.
+ */
+
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ if (masterPtr->typePtr != NULL) {
+ for (imagePtr = masterPtr->instancePtr; imagePtr != NULL;
+ imagePtr = imagePtr->nextPtr) {
+ (*masterPtr->typePtr->freeProc)(
+ imagePtr->instanceData, imagePtr->display);
+ (*imagePtr->changeProc)(imagePtr->widgetClientData, 0, 0,
+ masterPtr->width, masterPtr->height, masterPtr->width,
+ masterPtr->height);
+ }
+ (*masterPtr->typePtr->deleteProc)(masterPtr->masterData);
+ masterPtr->typePtr = NULL;
+ }
+ }
+
+ /*
+ * Call the image type manager so that it can perform its own
+ * initialization, then re-"get" for any existing instances of
+ * the image.
+ */
+
+ if ((*typePtr->createProc)(interp, name, argc-firstOption,
+ argv+firstOption, typePtr, (Tk_ImageMaster) masterPtr,
+ &masterPtr->masterData) != TCL_OK) {
+ DeleteImage(masterPtr);
+ return TCL_ERROR;
+ }
+ masterPtr->typePtr = typePtr;
+ for (imagePtr = masterPtr->instancePtr; imagePtr != NULL;
+ imagePtr = imagePtr->nextPtr) {
+ imagePtr->instanceData = (*typePtr->getProc)(
+ imagePtr->tkwin, masterPtr->masterData);
+ }
+ interp->result = Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr);
+ } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) {
+ for (i = 2; i < argc; i++) {
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, argv[i]);
+ if (hPtr == NULL) {
+ Tcl_AppendResult(interp, "image \"", argv[i],
+ "\" doesn't exist", (char *) NULL);
+ return TCL_ERROR;
+ }
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ DeleteImage(masterPtr);
+ }
+ } else if ((c == 'h') && (strncmp(argv[1], "height", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " height name\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, argv[2]);
+ if (hPtr == NULL) {
+ Tcl_AppendResult(interp, "image \"", argv[2],
+ "\" doesn't exist", (char *) NULL);
+ return TCL_ERROR;
+ }
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ sprintf(interp->result, "%d", masterPtr->height);
+ } else if ((c == 'n') && (strncmp(argv[1], "names", length) == 0)) {
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " names\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (hPtr = Tcl_FirstHashEntry(&winPtr->mainPtr->imageTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendElement(interp, Tcl_GetHashKey(
+ &winPtr->mainPtr->imageTable, hPtr));
+ }
+ } else if ((c == 't') && (strcmp(argv[1], "type") == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " type name\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, argv[2]);
+ if (hPtr == NULL) {
+ Tcl_AppendResult(interp, "image \"", argv[2],
+ "\" doesn't exist", (char *) NULL);
+ return TCL_ERROR;
+ }
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ if (masterPtr->typePtr != NULL) {
+ interp->result = masterPtr->typePtr->name;
+ }
+ } else if ((c == 't') && (strcmp(argv[1], "types") == 0)) {
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " types\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (typePtr = imageTypeList; typePtr != NULL;
+ typePtr = typePtr->nextPtr) {
+ Tcl_AppendElement(interp, typePtr->name);
+ }
+ } else if ((c == 'w') && (strncmp(argv[1], "width", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " width name\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, argv[2]);
+ if (hPtr == NULL) {
+ Tcl_AppendResult(interp, "image \"", argv[2],
+ "\" doesn't exist", (char *) NULL);
+ return TCL_ERROR;
+ }
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ sprintf(interp->result, "%d", masterPtr->width);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be create, delete, height, names, type, types,",
+ " or width", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ImageChanged --
+ *
+ * This procedure is called by an image manager whenever something
+ * has happened that requires the image to be redrawn (some of its
+ * pixels have changed, or its size has changed).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Any widgets that display the image are notified so that they
+ * can redisplay themselves as appropriate.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_ImageChanged(imageMaster, x, y, width, height, imageWidth,
+ imageHeight)
+ Tk_ImageMaster imageMaster; /* Image that needs redisplay. */
+ int x, y; /* Coordinates of upper-left pixel of
+ * region of image that needs to be
+ * redrawn. */
+ int width, height; /* Dimensions (in pixels) of region of
+ * image to redraw. If either dimension
+ * is zero then the image doesn't need to
+ * be redrawn (perhaps all that happened is
+ * that its size changed). */
+ int imageWidth, imageHeight;/* New dimensions of image. */
+{
+ ImageMaster *masterPtr = (ImageMaster *) imageMaster;
+ Image *imagePtr;
+
+ masterPtr->width = imageWidth;
+ masterPtr->height = imageHeight;
+ for (imagePtr = masterPtr->instancePtr; imagePtr != NULL;
+ imagePtr = imagePtr->nextPtr) {
+ (*imagePtr->changeProc)(imagePtr->widgetClientData, x, y,
+ width, height, imageWidth, imageHeight);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_NameOfImage --
+ *
+ * Given a token for an image master, this procedure returns
+ * the name of the image.
+ *
+ * Results:
+ * The return value is the string name for imageMaster.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tk_NameOfImage(imageMaster)
+ Tk_ImageMaster imageMaster; /* Token for image. */
+{
+ ImageMaster *masterPtr = (ImageMaster *) imageMaster;
+
+ return Tcl_GetHashKey(masterPtr->tablePtr, masterPtr->hPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetImage --
+ *
+ * This procedure is invoked by a widget when it wants to use
+ * a particular image in a particular window.
+ *
+ * Results:
+ * The return value is a token for the image. If there is no image
+ * by the given name, then NULL is returned and an error message is
+ * left in interp->result.
+ *
+ * Side effects:
+ * Tk records the fact that the widget is using the image, and
+ * it will invoke changeProc later if the widget needs redisplay
+ * (i.e. its size changes or some of its pixels change). The
+ * caller must eventually invoke Tk_FreeImage when it no longer
+ * needs the image.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Image
+Tk_GetImage(interp, tkwin, name, changeProc, clientData)
+ Tcl_Interp *interp; /* Place to leave error message if image
+ * can't be found. */
+ Tk_Window tkwin; /* Token for window in which image will
+ * be used. */
+ char *name; /* Name of desired image. */
+ Tk_ImageChangedProc *changeProc;
+ /* Procedure to invoke when redisplay is
+ * needed because image's pixels or size
+ * changed. */
+ ClientData clientData; /* One-word argument to pass to damageProc. */
+{
+ Tcl_HashEntry *hPtr;
+ ImageMaster *masterPtr;
+ Image *imagePtr;
+
+ hPtr = Tcl_FindHashEntry(&((TkWindow *) tkwin)->mainPtr->imageTable, name);
+ if (hPtr == NULL) {
+ goto noSuchImage;
+ }
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ if (masterPtr->typePtr == NULL) {
+ goto noSuchImage;
+ }
+ imagePtr = (Image *) ckalloc(sizeof(Image));
+ imagePtr->tkwin = tkwin;
+ imagePtr->display = Tk_Display(tkwin);
+ imagePtr->masterPtr = masterPtr;
+ imagePtr->instanceData =
+ (*masterPtr->typePtr->getProc)(tkwin, masterPtr->masterData);
+ imagePtr->changeProc = changeProc;
+ imagePtr->widgetClientData = clientData;
+ imagePtr->nextPtr = masterPtr->instancePtr;
+ masterPtr->instancePtr = imagePtr;
+ return (Tk_Image) imagePtr;
+
+ noSuchImage:
+ Tcl_AppendResult(interp, "image \"", name, "\" doesn't exist",
+ (char *) NULL);
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeImage --
+ *
+ * This procedure is invoked by a widget when it no longer needs
+ * an image acquired by a previous call to Tk_GetImage. For each
+ * call to Tk_GetImage there must be exactly one call to Tk_FreeImage.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The association between the image and the widget is removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeImage(image)
+ Tk_Image image; /* Token for image that is no longer
+ * needed by a widget. */
+{
+ Image *imagePtr = (Image *) image;
+ ImageMaster *masterPtr = imagePtr->masterPtr;
+ Image *prevPtr;
+
+ /*
+ * Clean up the particular instance.
+ */
+
+ if (masterPtr->typePtr != NULL) {
+ (*masterPtr->typePtr->freeProc)(imagePtr->instanceData,
+ imagePtr->display);
+ }
+ prevPtr = masterPtr->instancePtr;
+ if (prevPtr == imagePtr) {
+ masterPtr->instancePtr = imagePtr->nextPtr;
+ } else {
+ while (prevPtr->nextPtr != imagePtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ prevPtr->nextPtr = imagePtr->nextPtr;
+ }
+ ckfree((char *) imagePtr);
+
+ /*
+ * If there are no more instances left for the master, and if the
+ * master image has been deleted, then delete the master too.
+ */
+
+ if ((masterPtr->typePtr == NULL) && (masterPtr->instancePtr == NULL)) {
+ Tcl_DeleteHashEntry(masterPtr->hPtr);
+ ckfree((char *) masterPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_RedrawImage --
+ *
+ * This procedure is called by widgets that contain images in order
+ * to redisplay an image on the screen or an off-screen pixmap.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image's manager is notified, and it redraws the desired
+ * portion of the image before returning.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_RedrawImage(image, imageX, imageY, width, height, drawable,
+ drawableX, drawableY)
+ Tk_Image image; /* Token for image to redisplay. */
+ int imageX, imageY; /* Upper-left pixel of region in image that
+ * needs to be redisplayed. */
+ int width, height; /* Dimensions of region to redraw. */
+ Drawable drawable; /* Drawable in which to display image
+ * (window or pixmap). If this is a pixmap,
+ * it must have the same depth as the window
+ * used in the Tk_GetImage call for the
+ * image. */
+ int drawableX, drawableY; /* Coordinates in drawable that correspond
+ * to imageX and imageY. */
+{
+ Image *imagePtr = (Image *) image;
+
+ if (imagePtr->masterPtr->typePtr == NULL) {
+ /*
+ * No master for image, so nothing to display.
+ */
+
+ return;
+ }
+
+ /*
+ * Clip the redraw area to the area of the image.
+ */
+
+ if (imageX < 0) {
+ width += imageX;
+ drawableX -= imageX;
+ imageX = 0;
+ }
+ if (imageY < 0) {
+ height += imageY;
+ drawableY -= imageY;
+ imageY = 0;
+ }
+ if ((imageX + width) > imagePtr->masterPtr->width) {
+ width = imagePtr->masterPtr->width - imageX;
+ }
+ if ((imageY + height) > imagePtr->masterPtr->height) {
+ height = imagePtr->masterPtr->height - imageY;
+ }
+ (*imagePtr->masterPtr->typePtr->displayProc)(
+ imagePtr->instanceData, imagePtr->display, drawable,
+ imageX, imageY, width, height, drawableX, drawableY);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SizeOfImage --
+ *
+ * This procedure returns the current dimensions of an image.
+ *
+ * Results:
+ * The width and height of the image are returned in *widthPtr
+ * and *heightPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SizeOfImage(image, widthPtr, heightPtr)
+ Tk_Image image; /* Token for image whose size is wanted. */
+ int *widthPtr; /* Return width of image here. */
+ int *heightPtr; /* Return height of image here. */
+{
+ Image *imagePtr = (Image *) image;
+
+ *widthPtr = imagePtr->masterPtr->width;
+ *heightPtr = imagePtr->masterPtr->height;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DeleteImage --
+ *
+ * Given the name of an image, this procedure destroys the
+ * image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image is destroyed; existing instances will display as
+ * blank areas. If no such image exists then the procedure does
+ * nothing.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_DeleteImage(interp, name)
+ Tcl_Interp *interp; /* Interpreter in which the image was
+ * created. */
+ char *name; /* Name of image. */
+{
+ Tcl_HashEntry *hPtr;
+ TkWindow *winPtr;
+
+ winPtr = (TkWindow *) Tk_MainWindow(interp);
+ if (winPtr == NULL) {
+ return;
+ }
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, name);
+ if (hPtr == NULL) {
+ return;
+ }
+ DeleteImage((ImageMaster *) Tcl_GetHashValue(hPtr));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteImage --
+ *
+ * This procedure is responsible for deleting an image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The connection is dropped between instances of this image and
+ * an image master. Image instances will redisplay themselves
+ * as empty areas, but existing instances will not be deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteImage(masterPtr)
+ ImageMaster *masterPtr; /* Pointer to main data structure for image. */
+{
+ Image *imagePtr;
+ Tk_ImageType *typePtr;
+
+ typePtr = masterPtr->typePtr;
+ masterPtr->typePtr = NULL;
+ if (typePtr != NULL) {
+ for (imagePtr = masterPtr->instancePtr; imagePtr != NULL;
+ imagePtr = imagePtr->nextPtr) {
+ (*typePtr->freeProc)(imagePtr->instanceData,
+ imagePtr->display);
+ (*imagePtr->changeProc)(imagePtr->widgetClientData, 0, 0,
+ masterPtr->width, masterPtr->height, masterPtr->width,
+ masterPtr->height);
+ }
+ (*typePtr->deleteProc)(masterPtr->masterData);
+ }
+ if (masterPtr->instancePtr == NULL) {
+ Tcl_DeleteHashEntry(masterPtr->hPtr);
+ ckfree((char *) masterPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDeleteAllImages --
+ *
+ * This procedure is called when an application is deleted. It
+ * calls back all of the managers for all images so that they
+ * can cleanup, then it deletes all of Tk's internal information
+ * about images.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All information for all images gets deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkDeleteAllImages(mainPtr)
+ TkMainInfo *mainPtr; /* Structure describing application that is
+ * going away. */
+{
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+ ImageMaster *masterPtr;
+
+ for (hPtr = Tcl_FirstHashEntry(&mainPtr->imageTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ DeleteImage(masterPtr);
+ }
+ Tcl_DeleteHashTable(&mainPtr->imageTable);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetImageMasterData --
+ *
+ * Given the name of an image, this procedure returns the type
+ * of the image and the clientData associated with its master.
+ *
+ * Results:
+ * If there is no image by the given name, then NULL is returned
+ * and a NULL value is stored at *typePtrPtr. Otherwise the return
+ * value is the clientData returned by the createProc when the
+ * image was created and a pointer to the type structure for the
+ * image is stored at *typePtrPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+Tk_GetImageMasterData(interp, name, typePtrPtr)
+ Tcl_Interp *interp; /* Interpreter in which the image was
+ * created. */
+ char *name; /* Name of image. */
+ Tk_ImageType **typePtrPtr; /* Points to location to fill in with
+ * pointer to type information for image. */
+{
+ Tcl_HashEntry *hPtr;
+ TkWindow *winPtr;
+ ImageMaster *masterPtr;
+
+ winPtr = (TkWindow *) Tk_MainWindow(interp);
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, name);
+ if (hPtr == NULL) {
+ *typePtrPtr = NULL;
+ return NULL;
+ }
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ *typePtrPtr = masterPtr->typePtr;
+ return masterPtr->masterData;
+}
diff --git a/generic/tkImgBmap.c b/generic/tkImgBmap.c
new file mode 100644
index 0000000..f8a1d6e
--- /dev/null
+++ b/generic/tkImgBmap.c
@@ -0,0 +1,1061 @@
+/*
+ * tkImgBmap.c --
+ *
+ * This procedure implements images of type "bitmap" for Tk.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkImgBmap.c 1.33 97/07/31 09:08:22
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * The following data structure represents the master for a bitmap
+ * image:
+ */
+
+typedef struct BitmapMaster {
+ Tk_ImageMaster tkMaster; /* Tk's token for image master. NULL means
+ * the image is being deleted. */
+ Tcl_Interp *interp; /* Interpreter for application that is
+ * using image. */
+ Tcl_Command imageCmd; /* Token for image command (used to delete
+ * it when the image goes away). NULL means
+ * the image command has already been
+ * deleted. */
+ int width, height; /* Dimensions of image. */
+ char *data; /* Data comprising bitmap (suitable for
+ * input to XCreateBitmapFromData). May
+ * be NULL if no data. Malloc'ed. */
+ char *maskData; /* Data for bitmap's mask (suitable for
+ * input to XCreateBitmapFromData).
+ * Malloc'ed. */
+ Tk_Uid fgUid; /* Value of -foreground option (malloc'ed). */
+ Tk_Uid bgUid; /* Value of -background option (malloc'ed). */
+ char *fileString; /* Value of -file option (malloc'ed). */
+ char *dataString; /* Value of -data option (malloc'ed). */
+ char *maskFileString; /* Value of -maskfile option (malloc'ed). */
+ char *maskDataString; /* Value of -maskdata option (malloc'ed). */
+ struct BitmapInstance *instancePtr;
+ /* First in list of all instances associated
+ * with this master. */
+} BitmapMaster;
+
+/*
+ * The following data structure represents all of the instances of an
+ * image that lie within a particular window:
+ */
+
+typedef struct BitmapInstance {
+ int refCount; /* Number of instances that share this
+ * data structure. */
+ BitmapMaster *masterPtr; /* Pointer to master for image. */
+ Tk_Window tkwin; /* Window in which the instances will be
+ * displayed. */
+ XColor *fg; /* Foreground color for displaying image. */
+ XColor *bg; /* Background color for displaying image. */
+ Pixmap bitmap; /* The bitmap to display. */
+ Pixmap mask; /* Mask: only display bitmap pixels where
+ * there are 1's here. */
+ GC gc; /* Graphics context for displaying bitmap.
+ * None means there was an error while
+ * setting up the instance, so it cannot
+ * be displayed. */
+ struct BitmapInstance *nextPtr;
+ /* Next in list of all instance structures
+ * associated with masterPtr (NULL means
+ * end of list). */
+} BitmapInstance;
+
+/*
+ * The type record for bitmap images:
+ */
+
+static int GetByte _ANSI_ARGS_((Tcl_Channel chan));
+static int ImgBmapCreate _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, int argc, char **argv,
+ Tk_ImageType *typePtr, Tk_ImageMaster master,
+ ClientData *clientDataPtr));
+static ClientData ImgBmapGet _ANSI_ARGS_((Tk_Window tkwin,
+ ClientData clientData));
+static void ImgBmapDisplay _ANSI_ARGS_((ClientData clientData,
+ Display *display, Drawable drawable,
+ int imageX, int imageY, int width, int height,
+ int drawableX, int drawableY));
+static void ImgBmapFree _ANSI_ARGS_((ClientData clientData,
+ Display *display));
+static void ImgBmapDelete _ANSI_ARGS_((ClientData clientData));
+
+Tk_ImageType tkBitmapImageType = {
+ "bitmap", /* name */
+ ImgBmapCreate, /* createProc */
+ ImgBmapGet, /* getProc */
+ ImgBmapDisplay, /* displayProc */
+ ImgBmapFree, /* freeProc */
+ ImgBmapDelete, /* deleteProc */
+ (Tk_ImageType *) NULL /* nextPtr */
+};
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_UID, "-background", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(BitmapMaster, bgUid), 0},
+ {TK_CONFIG_STRING, "-data", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapMaster, dataString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapMaster, fileString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_UID, "-foreground", (char *) NULL, (char *) NULL,
+ "#000000", Tk_Offset(BitmapMaster, fgUid), 0},
+ {TK_CONFIG_STRING, "-maskdata", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapMaster, maskDataString),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-maskfile", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapMaster, maskFileString),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * The following data structure is used to describe the state of
+ * parsing a bitmap file or string. It is used for communication
+ * between TkGetBitmapData and NextBitmapWord.
+ */
+
+#define MAX_WORD_LENGTH 100
+typedef struct ParseInfo {
+ char *string; /* Next character of string data for bitmap,
+ * or NULL if bitmap is being read from
+ * file. */
+ Tcl_Channel chan; /* File containing bitmap data, or NULL
+ * if no file. */
+ char word[MAX_WORD_LENGTH+1];
+ /* Current word of bitmap data, NULL
+ * terminated. */
+ int wordLength; /* Number of non-NULL bytes in word. */
+} ParseInfo;
+
+/*
+ * Prototypes for procedures used only locally in this file:
+ */
+
+static int ImgBmapCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void ImgBmapCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void ImgBmapConfigureInstance _ANSI_ARGS_((
+ BitmapInstance *instancePtr));
+static int ImgBmapConfigureMaster _ANSI_ARGS_((
+ BitmapMaster *masterPtr, int argc, char **argv,
+ int flags));
+static int NextBitmapWord _ANSI_ARGS_((ParseInfo *parseInfoPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapCreate --
+ *
+ * This procedure is called by the Tk image code to create "test"
+ * images.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The data structure for a new image is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ImgBmapCreate(interp, name, argc, argv, typePtr, master, clientDataPtr)
+ Tcl_Interp *interp; /* Interpreter for application containing
+ * image. */
+ char *name; /* Name to use for image. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings for options (doesn't
+ * include image name or type). */
+ Tk_ImageType *typePtr; /* Pointer to our type record (not used). */
+ Tk_ImageMaster master; /* Token for image, to be used by us in
+ * later callbacks. */
+ ClientData *clientDataPtr; /* Store manager's token for image here;
+ * it will be returned in later callbacks. */
+{
+ BitmapMaster *masterPtr;
+
+ masterPtr = (BitmapMaster *) ckalloc(sizeof(BitmapMaster));
+ masterPtr->tkMaster = master;
+ masterPtr->interp = interp;
+ masterPtr->imageCmd = Tcl_CreateCommand(interp, name, ImgBmapCmd,
+ (ClientData) masterPtr, ImgBmapCmdDeletedProc);
+ masterPtr->width = masterPtr->height = 0;
+ masterPtr->data = NULL;
+ masterPtr->maskData = NULL;
+ masterPtr->fgUid = NULL;
+ masterPtr->bgUid = NULL;
+ masterPtr->fileString = NULL;
+ masterPtr->dataString = NULL;
+ masterPtr->maskFileString = NULL;
+ masterPtr->maskDataString = NULL;
+ masterPtr->instancePtr = NULL;
+ if (ImgBmapConfigureMaster(masterPtr, argc, argv, 0) != TCL_OK) {
+ ImgBmapDelete((ClientData) masterPtr);
+ return TCL_ERROR;
+ }
+ *clientDataPtr = (ClientData) masterPtr;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapConfigureMaster --
+ *
+ * This procedure is called when a bitmap image is created or
+ * reconfigured. It process configuration options and resets
+ * any instances of the image.
+ *
+ * Results:
+ * A standard Tcl return value. If TCL_ERROR is returned then
+ * an error message is left in masterPtr->interp->result.
+ *
+ * Side effects:
+ * Existing instances of the image will be redisplayed to match
+ * the new configuration options.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgBmapConfigureMaster(masterPtr, argc, argv, flags)
+ BitmapMaster *masterPtr; /* Pointer to data structure describing
+ * overall bitmap image to (reconfigure). */
+ int argc; /* Number of entries in argv. */
+ char **argv; /* Pairs of configuration options for image. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget,
+ * such as TK_CONFIG_ARGV_ONLY. */
+{
+ BitmapInstance *instancePtr;
+ int maskWidth, maskHeight, dummy1, dummy2;
+
+ if (Tk_ConfigureWidget(masterPtr->interp, Tk_MainWindow(masterPtr->interp),
+ configSpecs, argc, argv, (char *) masterPtr, flags)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse the bitmap and/or mask to create binary data. Make sure that
+ * the bitmap and mask have the same dimensions.
+ */
+
+ if (masterPtr->data != NULL) {
+ ckfree(masterPtr->data);
+ masterPtr->data = NULL;
+ }
+ if ((masterPtr->fileString != NULL) || (masterPtr->dataString != NULL)) {
+ masterPtr->data = TkGetBitmapData(masterPtr->interp,
+ masterPtr->dataString, masterPtr->fileString,
+ &masterPtr->width, &masterPtr->height, &dummy1, &dummy2);
+ if (masterPtr->data == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (masterPtr->maskData != NULL) {
+ ckfree(masterPtr->maskData);
+ masterPtr->maskData = NULL;
+ }
+ if ((masterPtr->maskFileString != NULL)
+ || (masterPtr->maskDataString != NULL)) {
+ if (masterPtr->data == NULL) {
+ masterPtr->interp->result = "can't have mask without bitmap";
+ return TCL_ERROR;
+ }
+ masterPtr->maskData = TkGetBitmapData(masterPtr->interp,
+ masterPtr->maskDataString, masterPtr->maskFileString,
+ &maskWidth, &maskHeight, &dummy1, &dummy2);
+ if (masterPtr->maskData == NULL) {
+ return TCL_ERROR;
+ }
+ if ((maskWidth != masterPtr->width)
+ || (maskHeight != masterPtr->height)) {
+ ckfree(masterPtr->maskData);
+ masterPtr->maskData = NULL;
+ masterPtr->interp->result = "bitmap and mask have different sizes";
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Cycle through all of the instances of this image, regenerating
+ * the information for each instance. Then force the image to be
+ * redisplayed everywhere that it is used.
+ */
+
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ ImgBmapConfigureInstance(instancePtr);
+ }
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, masterPtr->width,
+ masterPtr->height, masterPtr->width, masterPtr->height);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapConfigureInstance --
+ *
+ * This procedure is called to create displaying information for
+ * a bitmap image instance based on the configuration information
+ * in the master. It is invoked both when new instances are
+ * created and when the master is reconfigured.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates errors via Tcl_BackgroundError if there are problems
+ * in setting up the instance.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgBmapConfigureInstance(instancePtr)
+ BitmapInstance *instancePtr; /* Instance to reconfigure. */
+{
+ BitmapMaster *masterPtr = instancePtr->masterPtr;
+ XColor *colorPtr;
+ XGCValues gcValues;
+ GC gc;
+ unsigned int mask;
+
+ /*
+ * For each of the options in masterPtr, translate the string
+ * form into an internal form appropriate for instancePtr.
+ */
+
+ if (*masterPtr->bgUid != 0) {
+ colorPtr = Tk_GetColor(masterPtr->interp, instancePtr->tkwin,
+ masterPtr->bgUid);
+ if (colorPtr == NULL) {
+ goto error;
+ }
+ } else {
+ colorPtr = NULL;
+ }
+ if (instancePtr->bg != NULL) {
+ Tk_FreeColor(instancePtr->bg);
+ }
+ instancePtr->bg = colorPtr;
+
+ colorPtr = Tk_GetColor(masterPtr->interp, instancePtr->tkwin,
+ masterPtr->fgUid);
+ if (colorPtr == NULL) {
+ goto error;
+ }
+ if (instancePtr->fg != NULL) {
+ Tk_FreeColor(instancePtr->fg);
+ }
+ instancePtr->fg = colorPtr;
+
+ if (instancePtr->bitmap != None) {
+ Tk_FreePixmap(Tk_Display(instancePtr->tkwin), instancePtr->bitmap);
+ instancePtr->bitmap = None;
+ }
+ if (masterPtr->data != NULL) {
+ instancePtr->bitmap = XCreateBitmapFromData(
+ Tk_Display(instancePtr->tkwin),
+ RootWindowOfScreen(Tk_Screen(instancePtr->tkwin)),
+ masterPtr->data, (unsigned) masterPtr->width,
+ (unsigned) masterPtr->height);
+ }
+
+ if (instancePtr->mask != None) {
+ Tk_FreePixmap(Tk_Display(instancePtr->tkwin), instancePtr->mask);
+ instancePtr->mask = None;
+ }
+ if (masterPtr->maskData != NULL) {
+ instancePtr->mask = XCreateBitmapFromData(
+ Tk_Display(instancePtr->tkwin),
+ RootWindowOfScreen(Tk_Screen(instancePtr->tkwin)),
+ masterPtr->maskData, (unsigned) masterPtr->width,
+ (unsigned) masterPtr->height);
+ }
+
+ if (masterPtr->data != NULL) {
+ gcValues.foreground = instancePtr->fg->pixel;
+ gcValues.graphics_exposures = False;
+ mask = GCForeground|GCGraphicsExposures;
+ if (instancePtr->bg != NULL) {
+ gcValues.background = instancePtr->bg->pixel;
+ mask |= GCBackground;
+ if (instancePtr->mask != None) {
+ gcValues.clip_mask = instancePtr->mask;
+ mask |= GCClipMask;
+ }
+ } else {
+ gcValues.clip_mask = instancePtr->bitmap;
+ mask |= GCClipMask;
+ }
+ gc = Tk_GetGC(instancePtr->tkwin, mask, &gcValues);
+ } else {
+ gc = None;
+ }
+ if (instancePtr->gc != None) {
+ Tk_FreeGC(Tk_Display(instancePtr->tkwin), instancePtr->gc);
+ }
+ instancePtr->gc = gc;
+ return;
+
+ error:
+ /*
+ * An error occurred: clear the graphics context in the instance to
+ * make it clear that this instance cannot be displayed. Then report
+ * the error.
+ */
+
+ if (instancePtr->gc != None) {
+ Tk_FreeGC(Tk_Display(instancePtr->tkwin), instancePtr->gc);
+ }
+ instancePtr->gc = None;
+ Tcl_AddErrorInfo(masterPtr->interp, "\n (while configuring image \"");
+ Tcl_AddErrorInfo(masterPtr->interp, Tk_NameOfImage(masterPtr->tkMaster));
+ Tcl_AddErrorInfo(masterPtr->interp, "\")");
+ Tcl_BackgroundError(masterPtr->interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetBitmapData --
+ *
+ * Given a file name or ASCII string, this procedure parses the
+ * file or string contents to produce binary data for a bitmap.
+ *
+ * Results:
+ * If the bitmap description was parsed successfully then the
+ * return value is a malloc-ed array containing the bitmap data.
+ * The dimensions of the data are stored in *widthPtr and
+ * *heightPtr. *hotXPtr and *hotYPtr are set to the bitmap
+ * hotspot if one is defined, otherwise they are set to -1, -1.
+ * If an error occurred, NULL is returned and an error message is
+ * left in interp->result.
+ *
+ * Side effects:
+ * A bitmap is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkGetBitmapData(interp, string, fileName, widthPtr, heightPtr,
+ hotXPtr, hotYPtr)
+ Tcl_Interp *interp; /* For reporting errors. */
+ char *string; /* String describing bitmap. May
+ * be NULL. */
+ char *fileName; /* Name of file containing bitmap
+ * description. Used only if string
+ * is NULL. Must not be NULL if
+ * string is NULL. */
+ int *widthPtr, *heightPtr; /* Dimensions of bitmap get returned
+ * here. */
+ int *hotXPtr, *hotYPtr; /* Position of hot spot or -1,-1. */
+{
+ int width, height, numBytes, hotX, hotY;
+ char *p, *end, *expandedFileName;
+ ParseInfo pi;
+ char *data = NULL;
+ Tcl_DString buffer;
+
+ pi.string = string;
+ if (string == NULL) {
+ if (Tcl_IsSafe(interp)) {
+ Tcl_AppendResult(interp, "can't get bitmap data from a file in a",
+ " safe interpreter", (char *) NULL);
+ return NULL;
+ }
+ expandedFileName = Tcl_TranslateFileName(interp, fileName, &buffer);
+ if (expandedFileName == NULL) {
+ return NULL;
+ }
+ pi.chan = Tcl_OpenFileChannel(interp, expandedFileName, "r", 0);
+ Tcl_DStringFree(&buffer);
+ if (pi.chan == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "couldn't read bitmap file \"",
+ fileName, "\": ", Tcl_PosixError(interp), (char *) NULL);
+ return NULL;
+ }
+ } else {
+ pi.chan = NULL;
+ }
+
+ /*
+ * 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)) {
+ Tcl_AppendResult(interp, "format error in bitmap data; ",
+ "looks like it's an obsolete X10 bitmap file",
+ (char *) NULL);
+ goto errorCleanup;
+ }
+ }
+
+ /*
+ * Now we've read everything but the data. Allocate an array
+ * and read in the data.
+ */
+
+ getData:
+ if ((width <= 0) || (height <= 0)) {
+ goto error;
+ }
+ numBytes = ((width+7)/8) * height;
+ data = (char *) ckalloc((unsigned) numBytes);
+ for (p = data; numBytes > 0; p++, numBytes--) {
+ if (NextBitmapWord(&pi) != TCL_OK) {
+ goto error;
+ }
+ *p = (char) strtol(pi.word, &end, 0);
+ if (end == pi.word) {
+ goto error;
+ }
+ }
+
+ /*
+ * All done. Clean up and return.
+ */
+
+ if (pi.chan != NULL) {
+ Tcl_Close(NULL, pi.chan);
+ }
+ *widthPtr = width;
+ *heightPtr = height;
+ *hotXPtr = hotX;
+ *hotYPtr = hotY;
+ return data;
+
+ error:
+ interp->result = "format error in bitmap data";
+ errorCleanup:
+ if (data != NULL) {
+ ckfree(data);
+ }
+ if (pi.chan != NULL) {
+ Tcl_Close(NULL, pi.chan);
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NextBitmapWord --
+ *
+ * This procedure retrieves the next word of information (stuff
+ * between commas or white space) from a bitmap description.
+ *
+ * Results:
+ * Returns TCL_OK if all went well. In this case the next word,
+ * and its length, will be availble in *parseInfoPtr. If the end
+ * of the bitmap description was reached then TCL_ERROR is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NextBitmapWord(parseInfoPtr)
+ ParseInfo *parseInfoPtr; /* Describes what we're reading
+ * and where we are in it. */
+{
+ char *src, *dst;
+ int c;
+
+ parseInfoPtr->wordLength = 0;
+ dst = parseInfoPtr->word;
+ if (parseInfoPtr->string != NULL) {
+ for (src = parseInfoPtr->string; isspace(UCHAR(*src)) || (*src == ',');
+ src++) {
+ if (*src == 0) {
+ return TCL_ERROR;
+ }
+ }
+ for ( ; !isspace(UCHAR(*src)) && (*src != ',') && (*src != 0); src++) {
+ *dst = *src;
+ dst++;
+ parseInfoPtr->wordLength++;
+ if (parseInfoPtr->wordLength > MAX_WORD_LENGTH) {
+ return TCL_ERROR;
+ }
+ }
+ parseInfoPtr->string = src;
+ } else {
+ for (c = GetByte(parseInfoPtr->chan); isspace(UCHAR(c)) || (c == ',');
+ c = GetByte(parseInfoPtr->chan)) {
+ if (c == EOF) {
+ return TCL_ERROR;
+ }
+ }
+ for ( ; !isspace(UCHAR(c)) && (c != ',') && (c != EOF);
+ c = GetByte(parseInfoPtr->chan)) {
+ *dst = c;
+ dst++;
+ parseInfoPtr->wordLength++;
+ if (parseInfoPtr->wordLength > MAX_WORD_LENGTH) {
+ return TCL_ERROR;
+ }
+ }
+ }
+ if (parseInfoPtr->wordLength == 0) {
+ return TCL_ERROR;
+ }
+ parseInfoPtr->word[parseInfoPtr->wordLength] = 0;
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ImgBmapCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to an image managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ImgBmapCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about the image master. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ BitmapMaster *masterPtr = (BitmapMaster *) clientData;
+ int c, code;
+ size_t length;
+
+ if (argc < 2) {
+ sprintf(interp->result,
+ "wrong # args: should be \"%.50s option ?arg arg ...?\"",
+ argv[0]);
+ return TCL_ERROR;
+ }
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
+ && (length >= 2)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " cget option\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return Tk_ConfigureValue(interp, Tk_MainWindow(interp), configSpecs,
+ (char *) masterPtr, argv[2], 0);
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
+ && (length >= 2)) {
+ if (argc == 2) {
+ code = Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, (char *) NULL, 0);
+ } else if (argc == 3) {
+ code = Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, argv[2], 0);
+ } else {
+ code = ImgBmapConfigureMaster(masterPtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ return code;
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be cget or configure", (char *) NULL);
+ return TCL_ERROR;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapGet --
+ *
+ * This procedure is called for each use of a bitmap image in a
+ * widget.
+ *
+ * Results:
+ * The return value is a token for the instance, which is passed
+ * back to us in calls to ImgBmapDisplay and ImgBmapFree.
+ *
+ * Side effects:
+ * A data structure is set up for the instance (or, an existing
+ * instance is re-used for the new one).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ClientData
+ImgBmapGet(tkwin, masterData)
+ Tk_Window tkwin; /* Window in which the instance will be
+ * used. */
+ ClientData masterData; /* Pointer to our master structure for the
+ * image. */
+{
+ BitmapMaster *masterPtr = (BitmapMaster *) masterData;
+ BitmapInstance *instancePtr;
+
+ /*
+ * See if there is already an instance for this window. If so
+ * then just re-use it.
+ */
+
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ if (instancePtr->tkwin == tkwin) {
+ instancePtr->refCount++;
+ return (ClientData) instancePtr;
+ }
+ }
+
+ /*
+ * The image isn't already in use in this window. Make a new
+ * instance of the image.
+ */
+
+ instancePtr = (BitmapInstance *) ckalloc(sizeof(BitmapInstance));
+ instancePtr->refCount = 1;
+ instancePtr->masterPtr = masterPtr;
+ instancePtr->tkwin = tkwin;
+ instancePtr->fg = NULL;
+ instancePtr->bg = NULL;
+ instancePtr->bitmap = None;
+ instancePtr->mask = None;
+ instancePtr->gc = None;
+ instancePtr->nextPtr = masterPtr->instancePtr;
+ masterPtr->instancePtr = instancePtr;
+ ImgBmapConfigureInstance(instancePtr);
+
+ /*
+ * If this is the first instance, must set the size of the image.
+ */
+
+ if (instancePtr->nextPtr == NULL) {
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0, masterPtr->width,
+ masterPtr->height);
+ }
+
+ return (ClientData) instancePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapDisplay --
+ *
+ * This procedure is invoked to draw a bitmap image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A portion of the image gets rendered in a pixmap or window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgBmapDisplay(clientData, display, drawable, imageX, imageY, width,
+ height, drawableX, drawableY)
+ ClientData clientData; /* Pointer to BitmapInstance structure for
+ * for instance to be displayed. */
+ Display *display; /* Display on which to draw image. */
+ Drawable drawable; /* Pixmap or window in which to draw image. */
+ int imageX, imageY; /* Upper-left corner of region within image
+ * to draw. */
+ int width, height; /* Dimensions of region within image to draw. */
+ int drawableX, drawableY; /* Coordinates within drawable that
+ * correspond to imageX and imageY. */
+{
+ BitmapInstance *instancePtr = (BitmapInstance *) clientData;
+ int masking;
+
+ /*
+ * If there's no graphics context, it means that an error occurred
+ * while creating the image instance so it can't be displayed.
+ */
+
+ if (instancePtr->gc == None) {
+ return;
+ }
+
+ /*
+ * If masking is in effect, must modify the mask origin within
+ * the graphics context to line up with the image's origin.
+ * Then draw the image and reset the clip origin, if there's
+ * a mask.
+ */
+
+ masking = (instancePtr->mask != None) || (instancePtr->bg == NULL);
+ if (masking) {
+ XSetClipOrigin(display, instancePtr->gc, drawableX - imageX,
+ drawableY - imageY);
+ }
+ XCopyPlane(display, instancePtr->bitmap, drawable, instancePtr->gc,
+ imageX, imageY, (unsigned) width, (unsigned) height,
+ drawableX, drawableY, 1);
+ if (masking) {
+ XSetClipOrigin(display, instancePtr->gc, 0, 0);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapFree --
+ *
+ * This procedure is called when a widget ceases to use a
+ * particular instance of an image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Internal data structures get cleaned up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgBmapFree(clientData, display)
+ ClientData clientData; /* Pointer to BitmapInstance structure for
+ * for instance to be displayed. */
+ Display *display; /* Display containing window that used image. */
+{
+ BitmapInstance *instancePtr = (BitmapInstance *) clientData;
+ BitmapInstance *prevPtr;
+
+ instancePtr->refCount--;
+ if (instancePtr->refCount > 0) {
+ return;
+ }
+
+ /*
+ * There are no more uses of the image within this widget. Free
+ * the instance structure.
+ */
+
+ if (instancePtr->fg != NULL) {
+ Tk_FreeColor(instancePtr->fg);
+ }
+ if (instancePtr->bg != NULL) {
+ Tk_FreeColor(instancePtr->bg);
+ }
+ if (instancePtr->bitmap != None) {
+ Tk_FreePixmap(display, instancePtr->bitmap);
+ }
+ if (instancePtr->mask != None) {
+ Tk_FreePixmap(display, instancePtr->mask);
+ }
+ if (instancePtr->gc != None) {
+ Tk_FreeGC(display, instancePtr->gc);
+ }
+ if (instancePtr->masterPtr->instancePtr == instancePtr) {
+ instancePtr->masterPtr->instancePtr = instancePtr->nextPtr;
+ } else {
+ for (prevPtr = instancePtr->masterPtr->instancePtr;
+ prevPtr->nextPtr != instancePtr; prevPtr = prevPtr->nextPtr) {
+ /* Empty loop body */
+ }
+ prevPtr->nextPtr = instancePtr->nextPtr;
+ }
+ ckfree((char *) instancePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapDelete --
+ *
+ * This procedure is called by the image code to delete the
+ * master structure for an image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with the image get freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgBmapDelete(masterData)
+ ClientData masterData; /* Pointer to BitmapMaster structure for
+ * image. Must not have any more instances. */
+{
+ BitmapMaster *masterPtr = (BitmapMaster *) masterData;
+
+ if (masterPtr->instancePtr != NULL) {
+ panic("tried to delete bitmap image when instances still exist");
+ }
+ masterPtr->tkMaster = NULL;
+ if (masterPtr->imageCmd != NULL) {
+ Tcl_DeleteCommandFromToken(masterPtr->interp, masterPtr->imageCmd);
+ }
+ if (masterPtr->data != NULL) {
+ ckfree(masterPtr->data);
+ }
+ if (masterPtr->maskData != NULL) {
+ ckfree(masterPtr->maskData);
+ }
+ Tk_FreeOptions(configSpecs, (char *) masterPtr, (Display *) NULL, 0);
+ ckfree((char *) masterPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapCmdDeletedProc --
+ *
+ * This procedure is invoked when the image command for an image
+ * is deleted. It deletes the image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgBmapCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to BitmapMaster structure for
+ * image. */
+{
+ BitmapMaster *masterPtr = (BitmapMaster *) clientData;
+
+ masterPtr->imageCmd = NULL;
+ if (masterPtr->tkMaster != NULL) {
+ Tk_DeleteImage(masterPtr->interp, Tk_NameOfImage(masterPtr->tkMaster));
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetByte --
+ *
+ * Get the next byte from the open channel.
+ *
+ * Results:
+ * The next byte or EOF.
+ *
+ * Side effects:
+ * We read from the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetByte(chan)
+ Tcl_Channel chan; /* The channel we read from. */
+{
+ char buffer;
+ int size;
+
+ size = Tcl_Read(chan, &buffer, 1);
+ if (size <= 0) {
+ return EOF;
+ } else {
+ return buffer;
+ }
+}
diff --git a/generic/tkImgGIF.c b/generic/tkImgGIF.c
new file mode 100644
index 0000000..a2ad081
--- /dev/null
+++ b/generic/tkImgGIF.c
@@ -0,0 +1,1059 @@
+/*
+ * tkImgGIF.c --
+ *
+ * A photo image file handler for GIF files. Reads 87a and 89a GIF
+ * files. At present there is no write function. GIF images may be
+ * read using the -data option of the photo image 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.
+ *
+ * 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. |
+ * +-------------------------------------------------------------------+
+ *
+ * SCCS: @(#) tkImgGIF.c 1.19 97/08/13 15:23:45
+ */
+
+/*
+ * GIF's are represented as data in base64 format.
+ * base64 strings consist of 4 6-bit characters -> 3 8 bit bytes.
+ * A-Z, a-z, 0-9, + and / represent the 64 values (in order).
+ * '=' is a trailing padding char when the un-encoded data is not a
+ * multiple of 3 bytes. We'll ignore white space when encountered.
+ * Any other invalid character is treated as an EOF
+ */
+
+#define GIF_SPECIAL (256)
+#define GIF_PAD (GIF_SPECIAL+1)
+#define GIF_SPACE (GIF_SPECIAL+2)
+#define GIF_BAD (GIF_SPECIAL+3)
+#define GIF_DONE (GIF_SPECIAL+4)
+
+/*
+ * structure to "mimic" FILE for Mread, so we can look like fread.
+ * The decoder state keeps track of which byte we are about to read,
+ * or EOF.
+ */
+
+typedef struct mFile {
+ unsigned char *data; /* mmencoded source string */
+ int c; /* bits left over from previous character */
+ int state; /* decoder state (0-4 or GIF_DONE) */
+} MFile;
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * The format record for the GIF file format:
+ */
+
+static int FileMatchGIF _ANSI_ARGS_((Tcl_Channel chan, char *fileName,
+ char *formatString, int *widthPtr, int *heightPtr));
+static int FileReadGIF _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Channel chan, char *fileName, char *formatString,
+ Tk_PhotoHandle imageHandle, int destX, int destY,
+ int width, int height, int srcX, int srcY));
+static int StringMatchGIF _ANSI_ARGS_(( char *string,
+ char *formatString, int *widthPtr, int *heightPtr));
+static int StringReadGIF _ANSI_ARGS_((Tcl_Interp *interp, char *string,
+ char *formatString, Tk_PhotoHandle imageHandle,
+ int destX, int destY, int width, int height,
+ int srcX, int srcY));
+
+Tk_PhotoImageFormat tkImgFmtGIF = {
+ "GIF", /* name */
+ FileMatchGIF, /* fileMatchProc */
+ StringMatchGIF, /* stringMatchProc */
+ FileReadGIF, /* fileReadProc */
+ StringReadGIF, /* stringReadProc */
+ NULL, /* fileWriteProc */
+ NULL, /* stringWriteProc */
+};
+
+#define INTERLACE 0x40
+#define LOCALCOLORMAP 0x80
+#define BitSet(byte, bit) (((byte) & (bit)) == (bit))
+#define MAXCOLORMAPSIZE 256
+#define CM_RED 0
+#define CM_GREEN 1
+#define CM_BLUE 2
+#define CM_ALPHA 3
+#define MAX_LWZ_BITS 12
+#define LM_to_uint(a,b) (((b)<<8)|(a))
+#define ReadOK(file,buffer,len) (Fread(buffer, len, 1, file) != 0)
+
+/*
+ * HACK ALERT!! HACK ALERT!! HACK ALERT!!
+ * This code is hard-wired for reading from files. In order to read
+ * from a data stream, we'll trick fread so we can reuse the same code
+ */
+
+static int fromData=0;
+
+/*
+ * Prototypes for local procedures defined in this file:
+ */
+
+static int DoExtension _ANSI_ARGS_((Tcl_Channel chan, int label,
+ int *transparent));
+static int GetCode _ANSI_ARGS_((Tcl_Channel chan, int code_size,
+ int flag));
+static int GetDataBlock _ANSI_ARGS_((Tcl_Channel chan,
+ unsigned char *buf));
+static int LWZReadByte _ANSI_ARGS_((Tcl_Channel chan, int flag,
+ int input_code_size));
+static int ReadColorMap _ANSI_ARGS_((Tcl_Channel chan, int number,
+ unsigned char buffer[MAXCOLORMAPSIZE][4]));
+static int ReadGIFHeader _ANSI_ARGS_((Tcl_Channel chan,
+ int *widthPtr, int *heightPtr));
+static int ReadImage _ANSI_ARGS_((Tcl_Interp *interp,
+ char *imagePtr, Tcl_Channel chan,
+ int len, int rows,
+ unsigned char cmap[MAXCOLORMAPSIZE][4],
+ int width, int height, int srcX, int srcY,
+ int interlace, int transparent));
+
+/*
+ * these are for the BASE64 image reader code only
+ */
+
+static int Fread _ANSI_ARGS_((unsigned char *dst, size_t size,
+ size_t count, Tcl_Channel chan));
+static int Mread _ANSI_ARGS_((unsigned char *dst, size_t size,
+ size_t count, MFile *handle));
+static int Mgetc _ANSI_ARGS_((MFile *handle));
+static int char64 _ANSI_ARGS_((int c));
+static void mInit _ANSI_ARGS_((unsigned char *string,
+ MFile *handle));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileMatchGIF --
+ *
+ * This procedure is invoked by the photo image type to see if
+ * a file contains image data in GIF format.
+ *
+ * Results:
+ * The return value is 1 if the first characters in file f look
+ * like GIF data, and 0 otherwise.
+ *
+ * Side effects:
+ * The access position in f may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileMatchGIF(chan, fileName, formatString, widthPtr, heightPtr)
+ Tcl_Channel chan; /* The image file, open for reading. */
+ char *fileName; /* The name of the image file. */
+ char *formatString; /* User-specified format string, or NULL. */
+ int *widthPtr, *heightPtr; /* The dimensions of the image are
+ * returned here if the file is a valid
+ * raw GIF file. */
+{
+ return ReadGIFHeader(chan, widthPtr, heightPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileReadGIF --
+ *
+ * This procedure is called by the photo image type to read
+ * GIF format data from a file and write it into a given
+ * photo image.
+ *
+ * Results:
+ * A standard TCL completion code. If TCL_ERROR is returned
+ * then an error message is left in interp->result.
+ *
+ * Side effects:
+ * The access position in file f is changed, and new data is
+ * added to the image given by imageHandle.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileReadGIF(interp, chan, fileName, formatString, imageHandle, destX, destY,
+ width, height, srcX, srcY)
+ Tcl_Interp *interp; /* Interpreter to use for reporting errors. */
+ Tcl_Channel chan; /* The image file, open for reading. */
+ char *fileName; /* The name of the image file. */
+ char *formatString; /* User-specified format string, or NULL. */
+ Tk_PhotoHandle imageHandle; /* The photo image to write into. */
+ int destX, destY; /* Coordinates of top-left pixel in
+ * photo image to be written to. */
+ int width, height; /* Dimensions of block of photo image to
+ * be written to. */
+ int srcX, srcY; /* Coordinates of top-left pixel to be used
+ * in image being read. */
+{
+ int fileWidth, fileHeight;
+ int nBytes;
+ Tk_PhotoImageBlock block;
+ unsigned char buf[100];
+ int bitPixel;
+ unsigned char colorMap[MAXCOLORMAPSIZE][4];
+ int transparent = -1;
+
+ if (!ReadGIFHeader(chan, &fileWidth, &fileHeight)) {
+ Tcl_AppendResult(interp, "couldn't read GIF header from file \"",
+ fileName, "\"", NULL);
+ return TCL_ERROR;
+ }
+ if ((fileWidth <= 0) || (fileHeight <= 0)) {
+ Tcl_AppendResult(interp, "GIF image file \"", fileName,
+ "\" has dimension(s) <= 0", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (Fread(buf, 1, 3, chan) != 3) {
+ return TCL_OK;
+ }
+ bitPixel = 2<<(buf[0]&0x07);
+
+ if (BitSet(buf[0], LOCALCOLORMAP)) { /* Global Colormap */
+ if (!ReadColorMap(chan, bitPixel, colorMap)) {
+ Tcl_AppendResult(interp, "error reading color map",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if ((srcX + width) > fileWidth) {
+ width = fileWidth - srcX;
+ }
+ if ((srcY + height) > fileHeight) {
+ height = fileHeight - srcY;
+ }
+ if ((width <= 0) || (height <= 0)
+ || (srcX >= fileWidth) || (srcY >= fileHeight)) {
+ return TCL_OK;
+ }
+
+ Tk_PhotoExpand(imageHandle, destX + width, destY + height);
+
+ block.width = width;
+ block.height = height;
+ block.pixelSize = 4;
+ block.pitch = block.pixelSize * block.width;
+ block.offset[0] = 0;
+ block.offset[1] = 1;
+ block.offset[2] = 2;
+ nBytes = height * block.pitch;
+ block.pixelPtr = (unsigned char *) ckalloc((unsigned) nBytes);
+
+ while (1) {
+ if (Fread(buf, 1, 1, chan) != 1) {
+ /*
+ * Premature end of image. We should really notify
+ * the user, but for now just show garbage.
+ */
+
+ break;
+ }
+
+ if (buf[0] == ';') {
+ /*
+ * GIF terminator.
+ */
+
+ break;
+ }
+
+ if (buf[0] == '!') {
+ /*
+ * This is a GIF extension.
+ */
+
+ if (Fread(buf, 1, 1, chan) != 1) {
+ interp->result =
+ "error reading extension function code in GIF image";
+ goto error;
+ }
+ if (DoExtension(chan, buf[0], &transparent) < 0) {
+ interp->result = "error reading extension in GIF image";
+ goto error;
+ }
+ continue;
+ }
+
+ if (buf[0] != ',') {
+ /*
+ * Not a valid start character; ignore it.
+ */
+ continue;
+ }
+
+ if (Fread(buf, 1, 9, chan) != 9) {
+ interp->result = "couldn't read left/top/width/height in GIF image";
+ goto error;
+ }
+
+ bitPixel = 1<<((buf[8]&0x07)+1);
+
+ if (BitSet(buf[8], LOCALCOLORMAP)) {
+ if (!ReadColorMap(chan, bitPixel, colorMap)) {
+ Tcl_AppendResult(interp, "error reading color map",
+ (char *) NULL);
+ goto error;
+ }
+ }
+ if (ReadImage(interp, (char *) block.pixelPtr, chan, width,
+ height, colorMap, fileWidth, fileHeight, srcX, srcY,
+ BitSet(buf[8], INTERLACE), transparent) != TCL_OK) {
+ goto error;
+ }
+ break;
+ }
+
+ if (transparent == -1) {
+ Tk_PhotoPutBlock(imageHandle, &block, destX, destY, width, height);
+ } else {
+ int x, y, end;
+ unsigned char *imagePtr, *rowPtr, *pixelPtr;
+
+ imagePtr = rowPtr = block.pixelPtr;
+ for (y = 0; y < height; y++) {
+ x = 0;
+ pixelPtr = rowPtr;
+ while(x < width) {
+ /* search for first non-transparent pixel */
+ while ((x < width) && !(pixelPtr[CM_ALPHA])) {
+ x++; pixelPtr += 4;
+ }
+ end = x;
+ /* search for first transparent pixel */
+ while ((end < width) && pixelPtr[CM_ALPHA]) {
+ end++; pixelPtr += 4;
+ }
+ if (end > x) {
+ block.pixelPtr = rowPtr + 4 * x;
+ Tk_PhotoPutBlock(imageHandle, &block, destX+x,
+ destY+y, end-x, 1);
+ }
+ x = end;
+ }
+ rowPtr += block.pitch;
+ }
+ block.pixelPtr = imagePtr;
+ }
+ ckfree((char *) block.pixelPtr);
+ return TCL_OK;
+
+ error:
+ ckfree((char *) block.pixelPtr);
+ return TCL_ERROR;
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringMatchGIF --
+ *
+ * This procedure is invoked by the photo image type to see if
+ * a string contains image data in GIF format.
+ *
+ * Results:
+ * The return value is 1 if the first characters in the string
+ * like GIF data, and 0 otherwise.
+ *
+ * Side effects:
+ * the size of the image is placed in widthPre and heightPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringMatchGIF(string, formatString, widthPtr, heightPtr)
+ char *string; /* the string containing the image data */
+ char *formatString; /* the image format string */
+ int *widthPtr; /* where to put the string width */
+ int *heightPtr; /* where to put the string height */
+{
+ unsigned char header[10];
+ int got;
+ MFile handle;
+ mInit((unsigned char *) string, &handle);
+ got = Mread(header, 10, 1, &handle);
+ if (got != 10
+ || ((strncmp("GIF87a", (char *) header, 6) != 0)
+ && (strncmp("GIF89a", (char *) header, 6) != 0))) {
+ return 0;
+ }
+ *widthPtr = LM_to_uint(header[6],header[7]);
+ *heightPtr = LM_to_uint(header[8],header[9]);
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringReadGif -- --
+ *
+ * This procedure is called by the photo image type to read
+ * GIF format data from a base64 encoded string, and give it to
+ * the photo image.
+ *
+ * Results:
+ * A standard TCL completion code. If TCL_ERROR is returned
+ * then an error message is left in interp->result.
+ *
+ * Side effects:
+ * new data is added to the image given by imageHandle. This
+ * procedure calls FileReadGif by redefining the operation of
+ * fprintf temporarily.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringReadGIF(interp,string,formatString,imageHandle,
+ destX, destY, width, height, srcX, srcY)
+ Tcl_Interp *interp; /* interpreter for reporting errors in */
+ char *string; /* string containing the image */
+ char *formatString; /* format string if any */
+ Tk_PhotoHandle imageHandle; /* the image to write this data into */
+ int destX, destY; /* The rectangular region of the */
+ int width, height; /* image to copy */
+ int srcX, srcY;
+{
+ int result;
+ MFile handle;
+ mInit((unsigned char *)string,&handle);
+ fromData = 1;
+ result = FileReadGIF(interp, (Tcl_Channel) &handle, "inline data",
+ formatString, imageHandle, destX, destY, width, height,
+ srcX, srcY);
+ fromData = 0;
+ return(result);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadGIFHeader --
+ *
+ * This procedure reads the GIF header from the beginning of a
+ * GIF file and returns the dimensions of the image.
+ *
+ * Results:
+ * The return value is 1 if file "f" appears to start with
+ * a valid GIF header, 0 otherwise. If the header is valid,
+ * then *widthPtr and *heightPtr are modified to hold the
+ * dimensions of the image.
+ *
+ * Side effects:
+ * The access position in f advances.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadGIFHeader(chan, widthPtr, heightPtr)
+ Tcl_Channel chan; /* Image file to read the header from */
+ int *widthPtr, *heightPtr; /* The dimensions of the image are
+ * returned here. */
+{
+ unsigned char buf[7];
+
+ if ((Fread(buf, 1, 6, chan) != 6)
+ || ((strncmp("GIF87a", (char *) buf, 6) != 0)
+ && (strncmp("GIF89a", (char *) buf, 6) != 0))) {
+ return 0;
+ }
+
+ if (Fread(buf, 1, 4, chan) != 4) {
+ return 0;
+ }
+
+ *widthPtr = LM_to_uint(buf[0],buf[1]);
+ *heightPtr = LM_to_uint(buf[2],buf[3]);
+ return 1;
+}
+
+/*
+ *-----------------------------------------------------------------
+ * The code below is copied from the giftoppm program and modified
+ * just slightly.
+ *-----------------------------------------------------------------
+ */
+
+static int
+ReadColorMap(chan, number, buffer)
+ Tcl_Channel chan;
+ int number;
+ unsigned char buffer[MAXCOLORMAPSIZE][4];
+{
+ int i;
+ unsigned char rgb[3];
+
+ for (i = 0; i < number; ++i) {
+ if (! ReadOK(chan, rgb, sizeof(rgb))) {
+ return 0;
+ }
+
+ buffer[i][CM_RED] = rgb[0] ;
+ buffer[i][CM_GREEN] = rgb[1] ;
+ buffer[i][CM_BLUE] = rgb[2] ;
+ buffer[i][CM_ALPHA] = 255 ;
+ }
+ return 1;
+}
+
+
+
+static int
+DoExtension(chan, label, transparent)
+ Tcl_Channel chan;
+ int label;
+ int *transparent;
+{
+ static unsigned char buf[256];
+ int count;
+
+ switch (label) {
+ case 0x01: /* Plain Text Extension */
+ break;
+
+ case 0xff: /* Application Extension */
+ break;
+
+ case 0xfe: /* Comment Extension */
+ do {
+ count = GetDataBlock(chan, (unsigned char*) buf);
+ } while (count > 0);
+ return count;
+
+ case 0xf9: /* Graphic Control Extension */
+ count = GetDataBlock(chan, (unsigned char*) buf);
+ if (count < 0) {
+ return 1;
+ }
+ if ((buf[0] & 0x1) != 0) {
+ *transparent = buf[3];
+ }
+
+ do {
+ count = GetDataBlock(chan, (unsigned char*) buf);
+ } while (count > 0);
+ return count;
+ }
+
+ do {
+ count = GetDataBlock(chan, (unsigned char*) buf);
+ } while (count > 0);
+ return count;
+}
+
+static int ZeroDataBlock = 0;
+
+static int
+GetDataBlock(chan, buf)
+ Tcl_Channel chan;
+ unsigned char *buf;
+{
+ unsigned char count;
+
+ if (! ReadOK(chan, &count,1)) {
+ return -1;
+ }
+
+ ZeroDataBlock = count == 0;
+
+ if ((count != 0) && (! ReadOK(chan, buf, count))) {
+ return -1;
+ }
+
+ return count;
+}
+
+
+static int
+ReadImage(interp, imagePtr, chan, len, rows, cmap,
+ width, height, srcX, srcY, interlace, transparent)
+ Tcl_Interp *interp;
+ char *imagePtr;
+ Tcl_Channel chan;
+ int len, rows;
+ unsigned char cmap[MAXCOLORMAPSIZE][4];
+ int width, height;
+ int srcX, srcY;
+ int interlace;
+ int transparent;
+{
+ unsigned char c;
+ int v;
+ int xpos = 0, ypos = 0, pass = 0;
+ char *pixelPtr;
+
+
+ /*
+ * Initialize the Compression routines
+ */
+ if (! ReadOK(chan, &c, 1)) {
+ Tcl_AppendResult(interp, "error reading GIF image: ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (LWZReadByte(chan, 1, c) < 0) {
+ interp->result = "format error in GIF image";
+ return TCL_ERROR;
+ }
+
+ if (transparent!=-1) {
+ cmap[transparent][CM_RED] = 0;
+ cmap[transparent][CM_GREEN] = 0;
+ cmap[transparent][CM_BLUE] = 0;
+ cmap[transparent][CM_ALPHA] = 0;
+ }
+
+ pixelPtr = imagePtr;
+ while ((v = LWZReadByte(chan, 0, c)) >= 0 ) {
+
+ if ((xpos>=srcX) && (xpos<srcX+len) &&
+ (ypos>=srcY) && (ypos<srcY+rows)) {
+ *pixelPtr++ = cmap[v][CM_RED];
+ *pixelPtr++ = cmap[v][CM_GREEN];
+ *pixelPtr++ = cmap[v][CM_BLUE];
+ *pixelPtr++ = cmap[v][CM_ALPHA];
+ }
+
+ ++xpos;
+ if (xpos == width) {
+ xpos = 0;
+ if (interlace) {
+ switch (pass) {
+ case 0:
+ case 1:
+ ypos += 8; break;
+ case 2:
+ ypos += 4; break;
+ case 3:
+ ypos += 2; break;
+ }
+
+ while (ypos >= height) {
+ ++pass;
+ switch (pass) {
+ case 1:
+ ypos = 4; break;
+ case 2:
+ ypos = 2; break;
+ case 3:
+ ypos = 1; break;
+ default:
+ return TCL_OK;
+ }
+ }
+ } else {
+ ++ypos;
+ }
+ pixelPtr = imagePtr + (ypos-srcY) * len * 4;
+ }
+ if (ypos >= height)
+ break;
+ }
+ return TCL_OK;
+}
+
+static int
+LWZReadByte(chan, flag, input_code_size)
+ Tcl_Channel chan;
+ int flag;
+ int input_code_size;
+{
+ static int fresh = 0;
+ int code, incode;
+ static int code_size, set_code_size;
+ static int max_code, max_code_size;
+ static int firstcode, oldcode;
+ static int clear_code, end_code;
+ static int table[2][(1<< MAX_LWZ_BITS)];
+ static int stack[(1<<(MAX_LWZ_BITS))*2], *sp;
+ register int i;
+
+ if (flag) {
+ set_code_size = input_code_size;
+ code_size = set_code_size+1;
+ clear_code = 1 << set_code_size ;
+ end_code = clear_code + 1;
+ max_code_size = 2*clear_code;
+ max_code = clear_code+2;
+
+ GetCode(chan, 0, 1);
+
+ fresh = 1;
+
+ for (i = 0; i < clear_code; ++i) {
+ table[0][i] = 0;
+ table[1][i] = i;
+ }
+ for (; i < (1<<MAX_LWZ_BITS); ++i) {
+ table[0][i] = table[1][0] = 0;
+ }
+
+ sp = stack;
+
+ return 0;
+ } else if (fresh) {
+ fresh = 0;
+ do {
+ firstcode = oldcode = GetCode(chan, code_size, 0);
+ } while (firstcode == clear_code);
+ return firstcode;
+ }
+
+ if (sp > stack) {
+ return *--sp;
+ }
+
+ while ((code = GetCode(chan, code_size, 0)) >= 0) {
+ if (code == clear_code) {
+ for (i = 0; i < clear_code; ++i) {
+ table[0][i] = 0;
+ table[1][i] = i;
+ }
+
+ for (; i < (1<<MAX_LWZ_BITS); ++i) {
+ table[0][i] = table[1][i] = 0;
+ }
+
+ code_size = set_code_size+1;
+ max_code_size = 2*clear_code;
+ max_code = clear_code+2;
+ sp = stack;
+ firstcode = oldcode = GetCode(chan, code_size, 0);
+ return firstcode;
+
+ } else if (code == end_code) {
+ int count;
+ unsigned char buf[260];
+
+ if (ZeroDataBlock) {
+ return -2;
+ }
+
+ while ((count = GetDataBlock(chan, buf)) > 0)
+ /* Empty body */;
+
+ if (count != 0) {
+ return -2;
+ }
+ }
+
+ incode = code;
+
+ if (code >= max_code) {
+ *sp++ = firstcode;
+ code = oldcode;
+ }
+
+ while (code >= clear_code) {
+ *sp++ = table[1][code];
+ if (code == table[0][code]) {
+ return -2;
+
+ /*
+ * Used to be this instead, Steve Ball suggested
+ * the change to just return.
+ printf("circular table entry BIG ERROR\n");
+ */
+ }
+ code = table[0][code];
+ }
+
+ *sp++ = firstcode = table[1][code];
+
+ if ((code = max_code) <(1<<MAX_LWZ_BITS)) {
+ table[0][code] = oldcode;
+ table[1][code] = firstcode;
+ ++max_code;
+ if ((max_code>=max_code_size) && (max_code_size < (1<<MAX_LWZ_BITS))) {
+ max_code_size *= 2;
+ ++code_size;
+ }
+ }
+
+ oldcode = incode;
+
+ if (sp > stack)
+ return *--sp;
+ }
+ return code;
+}
+
+
+static int
+GetCode(chan, code_size, flag)
+ Tcl_Channel chan;
+ int code_size;
+ int flag;
+{
+ static unsigned char buf[280];
+ static int curbit, lastbit, done, last_byte;
+ int i, j, ret;
+ unsigned char count;
+
+ if (flag) {
+ curbit = 0;
+ lastbit = 0;
+ done = 0;
+ return 0;
+ }
+
+
+ if ( (curbit+code_size) >= lastbit) {
+ if (done) {
+ /* ran off the end of my bits */
+ return -1;
+ }
+ if (last_byte >= 2) {
+ buf[0] = buf[last_byte-2];
+ }
+ if (last_byte >= 1) {
+ buf[1] = buf[last_byte-1];
+ }
+
+ if ((count = GetDataBlock(chan, &buf[2])) == 0) {
+ done = 1;
+ }
+
+ last_byte = 2 + count;
+ curbit = (curbit - lastbit) + 16;
+ lastbit = (2+count)*8 ;
+ }
+
+ ret = 0;
+ for (i = curbit, j = 0; j < code_size; ++i, ++j) {
+ ret |= ((buf[ i / 8 ] & (1 << (i % 8))) != 0) << j;
+ }
+
+ curbit += code_size;
+
+ return ret;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Minit -- --
+ *
+ * This procedure initializes a base64 decoder handle
+ *
+ * Results:
+ * none
+ *
+ * Side effects:
+ * the base64 handle is initialized
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+mInit(string, handle)
+ unsigned char *string; /* string containing initial mmencoded data */
+ MFile *handle; /* mmdecode "file" handle */
+{
+ handle->data = string;
+ handle->state = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Mread --
+ *
+ * This procedure is invoked by the GIF file reader as a
+ * temporary replacement for "fread", to get GIF data out
+ * of a string (using Mgetc).
+ *
+ * Results:
+ * The return value is the number of characters "read"
+ *
+ * Side effects:
+ * The base64 handle will change state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Mread(dst, chunkSize, numChunks, handle)
+ unsigned char *dst; /* where to put the result */
+ size_t chunkSize; /* size of each transfer */
+ size_t numChunks; /* number of chunks */
+ MFile *handle; /* mmdecode "file" handle */
+{
+ register int i, c;
+ int count = chunkSize * numChunks;
+
+ for(i=0; i<count && (c=Mgetc(handle)) != GIF_DONE; i++) {
+ *dst++ = c;
+ }
+ return i;
+}
+
+/*
+ * get the next decoded character from an mmencode handle
+ * This causes at least 1 character to be "read" from the encoded string
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Mgetc --
+ *
+ * This procedure decodes and returns the next byte from a base64
+ * encoded string.
+ *
+ * Results:
+ * The next byte (or GIF_DONE) is returned.
+ *
+ * Side effects:
+ * The base64 handle will change state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Mgetc(handle)
+ MFile *handle; /* Handle containing decoder data and state. */
+{
+ int c;
+ int result = 0; /* Initialization needed only to prevent
+ * gcc compiler warning. */
+
+ if (handle->state == GIF_DONE) {
+ return(GIF_DONE);
+ }
+
+ do {
+ c = char64(*handle->data);
+ handle->data++;
+ } while (c==GIF_SPACE);
+
+ if (c>GIF_SPECIAL) {
+ handle->state = GIF_DONE;
+ return(handle->state ? handle->c : GIF_DONE);
+ }
+
+ switch (handle->state++) {
+ case 0:
+ handle->c = c<<2;
+ result = Mgetc(handle);
+ break;
+ case 1:
+ result = handle->c | (c>>4);
+ handle->c = (c&0xF)<<4;
+ break;
+ case 2:
+ result = handle->c | (c>>2);
+ handle->c = (c&0x3) << 6;
+ break;
+ case 3:
+ result = handle->c | c;
+ handle->state = 0;
+ break;
+ }
+ return(result);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * char64 --
+ *
+ * This procedure converts a base64 ascii character into its binary
+ * equivalent. This code is a slightly modified version of the
+ * char64 proc in N. Borenstein's metamail decoder.
+ *
+ * Results:
+ * The binary value, or an error code.
+ *
+ * Side effects:
+ * None.
+ *----------------------------------------------------------------------
+ */
+
+static int
+char64(c)
+int c;
+{
+ switch(c) {
+ case 'A': return(0); case 'B': return(1); case 'C': return(2);
+ case 'D': return(3); case 'E': return(4); case 'F': return(5);
+ case 'G': return(6); case 'H': return(7); case 'I': return(8);
+ case 'J': return(9); case 'K': return(10); case 'L': return(11);
+ case 'M': return(12); case 'N': return(13); case 'O': return(14);
+ case 'P': return(15); case 'Q': return(16); case 'R': return(17);
+ case 'S': return(18); case 'T': return(19); case 'U': return(20);
+ case 'V': return(21); case 'W': return(22); case 'X': return(23);
+ case 'Y': return(24); case 'Z': return(25); case 'a': return(26);
+ case 'b': return(27); case 'c': return(28); case 'd': return(29);
+ case 'e': return(30); case 'f': return(31); case 'g': return(32);
+ case 'h': return(33); case 'i': return(34); case 'j': return(35);
+ case 'k': return(36); case 'l': return(37); case 'm': return(38);
+ case 'n': return(39); case 'o': return(40); case 'p': return(41);
+ case 'q': return(42); case 'r': return(43); case 's': return(44);
+ case 't': return(45); case 'u': return(46); case 'v': return(47);
+ case 'w': return(48); case 'x': return(49); case 'y': return(50);
+ case 'z': return(51); case '0': return(52); case '1': return(53);
+ case '2': return(54); case '3': return(55); case '4': return(56);
+ case '5': return(57); case '6': return(58); case '7': return(59);
+ case '8': return(60); case '9': return(61); case '+': return(62);
+ case '/': return(63);
+
+ case ' ': case '\t': case '\n': case '\r': case '\f': return(GIF_SPACE);
+ case '=': return(GIF_PAD);
+ case '\0': return(GIF_DONE);
+ default: return(GIF_BAD);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Fread --
+ *
+ * This procedure calls either fread or Mread to read data
+ * from a file or a base64 encoded string.
+ *
+ * Results: - same as fread
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Fread(dst, hunk, count, chan)
+ unsigned char *dst; /* where to put the result */
+ size_t hunk,count; /* how many */
+ Tcl_Channel chan;
+{
+ if (fromData) {
+ return(Mread(dst, hunk, count, (MFile *) chan));
+ } else {
+ return Tcl_Read(chan, (char *) dst, (int) (hunk * count));
+ }
+}
diff --git a/generic/tkImgPPM.c b/generic/tkImgPPM.c
new file mode 100644
index 0000000..3a54003
--- /dev/null
+++ b/generic/tkImgPPM.c
@@ -0,0 +1,421 @@
+/*
+ * tkImgPPM.c --
+ *
+ * A photo image file handler for PPM (Portable PixMap) files.
+ *
+ * Copyright (c) 1994 The Australian National University.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * Author: Paul Mackerras (paulus@cs.anu.edu.au),
+ * Department of Computer Science,
+ * Australian National University.
+ *
+ * SCCS: @(#) tkImgPPM.c 1.16 97/10/28 14:51:46
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * The maximum amount of memory to allocate for data read from the
+ * file. If we need more than this, we do it in pieces.
+ */
+
+#define MAX_MEMORY 10000 /* don't allocate > 10KB */
+
+/*
+ * Define PGM and PPM, i.e. gray images and color images.
+ */
+
+#define PGM 1
+#define PPM 2
+
+/*
+ * The format record for the PPM file format:
+ */
+
+static int FileMatchPPM _ANSI_ARGS_((Tcl_Channel chan,
+ char *fileName, char *formatString,
+ int *widthPtr, int *heightPtr));
+static int FileReadPPM _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Channel chan, char *fileName,
+ char *formatString, Tk_PhotoHandle imageHandle,
+ int destX, int destY, int width, int height,
+ int srcX, int srcY));
+static int FileWritePPM _ANSI_ARGS_((Tcl_Interp *interp,
+ char *fileName, char *formatString,
+ Tk_PhotoImageBlock *blockPtr));
+
+Tk_PhotoImageFormat tkImgFmtPPM = {
+ "PPM", /* name */
+ FileMatchPPM, /* fileMatchProc */
+ NULL, /* stringMatchProc */
+ FileReadPPM, /* fileReadProc */
+ NULL, /* stringReadProc */
+ FileWritePPM, /* fileWriteProc */
+ NULL, /* stringWriteProc */
+};
+
+/*
+ * Prototypes for local procedures defined in this file:
+ */
+
+static int ReadPPMFileHeader _ANSI_ARGS_((Tcl_Channel chan,
+ int *widthPtr, int *heightPtr,
+ int *maxIntensityPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileMatchPPM --
+ *
+ * This procedure is invoked by the photo image type to see if
+ * a file contains image data in PPM format.
+ *
+ * Results:
+ * The return value is >0 if the first characters in file "f" look
+ * like PPM data, and 0 otherwise.
+ *
+ * Side effects:
+ * The access position in f may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileMatchPPM(chan, fileName, formatString, widthPtr, heightPtr)
+ Tcl_Channel chan; /* The image file, open for reading. */
+ char *fileName; /* The name of the image file. */
+ char *formatString; /* User-specified format string, or NULL. */
+ int *widthPtr, *heightPtr; /* The dimensions of the image are
+ * returned here if the file is a valid
+ * raw PPM file. */
+{
+ int dummy;
+
+ return ReadPPMFileHeader(chan, widthPtr, heightPtr, &dummy);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileReadPPM --
+ *
+ * This procedure is called by the photo image type to read
+ * PPM format data from a file and write it into a given
+ * photo image.
+ *
+ * Results:
+ * A standard TCL completion code. If TCL_ERROR is returned
+ * then an error message is left in interp->result.
+ *
+ * Side effects:
+ * The access position in file f is changed, and new data is
+ * added to the image given by imageHandle.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileReadPPM(interp, chan, fileName, formatString, imageHandle, destX, destY,
+ width, height, srcX, srcY)
+ Tcl_Interp *interp; /* Interpreter to use for reporting errors. */
+ Tcl_Channel chan; /* The image file, open for reading. */
+ char *fileName; /* The name of the image file. */
+ char *formatString; /* User-specified format string, or NULL. */
+ Tk_PhotoHandle imageHandle; /* The photo image to write into. */
+ int destX, destY; /* Coordinates of top-left pixel in
+ * photo image to be written to. */
+ int width, height; /* Dimensions of block of photo image to
+ * be written to. */
+ int srcX, srcY; /* Coordinates of top-left pixel to be used
+ * in image being read. */
+{
+ int fileWidth, fileHeight, maxIntensity;
+ int nLines, nBytes, h, type, count;
+ unsigned char *pixelPtr;
+ Tk_PhotoImageBlock block;
+
+ type = ReadPPMFileHeader(chan, &fileWidth, &fileHeight, &maxIntensity);
+ if (type == 0) {
+ Tcl_AppendResult(interp, "couldn't read raw PPM header from file \"",
+ fileName, "\"", NULL);
+ return TCL_ERROR;
+ }
+ if ((fileWidth <= 0) || (fileHeight <= 0)) {
+ Tcl_AppendResult(interp, "PPM image file \"", fileName,
+ "\" has dimension(s) <= 0", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ((maxIntensity <= 0) || (maxIntensity >= 256)) {
+ char buffer[30];
+
+ sprintf(buffer, "%d", maxIntensity);
+ Tcl_AppendResult(interp, "PPM image file \"", fileName,
+ "\" has bad maximum intensity value ", buffer,
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if ((srcX + width) > fileWidth) {
+ width = fileWidth - srcX;
+ }
+ if ((srcY + height) > fileHeight) {
+ height = fileHeight - srcY;
+ }
+ if ((width <= 0) || (height <= 0)
+ || (srcX >= fileWidth) || (srcY >= fileHeight)) {
+ return TCL_OK;
+ }
+
+ if (type == PGM) {
+ block.pixelSize = 1;
+ block.offset[0] = 0;
+ block.offset[1] = 0;
+ block.offset[2] = 0;
+ }
+ else {
+ block.pixelSize = 3;
+ block.offset[0] = 0;
+ block.offset[1] = 1;
+ block.offset[2] = 2;
+ }
+ block.width = width;
+ block.pitch = block.pixelSize * fileWidth;
+
+ Tk_PhotoExpand(imageHandle, destX + width, destY + height);
+
+ if (srcY > 0) {
+ Tcl_Seek(chan, (srcY * block.pitch), SEEK_CUR);
+ }
+
+ nLines = (MAX_MEMORY + block.pitch - 1) / block.pitch;
+ if (nLines > height) {
+ nLines = height;
+ }
+ if (nLines <= 0) {
+ nLines = 1;
+ }
+ nBytes = nLines * block.pitch;
+ pixelPtr = (unsigned char *) ckalloc((unsigned) nBytes);
+ block.pixelPtr = pixelPtr + srcX * block.pixelSize;
+
+ for (h = height; h > 0; h -= nLines) {
+ if (nLines > h) {
+ nLines = h;
+ nBytes = nLines * block.pitch;
+ }
+ count = Tcl_Read(chan, (char *) pixelPtr, nBytes);
+ if (count != nBytes) {
+ Tcl_AppendResult(interp, "error reading PPM image file \"",
+ fileName, "\": ",
+ Tcl_Eof(chan) ? "not enough data" : Tcl_PosixError(interp),
+ (char *) NULL);
+ ckfree((char *) pixelPtr);
+ return TCL_ERROR;
+ }
+ if (maxIntensity != 255) {
+ unsigned char *p;
+
+ for (p = pixelPtr; count > 0; count--, p++) {
+ *p = (((int) *p) * 255)/maxIntensity;
+ }
+ }
+ block.height = nLines;
+ Tk_PhotoPutBlock(imageHandle, &block, destX, destY, width, nLines);
+ destY += nLines;
+ }
+
+ ckfree((char *) pixelPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileWritePPM --
+ *
+ * This procedure is invoked to write image data to a file in PPM
+ * format.
+ *
+ * Results:
+ * A standard TCL completion code. If TCL_ERROR is returned
+ * then an error message is left in interp->result.
+ *
+ * Side effects:
+ * Data is written to the file given by "fileName".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileWritePPM(interp, fileName, formatString, blockPtr)
+ Tcl_Interp *interp;
+ char *fileName;
+ char *formatString;
+ Tk_PhotoImageBlock *blockPtr;
+{
+ Tcl_Channel chan;
+ int w, h;
+ int greenOffset, blueOffset, nBytes;
+ unsigned char *pixelPtr, *pixLinePtr;
+ char header[30];
+
+ chan = Tcl_OpenFileChannel(interp, fileName, "w", 0666);
+ if (chan == NULL) {
+ return TCL_ERROR;
+ }
+
+ sprintf(header, "P6\n%d %d\n255\n", blockPtr->width, blockPtr->height);
+ Tcl_Write(chan, header, -1);
+
+ pixLinePtr = blockPtr->pixelPtr + blockPtr->offset[0];
+ greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
+ blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
+
+ if ((greenOffset == 1) && (blueOffset == 2) && (blockPtr->pixelSize == 3)
+ && (blockPtr->pitch == (blockPtr->width * 3))) {
+ nBytes = blockPtr->height * blockPtr->pitch;
+ if (Tcl_Write(chan, (char *) pixLinePtr, nBytes) != nBytes) {
+ goto writeerror;
+ }
+ } else {
+ for (h = blockPtr->height; h > 0; h--) {
+ pixelPtr = pixLinePtr;
+ for (w = blockPtr->width; w > 0; w--) {
+ if ((Tcl_Write(chan, (char *) &pixelPtr[0], 1) == -1)
+ || (Tcl_Write(chan, (char *) &pixelPtr[greenOffset], 1) == -1)
+ || (Tcl_Write(chan, (char *) &pixelPtr[blueOffset], 1) == -1)) {
+ goto writeerror;
+ }
+ pixelPtr += blockPtr->pixelSize;
+ }
+ pixLinePtr += blockPtr->pitch;
+ }
+ }
+
+ if (Tcl_Close(NULL, chan) == 0) {
+ return TCL_OK;
+ }
+ chan = NULL;
+
+ writeerror:
+ Tcl_AppendResult(interp, "error writing \"", fileName, "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ if (chan != NULL) {
+ Tcl_Close(NULL, chan);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadPPMFileHeader --
+ *
+ * This procedure reads the PPM header from the beginning of a
+ * PPM file and returns information from the header.
+ *
+ * Results:
+ * The return value is PGM if file "f" appears to start with
+ * a valid PGM header, PPM if "f" appears to start with a valid
+ * PPM header, and 0 otherwise. If the header is valid,
+ * then *widthPtr and *heightPtr are modified to hold the
+ * dimensions of the image and *maxIntensityPtr is modified to
+ * hold the value of a "fully on" intensity value.
+ *
+ * Side effects:
+ * The access position in f advances.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadPPMFileHeader(chan, widthPtr, heightPtr, maxIntensityPtr)
+ Tcl_Channel chan; /* Image file to read the header from */
+ int *widthPtr, *heightPtr; /* The dimensions of the image are
+ * returned here. */
+ int *maxIntensityPtr; /* The maximum intensity value for
+ * the image is stored here. */
+{
+#define BUFFER_SIZE 1000
+ char buffer[BUFFER_SIZE];
+ int i, numFields, firstInLine;
+ int type = 0;
+ char c;
+
+ /*
+ * Read 4 space-separated fields from the file, ignoring
+ * comments (any line that starts with "#").
+ */
+
+ if (Tcl_Read(chan, &c, 1) != 1) {
+ return 0;
+ }
+ firstInLine = 1;
+ i = 0;
+ for (numFields = 0; numFields < 4; numFields++) {
+ /*
+ * Skip comments and white space.
+ */
+
+ while (1) {
+ while (isspace(UCHAR(c))) {
+ firstInLine = (c == '\n');
+ if (Tcl_Read(chan, &c, 1) != 1) {
+ return 0;
+ }
+ }
+ if (c != '#') {
+ break;
+ }
+ do {
+ if (Tcl_Read(chan, &c, 1) != 1) {
+ return 0;
+ }
+ } while (c != '\n');
+ firstInLine = 1;
+ }
+
+ /*
+ * Read a field (everything up to the next white space).
+ */
+
+ while (!isspace(UCHAR(c))) {
+ if (i < (BUFFER_SIZE-2)) {
+ buffer[i] = c;
+ i++;
+ }
+ if (Tcl_Read(chan, &c, 1) != 1) {
+ goto done;
+ }
+ }
+ if (i < (BUFFER_SIZE-1)) {
+ buffer[i] = ' ';
+ i++;
+ }
+ firstInLine = 0;
+ }
+ done:
+ buffer[i] = 0;
+
+ /*
+ * Parse the fields, which are: id, width, height, maxIntensity.
+ */
+
+ if (strncmp(buffer, "P6 ", 3) == 0) {
+ type = PPM;
+ } else if (strncmp(buffer, "P5 ", 3) == 0) {
+ type = PGM;
+ } else {
+ return 0;
+ }
+ if (sscanf(buffer+3, "%d %d %d", widthPtr, heightPtr, maxIntensityPtr)
+ != 3) {
+ return 0;
+ }
+ return type;
+}
diff --git a/generic/tkImgPhoto.c b/generic/tkImgPhoto.c
new file mode 100644
index 0000000..86fbf80
--- /dev/null
+++ b/generic/tkImgPhoto.c
@@ -0,0 +1,4144 @@
+/*
+ * tkImgPhoto.c --
+ *
+ * Implements images of type "photo" for Tk. Photo images are
+ * stored in full color (24 bits per pixel) and displayed using
+ * dithering if necessary.
+ *
+ * Copyright (c) 1994 The Australian National University.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * Author: Paul Mackerras (paulus@cs.anu.edu.au),
+ * Department of Computer Science,
+ * Australian National University.
+ *
+ * SCCS: @(#) tkImgPhoto.c 1.60 97/08/08 11:32:46
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tclMath.h"
+#include <ctype.h>
+
+/*
+ * Declaration for internal Xlib function used here:
+ */
+
+extern _XInitImageFuncPtrs _ANSI_ARGS_((XImage *image));
+
+/*
+ * A signed 8-bit integral type. If chars are unsigned and the compiler
+ * isn't an ANSI one, then we have to use short instead (which wastes
+ * space) to get signed behavior.
+ */
+
+#if defined(__STDC__) || defined(_AIX)
+ typedef signed char schar;
+#else
+# ifndef __CHAR_UNSIGNED__
+ typedef char schar;
+# else
+ typedef short schar;
+# endif
+#endif
+
+/*
+ * An unsigned 32-bit integral type, used for pixel values.
+ * We use int rather than long here to accommodate those systems
+ * where longs are 64 bits.
+ */
+
+typedef unsigned int pixel;
+
+/*
+ * The maximum number of pixels to transmit to the server in a
+ * single XPutImage call.
+ */
+
+#define MAX_PIXELS 65536
+
+/*
+ * The set of colors required to display a photo image in a window depends on:
+ * - the visual used by the window
+ * - the palette, which specifies how many levels of each primary
+ * color to use, and
+ * - the gamma value for the image.
+ *
+ * Pixel values allocated for specific colors are valid only for the
+ * colormap in which they were allocated. Sets of pixel values
+ * allocated for displaying photos are re-used in other windows if
+ * possible, that is, if the display, colormap, palette and gamma
+ * values match. A hash table is used to locate these sets of pixel
+ * values, using the following data structure as key:
+ */
+
+typedef struct {
+ Display *display; /* Qualifies the colormap resource ID */
+ Colormap colormap; /* Colormap that the windows are using. */
+ double gamma; /* Gamma exponent value for images. */
+ Tk_Uid palette; /* Specifies how many shades of each primary
+ * we want to allocate. */
+} ColorTableId;
+
+/*
+ * For a particular (display, colormap, palette, gamma) combination,
+ * a data structure of the following type is used to store the allocated
+ * pixel values and other information:
+ */
+
+typedef struct ColorTable {
+ ColorTableId id; /* Information used in selecting this
+ * color table. */
+ int flags; /* See below. */
+ int refCount; /* Number of instances using this map. */
+ int liveRefCount; /* Number of instances which are actually
+ * in use, using this map. */
+ int numColors; /* Number of colors allocated for this map. */
+
+ XVisualInfo visualInfo; /* Information about the visual for windows
+ * using this color table. */
+
+ pixel redValues[256]; /* Maps 8-bit values of red intensity
+ * to a pixel value or index in pixelMap. */
+ pixel greenValues[256]; /* Ditto for green intensity */
+ pixel blueValues[256]; /* Ditto for blue intensity */
+ unsigned long *pixelMap; /* Actual pixel values allocated. */
+
+ unsigned char colorQuant[3][256];
+ /* Maps 8-bit intensities to quantized
+ * intensities. The first index is 0 for
+ * red, 1 for green, 2 for blue. */
+} ColorTable;
+
+/*
+ * Bit definitions for the flags field of a ColorTable.
+ * BLACK_AND_WHITE: 1 means only black and white colors are
+ * available.
+ * COLOR_WINDOW: 1 means a full 3-D color cube has been
+ * allocated.
+ * DISPOSE_PENDING: 1 means a call to DisposeColorTable has
+ * been scheduled as an idle handler, but it
+ * hasn't been invoked yet.
+ * MAP_COLORS: 1 means pixel values should be mapped
+ * through pixelMap.
+ */
+
+#define BLACK_AND_WHITE 1
+#define COLOR_WINDOW 2
+#define DISPOSE_PENDING 4
+#define MAP_COLORS 8
+
+/*
+ * Definition of the data associated with each photo image master.
+ */
+
+typedef struct PhotoMaster {
+ Tk_ImageMaster tkMaster; /* Tk's token for image master. NULL means
+ * the image is being deleted. */
+ Tcl_Interp *interp; /* Interpreter associated with the
+ * application using this image. */
+ Tcl_Command imageCmd; /* Token for image command (used to delete
+ * it when the image goes away). NULL means
+ * the image command has already been
+ * deleted. */
+ int flags; /* Sundry flags, defined below. */
+ int width, height; /* Dimensions of image. */
+ int userWidth, userHeight; /* User-declared image dimensions. */
+ Tk_Uid palette; /* User-specified default palette for
+ * instances of this image. */
+ double gamma; /* Display gamma value to correct for. */
+ char *fileString; /* Name of file to read into image. */
+ char *dataString; /* String value to use as contents of image. */
+ char *format; /* User-specified format of data in image
+ * file or string value. */
+ unsigned char *pix24; /* Local storage for 24-bit image. */
+ int ditherX, ditherY; /* Location of first incorrectly
+ * dithered pixel in image. */
+ TkRegion validRegion; /* Tk region indicating which parts of
+ * the image have valid image data. */
+ struct PhotoInstance *instancePtr;
+ /* First in the list of instances
+ * associated with this master. */
+} PhotoMaster;
+
+/*
+ * Bit definitions for the flags field of a PhotoMaster.
+ * COLOR_IMAGE: 1 means that the image has different color
+ * components.
+ * IMAGE_CHANGED: 1 means that the instances of this image
+ * need to be redithered.
+ */
+
+#define COLOR_IMAGE 1
+#define IMAGE_CHANGED 2
+
+/*
+ * The following data structure represents all of the instances of
+ * a photo image in windows on a given screen that are using the
+ * same colormap.
+ */
+
+typedef struct PhotoInstance {
+ PhotoMaster *masterPtr; /* Pointer to master for image. */
+ Display *display; /* Display for windows using this instance. */
+ Colormap colormap; /* The image may only be used in windows with
+ * this particular colormap. */
+ struct PhotoInstance *nextPtr;
+ /* Pointer to the next instance in the list
+ * of instances associated with this master. */
+ int refCount; /* Number of instances using this structure. */
+ Tk_Uid palette; /* Palette for these particular instances. */
+ double gamma; /* Gamma value for these instances. */
+ Tk_Uid defaultPalette; /* Default palette to use if a palette
+ * is not specified for the master. */
+ ColorTable *colorTablePtr; /* Pointer to information about colors
+ * allocated for image display in windows
+ * like this one. */
+ Pixmap pixels; /* X pixmap containing dithered image. */
+ int width, height; /* Dimensions of the pixmap. */
+ schar *error; /* Error image, used in dithering. */
+ XImage *imagePtr; /* Image structure for converted pixels. */
+ XVisualInfo visualInfo; /* Information about the visual that these
+ * windows are using. */
+ GC gc; /* Graphics context for writing images
+ * to the pixmap. */
+} PhotoInstance;
+
+/*
+ * The following data structure is used to return information
+ * from ParseSubcommandOptions:
+ */
+
+struct SubcommandOptions {
+ int options; /* Individual bits indicate which
+ * options were specified - see below. */
+ char *name; /* Name specified without an option. */
+ int fromX, fromY; /* Values specified for -from option. */
+ int fromX2, fromY2; /* Second coordinate pair for -from option. */
+ int toX, toY; /* Values specified for -to option. */
+ int toX2, toY2; /* Second coordinate pair for -to option. */
+ int zoomX, zoomY; /* Values specified for -zoom option. */
+ int subsampleX, subsampleY; /* Values specified for -subsample option. */
+ char *format; /* Value specified for -format option. */
+};
+
+/*
+ * 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_FORMAT: Set if -format option allowed/specified.
+ * OPT_FROM: Set if -from 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_FORMAT 1
+#define OPT_FROM 2
+#define OPT_SHRINK 4
+#define OPT_SUBSAMPLE 8
+#define OPT_TO 0x10
+#define OPT_ZOOM 0x20
+
+/*
+ * List of option names. The order here must match the order of
+ * declarations of the OPT_* constants above.
+ */
+
+static char *optionNames[] = {
+ "-format",
+ "-from",
+ "-shrink",
+ "-subsample",
+ "-to",
+ "-zoom",
+ (char *) NULL
+};
+
+/*
+ * The type record for photo images:
+ */
+
+static int ImgPhotoCreate _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, int argc, char **argv,
+ Tk_ImageType *typePtr, Tk_ImageMaster master,
+ ClientData *clientDataPtr));
+static ClientData ImgPhotoGet _ANSI_ARGS_((Tk_Window tkwin,
+ ClientData clientData));
+static void ImgPhotoDisplay _ANSI_ARGS_((ClientData clientData,
+ Display *display, Drawable drawable,
+ int imageX, int imageY, int width, int height,
+ int drawableX, int drawableY));
+static void ImgPhotoFree _ANSI_ARGS_((ClientData clientData,
+ Display *display));
+static void ImgPhotoDelete _ANSI_ARGS_((ClientData clientData));
+
+Tk_ImageType tkPhotoImageType = {
+ "photo", /* name */
+ ImgPhotoCreate, /* createProc */
+ ImgPhotoGet, /* getProc */
+ ImgPhotoDisplay, /* displayProc */
+ ImgPhotoFree, /* freeProc */
+ ImgPhotoDelete, /* deleteProc */
+ (Tk_ImageType *) NULL /* nextPtr */
+};
+
+/*
+ * Default configuration
+ */
+
+#define DEF_PHOTO_GAMMA "1"
+#define DEF_PHOTO_HEIGHT "0"
+#define DEF_PHOTO_PALETTE ""
+#define DEF_PHOTO_WIDTH "0"
+
+/*
+ * Information used for parsing configuration specifications:
+ */
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_STRING, "-data", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PhotoMaster, dataString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-format", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PhotoMaster, format), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PhotoMaster, fileString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_DOUBLE, "-gamma", (char *) NULL, (char *) NULL,
+ DEF_PHOTO_GAMMA, Tk_Offset(PhotoMaster, gamma), 0},
+ {TK_CONFIG_INT, "-height", (char *) NULL, (char *) NULL,
+ DEF_PHOTO_HEIGHT, Tk_Offset(PhotoMaster, userHeight), 0},
+ {TK_CONFIG_UID, "-palette", (char *) NULL, (char *) NULL,
+ DEF_PHOTO_PALETTE, Tk_Offset(PhotoMaster, palette), 0},
+ {TK_CONFIG_INT, "-width", (char *) NULL, (char *) NULL,
+ DEF_PHOTO_WIDTH, Tk_Offset(PhotoMaster, userWidth), 0},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Hash table used to hash from (display, colormap, palette, gamma)
+ * to ColorTable address.
+ */
+
+static Tcl_HashTable imgPhotoColorHash;
+static int imgPhotoColorHashInitialized;
+#define N_COLOR_HASH (sizeof(ColorTableId) / sizeof(int))
+
+/*
+ * Pointer to the first in the list of known photo image formats.
+ */
+
+static Tk_PhotoImageFormat *formatList = NULL;
+
+/*
+ * Forward declarations
+ */
+
+static int ImgPhotoCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static int ParseSubcommandOptions _ANSI_ARGS_((
+ struct SubcommandOptions *optPtr,
+ Tcl_Interp *interp, int allowedOptions,
+ int *indexPtr, int argc, char **argv));
+static void ImgPhotoCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static int ImgPhotoConfigureMaster _ANSI_ARGS_((
+ Tcl_Interp *interp, PhotoMaster *masterPtr,
+ int argc, char **argv, int flags));
+static void ImgPhotoConfigureInstance _ANSI_ARGS_((
+ PhotoInstance *instancePtr));
+static void ImgPhotoSetSize _ANSI_ARGS_((PhotoMaster *masterPtr,
+ int width, int height));
+static void ImgPhotoInstanceSetSize _ANSI_ARGS_((
+ PhotoInstance *instancePtr));
+static int IsValidPalette _ANSI_ARGS_((PhotoInstance *instancePtr,
+ char *palette));
+static int CountBits _ANSI_ARGS_((pixel mask));
+static void GetColorTable _ANSI_ARGS_((PhotoInstance *instancePtr));
+static void FreeColorTable _ANSI_ARGS_((ColorTable *colorPtr));
+static void AllocateColors _ANSI_ARGS_((ColorTable *colorPtr));
+static void DisposeColorTable _ANSI_ARGS_((ClientData clientData));
+static void DisposeInstance _ANSI_ARGS_((ClientData clientData));
+static int ReclaimColors _ANSI_ARGS_((ColorTableId *id,
+ int numColors));
+static int MatchFileFormat _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Channel chan, char *fileName,
+ char *formatString,
+ Tk_PhotoImageFormat **imageFormatPtr,
+ int *widthPtr, int *heightPtr));
+static int MatchStringFormat _ANSI_ARGS_((Tcl_Interp *interp,
+ char *string, char *formatString,
+ Tk_PhotoImageFormat **imageFormatPtr,
+ int *widthPtr, int *heightPtr));
+static void Dither _ANSI_ARGS_((PhotoMaster *masterPtr,
+ int x, int y, int width, int height));
+static void DitherInstance _ANSI_ARGS_((PhotoInstance *instancePtr,
+ int x, int y, int width, int height));
+
+#undef MIN
+#define MIN(a, b) ((a) < (b)? (a): (b))
+#undef MAX
+#define MAX(a, b) ((a) > (b)? (a): (b))
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CreatePhotoImageFormat --
+ *
+ * This procedure is invoked by an image file handler to register
+ * a new photo image format and the procedures that handle the
+ * new format. The procedure is typically invoked during
+ * Tcl_AppInit.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The new image file format is entered into a table used in the
+ * photo image "read" and "write" subcommands.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CreatePhotoImageFormat(formatPtr)
+ Tk_PhotoImageFormat *formatPtr;
+ /* Structure describing the format. All of
+ * the fields except "nextPtr" must be filled
+ * in by caller. Must not have been passed
+ * to Tk_CreatePhotoImageFormat previously. */
+{
+ Tk_PhotoImageFormat *copyPtr;
+
+ copyPtr = (Tk_PhotoImageFormat *) ckalloc(sizeof(Tk_PhotoImageFormat));
+ *copyPtr = *formatPtr;
+ copyPtr->name = (char *) ckalloc((unsigned) (strlen(formatPtr->name) + 1));
+ strcpy(copyPtr->name, formatPtr->name);
+ copyPtr->nextPtr = formatList;
+ formatList = copyPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoCreate --
+ *
+ * This procedure is called by the Tk image code to create
+ * a new photo image.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The data structure for a new photo image is allocated and
+ * initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgPhotoCreate(interp, name, argc, argv, typePtr, master, clientDataPtr)
+ Tcl_Interp *interp; /* Interpreter for application containing
+ * image. */
+ char *name; /* Name to use for image. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings for options (doesn't
+ * include image name or type). */
+ Tk_ImageType *typePtr; /* Pointer to our type record (not used). */
+ Tk_ImageMaster master; /* Token for image, to be used by us in
+ * later callbacks. */
+ ClientData *clientDataPtr; /* Store manager's token for image here;
+ * it will be returned in later callbacks. */
+{
+ PhotoMaster *masterPtr;
+
+ /*
+ * Allocate and initialize the photo image master record.
+ */
+
+ masterPtr = (PhotoMaster *) ckalloc(sizeof(PhotoMaster));
+ memset((void *) masterPtr, 0, sizeof(PhotoMaster));
+ masterPtr->tkMaster = master;
+ masterPtr->interp = interp;
+ masterPtr->imageCmd = Tcl_CreateCommand(interp, name, ImgPhotoCmd,
+ (ClientData) masterPtr, ImgPhotoCmdDeletedProc);
+ masterPtr->palette = NULL;
+ masterPtr->pix24 = NULL;
+ masterPtr->instancePtr = NULL;
+ masterPtr->validRegion = TkCreateRegion();
+
+ /*
+ * Process configuration options given in the image create command.
+ */
+
+ if (ImgPhotoConfigureMaster(interp, masterPtr, argc, argv, 0) != TCL_OK) {
+ ImgPhotoDelete((ClientData) masterPtr);
+ return TCL_ERROR;
+ }
+
+ *clientDataPtr = (ClientData) masterPtr;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoCmd --
+ *
+ * This procedure is invoked to process the Tcl command that
+ * corresponds to a photo image. See the user documentation
+ * for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgPhotoCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about photo master. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ PhotoMaster *masterPtr = (PhotoMaster *) clientData;
+ int c, result, index;
+ int x, y, width, height;
+ int dataWidth, dataHeight;
+ struct SubcommandOptions options;
+ int listArgc;
+ char **listArgv;
+ char **srcArgv;
+ unsigned char *pixelPtr;
+ Tk_PhotoImageBlock block;
+ Tk_Window tkwin;
+ char string[16];
+ XColor color;
+ Tk_PhotoImageFormat *imageFormat;
+ int imageWidth, imageHeight;
+ int matched;
+ Tcl_Channel chan;
+ Tk_PhotoHandle srcHandle;
+ size_t length;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = argv[1][0];
+ length = strlen(argv[1]);
+
+ if ((c == 'b') && (strncmp(argv[1], "blank", length) == 0)) {
+ /*
+ * photo blank command - just call Tk_PhotoBlank.
+ */
+
+ if (argc == 2) {
+ Tk_PhotoBlank(masterPtr);
+ } else {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " blank\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if ((c == 'c') && (length >= 2)
+ && (strncmp(argv[1], "cget", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " cget option\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tk_ConfigureValue(interp, Tk_MainWindow(interp), configSpecs,
+ (char *) masterPtr, argv[2], 0);
+ } else if ((c == 'c') && (length >= 3)
+ && (strncmp(argv[1], "configure", length) == 0)) {
+ /*
+ * photo configure command - handle this in the standard way.
+ */
+
+ if (argc == 2) {
+ return Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, (char *) NULL, 0);
+ }
+ if (argc == 3) {
+ return Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, argv[2], 0);
+ }
+ return ImgPhotoConfigureMaster(interp, masterPtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ } else if ((c == 'c') && (length >= 3)
+ && (strncmp(argv[1], "copy", length) == 0)) {
+ /*
+ * photo copy command - first parse options.
+ */
+
+ index = 2;
+ memset((VOID *) &options, 0, sizeof(options));
+ options.zoomX = options.zoomY = 1;
+ options.subsampleX = options.subsampleY = 1;
+ options.name = NULL;
+ if (ParseSubcommandOptions(&options, interp,
+ OPT_FROM | OPT_TO | OPT_ZOOM | OPT_SUBSAMPLE | OPT_SHRINK,
+ &index, argc, argv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (options.name == NULL || index < argc) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " copy source-image ?-from x1 y1 x2 y2?",
+ " ?-to x1 y1 x2 y2? ?-zoom x y? ?-subsample x y?",
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look for the source image and get a pointer to its image data.
+ * Check the values given for the -from option.
+ */
+
+ if ((srcHandle = Tk_FindPhoto(interp, options.name)) == NULL) {
+ Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't",
+ " exist or is not a photo image", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tk_PhotoGetImage(srcHandle, &block);
+ if ((options.fromX2 > block.width) || (options.fromY2 > block.height)
+ || (options.fromX2 > block.width)
+ || (options.fromY2 > block.height)) {
+ Tcl_AppendResult(interp, "coordinates for -from option extend ",
+ "outside source image", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Fill in default values for unspecified parameters.
+ */
+
+ if (((options.options & OPT_FROM) == 0) || (options.fromX2 < 0)) {
+ options.fromX2 = block.width;
+ options.fromY2 = block.height;
+ }
+ if (((options.options & OPT_TO) == 0) || (options.toX2 < 0)) {
+ width = options.fromX2 - options.fromX;
+ if (options.subsampleX > 0) {
+ width = (width + options.subsampleX - 1) / options.subsampleX;
+ } else if (options.subsampleX == 0) {
+ width = 0;
+ } else {
+ width = (width - options.subsampleX - 1) / -options.subsampleX;
+ }
+ options.toX2 = options.toX + width * options.zoomX;
+
+ height = options.fromY2 - options.fromY;
+ if (options.subsampleY > 0) {
+ height = (height + options.subsampleY - 1)
+ / options.subsampleY;
+ } else if (options.subsampleY == 0) {
+ height = 0;
+ } else {
+ height = (height - options.subsampleY - 1)
+ / -options.subsampleY;
+ }
+ options.toY2 = options.toY + height * options.zoomY;
+ }
+
+ /*
+ * Set the destination image size if the -shrink option was specified.
+ */
+
+ if (options.options & OPT_SHRINK) {
+ ImgPhotoSetSize(masterPtr, options.toX2, options.toY2);
+ }
+
+ /*
+ * Copy the image data over using Tk_PhotoPutZoomedBlock.
+ */
+
+ block.pixelPtr += options.fromX * block.pixelSize
+ + options.fromY * block.pitch;
+ block.width = options.fromX2 - options.fromX;
+ block.height = options.fromY2 - options.fromY;
+ Tk_PhotoPutZoomedBlock((Tk_PhotoHandle) masterPtr, &block,
+ options.toX, options.toY, options.toX2 - options.toX,
+ options.toY2 - options.toY, options.zoomX, options.zoomY,
+ options.subsampleX, options.subsampleY);
+
+ } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
+ /*
+ * photo get command - first parse and check parameters.
+ */
+
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " get x y\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if ((x < 0) || (x >= masterPtr->width)
+ || (y < 0) || (y >= masterPtr->height)) {
+ Tcl_AppendResult(interp, argv[0], " get: ",
+ "coordinates out of range", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Extract the value of the desired pixel and format it as a string.
+ */
+
+ pixelPtr = masterPtr->pix24 + (y * masterPtr->width + x) * 3;
+ sprintf(string, "%d %d %d", pixelPtr[0], pixelPtr[1],
+ pixelPtr[2]);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ } else if ((c == 'p') && (strncmp(argv[1], "put", length) == 0)) {
+ /*
+ * photo put command - first parse the options and colors specified.
+ */
+
+ index = 2;
+ memset((VOID *) &options, 0, sizeof(options));
+ options.name = NULL;
+ if (ParseSubcommandOptions(&options, interp, OPT_TO,
+ &index, argc, argv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((options.name == NULL) || (index < argc)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " put {{colors...}...} ?-to x1 y1 x2 y2?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_SplitList(interp, options.name, &dataHeight, &srcArgv)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ tkwin = Tk_MainWindow(interp);
+ block.pixelPtr = NULL;
+ dataWidth = 0;
+ pixelPtr = NULL;
+ for (y = 0; y < dataHeight; ++y) {
+ if (Tcl_SplitList(interp, srcArgv[y], &listArgc, &listArgv)
+ != TCL_OK) {
+ break;
+ }
+ if (y == 0) {
+ dataWidth = listArgc;
+ pixelPtr = (unsigned char *) ckalloc((unsigned)
+ dataWidth * dataHeight * 3);
+ block.pixelPtr = pixelPtr;
+ } else {
+ if (listArgc != dataWidth) {
+ Tcl_AppendResult(interp, "all elements of color list must",
+ " have the same number of elements",
+ (char *) NULL);
+ ckfree((char *) listArgv);
+ break;
+ }
+ }
+ for (x = 0; x < dataWidth; ++x) {
+ if (!XParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin),
+ listArgv[x], &color)) {
+ Tcl_AppendResult(interp, "can't parse color \"",
+ listArgv[x], "\"", (char *) NULL);
+ break;
+ }
+ *pixelPtr++ = color.red >> 8;
+ *pixelPtr++ = color.green >> 8;
+ *pixelPtr++ = color.blue >> 8;
+ }
+ ckfree((char *) listArgv);
+ if (x < dataWidth)
+ break;
+ }
+ ckfree((char *) srcArgv);
+ if (y < dataHeight || dataHeight == 0 || dataWidth == 0) {
+ if (block.pixelPtr != NULL) {
+ ckfree((char *) block.pixelPtr);
+ }
+ if (y < dataHeight) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Fill in default values for the -to option, then
+ * copy the block in using Tk_PhotoPutBlock.
+ */
+
+ if (((options.options & OPT_TO) == 0) || (options.toX2 < 0)) {
+ options.toX2 = options.toX + dataWidth;
+ options.toY2 = options.toY + dataHeight;
+ }
+ block.width = dataWidth;
+ block.height = dataHeight;
+ block.pitch = dataWidth * 3;
+ block.pixelSize = 3;
+ block.offset[0] = 0;
+ block.offset[1] = 1;
+ block.offset[2] = 2;
+ Tk_PhotoPutBlock((ClientData)masterPtr, &block,
+ options.toX, options.toY, options.toX2 - options.toX,
+ options.toY2 - options.toY);
+ ckfree((char *) block.pixelPtr);
+ } else if ((c == 'r') && (length >= 3)
+ && (strncmp(argv[1], "read", length) == 0)) {
+ /*
+ * photo read command - first parse the options specified.
+ */
+
+ index = 2;
+ memset((VOID *) &options, 0, sizeof(options));
+ options.name = NULL;
+ options.format = NULL;
+ if (ParseSubcommandOptions(&options, interp,
+ OPT_FORMAT | OPT_FROM | OPT_TO | OPT_SHRINK,
+ &index, argc, argv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((options.name == NULL) || (index < argc)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " read fileName ?-format format-name?",
+ " ?-from x1 y1 x2 y2? ?-to x y? ?-shrink?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Prevent file system access in safe interpreters.
+ */
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_AppendResult(interp, "can't get image from a file in a",
+ " safe interpreter", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Open the image file and look for a handler for it.
+ */
+
+ chan = Tcl_OpenFileChannel(interp, options.name, "r", 0);
+ if (chan == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tcl_SetChannelOption(interp, chan, "-translation", "binary")
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (MatchFileFormat(interp, chan, options.name, options.format,
+ &imageFormat, &imageWidth, &imageHeight) != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Check the values given for the -from option.
+ */
+
+ if ((options.fromX > imageWidth) || (options.fromY > imageHeight)
+ || (options.fromX2 > imageWidth)
+ || (options.fromY2 > imageHeight)) {
+ Tcl_AppendResult(interp, "coordinates for -from option extend ",
+ "outside source image", (char *) NULL);
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+ if (((options.options & OPT_FROM) == 0) || (options.fromX2 < 0)) {
+ width = imageWidth - options.fromX;
+ height = imageHeight - options.fromY;
+ } else {
+ width = options.fromX2 - options.fromX;
+ height = options.fromY2 - options.fromY;
+ }
+
+ /*
+ * If the -shrink option was specified, set the size of the image.
+ */
+
+ if (options.options & OPT_SHRINK) {
+ ImgPhotoSetSize(masterPtr, options.toX + width,
+ options.toY + height);
+ }
+
+ /*
+ * Call the handler's file read procedure to read the data
+ * into the image.
+ */
+
+ result = (*imageFormat->fileReadProc)(interp, chan, options.name,
+ options.format, (Tk_PhotoHandle) masterPtr, options.toX,
+ options.toY, width, height, options.fromX, options.fromY);
+ if (chan != NULL) {
+ Tcl_Close(NULL, chan);
+ }
+ return result;
+ } else if ((c == 'r') && (length >= 3)
+ && (strncmp(argv[1], "redither", length) == 0)) {
+
+ if (argc == 2) {
+ /*
+ * Call Dither if any part of the image is not correctly
+ * dithered at present.
+ */
+
+ x = masterPtr->ditherX;
+ y = masterPtr->ditherY;
+ if (masterPtr->ditherX != 0) {
+ Dither(masterPtr, x, y, masterPtr->width - x, 1);
+ }
+ if (masterPtr->ditherY < masterPtr->height) {
+ x = 0;
+ Dither(masterPtr, 0, masterPtr->ditherY, masterPtr->width,
+ masterPtr->height - masterPtr->ditherY);
+ }
+
+ if (y < masterPtr->height) {
+ /*
+ * Tell the core image code that part of the image has changed.
+ */
+
+ Tk_ImageChanged(masterPtr->tkMaster, x, y,
+ (masterPtr->width - x), (masterPtr->height - y),
+ masterPtr->width, masterPtr->height);
+ }
+
+ } else {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " redither\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if ((c == 'w') && (strncmp(argv[1], "write", length) == 0)) {
+
+ /*
+ * Prevent file system access in safe interpreters.
+ */
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_AppendResult(interp, "can't write image to a file in a",
+ " safe interpreter", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * photo write command - first parse and check any options given.
+ */
+
+ index = 2;
+ memset((VOID *) &options, 0, sizeof(options));
+ options.name = NULL;
+ options.format = NULL;
+ if (ParseSubcommandOptions(&options, interp, OPT_FORMAT | OPT_FROM,
+ &index, argc, argv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((options.name == NULL) || (index < argc)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " write fileName ?-format format-name?",
+ "?-from x1 y1 x2 y2?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ((options.fromX > masterPtr->width)
+ || (options.fromY > masterPtr->height)
+ || (options.fromX2 > masterPtr->width)
+ || (options.fromY2 > masterPtr->height)) {
+ Tcl_AppendResult(interp, "coordinates for -from option extend ",
+ "outside image", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Fill in default values for unspecified parameters.
+ */
+
+ if (((options.options & OPT_FROM) == 0) || (options.fromX2 < 0)) {
+ options.fromX2 = masterPtr->width;
+ options.fromY2 = masterPtr->height;
+ }
+
+ /*
+ * Search for an appropriate image file format handler,
+ * and give an error if none is found.
+ */
+
+ matched = 0;
+ for (imageFormat = formatList; imageFormat != NULL;
+ imageFormat = imageFormat->nextPtr) {
+ if ((options.format == NULL)
+ || (strncasecmp(options.format, imageFormat->name,
+ strlen(imageFormat->name)) == 0)) {
+ matched = 1;
+ if (imageFormat->fileWriteProc != NULL) {
+ break;
+ }
+ }
+ }
+ if (imageFormat == NULL) {
+ if (options.format == NULL) {
+ Tcl_AppendResult(interp, "no available image file format ",
+ "has file writing capability", (char *) NULL);
+ } else if (!matched) {
+ Tcl_AppendResult(interp, "image file format \"",
+ options.format, "\" is unknown", (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, "image file format \"",
+ options.format, "\" has no file writing capability",
+ (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * Call the handler's file write procedure to write out
+ * the image.
+ */
+
+ Tk_PhotoGetImage((Tk_PhotoHandle) masterPtr, &block);
+ block.pixelPtr += options.fromY * block.pitch + options.fromX * 3;
+ block.width = options.fromX2 - options.fromX;
+ block.height = options.fromY2 - options.fromY;
+ return (*imageFormat->fileWriteProc)(interp, options.name,
+ options.format, &block);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be blank, cget, configure, copy, get, put,",
+ " read, redither, or write", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseSubcommandOptions --
+ *
+ * This procedure is invoked to process one of the options
+ * which may be specified for the photo image subcommands,
+ * namely, -from, -to, -zoom, -subsample, -format, and -shrink.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Fields in *optPtr get filled in.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseSubcommandOptions(optPtr, interp, allowedOptions, optIndexPtr, argc, argv)
+ struct SubcommandOptions *optPtr;
+ /* Information about the options specified
+ * and the values given is returned here. */
+ Tcl_Interp *interp; /* Interpreter to use for reporting errors. */
+ int allowedOptions; /* Indicates which options are valid for
+ * the current command. */
+ int *optIndexPtr; /* Points to a variable containing the
+ * current index in argv; this variable is
+ * updated by this procedure. */
+ int argc; /* Number of arguments in argv[]. */
+ char **argv; /* Arguments to be parsed. */
+{
+ int index, c, bit, currentBit;
+ size_t length;
+ char *option, **listPtr;
+ int values[4];
+ int numValues, maxValues, argIndex;
+
+ for (index = *optIndexPtr; index < argc; *optIndexPtr = ++index) {
+ /*
+ * We can have one value specified without an option;
+ * it goes into optPtr->name.
+ */
+
+ option = argv[index];
+ if (option[0] != '-') {
+ if (optPtr->name == NULL) {
+ optPtr->name = option;
+ continue;
+ }
+ break;
+ }
+
+ /*
+ * Work out which option this is.
+ */
+
+ length = strlen(option);
+ c = option[0];
+ bit = 0;
+ currentBit = 1;
+ for (listPtr = optionNames; *listPtr != NULL; ++listPtr) {
+ if ((c == *listPtr[0])
+ && (strncmp(option, *listPtr, length) == 0)) {
+ if (bit != 0) {
+ bit = 0; /* An ambiguous option. */
+ break;
+ }
+ bit = currentBit;
+ }
+ currentBit <<= 1;
+ }
+
+ /*
+ * If this option is not recognized and allowed, put
+ * an error message in the interpreter and return.
+ */
+
+ if ((allowedOptions & bit) == 0) {
+ Tcl_AppendResult(interp, "unrecognized option \"", argv[index],
+ "\": must be ", (char *)NULL);
+ bit = 1;
+ for (listPtr = optionNames; *listPtr != NULL; ++listPtr) {
+ if ((allowedOptions & bit) != 0) {
+ if ((allowedOptions & (bit - 1)) != 0) {
+ Tcl_AppendResult(interp, ", ", (char *) NULL);
+ if ((allowedOptions & ~((bit << 1) - 1)) == 0) {
+ Tcl_AppendResult(interp, "or ", (char *) NULL);
+ }
+ }
+ Tcl_AppendResult(interp, *listPtr, (char *) NULL);
+ }
+ bit <<= 1;
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * For the -from, -to, -zoom and -subsample options,
+ * parse the values given. Report an error if too few
+ * or too many values are given.
+ */
+
+ if ((bit != OPT_SHRINK) && (bit != OPT_FORMAT)) {
+ maxValues = ((bit == OPT_FROM) || (bit == OPT_TO))? 4: 2;
+ argIndex = index + 1;
+ for (numValues = 0; numValues < maxValues; ++numValues) {
+ if ((argIndex < argc) && (isdigit(UCHAR(argv[argIndex][0]))
+ || ((argv[argIndex][0] == '-')
+ && (isdigit(UCHAR(argv[argIndex][1])))))) {
+ if (Tcl_GetInt(interp, argv[argIndex], &values[numValues])
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ break;
+ }
+ ++argIndex;
+ }
+
+ if (numValues == 0) {
+ Tcl_AppendResult(interp, "the \"", argv[index], "\" option ",
+ "requires one ", maxValues == 2? "or two": "to four",
+ " integer values", (char *) NULL);
+ return TCL_ERROR;
+ }
+ *optIndexPtr = (index += numValues);
+
+ /*
+ * Y values default to the corresponding X value if not specified.
+ */
+
+ if (numValues == 1) {
+ values[1] = values[0];
+ }
+ if (numValues == 3) {
+ values[3] = values[2];
+ }
+
+ /*
+ * Check the values given and put them in the appropriate
+ * field of the SubcommandOptions structure.
+ */
+
+ switch (bit) {
+ case OPT_FROM:
+ if ((values[0] < 0) || (values[1] < 0) || ((numValues > 2)
+ && ((values[2] < 0) || (values[3] < 0)))) {
+ Tcl_AppendResult(interp, "value(s) for the -from",
+ " option must be non-negative", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (numValues <= 2) {
+ optPtr->fromX = values[0];
+ optPtr->fromY = values[1];
+ optPtr->fromX2 = -1;
+ optPtr->fromY2 = -1;
+ } else {
+ optPtr->fromX = MIN(values[0], values[2]);
+ optPtr->fromY = MIN(values[1], values[3]);
+ optPtr->fromX2 = MAX(values[0], values[2]);
+ optPtr->fromY2 = MAX(values[1], values[3]);
+ }
+ break;
+ case OPT_SUBSAMPLE:
+ optPtr->subsampleX = values[0];
+ optPtr->subsampleY = values[1];
+ break;
+ case OPT_TO:
+ if ((values[0] < 0) || (values[1] < 0) || ((numValues > 2)
+ && ((values[2] < 0) || (values[3] < 0)))) {
+ Tcl_AppendResult(interp, "value(s) for the -to",
+ " option must be non-negative", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (numValues <= 2) {
+ optPtr->toX = values[0];
+ optPtr->toY = values[1];
+ optPtr->toX2 = -1;
+ optPtr->toY2 = -1;
+ } else {
+ optPtr->toX = MIN(values[0], values[2]);
+ optPtr->toY = MIN(values[1], values[3]);
+ optPtr->toX2 = MAX(values[0], values[2]);
+ optPtr->toY2 = MAX(values[1], values[3]);
+ }
+ break;
+ case OPT_ZOOM:
+ if ((values[0] <= 0) || (values[1] <= 0)) {
+ Tcl_AppendResult(interp, "value(s) for the -zoom",
+ " option must be positive", (char *) NULL);
+ return TCL_ERROR;
+ }
+ optPtr->zoomX = values[0];
+ optPtr->zoomY = values[1];
+ break;
+ }
+ } else if (bit == OPT_FORMAT) {
+ /*
+ * The -format option takes a single string value.
+ */
+
+ if (index + 1 < argc) {
+ *optIndexPtr = ++index;
+ optPtr->format = argv[index];
+ } else {
+ Tcl_AppendResult(interp, "the \"-format\" option ",
+ "requires a value", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Remember that we saw this option.
+ */
+
+ optPtr->options |= bit;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoConfigureMaster --
+ *
+ * This procedure is called when a photo image is created or
+ * reconfigured. It processes configuration options and resets
+ * any instances of the image.
+ *
+ * Results:
+ * A standard Tcl return value. If TCL_ERROR is returned then
+ * an error message is left in masterPtr->interp->result.
+ *
+ * Side effects:
+ * Existing instances of the image will be redisplayed to match
+ * the new configuration options.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgPhotoConfigureMaster(interp, masterPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Interpreter to use for reporting errors. */
+ PhotoMaster *masterPtr; /* Pointer to data structure describing
+ * overall photo image to (re)configure. */
+ int argc; /* Number of entries in argv. */
+ char **argv; /* Pairs of configuration options for image. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget,
+ * such as TK_CONFIG_ARGV_ONLY. */
+{
+ PhotoInstance *instancePtr;
+ char *oldFileString, *oldDataString, *oldPaletteString;
+ double oldGamma;
+ int result;
+ Tcl_Channel chan;
+ Tk_PhotoImageFormat *imageFormat;
+ int imageWidth, imageHeight;
+
+ /*
+ * Save the current values for fileString and dataString, so we
+ * can tell if the user specifies them anew.
+ */
+
+ oldFileString = masterPtr->fileString;
+ oldDataString = (oldFileString == NULL)? masterPtr->dataString: NULL;
+ oldPaletteString = masterPtr->palette;
+ oldGamma = masterPtr->gamma;
+
+ /*
+ * Process the configuration options specified.
+ */
+
+ if (Tk_ConfigureWidget(interp, Tk_MainWindow(interp), configSpecs,
+ argc, argv, (char *) masterPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Regard the empty string for -file, -data or -format as the null
+ * value.
+ */
+
+ if ((masterPtr->fileString != NULL) && (masterPtr->fileString[0] == 0)) {
+ ckfree(masterPtr->fileString);
+ masterPtr->fileString = NULL;
+ }
+ if ((masterPtr->dataString != NULL) && (masterPtr->dataString[0] == 0)) {
+ ckfree(masterPtr->dataString);
+ masterPtr->dataString = NULL;
+ }
+ if ((masterPtr->format != NULL) && (masterPtr->format[0] == 0)) {
+ ckfree(masterPtr->format);
+ masterPtr->format = NULL;
+ }
+
+ /*
+ * Set the image to the user-requested size, if any,
+ * and make sure storage is correctly allocated for this image.
+ */
+
+ ImgPhotoSetSize(masterPtr, masterPtr->width, masterPtr->height);
+
+ /*
+ * Read in the image from the file or string if the user has
+ * specified the -file or -data option.
+ */
+
+ if ((masterPtr->fileString != NULL)
+ && (masterPtr->fileString != oldFileString)) {
+
+ /*
+ * Prevent file system access in a safe interpreter.
+ */
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_AppendResult(interp, "can't get image from a file in a",
+ " safe interpreter", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ chan = Tcl_OpenFileChannel(interp, masterPtr->fileString, "r", 0);
+ if (chan == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tcl_SetChannelOption(interp, chan, "-translation", "binary")
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (MatchFileFormat(interp, chan, masterPtr->fileString,
+ masterPtr->format, &imageFormat, &imageWidth,
+ &imageHeight) != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+ ImgPhotoSetSize(masterPtr, imageWidth, imageHeight);
+ result = (*imageFormat->fileReadProc)(interp, chan,
+ masterPtr->fileString, masterPtr->format,
+ (Tk_PhotoHandle) masterPtr, 0, 0,
+ imageWidth, imageHeight, 0, 0);
+ Tcl_Close(NULL, chan);
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ masterPtr->flags |= IMAGE_CHANGED;
+ }
+
+ if ((masterPtr->fileString == NULL) && (masterPtr->dataString != NULL)
+ && (masterPtr->dataString != oldDataString)) {
+
+ if (MatchStringFormat(interp, masterPtr->dataString,
+ masterPtr->format, &imageFormat, &imageWidth,
+ &imageHeight) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ ImgPhotoSetSize(masterPtr, imageWidth, imageHeight);
+ if ((*imageFormat->stringReadProc)(interp, masterPtr->dataString,
+ masterPtr->format, (Tk_PhotoHandle) masterPtr,
+ 0, 0, imageWidth, imageHeight, 0, 0) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ masterPtr->flags |= IMAGE_CHANGED;
+ }
+
+ /*
+ * Enforce a reasonable value for gamma.
+ */
+
+ if (masterPtr->gamma <= 0) {
+ masterPtr->gamma = 1.0;
+ }
+
+ if ((masterPtr->gamma != oldGamma)
+ || (masterPtr->palette != oldPaletteString)) {
+ masterPtr->flags |= IMAGE_CHANGED;
+ }
+
+ /*
+ * Cycle through all of the instances of this image, regenerating
+ * the information for each instance. Then force the image to be
+ * redisplayed everywhere that it is used.
+ */
+
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ ImgPhotoConfigureInstance(instancePtr);
+ }
+
+ /*
+ * Inform the generic image code that the image
+ * has (potentially) changed.
+ */
+
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, masterPtr->width,
+ masterPtr->height, masterPtr->width, masterPtr->height);
+ masterPtr->flags &= ~IMAGE_CHANGED;
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoConfigureInstance --
+ *
+ * This procedure is called to create displaying information for
+ * a photo image instance based on the configuration information
+ * in the master. It is invoked both when new instances are
+ * created and when the master is reconfigured.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates errors via Tcl_BackgroundError if there are problems
+ * in setting up the instance.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgPhotoConfigureInstance(instancePtr)
+ PhotoInstance *instancePtr; /* Instance to reconfigure. */
+{
+ PhotoMaster *masterPtr = instancePtr->masterPtr;
+ XImage *imagePtr;
+ int bitsPerPixel;
+ ColorTable *colorTablePtr;
+ XRectangle validBox;
+
+ /*
+ * If the -palette configuration option has been set for the master,
+ * use the value specified for our palette, but only if it is
+ * a valid palette for our windows. Use the gamma value specified
+ * the master.
+ */
+
+ if ((masterPtr->palette && masterPtr->palette[0])
+ && IsValidPalette(instancePtr, masterPtr->palette)) {
+ instancePtr->palette = masterPtr->palette;
+ } else {
+ instancePtr->palette = instancePtr->defaultPalette;
+ }
+ instancePtr->gamma = masterPtr->gamma;
+
+ /*
+ * If we don't currently have a color table, or if the one we
+ * have no longer applies (e.g. because our palette or gamma
+ * has changed), get a new one.
+ */
+
+ colorTablePtr = instancePtr->colorTablePtr;
+ if ((colorTablePtr == NULL)
+ || (instancePtr->colormap != colorTablePtr->id.colormap)
+ || (instancePtr->palette != colorTablePtr->id.palette)
+ || (instancePtr->gamma != colorTablePtr->id.gamma)) {
+ /*
+ * Free up our old color table, and get a new one.
+ */
+
+ if (colorTablePtr != NULL) {
+ colorTablePtr->liveRefCount -= 1;
+ FreeColorTable(colorTablePtr);
+ }
+ GetColorTable(instancePtr);
+
+ /*
+ * Create a new XImage structure for sending data to
+ * the X server, if necessary.
+ */
+
+ if (instancePtr->colorTablePtr->flags & BLACK_AND_WHITE) {
+ bitsPerPixel = 1;
+ } else {
+ bitsPerPixel = instancePtr->visualInfo.depth;
+ }
+
+ if ((instancePtr->imagePtr == NULL)
+ || (instancePtr->imagePtr->bits_per_pixel != bitsPerPixel)) {
+ if (instancePtr->imagePtr != NULL) {
+ XFree((char *) instancePtr->imagePtr);
+ }
+ imagePtr = XCreateImage(instancePtr->display,
+ instancePtr->visualInfo.visual, (unsigned) bitsPerPixel,
+ (bitsPerPixel > 1? ZPixmap: XYBitmap), 0, (char *) NULL,
+ 1, 1, 32, 0);
+ instancePtr->imagePtr = imagePtr;
+
+ /*
+ * Determine the endianness of this machine.
+ * We create images using the local host's endianness, rather
+ * than the endianness of the server; otherwise we would have
+ * to byte-swap any 16 or 32 bit values that we store in the
+ * image in those situations where the server's endianness
+ * is different from ours.
+ */
+
+ if (imagePtr != NULL) {
+ union {
+ int i;
+ char c[sizeof(int)];
+ } kludge;
+
+ imagePtr->bitmap_unit = sizeof(pixel) * NBBY;
+ kludge.i = 0;
+ kludge.c[0] = 1;
+ imagePtr->byte_order = (kludge.i == 1) ? LSBFirst : MSBFirst;
+ _XInitImageFuncPtrs(imagePtr);
+ }
+ }
+ }
+
+ /*
+ * If the user has specified a width and/or height for the master
+ * which is different from our current width/height, set the size
+ * to the values specified by the user. If we have no pixmap, we
+ * do this also, since it has the side effect of allocating a
+ * pixmap for us.
+ */
+
+ if ((instancePtr->pixels == None) || (instancePtr->error == NULL)
+ || (instancePtr->width != masterPtr->width)
+ || (instancePtr->height != masterPtr->height)) {
+ ImgPhotoInstanceSetSize(instancePtr);
+ }
+
+ /*
+ * Redither this instance if necessary.
+ */
+
+ if ((masterPtr->flags & IMAGE_CHANGED)
+ || (instancePtr->colorTablePtr != colorTablePtr)) {
+ TkClipBox(masterPtr->validRegion, &validBox);
+ if ((validBox.width > 0) && (validBox.height > 0)) {
+ DitherInstance(instancePtr, validBox.x, validBox.y,
+ validBox.width, validBox.height);
+ }
+ }
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoGet --
+ *
+ * This procedure is called for each use of a photo image in a
+ * widget.
+ *
+ * Results:
+ * The return value is a token for the instance, which is passed
+ * back to us in calls to ImgPhotoDisplay and ImgPhotoFree.
+ *
+ * Side effects:
+ * A data structure is set up for the instance (or, an existing
+ * instance is re-used for the new one).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ClientData
+ImgPhotoGet(tkwin, masterData)
+ Tk_Window tkwin; /* Window in which the instance will be
+ * used. */
+ ClientData masterData; /* Pointer to our master structure for the
+ * image. */
+{
+ PhotoMaster *masterPtr = (PhotoMaster *) masterData;
+ PhotoInstance *instancePtr;
+ Colormap colormap;
+ int mono, nRed, nGreen, nBlue;
+ XVisualInfo visualInfo, *visInfoPtr;
+ XRectangle validBox;
+ char buf[16];
+ int numVisuals;
+ XColor *white, *black;
+ XGCValues gcValues;
+
+ /*
+ * Table of "best" choices for palette for PseudoColor displays
+ * with between 3 and 15 bits/pixel.
+ */
+
+ static int paletteChoice[13][3] = {
+ /* #red, #green, #blue */
+ {2, 2, 2, /* 3 bits, 8 colors */},
+ {2, 3, 2, /* 4 bits, 12 colors */},
+ {3, 4, 2, /* 5 bits, 24 colors */},
+ {4, 5, 3, /* 6 bits, 60 colors */},
+ {5, 6, 4, /* 7 bits, 120 colors */},
+ {7, 7, 4, /* 8 bits, 198 colors */},
+ {8, 10, 6, /* 9 bits, 480 colors */},
+ {10, 12, 8, /* 10 bits, 960 colors */},
+ {14, 15, 9, /* 11 bits, 1890 colors */},
+ {16, 20, 12, /* 12 bits, 3840 colors */},
+ {20, 24, 16, /* 13 bits, 7680 colors */},
+ {26, 30, 20, /* 14 bits, 15600 colors */},
+ {32, 32, 30, /* 15 bits, 30720 colors */}
+ };
+
+ /*
+ * See if there is already an instance for windows using
+ * the same colormap. If so then just re-use it.
+ */
+
+ colormap = Tk_Colormap(tkwin);
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ if ((colormap == instancePtr->colormap)
+ && (Tk_Display(tkwin) == instancePtr->display)) {
+
+ /*
+ * Re-use this instance.
+ */
+
+ if (instancePtr->refCount == 0) {
+ /*
+ * We are resurrecting this instance.
+ */
+
+ Tcl_CancelIdleCall(DisposeInstance, (ClientData) instancePtr);
+ if (instancePtr->colorTablePtr != NULL) {
+ FreeColorTable(instancePtr->colorTablePtr);
+ }
+ GetColorTable(instancePtr);
+ }
+ instancePtr->refCount++;
+ return (ClientData) instancePtr;
+ }
+ }
+
+ /*
+ * The image isn't already in use in a window with the same colormap.
+ * Make a new instance of the image.
+ */
+
+ instancePtr = (PhotoInstance *) ckalloc(sizeof(PhotoInstance));
+ instancePtr->masterPtr = masterPtr;
+ instancePtr->display = Tk_Display(tkwin);
+ instancePtr->colormap = Tk_Colormap(tkwin);
+ Tk_PreserveColormap(instancePtr->display, instancePtr->colormap);
+ instancePtr->refCount = 1;
+ instancePtr->colorTablePtr = NULL;
+ instancePtr->pixels = None;
+ instancePtr->error = NULL;
+ instancePtr->width = 0;
+ instancePtr->height = 0;
+ instancePtr->imagePtr = 0;
+ instancePtr->nextPtr = masterPtr->instancePtr;
+ masterPtr->instancePtr = instancePtr;
+
+ /*
+ * Obtain information about the visual and decide on the
+ * default palette.
+ */
+
+ visualInfo.screen = Tk_ScreenNumber(tkwin);
+ visualInfo.visualid = XVisualIDFromVisual(Tk_Visual(tkwin));
+ visInfoPtr = XGetVisualInfo(Tk_Display(tkwin),
+ VisualScreenMask | VisualIDMask, &visualInfo, &numVisuals);
+ nRed = 2;
+ nGreen = nBlue = 0;
+ mono = 1;
+ if (visInfoPtr != NULL) {
+ instancePtr->visualInfo = *visInfoPtr;
+ switch (visInfoPtr->class) {
+ case DirectColor:
+ case TrueColor:
+ nRed = 1 << CountBits(visInfoPtr->red_mask);
+ nGreen = 1 << CountBits(visInfoPtr->green_mask);
+ nBlue = 1 << CountBits(visInfoPtr->blue_mask);
+ mono = 0;
+ break;
+ case PseudoColor:
+ case StaticColor:
+ if (visInfoPtr->depth > 15) {
+ nRed = 32;
+ nGreen = 32;
+ nBlue = 32;
+ mono = 0;
+ } else if (visInfoPtr->depth >= 3) {
+ int *ip = paletteChoice[visInfoPtr->depth - 3];
+
+ nRed = ip[0];
+ nGreen = ip[1];
+ nBlue = ip[2];
+ mono = 0;
+ }
+ break;
+ case GrayScale:
+ case StaticGray:
+ nRed = 1 << visInfoPtr->depth;
+ break;
+ }
+ XFree((char *) visInfoPtr);
+
+ } else {
+ panic("ImgPhotoGet couldn't find visual for window");
+ }
+
+ sprintf(buf, ((mono) ? "%d": "%d/%d/%d"), nRed, nGreen, nBlue);
+ instancePtr->defaultPalette = Tk_GetUid(buf);
+
+ /*
+ * Make a GC with background = black and foreground = white.
+ */
+
+ white = Tk_GetColor(masterPtr->interp, tkwin, "white");
+ black = Tk_GetColor(masterPtr->interp, tkwin, "black");
+ gcValues.foreground = (white != NULL)? white->pixel:
+ WhitePixelOfScreen(Tk_Screen(tkwin));
+ gcValues.background = (black != NULL)? black->pixel:
+ BlackPixelOfScreen(Tk_Screen(tkwin));
+ gcValues.graphics_exposures = False;
+ instancePtr->gc = Tk_GetGC(tkwin,
+ GCForeground|GCBackground|GCGraphicsExposures, &gcValues);
+
+ /*
+ * Set configuration options and finish the initialization of the instance.
+ */
+
+ ImgPhotoConfigureInstance(instancePtr);
+
+ /*
+ * If this is the first instance, must set the size of the image.
+ */
+
+ if (instancePtr->nextPtr == NULL) {
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0,
+ masterPtr->width, masterPtr->height);
+ }
+
+ /*
+ * Dither the image to fill in this instance's pixmap.
+ */
+
+ TkClipBox(masterPtr->validRegion, &validBox);
+ if ((validBox.width > 0) && (validBox.height > 0)) {
+ DitherInstance(instancePtr, validBox.x, validBox.y, validBox.width,
+ validBox.height);
+ }
+
+ return (ClientData) instancePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoDisplay --
+ *
+ * This procedure is invoked to draw a photo image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A portion of the image gets rendered in a pixmap or window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgPhotoDisplay(clientData, display, drawable, imageX, imageY, width,
+ height, drawableX, drawableY)
+ ClientData clientData; /* Pointer to PhotoInstance structure for
+ * for instance to be displayed. */
+ Display *display; /* Display on which to draw image. */
+ Drawable drawable; /* Pixmap or window in which to draw image. */
+ int imageX, imageY; /* Upper-left corner of region within image
+ * to draw. */
+ int width, height; /* Dimensions of region within image to draw. */
+ int drawableX, drawableY; /* Coordinates within drawable that
+ * correspond to imageX and imageY. */
+{
+ PhotoInstance *instancePtr = (PhotoInstance *) clientData;
+
+ /*
+ * If there's no pixmap, it means that an error occurred
+ * while creating the image instance so it can't be displayed.
+ */
+
+ if (instancePtr->pixels == None) {
+ return;
+ }
+
+ /*
+ * masterPtr->region describes which parts of the image contain
+ * valid data. We set this region as the clip mask for the gc,
+ * setting its origin appropriately, and use it when drawing the
+ * image.
+ */
+
+ TkSetRegion(display, instancePtr->gc, instancePtr->masterPtr->validRegion);
+ XSetClipOrigin(display, instancePtr->gc, drawableX - imageX,
+ drawableY - imageY);
+ XCopyArea(display, instancePtr->pixels, drawable, instancePtr->gc,
+ imageX, imageY, (unsigned) width, (unsigned) height,
+ drawableX, drawableY);
+ XSetClipMask(display, instancePtr->gc, None);
+ XSetClipOrigin(display, instancePtr->gc, 0, 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoFree --
+ *
+ * This procedure is called when a widget ceases to use a
+ * particular instance of an image. We don't actually get
+ * rid of the instance until later because we may be about
+ * to get this instance again.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Internal data structures get cleaned up, later.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgPhotoFree(clientData, display)
+ ClientData clientData; /* Pointer to PhotoInstance structure for
+ * for instance to be displayed. */
+ Display *display; /* Display containing window that used image. */
+{
+ PhotoInstance *instancePtr = (PhotoInstance *) clientData;
+ ColorTable *colorPtr;
+
+ instancePtr->refCount -= 1;
+ if (instancePtr->refCount > 0) {
+ return;
+ }
+
+ /*
+ * There are no more uses of the image within this widget.
+ * Decrement the count of live uses of its color table, so
+ * that its colors can be reclaimed if necessary, and
+ * set up an idle call to free the instance structure.
+ */
+
+ colorPtr = instancePtr->colorTablePtr;
+ if (colorPtr != NULL) {
+ colorPtr->liveRefCount -= 1;
+ }
+
+ Tcl_DoWhenIdle(DisposeInstance, (ClientData) instancePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoDelete --
+ *
+ * This procedure is called by the image code to delete the
+ * master structure for an image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with the image get freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgPhotoDelete(masterData)
+ ClientData masterData; /* Pointer to PhotoMaster structure for
+ * image. Must not have any more instances. */
+{
+ PhotoMaster *masterPtr = (PhotoMaster *) masterData;
+ PhotoInstance *instancePtr;
+
+ while ((instancePtr = masterPtr->instancePtr) != NULL) {
+ if (instancePtr->refCount > 0) {
+ panic("tried to delete photo image when instances still exist");
+ }
+ Tcl_CancelIdleCall(DisposeInstance, (ClientData) instancePtr);
+ DisposeInstance((ClientData) instancePtr);
+ }
+ masterPtr->tkMaster = NULL;
+ if (masterPtr->imageCmd != NULL) {
+ Tcl_DeleteCommandFromToken(masterPtr->interp, masterPtr->imageCmd);
+ }
+ if (masterPtr->pix24 != NULL) {
+ ckfree((char *) masterPtr->pix24);
+ }
+ if (masterPtr->validRegion != NULL) {
+ TkDestroyRegion(masterPtr->validRegion);
+ }
+ Tk_FreeOptions(configSpecs, (char *) masterPtr, (Display *) NULL, 0);
+ ckfree((char *) masterPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoCmdDeletedProc --
+ *
+ * This procedure is invoked when the image command for an image
+ * is deleted. It deletes the image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgPhotoCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to PhotoMaster structure for
+ * image. */
+{
+ PhotoMaster *masterPtr = (PhotoMaster *) clientData;
+
+ masterPtr->imageCmd = NULL;
+ if (masterPtr->tkMaster != NULL) {
+ Tk_DeleteImage(masterPtr->interp, Tk_NameOfImage(masterPtr->tkMaster));
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoSetSize --
+ *
+ * This procedure reallocates the image storage and instance
+ * pixmaps for a photo image, as necessary, to change the
+ * image's size to `width' x `height' pixels.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Storage gets reallocated, for the master and all its instances.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgPhotoSetSize(masterPtr, width, height)
+ PhotoMaster *masterPtr;
+ int width, height;
+{
+ unsigned char *newPix24;
+ int h, offset, pitch;
+ unsigned char *srcPtr, *destPtr;
+ XRectangle validBox, clipBox;
+ TkRegion clipRegion;
+ PhotoInstance *instancePtr;
+
+ if (masterPtr->userWidth > 0) {
+ width = masterPtr->userWidth;
+ }
+ if (masterPtr->userHeight > 0) {
+ height = masterPtr->userHeight;
+ }
+
+ /*
+ * We have to trim the valid region if it is currently
+ * larger than the new image size.
+ */
+
+ TkClipBox(masterPtr->validRegion, &validBox);
+ if ((validBox.x + validBox.width > width)
+ || (validBox.y + validBox.height > height)) {
+ clipBox.x = 0;
+ clipBox.y = 0;
+ clipBox.width = width;
+ clipBox.height = height;
+ clipRegion = TkCreateRegion();
+ TkUnionRectWithRegion(&clipBox, clipRegion, clipRegion);
+ TkIntersectRegion(masterPtr->validRegion, clipRegion,
+ masterPtr->validRegion);
+ TkDestroyRegion(clipRegion);
+ TkClipBox(masterPtr->validRegion, &validBox);
+ }
+
+ if ((width != masterPtr->width) || (height != masterPtr->height)
+ || (masterPtr->pix24 == NULL)) {
+
+ /*
+ * Reallocate storage for the 24-bit image and copy
+ * over valid regions.
+ */
+
+ pitch = width * 3;
+ newPix24 = (unsigned char *) ckalloc((unsigned) (height * pitch));
+
+ /*
+ * Zero the new array. The dithering code shouldn't read the
+ * areas outside validBox, but they might be copied to another
+ * photo image or written to a file.
+ */
+
+ if ((masterPtr->pix24 != NULL)
+ && ((width == masterPtr->width) || (width == validBox.width))) {
+ if (validBox.y > 0) {
+ memset((VOID *) newPix24, 0, (size_t) (validBox.y * pitch));
+ }
+ h = validBox.y + validBox.height;
+ if (h < height) {
+ memset((VOID *) (newPix24 + h * pitch), 0,
+ (size_t) ((height - h) * pitch));
+ }
+ } else {
+ memset((VOID *) newPix24, 0, (size_t) (height * pitch));
+ }
+
+ if (masterPtr->pix24 != NULL) {
+
+ /*
+ * Copy the common area over to the new array array and
+ * free the old array.
+ */
+
+ if (width == masterPtr->width) {
+
+ /*
+ * The region to be copied is contiguous.
+ */
+
+ offset = validBox.y * pitch;
+ memcpy((VOID *) (newPix24 + offset),
+ (VOID *) (masterPtr->pix24 + offset),
+ (size_t) (validBox.height * pitch));
+
+ } else if ((validBox.width > 0) && (validBox.height > 0)) {
+
+ /*
+ * Area to be copied is not contiguous - copy line by line.
+ */
+
+ destPtr = newPix24 + (validBox.y * width + validBox.x) * 3;
+ srcPtr = masterPtr->pix24 + (validBox.y * masterPtr->width
+ + validBox.x) * 3;
+ for (h = validBox.height; h > 0; h--) {
+ memcpy((VOID *) destPtr, (VOID *) srcPtr,
+ (size_t) (validBox.width * 3));
+ destPtr += width * 3;
+ srcPtr += masterPtr->width * 3;
+ }
+ }
+
+ ckfree((char *) masterPtr->pix24);
+ }
+
+ masterPtr->pix24 = newPix24;
+ masterPtr->width = width;
+ masterPtr->height = height;
+
+ /*
+ * Dithering will be correct up to the end of the last
+ * pre-existing complete scanline.
+ */
+
+ if ((validBox.x > 0) || (validBox.y > 0)) {
+ masterPtr->ditherX = 0;
+ masterPtr->ditherY = 0;
+ } else if (validBox.width == width) {
+ if ((int) validBox.height < masterPtr->ditherY) {
+ masterPtr->ditherX = 0;
+ masterPtr->ditherY = validBox.height;
+ }
+ } else {
+ if ((masterPtr->ditherY > 0)
+ || ((int) validBox.width < masterPtr->ditherX)) {
+ masterPtr->ditherX = validBox.width;
+ masterPtr->ditherY = 0;
+ }
+ }
+ }
+
+ /*
+ * Now adjust the sizes of the pixmaps for all of the instances.
+ */
+
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ ImgPhotoInstanceSetSize(instancePtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoInstanceSetSize --
+ *
+ * This procedure reallocates the instance pixmap and dithering
+ * error array for a photo instance, as necessary, to change the
+ * image's size to `width' x `height' pixels.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Storage gets reallocated, here and in the X server.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgPhotoInstanceSetSize(instancePtr)
+ PhotoInstance *instancePtr; /* Instance whose size is to be
+ * changed. */
+{
+ PhotoMaster *masterPtr;
+ schar *newError;
+ schar *errSrcPtr, *errDestPtr;
+ int h, offset;
+ XRectangle validBox;
+ Pixmap newPixmap;
+
+ masterPtr = instancePtr->masterPtr;
+ TkClipBox(masterPtr->validRegion, &validBox);
+
+ if ((instancePtr->width != masterPtr->width)
+ || (instancePtr->height != masterPtr->height)
+ || (instancePtr->pixels == None)) {
+ newPixmap = Tk_GetPixmap(instancePtr->display,
+ RootWindow(instancePtr->display,
+ instancePtr->visualInfo.screen),
+ (masterPtr->width > 0) ? masterPtr->width: 1,
+ (masterPtr->height > 0) ? masterPtr->height: 1,
+ instancePtr->visualInfo.depth);
+
+ /*
+ * The following is a gross hack needed to properly support colormaps
+ * under Windows. Before the pixels can be copied to the pixmap,
+ * the relevent colormap must be associated with the drawable.
+ * Normally we can infer this association from the window that
+ * was used to create the pixmap. However, in this case we're
+ * using the root window, so we have to be more explicit.
+ */
+
+ TkSetPixmapColormap(newPixmap, instancePtr->colormap);
+
+ if (instancePtr->pixels != None) {
+ /*
+ * Copy any common pixels from the old pixmap and free it.
+ */
+ XCopyArea(instancePtr->display, instancePtr->pixels, newPixmap,
+ instancePtr->gc, validBox.x, validBox.y,
+ validBox.width, validBox.height, validBox.x, validBox.y);
+ Tk_FreePixmap(instancePtr->display, instancePtr->pixels);
+ }
+ instancePtr->pixels = newPixmap;
+ }
+
+ if ((instancePtr->width != masterPtr->width)
+ || (instancePtr->height != masterPtr->height)
+ || (instancePtr->error == NULL)) {
+
+ newError = (schar *) ckalloc((unsigned)
+ (masterPtr->height * masterPtr->width * 3 * sizeof(schar)));
+
+ /*
+ * Zero the new array so that we don't get bogus error values
+ * propagating into areas we dither later.
+ */
+
+ if ((instancePtr->error != NULL)
+ && ((instancePtr->width == masterPtr->width)
+ || (validBox.width == masterPtr->width))) {
+ if (validBox.y > 0) {
+ memset((VOID *) newError, 0, (size_t)
+ (validBox.y * masterPtr->width * 3 * sizeof(schar)));
+ }
+ h = validBox.y + validBox.height;
+ if (h < masterPtr->height) {
+ memset((VOID *) (newError + h * masterPtr->width * 3), 0,
+ (size_t) ((masterPtr->height - h)
+ * masterPtr->width * 3 * sizeof(schar)));
+ }
+ } else {
+ memset((VOID *) newError, 0, (size_t)
+ (masterPtr->height * masterPtr->width * 3 * sizeof(schar)));
+ }
+
+ if (instancePtr->error != NULL) {
+
+ /*
+ * Copy the common area over to the new array
+ * and free the old array.
+ */
+
+ if (masterPtr->width == instancePtr->width) {
+
+ offset = validBox.y * masterPtr->width * 3;
+ memcpy((VOID *) (newError + offset),
+ (VOID *) (instancePtr->error + offset),
+ (size_t) (validBox.height
+ * masterPtr->width * 3 * sizeof(schar)));
+
+ } else if (validBox.width > 0 && validBox.height > 0) {
+
+ errDestPtr = newError
+ + (validBox.y * masterPtr->width + validBox.x) * 3;
+ errSrcPtr = instancePtr->error
+ + (validBox.y * instancePtr->width + validBox.x) * 3;
+ for (h = validBox.height; h > 0; --h) {
+ memcpy((VOID *) errDestPtr, (VOID *) errSrcPtr,
+ validBox.width * 3 * sizeof(schar));
+ errDestPtr += masterPtr->width * 3;
+ errSrcPtr += instancePtr->width * 3;
+ }
+ }
+ ckfree((char *) instancePtr->error);
+ }
+
+ instancePtr->error = newError;
+ }
+
+ instancePtr->width = masterPtr->width;
+ instancePtr->height = masterPtr->height;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IsValidPalette --
+ *
+ * This procedure is called to check whether a value given for
+ * the -palette option is valid for a particular instance
+ * of a photo image.
+ *
+ * Results:
+ * A boolean value: 1 if the palette is acceptable, 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+IsValidPalette(instancePtr, palette)
+ PhotoInstance *instancePtr; /* Instance to which the palette
+ * specification is to be applied. */
+ char *palette; /* Palette specification string. */
+{
+ int nRed, nGreen, nBlue, mono, numColors;
+ char *endp;
+
+ /*
+ * First parse the specification: it must be of the form
+ * %d or %d/%d/%d.
+ */
+
+ nRed = strtol(palette, &endp, 10);
+ if ((endp == palette) || ((*endp != 0) && (*endp != '/'))
+ || (nRed < 2) || (nRed > 256)) {
+ return 0;
+ }
+
+ if (*endp == 0) {
+ mono = 1;
+ nGreen = nBlue = nRed;
+ } else {
+ palette = endp + 1;
+ nGreen = strtol(palette, &endp, 10);
+ if ((endp == palette) || (*endp != '/') || (nGreen < 2)
+ || (nGreen > 256)) {
+ return 0;
+ }
+ palette = endp + 1;
+ nBlue = strtol(palette, &endp, 10);
+ if ((endp == palette) || (*endp != 0) || (nBlue < 2)
+ || (nBlue > 256)) {
+ return 0;
+ }
+ mono = 0;
+ }
+
+ switch (instancePtr->visualInfo.class) {
+ case DirectColor:
+ case TrueColor:
+ if ((nRed > (1 << CountBits(instancePtr->visualInfo.red_mask)))
+ || (nGreen > (1
+ << CountBits(instancePtr->visualInfo.green_mask)))
+ || (nBlue > (1
+ << CountBits(instancePtr->visualInfo.blue_mask)))) {
+ return 0;
+ }
+ break;
+ case PseudoColor:
+ case StaticColor:
+ numColors = nRed;
+ if (!mono) {
+ numColors *= nGreen*nBlue;
+ }
+ if (numColors > (1 << instancePtr->visualInfo.depth)) {
+ return 0;
+ }
+ break;
+ case GrayScale:
+ case StaticGray:
+ if (!mono || (nRed > (1 << instancePtr->visualInfo.depth))) {
+ return 0;
+ }
+ break;
+ }
+
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CountBits --
+ *
+ * This procedure counts how many bits are set to 1 in `mask'.
+ *
+ * Results:
+ * The integer number of bits.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CountBits(mask)
+ pixel mask; /* Value to count the 1 bits in. */
+{
+ int n;
+
+ for( n = 0; mask != 0; mask &= mask - 1 )
+ n++;
+ return n;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetColorTable --
+ *
+ * This procedure is called to allocate a table of colormap
+ * information for an instance of a photo image. Only one such
+ * table is allocated for all photo instances using the same
+ * display, colormap, palette and gamma values, so that the
+ * application need only request a set of colors from the X
+ * server once for all such photo widgets. This procedure
+ * maintains a hash table to find previously-allocated
+ * ColorTables.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new ColorTable may be allocated and placed in the hash
+ * table, and have colors allocated for it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetColorTable(instancePtr)
+ PhotoInstance *instancePtr; /* Instance needing a color table. */
+{
+ ColorTable *colorPtr;
+ Tcl_HashEntry *entry;
+ ColorTableId id;
+ int isNew;
+
+ /*
+ * Look for an existing ColorTable in the hash table.
+ */
+
+ memset((VOID *) &id, 0, sizeof(id));
+ id.display = instancePtr->display;
+ id.colormap = instancePtr->colormap;
+ id.palette = instancePtr->palette;
+ id.gamma = instancePtr->gamma;
+ if (!imgPhotoColorHashInitialized) {
+ Tcl_InitHashTable(&imgPhotoColorHash, N_COLOR_HASH);
+ imgPhotoColorHashInitialized = 1;
+ }
+ entry = Tcl_CreateHashEntry(&imgPhotoColorHash, (char *) &id, &isNew);
+
+ if (!isNew) {
+ /*
+ * Re-use the existing entry.
+ */
+
+ colorPtr = (ColorTable *) Tcl_GetHashValue(entry);
+
+ } else {
+ /*
+ * No color table currently available; need to make one.
+ */
+
+ colorPtr = (ColorTable *) ckalloc(sizeof(ColorTable));
+
+ /*
+ * The following line of code should not normally be needed due
+ * to the assignment in the following line. However, it compensates
+ * for bugs in some compilers (HP, for example) where
+ * sizeof(ColorTable) is 24 but the assignment only copies 20 bytes,
+ * leaving 4 bytes uninitialized; these cause problems when using
+ * the id for lookups in imgPhotoColorHash, and can result in
+ * core dumps.
+ */
+
+ memset((VOID *) &colorPtr->id, 0, sizeof(ColorTableId));
+ colorPtr->id = id;
+ Tk_PreserveColormap(colorPtr->id.display, colorPtr->id.colormap);
+ colorPtr->flags = 0;
+ colorPtr->refCount = 0;
+ colorPtr->liveRefCount = 0;
+ colorPtr->numColors = 0;
+ colorPtr->visualInfo = instancePtr->visualInfo;
+ colorPtr->pixelMap = NULL;
+ Tcl_SetHashValue(entry, colorPtr);
+ }
+
+ colorPtr->refCount++;
+ colorPtr->liveRefCount++;
+ instancePtr->colorTablePtr = colorPtr;
+ if (colorPtr->flags & DISPOSE_PENDING) {
+ Tcl_CancelIdleCall(DisposeColorTable, (ClientData) colorPtr);
+ colorPtr->flags &= ~DISPOSE_PENDING;
+ }
+
+ /*
+ * Allocate colors for this color table if necessary.
+ */
+
+ if ((colorPtr->numColors == 0)
+ && ((colorPtr->flags & BLACK_AND_WHITE) == 0)) {
+ AllocateColors(colorPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeColorTable --
+ *
+ * This procedure is called when an instance ceases using a
+ * color table.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If no other instances are using this color table, a when-idle
+ * handler is registered to free up the color table and the colors
+ * allocated for it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeColorTable(colorPtr)
+ ColorTable *colorPtr; /* Pointer to the color table which is
+ * no longer required by an instance. */
+{
+ colorPtr->refCount--;
+ if (colorPtr->refCount > 0) {
+ return;
+ }
+ if ((colorPtr->flags & DISPOSE_PENDING) == 0) {
+ Tcl_DoWhenIdle(DisposeColorTable, (ClientData) colorPtr);
+ colorPtr->flags |= DISPOSE_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AllocateColors --
+ *
+ * This procedure allocates the colors required by a color table,
+ * and sets up the fields in the color table data structure which
+ * are used in dithering.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Colors are allocated from the X server. Fields in the
+ * color table data structure are updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AllocateColors(colorPtr)
+ ColorTable *colorPtr; /* Pointer to the color table requiring
+ * colors to be allocated. */
+{
+ int i, r, g, b, rMult, mono;
+ int numColors, nRed, nGreen, nBlue;
+ double fr, fg, fb, igam;
+ XColor *colors;
+ unsigned long *pixels;
+
+ /* 16-bit intensity value for i/n of full intensity. */
+# define CFRAC(i, n) ((i) * 65535 / (n))
+
+ /* As for CFRAC, but apply exponent of g. */
+# define CGFRAC(i, n, g) ((int)(65535 * pow((double)(i) / (n), (g))))
+
+ /*
+ * First parse the palette specification to get the required number of
+ * shades of each primary.
+ */
+
+ mono = sscanf(colorPtr->id.palette, "%d/%d/%d", &nRed, &nGreen, &nBlue)
+ <= 1;
+ igam = 1.0 / colorPtr->id.gamma;
+
+ /*
+ * Each time around this loop, we reduce the number of colors we're
+ * trying to allocate until we succeed in allocating all of the colors
+ * we need.
+ */
+
+ for (;;) {
+ /*
+ * If we are using 1 bit/pixel, we don't need to allocate
+ * any colors (we just use the foreground and background
+ * colors in the GC).
+ */
+
+ if (mono && (nRed <= 2)) {
+ colorPtr->flags |= BLACK_AND_WHITE;
+ return;
+ }
+
+ /*
+ * Calculate the RGB coordinates of the colors we want to
+ * allocate and store them in *colors.
+ */
+
+ if ((colorPtr->visualInfo.class == DirectColor)
+ || (colorPtr->visualInfo.class == TrueColor)) {
+
+ /*
+ * Direct/True Color: allocate shades of red, green, blue
+ * independently.
+ */
+
+ if (mono) {
+ numColors = nGreen = nBlue = nRed;
+ } else {
+ numColors = MAX(MAX(nRed, nGreen), nBlue);
+ }
+ colors = (XColor *) ckalloc(numColors * sizeof(XColor));
+
+ for (i = 0; i < numColors; ++i) {
+ if (igam == 1.0) {
+ colors[i].red = CFRAC(i, nRed - 1);
+ colors[i].green = CFRAC(i, nGreen - 1);
+ colors[i].blue = CFRAC(i, nBlue - 1);
+ } else {
+ colors[i].red = CGFRAC(i, nRed - 1, igam);
+ colors[i].green = CGFRAC(i, nGreen - 1, igam);
+ colors[i].blue = CGFRAC(i, nBlue - 1, igam);
+ }
+ }
+ } else {
+ /*
+ * PseudoColor, StaticColor, GrayScale or StaticGray visual:
+ * we have to allocate each color in the color cube separately.
+ */
+
+ numColors = (mono) ? nRed: (nRed * nGreen * nBlue);
+ colors = (XColor *) ckalloc(numColors * sizeof(XColor));
+
+ if (!mono) {
+ /*
+ * Color display using a PseudoColor or StaticColor visual.
+ */
+
+ i = 0;
+ for (r = 0; r < nRed; ++r) {
+ for (g = 0; g < nGreen; ++g) {
+ for (b = 0; b < nBlue; ++b) {
+ if (igam == 1.0) {
+ colors[i].red = CFRAC(r, nRed - 1);
+ colors[i].green = CFRAC(g, nGreen - 1);
+ colors[i].blue = CFRAC(b, nBlue - 1);
+ } else {
+ colors[i].red = CGFRAC(r, nRed - 1, igam);
+ colors[i].green = CGFRAC(g, nGreen - 1, igam);
+ colors[i].blue = CGFRAC(b, nBlue - 1, igam);
+ }
+ i++;
+ }
+ }
+ }
+ } else {
+ /*
+ * Monochrome display - allocate the shades of grey we want.
+ */
+
+ for (i = 0; i < numColors; ++i) {
+ if (igam == 1.0) {
+ r = CFRAC(i, numColors - 1);
+ } else {
+ r = CGFRAC(i, numColors - 1, igam);
+ }
+ colors[i].red = colors[i].green = colors[i].blue = r;
+ }
+ }
+ }
+
+ /*
+ * Now try to allocate the colors we've calculated.
+ */
+
+ pixels = (unsigned long *) ckalloc(numColors * sizeof(unsigned long));
+ for (i = 0; i < numColors; ++i) {
+ if (!XAllocColor(colorPtr->id.display, colorPtr->id.colormap,
+ &colors[i])) {
+
+ /*
+ * Can't get all the colors we want in the default colormap;
+ * first try freeing colors from other unused color tables.
+ */
+
+ if (!ReclaimColors(&colorPtr->id, numColors - i)
+ || !XAllocColor(colorPtr->id.display,
+ colorPtr->id.colormap, &colors[i])) {
+ /*
+ * Still can't allocate the color.
+ */
+ break;
+ }
+ }
+ pixels[i] = colors[i].pixel;
+ }
+
+ /*
+ * If we didn't get all of the colors, reduce the
+ * resolution of the color cube, free the ones we got,
+ * and try again.
+ */
+
+ if (i >= numColors) {
+ break;
+ }
+ XFreeColors(colorPtr->id.display, colorPtr->id.colormap, pixels, i, 0);
+ ckfree((char *) colors);
+ ckfree((char *) pixels);
+
+ if (!mono) {
+ if ((nRed == 2) && (nGreen == 2) && (nBlue == 2)) {
+ /*
+ * Fall back to 1-bit monochrome display.
+ */
+
+ mono = 1;
+ } else {
+ /*
+ * Reduce the number of shades of each primary to about
+ * 3/4 of the previous value. This should reduce the
+ * total number of colors required to about half the
+ * previous value for PseudoColor displays.
+ */
+
+ nRed = (nRed * 3 + 2) / 4;
+ nGreen = (nGreen * 3 + 2) / 4;
+ nBlue = (nBlue * 3 + 2) / 4;
+ }
+ } else {
+ /*
+ * Reduce the number of shades of gray to about 1/2.
+ */
+
+ nRed = nRed / 2;
+ }
+ }
+
+ /*
+ * We have allocated all of the necessary colors:
+ * fill in various fields of the ColorTable record.
+ */
+
+ if (!mono) {
+ colorPtr->flags |= COLOR_WINDOW;
+
+ /*
+ * The following is a hairy hack. We only want to index into
+ * the pixelMap on colormap displays. However, if the display
+ * is on Windows, then we actually want to store the index not
+ * the value since we will be passing the color table into the
+ * TkPutImage call.
+ */
+
+#ifndef __WIN32__
+ if ((colorPtr->visualInfo.class != DirectColor)
+ && (colorPtr->visualInfo.class != TrueColor)) {
+ colorPtr->flags |= MAP_COLORS;
+ }
+#endif /* __WIN32__ */
+ }
+
+ colorPtr->numColors = numColors;
+ colorPtr->pixelMap = pixels;
+
+ /*
+ * Set up quantization tables for dithering.
+ */
+ rMult = nGreen * nBlue;
+ for (i = 0; i < 256; ++i) {
+ r = (i * (nRed - 1) + 127) / 255;
+ if (mono) {
+ fr = (double) colors[r].red / 65535.0;
+ if (colorPtr->id.gamma != 1.0 ) {
+ fr = pow(fr, colorPtr->id.gamma);
+ }
+ colorPtr->colorQuant[0][i] = (int)(fr * 255.99);
+ colorPtr->redValues[i] = colors[r].pixel;
+ } else {
+ g = (i * (nGreen - 1) + 127) / 255;
+ b = (i * (nBlue - 1) + 127) / 255;
+ if ((colorPtr->visualInfo.class == DirectColor)
+ || (colorPtr->visualInfo.class == TrueColor)) {
+ colorPtr->redValues[i] = colors[r].pixel
+ & colorPtr->visualInfo.red_mask;
+ colorPtr->greenValues[i] = colors[g].pixel
+ & colorPtr->visualInfo.green_mask;
+ colorPtr->blueValues[i] = colors[b].pixel
+ & colorPtr->visualInfo.blue_mask;
+ } else {
+ r *= rMult;
+ g *= nBlue;
+ colorPtr->redValues[i] = r;
+ colorPtr->greenValues[i] = g;
+ colorPtr->blueValues[i] = b;
+ }
+ fr = (double) colors[r].red / 65535.0;
+ fg = (double) colors[g].green / 65535.0;
+ fb = (double) colors[b].blue / 65535.0;
+ if (colorPtr->id.gamma != 1.0) {
+ fr = pow(fr, colorPtr->id.gamma);
+ fg = pow(fg, colorPtr->id.gamma);
+ fb = pow(fb, colorPtr->id.gamma);
+ }
+ colorPtr->colorQuant[0][i] = (int)(fr * 255.99);
+ colorPtr->colorQuant[1][i] = (int)(fg * 255.99);
+ colorPtr->colorQuant[2][i] = (int)(fb * 255.99);
+ }
+ }
+
+ ckfree((char *) colors);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisposeColorTable --
+ *
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The colors in the argument color table are freed, as is the
+ * color table structure itself. The color table is removed
+ * from the hash table which is used to locate color tables.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisposeColorTable(clientData)
+ ClientData clientData; /* Pointer to the ColorTable whose
+ * colors are to be released. */
+{
+ ColorTable *colorPtr;
+ Tcl_HashEntry *entry;
+
+ colorPtr = (ColorTable *) clientData;
+ if (colorPtr->pixelMap != NULL) {
+ if (colorPtr->numColors > 0) {
+ XFreeColors(colorPtr->id.display, colorPtr->id.colormap,
+ colorPtr->pixelMap, colorPtr->numColors, 0);
+ Tk_FreeColormap(colorPtr->id.display, colorPtr->id.colormap);
+ }
+ ckfree((char *) colorPtr->pixelMap);
+ }
+
+ entry = Tcl_FindHashEntry(&imgPhotoColorHash, (char *) &colorPtr->id);
+ if (entry == NULL) {
+ panic("DisposeColorTable couldn't find hash entry");
+ }
+ Tcl_DeleteHashEntry(entry);
+
+ ckfree((char *) colorPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReclaimColors --
+ *
+ * This procedure is called to try to free up colors in the
+ * colormap used by a color table. It looks for other color
+ * tables with the same colormap and with a zero live reference
+ * count, and frees their colors. It only does so if there is
+ * the possibility of freeing up at least `numColors' colors.
+ *
+ * Results:
+ * The return value is TRUE if any colors were freed, FALSE
+ * otherwise.
+ *
+ * Side effects:
+ * ColorTables which are not currently in use may lose their
+ * color allocations.
+ *
+ *---------------------------------------------------------------------- */
+
+static int
+ReclaimColors(id, numColors)
+ ColorTableId *id; /* Pointer to information identifying
+ * the color table which needs more colors. */
+ int numColors; /* Number of colors required. */
+{
+ Tcl_HashSearch srch;
+ Tcl_HashEntry *entry;
+ ColorTable *colorPtr;
+ int nAvail;
+
+ /*
+ * First scan through the color hash table to get an
+ * upper bound on how many colors we might be able to free.
+ */
+
+ nAvail = 0;
+ entry = Tcl_FirstHashEntry(&imgPhotoColorHash, &srch);
+ while (entry != NULL) {
+ colorPtr = (ColorTable *) Tcl_GetHashValue(entry);
+ if ((colorPtr->id.display == id->display)
+ && (colorPtr->id.colormap == id->colormap)
+ && (colorPtr->liveRefCount == 0 )&& (colorPtr->numColors != 0)
+ && ((colorPtr->id.palette != id->palette)
+ || (colorPtr->id.gamma != id->gamma))) {
+
+ /*
+ * We could take this guy's colors off him.
+ */
+
+ nAvail += colorPtr->numColors;
+ }
+ entry = Tcl_NextHashEntry(&srch);
+ }
+
+ /*
+ * nAvail is an (over)estimate of the number of colors we could free.
+ */
+
+ if (nAvail < numColors) {
+ return 0;
+ }
+
+ /*
+ * Scan through a second time freeing colors.
+ */
+
+ entry = Tcl_FirstHashEntry(&imgPhotoColorHash, &srch);
+ while ((entry != NULL) && (numColors > 0)) {
+ colorPtr = (ColorTable *) Tcl_GetHashValue(entry);
+ if ((colorPtr->id.display == id->display)
+ && (colorPtr->id.colormap == id->colormap)
+ && (colorPtr->liveRefCount == 0) && (colorPtr->numColors != 0)
+ && ((colorPtr->id.palette != id->palette)
+ || (colorPtr->id.gamma != id->gamma))) {
+
+ /*
+ * Free the colors that this ColorTable has.
+ */
+
+ XFreeColors(colorPtr->id.display, colorPtr->id.colormap,
+ colorPtr->pixelMap, colorPtr->numColors, 0);
+ numColors -= colorPtr->numColors;
+ colorPtr->numColors = 0;
+ ckfree((char *) colorPtr->pixelMap);
+ colorPtr->pixelMap = NULL;
+ }
+
+ entry = Tcl_NextHashEntry(&srch);
+ }
+ return 1; /* we freed some colors */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisposeInstance --
+ *
+ * This procedure is called to finally free up an instance
+ * of a photo image which is no longer required.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The instance data structure and the resources it references
+ * are freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisposeInstance(clientData)
+ ClientData clientData; /* Pointer to the instance whose resources
+ * are to be released. */
+{
+ PhotoInstance *instancePtr = (PhotoInstance *) clientData;
+ PhotoInstance *prevPtr;
+
+ if (instancePtr->pixels != None) {
+ Tk_FreePixmap(instancePtr->display, instancePtr->pixels);
+ }
+ if (instancePtr->gc != None) {
+ Tk_FreeGC(instancePtr->display, instancePtr->gc);
+ }
+ if (instancePtr->imagePtr != NULL) {
+ XFree((char *) instancePtr->imagePtr);
+ }
+ if (instancePtr->error != NULL) {
+ ckfree((char *) instancePtr->error);
+ }
+ if (instancePtr->colorTablePtr != NULL) {
+ FreeColorTable(instancePtr->colorTablePtr);
+ }
+
+ if (instancePtr->masterPtr->instancePtr == instancePtr) {
+ instancePtr->masterPtr->instancePtr = instancePtr->nextPtr;
+ } else {
+ for (prevPtr = instancePtr->masterPtr->instancePtr;
+ prevPtr->nextPtr != instancePtr; prevPtr = prevPtr->nextPtr) {
+ /* Empty loop body */
+ }
+ prevPtr->nextPtr = instancePtr->nextPtr;
+ }
+ Tk_FreeColormap(instancePtr->display, instancePtr->colormap);
+ ckfree((char *) instancePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MatchFileFormat --
+ *
+ * This procedure is called to find a photo image file format
+ * handler which can parse the image data in the given file.
+ * If a user-specified format string is provided, only handlers
+ * whose names match a prefix of the format string are tried.
+ *
+ * Results:
+ * A standard TCL return value. If the return value is TCL_OK, a
+ * pointer to the image format record is returned in
+ * *imageFormatPtr, and the width and height of the image are
+ * returned in *widthPtr and *heightPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+MatchFileFormat(interp, chan, fileName, formatString, imageFormatPtr,
+ widthPtr, heightPtr)
+ Tcl_Interp *interp; /* Interpreter to use for reporting errors. */
+ Tcl_Channel chan; /* The image file, open for reading. */
+ char *fileName; /* The name of the image file. */
+ char *formatString; /* User-specified format string, or NULL. */
+ Tk_PhotoImageFormat **imageFormatPtr;
+ /* A pointer to the photo image format
+ * record is returned here. */
+ int *widthPtr, *heightPtr; /* The dimensions of the image are
+ * returned here. */
+{
+ int matched;
+ Tk_PhotoImageFormat *formatPtr;
+
+ /*
+ * Scan through the table of file format handlers to find
+ * one which can handle the image.
+ */
+
+ matched = 0;
+ for (formatPtr = formatList; formatPtr != NULL;
+ formatPtr = formatPtr->nextPtr) {
+ if (formatString != NULL) {
+ if (strncasecmp(formatString, formatPtr->name,
+ strlen(formatPtr->name)) != 0) {
+ continue;
+ }
+ matched = 1;
+ if (formatPtr->fileMatchProc == NULL) {
+ Tcl_AppendResult(interp, "-file option isn't supported for ",
+ formatString, " images", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (formatPtr->fileMatchProc != NULL) {
+ (void) Tcl_Seek(chan, 0L, SEEK_SET);
+
+ if ((*formatPtr->fileMatchProc)(chan, fileName, formatString,
+ widthPtr, heightPtr)) {
+ if (*widthPtr < 1) {
+ *widthPtr = 1;
+ }
+ if (*heightPtr < 1) {
+ *heightPtr = 1;
+ }
+ break;
+ }
+ }
+ }
+
+ if (formatPtr == NULL) {
+ if ((formatString != NULL) && !matched) {
+ Tcl_AppendResult(interp, "image file format \"", formatString,
+ "\" is not supported", (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp,
+ "couldn't recognize data in image file \"",
+ fileName, "\"", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ *imageFormatPtr = formatPtr;
+ (void) Tcl_Seek(chan, 0L, SEEK_SET);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MatchStringFormat --
+ *
+ * This procedure is called to find a photo image file format
+ * handler which can parse the image data in the given string.
+ * If a user-specified format string is provided, only handlers
+ * whose names match a prefix of the format string are tried.
+ *
+ * Results:
+ * A standard TCL return value. If the return value is TCL_OK, a
+ * pointer to the image format record is returned in
+ * *imageFormatPtr, and the width and height of the image are
+ * returned in *widthPtr and *heightPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+MatchStringFormat(interp, string, formatString, imageFormatPtr,
+ widthPtr, heightPtr)
+ Tcl_Interp *interp; /* Interpreter to use for reporting errors. */
+ char *string; /* String containing the image data. */
+ char *formatString; /* User-specified format string, or NULL. */
+ Tk_PhotoImageFormat **imageFormatPtr;
+ /* A pointer to the photo image format
+ * record is returned here. */
+ int *widthPtr, *heightPtr; /* The dimensions of the image are
+ * returned here. */
+{
+ int matched;
+ Tk_PhotoImageFormat *formatPtr;
+
+ /*
+ * Scan through the table of file format handlers to find
+ * one which can handle the image.
+ */
+
+ matched = 0;
+ for (formatPtr = formatList; formatPtr != NULL;
+ formatPtr = formatPtr->nextPtr) {
+ if (formatString != NULL) {
+ if (strncasecmp(formatString, formatPtr->name,
+ strlen(formatPtr->name)) != 0) {
+ continue;
+ }
+ matched = 1;
+ if (formatPtr->stringMatchProc == NULL) {
+ Tcl_AppendResult(interp, "-data option isn't supported for ",
+ formatString, " images", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ if ((formatPtr->stringMatchProc != NULL)
+ && (*formatPtr->stringMatchProc)(string, formatString,
+ widthPtr, heightPtr)) {
+ break;
+ }
+ }
+
+ if (formatPtr == NULL) {
+ if ((formatString != NULL) && !matched) {
+ Tcl_AppendResult(interp, "image format \"", formatString,
+ "\" is not supported", (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, "couldn't recognize image data",
+ (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ *imageFormatPtr = formatPtr;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FindPhoto --
+ *
+ * This procedure is called to get an opaque handle (actually a
+ * PhotoMaster *) for a given image, which can be used in
+ * subsequent calls to Tk_PhotoPutBlock, etc. The `name'
+ * parameter is the name of the image.
+ *
+ * Results:
+ * The handle for the photo image, or NULL if there is no
+ * photo image with the name given.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_PhotoHandle
+Tk_FindPhoto(interp, imageName)
+ Tcl_Interp *interp; /* Interpreter (application) in which image
+ * exists. */
+ char *imageName; /* Name of the desired photo image. */
+{
+ ClientData clientData;
+ Tk_ImageType *typePtr;
+
+ clientData = Tk_GetImageMasterData(interp, imageName, &typePtr);
+ if (typePtr != &tkPhotoImageType) {
+ return NULL;
+ }
+ return (Tk_PhotoHandle) clientData;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoPutBlock --
+ *
+ * This procedure is called to put image data into a photo image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image data is stored. The image may be expanded.
+ * The Tk image code is informed that the image has changed.
+ *
+ *---------------------------------------------------------------------- */
+
+void
+Tk_PhotoPutBlock(handle, blockPtr, x, y, width, height)
+ Tk_PhotoHandle handle; /* Opaque handle for the photo image
+ * to be updated. */
+ register Tk_PhotoImageBlock *blockPtr;
+ /* Pointer to a structure describing the
+ * pixel data to be copied into the image. */
+ int x, y; /* Coordinates of the top-left pixel to
+ * be updated in the image. */
+ int width, height; /* Dimensions of the area of the image
+ * to be updated. */
+{
+ register PhotoMaster *masterPtr;
+ int xEnd, yEnd;
+ int greenOffset, blueOffset;
+ int wLeft, hLeft;
+ int wCopy, hCopy;
+ unsigned char *srcPtr, *srcLinePtr;
+ unsigned char *destPtr, *destLinePtr;
+ int pitch;
+ XRectangle rect;
+
+ masterPtr = (PhotoMaster *) handle;
+
+ if ((masterPtr->userWidth != 0) && ((x + width) > masterPtr->userWidth)) {
+ width = masterPtr->userWidth - x;
+ }
+ if ((masterPtr->userHeight != 0)
+ && ((y + height) > masterPtr->userHeight)) {
+ height = masterPtr->userHeight - y;
+ }
+ if ((width <= 0) || (height <= 0))
+ return;
+
+ xEnd = x + width;
+ yEnd = y + height;
+ if ((xEnd > masterPtr->width) || (yEnd > masterPtr->height)) {
+ ImgPhotoSetSize(masterPtr, MAX(xEnd, masterPtr->width),
+ MAX(yEnd, masterPtr->height));
+ }
+
+ if ((y < masterPtr->ditherY) || ((y == masterPtr->ditherY)
+ && (x < masterPtr->ditherX))) {
+ /*
+ * The dithering isn't correct past the start of this block.
+ */
+ masterPtr->ditherX = x;
+ masterPtr->ditherY = y;
+ }
+
+ /*
+ * If this image block could have different red, green and blue
+ * components, mark it as a color image.
+ */
+
+ greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
+ blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
+ if ((greenOffset != 0) || (blueOffset != 0)) {
+ masterPtr->flags |= COLOR_IMAGE;
+ }
+
+ /*
+ * Copy the data into our local 24-bit/pixel array.
+ * If we can do it with a single memcpy, we do.
+ */
+
+ destLinePtr = masterPtr->pix24 + (y * masterPtr->width + x) * 3;
+ pitch = masterPtr->width * 3;
+
+ if ((blockPtr->pixelSize == 3) && (greenOffset == 1) && (blueOffset == 2)
+ && (width <= blockPtr->width) && (height <= blockPtr->height)
+ && ((height == 1) || ((x == 0) && (width == masterPtr->width)
+ && (blockPtr->pitch == pitch)))) {
+ memcpy((VOID *) destLinePtr,
+ (VOID *) (blockPtr->pixelPtr + blockPtr->offset[0]),
+ (size_t) (height * width * 3));
+ } else {
+ for (hLeft = height; hLeft > 0;) {
+ srcLinePtr = blockPtr->pixelPtr + blockPtr->offset[0];
+ hCopy = MIN(hLeft, blockPtr->height);
+ hLeft -= hCopy;
+ for (; hCopy > 0; --hCopy) {
+ destPtr = destLinePtr;
+ for (wLeft = width; wLeft > 0;) {
+ wCopy = MIN(wLeft, blockPtr->width);
+ wLeft -= wCopy;
+ srcPtr = srcLinePtr;
+ for (; wCopy > 0; --wCopy) {
+ *destPtr++ = srcPtr[0];
+ *destPtr++ = srcPtr[greenOffset];
+ *destPtr++ = srcPtr[blueOffset];
+ srcPtr += blockPtr->pixelSize;
+ }
+ }
+ srcLinePtr += blockPtr->pitch;
+ destLinePtr += pitch;
+ }
+ }
+ }
+
+ /*
+ * Add this new block to the region which specifies which data is valid.
+ */
+
+ rect.x = x;
+ rect.y = y;
+ rect.width = width;
+ rect.height = height;
+ TkUnionRectWithRegion(&rect, masterPtr->validRegion,
+ masterPtr->validRegion);
+
+ /*
+ * Update each instance.
+ */
+
+ Dither(masterPtr, x, y, width, height);
+
+ /*
+ * Tell the core image code that this image has changed.
+ */
+
+ Tk_ImageChanged(masterPtr->tkMaster, x, y, width, height, masterPtr->width,
+ masterPtr->height);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoPutZoomedBlock --
+ *
+ * This procedure is called to put image data into a photo image,
+ * with possible subsampling and/or zooming of the pixels.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image data is stored. The image may be expanded.
+ * The Tk image code is informed that the image has changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_PhotoPutZoomedBlock(handle, blockPtr, x, y, width, height, zoomX, zoomY,
+ subsampleX, subsampleY)
+ Tk_PhotoHandle handle; /* Opaque handle for the photo image
+ * to be updated. */
+ register Tk_PhotoImageBlock *blockPtr;
+ /* Pointer to a structure describing the
+ * pixel data to be copied into the image. */
+ int x, y; /* Coordinates of the top-left pixel to
+ * be updated in the image. */
+ int width, height; /* Dimensions of the area of the image
+ * to be updated. */
+ int zoomX, zoomY; /* Zoom factors for the X and Y axes. */
+ int subsampleX, subsampleY; /* Subsampling factors for the X and Y axes. */
+{
+ register PhotoMaster *masterPtr;
+ int xEnd, yEnd;
+ int greenOffset, blueOffset;
+ int wLeft, hLeft;
+ int wCopy, hCopy;
+ int blockWid, blockHt;
+ unsigned char *srcPtr, *srcLinePtr, *srcOrigPtr;
+ unsigned char *destPtr, *destLinePtr;
+ int pitch;
+ int xRepeat, yRepeat;
+ int blockXSkip, blockYSkip;
+ XRectangle rect;
+
+ if ((zoomX == 1) && (zoomY == 1) && (subsampleX == 1)
+ && (subsampleY == 1)) {
+ Tk_PhotoPutBlock(handle, blockPtr, x, y, width, height);
+ return;
+ }
+
+ masterPtr = (PhotoMaster *) handle;
+
+ if ((zoomX <= 0) || (zoomY <= 0))
+ return;
+ if ((masterPtr->userWidth != 0) && ((x + width) > masterPtr->userWidth)) {
+ width = masterPtr->userWidth - x;
+ }
+ if ((masterPtr->userHeight != 0)
+ && ((y + height) > masterPtr->userHeight)) {
+ height = masterPtr->userHeight - y;
+ }
+ if ((width <= 0) || (height <= 0))
+ return;
+
+ xEnd = x + width;
+ yEnd = y + height;
+ if ((xEnd > masterPtr->width) || (yEnd > masterPtr->height)) {
+ int sameSrc = (blockPtr->pixelPtr == masterPtr->pix24);
+ ImgPhotoSetSize(masterPtr, MAX(xEnd, masterPtr->width),
+ MAX(yEnd, masterPtr->height));
+ if (sameSrc) {
+ blockPtr->pixelPtr = masterPtr->pix24;
+ }
+ }
+
+ if ((y < masterPtr->ditherY) || ((y == masterPtr->ditherY)
+ && (x < masterPtr->ditherX))) {
+ /*
+ * The dithering isn't correct past the start of this block.
+ */
+
+ masterPtr->ditherX = x;
+ masterPtr->ditherY = y;
+ }
+
+ /*
+ * If this image block could have different red, green and blue
+ * components, mark it as a color image.
+ */
+
+ greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
+ blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
+ if ((greenOffset != 0) || (blueOffset != 0)) {
+ masterPtr->flags |= COLOR_IMAGE;
+ }
+
+ /*
+ * Work out what area the pixel data in the block expands to after
+ * subsampling and zooming.
+ */
+
+ blockXSkip = subsampleX * blockPtr->pixelSize;
+ blockYSkip = subsampleY * blockPtr->pitch;
+ if (subsampleX > 0)
+ blockWid = ((blockPtr->width + subsampleX - 1) / subsampleX) * zoomX;
+ else if (subsampleX == 0)
+ blockWid = width;
+ else
+ blockWid = ((blockPtr->width - subsampleX - 1) / -subsampleX) * zoomX;
+ if (subsampleY > 0)
+ blockHt = ((blockPtr->height + subsampleY - 1) / subsampleY) * zoomY;
+ else if (subsampleY == 0)
+ blockHt = height;
+ else
+ blockHt = ((blockPtr->height - subsampleY - 1) / -subsampleY) * zoomY;
+
+ /*
+ * Copy the data into our local 24-bit/pixel array.
+ */
+
+ destLinePtr = masterPtr->pix24 + (y * masterPtr->width + x) * 3;
+ 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 * 3;
+ for (hLeft = height; hLeft > 0; ) {
+ hCopy = MIN(hLeft, blockHt);
+ hLeft -= hCopy;
+ yRepeat = zoomY;
+ srcLinePtr = srcOrigPtr;
+ for (; hCopy > 0; --hCopy) {
+ destPtr = destLinePtr;
+ for (wLeft = width; wLeft > 0;) {
+ wCopy = MIN(wLeft, blockWid);
+ wLeft -= wCopy;
+ srcPtr = srcLinePtr;
+ for (; wCopy > 0; wCopy -= zoomX) {
+ for (xRepeat = MIN(wCopy, zoomX); xRepeat > 0; xRepeat--) {
+ *destPtr++ = srcPtr[0];
+ *destPtr++ = srcPtr[greenOffset];
+ *destPtr++ = srcPtr[blueOffset];
+ }
+ srcPtr += blockXSkip;
+ }
+ }
+ destLinePtr += pitch;
+ yRepeat--;
+ if (yRepeat <= 0) {
+ srcLinePtr += blockYSkip;
+ yRepeat = zoomY;
+ }
+ }
+ }
+
+ /*
+ * Add this new block to the region that specifies which data is valid.
+ */
+
+ rect.x = x;
+ rect.y = y;
+ rect.width = width;
+ rect.height = height;
+ TkUnionRectWithRegion(&rect, masterPtr->validRegion,
+ masterPtr->validRegion);
+
+ /*
+ * Update each instance.
+ */
+
+ Dither(masterPtr, x, y, width, height);
+
+ /*
+ * Tell the core image code that this image has changed.
+ */
+
+ Tk_ImageChanged(masterPtr->tkMaster, x, y, width, height, masterPtr->width,
+ masterPtr->height);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Dither --
+ *
+ * This procedure is called to update an area of each instance's
+ * pixmap by dithering the corresponding area of the image master.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The pixmap of each instance of this image gets updated.
+ * The fields in *masterPtr indicating which area of the image
+ * is correctly dithered get updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+Dither(masterPtr, x, y, width, height)
+ PhotoMaster *masterPtr; /* Image master whose instances are
+ * to be updated. */
+ int x, y; /* Coordinates of the top-left pixel
+ * in the area to be dithered. */
+ int width, height; /* Dimensions of the area to be dithered. */
+{
+ PhotoInstance *instancePtr;
+
+ if ((width <= 0) || (height <= 0)) {
+ return;
+ }
+
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ DitherInstance(instancePtr, x, y, width, height);
+ }
+
+ /*
+ * Work out whether this block will be correctly dithered
+ * and whether it will extend the correctly dithered region.
+ */
+
+ if (((y < masterPtr->ditherY)
+ || ((y == masterPtr->ditherY) && (x <= masterPtr->ditherX)))
+ && ((y + height) > (masterPtr->ditherY))) {
+
+ /*
+ * This block starts inside (or immediately after) the correctly
+ * dithered region, so the first scan line at least will be right.
+ * Furthermore this block extends into scanline masterPtr->ditherY.
+ */
+
+ if ((x == 0) && (width == masterPtr->width)) {
+ /*
+ * We are doing the full width, therefore the dithering
+ * will be correct to the end.
+ */
+
+ masterPtr->ditherX = 0;
+ masterPtr->ditherY = y + height;
+ } else {
+ /*
+ * We are doing partial scanlines, therefore the
+ * correctly-dithered region will be extended by
+ * at most one scan line.
+ */
+
+ if (x <= masterPtr->ditherX) {
+ masterPtr->ditherX = x + width;
+ if (masterPtr->ditherX >= masterPtr->width) {
+ masterPtr->ditherX = 0;
+ masterPtr->ditherY++;
+ }
+ }
+ }
+ }
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DitherInstance --
+ *
+ * This procedure is called to update an area of an instance's
+ * pixmap by dithering the corresponding area of the master.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The instance's pixmap gets updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DitherInstance(instancePtr, xStart, yStart, width, height)
+ PhotoInstance *instancePtr; /* The instance to be updated. */
+ int xStart, yStart; /* Coordinates of the top-left pixel in the
+ * block to be dithered. */
+ int width, height; /* Dimensions of the block to be dithered. */
+{
+ PhotoMaster *masterPtr;
+ ColorTable *colorPtr;
+ XImage *imagePtr;
+ int nLines, bigEndian;
+ int i, c, x, y;
+ int xEnd, yEnd;
+ int bitsPerPixel, bytesPerLine, lineLength;
+ unsigned char *srcLinePtr, *srcPtr;
+ schar *errLinePtr, *errPtr;
+ unsigned char *destBytePtr, *dstLinePtr;
+ pixel *destLongPtr;
+ pixel firstBit, word, mask;
+ int col[3];
+ int doDithering = 1;
+
+ colorPtr = instancePtr->colorTablePtr;
+ masterPtr = instancePtr->masterPtr;
+
+ /*
+ * Turn dithering off in certain cases where it is not
+ * needed (TrueColor, DirectColor with many colors).
+ */
+
+ if ((colorPtr->visualInfo.class == DirectColor)
+ || (colorPtr->visualInfo.class == TrueColor)) {
+ int nRed, nGreen, nBlue, result;
+
+ result = sscanf(colorPtr->id.palette, "%d/%d/%d", &nRed,
+ &nGreen, &nBlue);
+ if ((nRed >= 256)
+ && ((result == 1) || ((nGreen >= 256) && (nBlue >= 256)))) {
+ doDithering = 0;
+ }
+ }
+
+ /*
+ * First work out how many lines to do at a time,
+ * then how many bytes we'll need for pixel storage,
+ * and allocate it.
+ */
+
+ nLines = (MAX_PIXELS + width - 1) / width;
+ if (nLines < 1) {
+ nLines = 1;
+ }
+ if (nLines > height ) {
+ nLines = height;
+ }
+
+ imagePtr = instancePtr->imagePtr;
+ if (imagePtr == NULL) {
+ return; /* we must be really tight on memory */
+ }
+ bitsPerPixel = imagePtr->bits_per_pixel;
+ bytesPerLine = ((bitsPerPixel * width + 31) >> 3) & ~3;
+ imagePtr->width = width;
+ imagePtr->height = nLines;
+ imagePtr->bytes_per_line = bytesPerLine;
+ imagePtr->data = (char *) ckalloc((unsigned) (imagePtr->bytes_per_line * nLines));
+ bigEndian = imagePtr->bitmap_bit_order == MSBFirst;
+ firstBit = bigEndian? (1 << (imagePtr->bitmap_unit - 1)): 1;
+
+ lineLength = masterPtr->width * 3;
+ srcLinePtr = masterPtr->pix24 + yStart * lineLength + xStart * 3;
+ errLinePtr = instancePtr->error + yStart * lineLength + xStart * 3;
+ xEnd = xStart + width;
+
+ /*
+ * Loop over the image, doing at most nLines lines before
+ * updating the screen image.
+ */
+
+ for (; height > 0; height -= nLines) {
+ if (nLines > height) {
+ nLines = height;
+ }
+ dstLinePtr = (unsigned char *) imagePtr->data;
+ yEnd = yStart + nLines;
+ for (y = yStart; y < yEnd; ++y) {
+ srcPtr = srcLinePtr;
+ errPtr = errLinePtr;
+ destBytePtr = dstLinePtr;
+ destLongPtr = (pixel *) dstLinePtr;
+ if (colorPtr->flags & COLOR_WINDOW) {
+ /*
+ * Color window. We dither the three components
+ * independently, using Floyd-Steinberg dithering,
+ * which propagates errors from the quantization of
+ * pixels to the pixels below and to the right.
+ */
+
+ for (x = xStart; x < xEnd; ++x) {
+ if (doDithering) {
+ for (i = 0; i < 3; ++i) {
+ /*
+ * Compute the error propagated into this pixel
+ * for this component.
+ * If e[x,y] is the array of quantization error
+ * values, we compute
+ * 7/16 * e[x-1,y] + 1/16 * e[x-1,y-1]
+ * + 5/16 * e[x,y-1] + 3/16 * e[x+1,y-1]
+ * and round it to an integer.
+ *
+ * The expression ((c + 2056) >> 4) - 128
+ * computes round(c / 16), and works correctly on
+ * machines without a sign-extending right shift.
+ */
+
+ c = (x > 0) ? errPtr[-3] * 7: 0;
+ if (y > 0) {
+ if (x > 0) {
+ c += errPtr[-lineLength-3];
+ }
+ c += errPtr[-lineLength] * 5;
+ if ((x + 1) < masterPtr->width) {
+ c += errPtr[-lineLength+3] * 3;
+ }
+ }
+
+ /*
+ * Add the propagated error to the value of this
+ * component, quantize it, and store the
+ * quantization error.
+ */
+
+ c = ((c + 2056) >> 4) - 128 + *srcPtr++;
+ if (c < 0) {
+ c = 0;
+ } else if (c > 255) {
+ c = 255;
+ }
+ col[i] = colorPtr->colorQuant[i][c];
+ *errPtr++ = c - col[i];
+ }
+ } else {
+ /*
+ * Output is virtually continuous in this case,
+ * so don't bother dithering.
+ */
+
+ col[0] = *srcPtr++;
+ col[1] = *srcPtr++;
+ col[2] = *srcPtr++;
+ }
+
+ /*
+ * Translate the quantized component values into
+ * an X pixel value, and store it in the image.
+ */
+
+ i = colorPtr->redValues[col[0]]
+ + colorPtr->greenValues[col[1]]
+ + colorPtr->blueValues[col[2]];
+ if (colorPtr->flags & MAP_COLORS) {
+ i = colorPtr->pixelMap[i];
+ }
+ switch (bitsPerPixel) {
+ case NBBY:
+ *destBytePtr++ = i;
+ break;
+#ifndef __WIN32__
+/*
+ * This case is not valid for Windows because the image format is different
+ * from the pixel format in Win32. Eventually we need to fix the image
+ * code in Tk to use the Windows native image ordering. This would speed
+ * up the image code for all of the common sizes.
+ */
+
+ case NBBY * sizeof(pixel):
+ *destLongPtr++ = i;
+ break;
+#endif
+ default:
+ XPutPixel(imagePtr, x - xStart, y - yStart,
+ (unsigned) i);
+ }
+ }
+
+ } else if (bitsPerPixel > 1) {
+ /*
+ * Multibit monochrome window. The operation here is similar
+ * to the color window case above, except that there is only
+ * one component. If the master image is in color, use the
+ * luminance computed as
+ * 0.344 * red + 0.5 * green + 0.156 * blue.
+ */
+
+ for (x = xStart; x < xEnd; ++x) {
+ c = (x > 0) ? errPtr[-1] * 7: 0;
+ if (y > 0) {
+ if (x > 0) {
+ c += errPtr[-lineLength-1];
+ }
+ c += errPtr[-lineLength] * 5;
+ if (x + 1 < masterPtr->width) {
+ c += errPtr[-lineLength+1] * 3;
+ }
+ }
+ c = ((c + 2056) >> 4) - 128;
+
+ if ((masterPtr->flags & COLOR_IMAGE) == 0) {
+ c += srcPtr[0];
+ } else {
+ c += (unsigned)(srcPtr[0] * 11 + srcPtr[1] * 16
+ + srcPtr[2] * 5 + 16) >> 5;
+ }
+ srcPtr += 3;
+
+ if (c < 0) {
+ c = 0;
+ } else if (c > 255) {
+ c = 255;
+ }
+ i = colorPtr->colorQuant[0][c];
+ *errPtr++ = c - i;
+ i = colorPtr->redValues[i];
+ switch (bitsPerPixel) {
+ case NBBY:
+ *destBytePtr++ = i;
+ break;
+#ifndef __WIN32__
+/*
+ * This case is not valid for Windows because the image format is different
+ * from the pixel format in Win32. Eventually we need to fix the image
+ * code in Tk to use the Windows native image ordering. This would speed
+ * up the image code for all of the common sizes.
+ */
+
+ case NBBY * sizeof(pixel):
+ *destLongPtr++ = i;
+ break;
+#endif
+ default:
+ XPutPixel(imagePtr, x - xStart, y - yStart,
+ (unsigned) i);
+ }
+ }
+ } else {
+ /*
+ * 1-bit monochrome window. This is similar to the
+ * multibit monochrome case above, except that the
+ * quantization is simpler (we only have black = 0
+ * and white = 255), and we produce an XY-Bitmap.
+ */
+
+ word = 0;
+ mask = firstBit;
+ for (x = xStart; x < xEnd; ++x) {
+ /*
+ * If we have accumulated a whole word, store it
+ * in the image and start a new word.
+ */
+
+ if (mask == 0) {
+ *destLongPtr++ = word;
+ mask = firstBit;
+ word = 0;
+ }
+
+ c = (x > 0) ? errPtr[-1] * 7: 0;
+ if (y > 0) {
+ if (x > 0) {
+ c += errPtr[-lineLength-1];
+ }
+ c += errPtr[-lineLength] * 5;
+ if (x + 1 < masterPtr->width) {
+ c += errPtr[-lineLength+1] * 3;
+ }
+ }
+ c = ((c + 2056) >> 4) - 128;
+
+ if ((masterPtr->flags & COLOR_IMAGE) == 0) {
+ c += srcPtr[0];
+ } else {
+ c += (unsigned)(srcPtr[0] * 11 + srcPtr[1] * 16
+ + srcPtr[2] * 5 + 16) >> 5;
+ }
+ srcPtr += 3;
+
+ 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 += lineLength;
+ errLinePtr += lineLength;
+ dstLinePtr += bytesPerLine;
+ }
+
+ /*
+ * Update the pixmap for this instance with the block of
+ * pixels that we have just computed.
+ */
+
+ TkPutImage(colorPtr->pixelMap, colorPtr->numColors,
+ instancePtr->display, instancePtr->pixels,
+ instancePtr->gc, imagePtr, 0, 0, xStart, yStart,
+ (unsigned) width, (unsigned) nLines);
+ yStart = yEnd;
+
+ }
+
+ ckfree(imagePtr->data);
+ imagePtr->data = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoBlank --
+ *
+ * This procedure is called to clear an entire photo image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The valid region for the image is set to the null region.
+ * The generic image code is notified that the image has changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_PhotoBlank(handle)
+ Tk_PhotoHandle handle; /* Handle for the image to be blanked. */
+{
+ PhotoMaster *masterPtr;
+ PhotoInstance *instancePtr;
+
+ masterPtr = (PhotoMaster *) handle;
+ masterPtr->ditherX = masterPtr->ditherY = 0;
+ masterPtr->flags = 0;
+
+ /*
+ * The image has valid data nowhere.
+ */
+
+ if (masterPtr->validRegion != NULL) {
+ TkDestroyRegion(masterPtr->validRegion);
+ }
+ masterPtr->validRegion = TkCreateRegion();
+
+ /*
+ * Clear out the 24-bit pixel storage array.
+ * Clear out the dithering error arrays for each instance.
+ */
+
+ memset((VOID *) masterPtr->pix24, 0,
+ (size_t) (masterPtr->width * masterPtr->height * 3));
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ if (instancePtr->error) {
+ memset((VOID *) instancePtr->error, 0,
+ (size_t) (masterPtr->width * masterPtr->height
+ * 3 * sizeof(schar)));
+ }
+ }
+
+ /*
+ * Tell the core image code that this image has changed.
+ */
+
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, masterPtr->width,
+ masterPtr->height, masterPtr->width, masterPtr->height);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoExpand --
+ *
+ * This procedure is called to request that a photo image be
+ * expanded if necessary to be at least `width' pixels wide and
+ * `height' pixels high. If the user has declared a definite
+ * image size (using the -width and -height configuration
+ * options) then this call has no effect.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The size of the photo image may change; if so the generic
+ * image code is informed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_PhotoExpand(handle, width, height)
+ Tk_PhotoHandle handle; /* Handle for the image to be expanded. */
+ int width, height; /* Desired minimum dimensions of the image. */
+{
+ PhotoMaster *masterPtr;
+
+ masterPtr = (PhotoMaster *) handle;
+
+ if (width <= masterPtr->width) {
+ width = masterPtr->width;
+ }
+ if (height <= masterPtr->height) {
+ height = masterPtr->height;
+ }
+ if ((width != masterPtr->width) || (height != masterPtr->height)) {
+ ImgPhotoSetSize(masterPtr, MAX(width, masterPtr->width),
+ MAX(height, masterPtr->height));
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0, masterPtr->width,
+ masterPtr->height);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoGetSize --
+ *
+ * This procedure is called to obtain the current size of a photo
+ * image.
+ *
+ * Results:
+ * The image's width and height are returned in *widthp
+ * and *heightp.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_PhotoGetSize(handle, widthPtr, heightPtr)
+ Tk_PhotoHandle handle; /* Handle for the image whose dimensions
+ * are requested. */
+ int *widthPtr, *heightPtr; /* The dimensions of the image are returned
+ * here. */
+{
+ PhotoMaster *masterPtr;
+
+ masterPtr = (PhotoMaster *) handle;
+ *widthPtr = masterPtr->width;
+ *heightPtr = masterPtr->height;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoSetSize --
+ *
+ * This procedure is called to set size of a photo image.
+ * This call is equivalent to using the -width and -height
+ * configuration options.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The size of the image may change; if so the generic
+ * image code is informed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_PhotoSetSize(handle, width, height)
+ Tk_PhotoHandle handle; /* Handle for the image whose size is to
+ * be set. */
+ int width, height; /* New dimensions for the image. */
+{
+ PhotoMaster *masterPtr;
+
+ masterPtr = (PhotoMaster *) handle;
+
+ masterPtr->userWidth = width;
+ masterPtr->userHeight = height;
+ ImgPhotoSetSize(masterPtr, ((width > 0) ? width: masterPtr->width),
+ ((height > 0) ? height: masterPtr->height));
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0,
+ masterPtr->width, masterPtr->height);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoGetImage --
+ *
+ * This procedure is called to obtain image data from a photo
+ * image. This procedure fills in the Tk_PhotoImageBlock structure
+ * pointed to by `blockPtr' with details of the address and
+ * layout of the image data in memory.
+ *
+ * Results:
+ * TRUE (1) indicating that image data is available,
+ * for backwards compatibility with the old photo widget.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_PhotoGetImage(handle, blockPtr)
+ Tk_PhotoHandle handle; /* Handle for the photo image from which
+ * image data is desired. */
+ Tk_PhotoImageBlock *blockPtr;
+ /* Information about the address and layout
+ * of the image data is returned here. */
+{
+ PhotoMaster *masterPtr;
+
+ masterPtr = (PhotoMaster *) handle;
+ blockPtr->pixelPtr = masterPtr->pix24;
+ blockPtr->width = masterPtr->width;
+ blockPtr->height = masterPtr->height;
+ blockPtr->pitch = masterPtr->width * 3;
+ blockPtr->pixelSize = 3;
+ blockPtr->offset[0] = 0;
+ blockPtr->offset[1] = 1;
+ blockPtr->offset[2] = 2;
+ return 1;
+}
diff --git a/generic/tkImgUtil.c b/generic/tkImgUtil.c
new file mode 100644
index 0000000..31504b8
--- /dev/null
+++ b/generic/tkImgUtil.c
@@ -0,0 +1,78 @@
+/*
+ * tkImgUtil.c --
+ *
+ * This file contains image related utility functions.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkImgUtil.c 1.3 96/02/15 18:53:12
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+#include "xbytes.h"
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkAlignImageData --
+ *
+ * This function takes an image and copies the data into an
+ * aligned buffer, performing any necessary bit swapping.
+ *
+ * Results:
+ * Returns a newly allocated buffer that should be freed by the
+ * caller.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkAlignImageData(image, alignment, bitOrder)
+ XImage *image; /* Image to be aligned. */
+ int alignment; /* Number of bytes to which the data should
+ * be aligned (e.g. 2 or 4) */
+ int bitOrder; /* Desired bit order: LSBFirst or MSBFirst. */
+{
+ long dataWidth;
+ char *data, *srcPtr, *destPtr;
+ int i, j;
+
+ if (image->bits_per_pixel != 1) {
+ panic("TkAlignImageData: Can't handle image depths greater than 1.");
+ }
+
+ /*
+ * Compute line width for output data buffer.
+ */
+
+ dataWidth = image->bytes_per_line;
+ if (dataWidth % alignment) {
+ dataWidth += (alignment - (dataWidth % alignment));
+ }
+
+ data = ckalloc(dataWidth * image->height);
+
+ destPtr = data;
+ for (i = 0; i < image->height; i++) {
+ srcPtr = &image->data[i * image->bytes_per_line];
+ for (j = 0; j < dataWidth; j++) {
+ if (j >= image->bytes_per_line) {
+ *destPtr = 0;
+ } else if (image->bitmap_bit_order != bitOrder) {
+ *destPtr = xBitReverseTable[(unsigned char)(*(srcPtr++))];
+ } else {
+ *destPtr = *(srcPtr++);
+ }
+ destPtr++;
+ }
+ }
+ return data;
+}
diff --git a/generic/tkInitScript.h b/generic/tkInitScript.h
new file mode 100644
index 0000000..e86d16e
--- /dev/null
+++ b/generic/tkInitScript.h
@@ -0,0 +1,73 @@
+/*
+ * tkInitScript.h --
+ *
+ * This file contains Unix & Windows common init script
+ * It is not used on the Mac. (the mac init script is in tkMacInit.c)
+ *
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkInitScript.h 1.3 97/08/11 19:12:28
+ */
+
+
+
+/*
+ * The following string is the startup script executed in new
+ * interpreters. It looks in several different directories
+ * for a script "tk.tcl" that is compatible with this version
+ * of Tk. The tk.tcl script does all of the real work of
+ * initialization.
+ * When called from a safe interpreter, it does not use file exists.
+ * we don't use pwd either because of safe interpreters.
+ */
+
+static char initScript[] =
+"proc tkInit {} {\n\
+ global tk_library tk_version tk_patchLevel env errorInfo\n\
+ rename tkInit {}\n\
+ set errors \"\"\n\
+ if {![info exists tk_library]} {\n\
+ set tk_library .\n\
+ }\n\
+ set dirs {}\n\
+ if {[info exists env(TK_LIBRARY)]} {\n\
+ lappend dirs $env(TK_LIBRARY)\n\
+ }\n\
+ lappend dirs $tk_library\n\
+ lappend dirs [file join [file dirname [info library]] tk$tk_version]\n\
+ set parentDir [file dirname [file dirname [info nameofexecutable]]]\n\
+ lappend dirs [file join $parentDir tk$tk_version]\n\
+ lappend dirs [file join $parentDir lib tk$tk_version]\n\
+ lappend dirs [file join $parentDir library]\n\
+ set parentParentDir [file dirname $parentDir]\n\
+ if [string match {*[ab]*} $tk_patchLevel] {\n\
+ set dirSuffix $tk_patchLevel\n\
+ } else {\n\
+ set dirSuffix $tk_version\n\
+ }\n\
+ lappend dirs [file join $parentParentDir tk$dirSuffix library]\n\
+ lappend dirs [file join $parentParentDir library]\n\
+ lappend dirs [file join [file dirname \
+ [file dirname [info library]]] tk$dirSuffix library]\n\
+ foreach i $dirs {\n\
+ set tk_library $i\n\
+ set tkfile [file join $i tk.tcl]\n\
+ if {[interp issafe] || [file exists $tkfile]} {\n\
+ if {![catch {uplevel #0 [list source $tkfile]} msg]} {\n\
+ return\n\
+ } else {\n\
+ append errors \"$tkfile: $msg\n$errorInfo\n\"\n\
+ }\n\
+ }\n\
+ }\n\
+ set msg \"Can't find a usable tk.tcl in the following directories: \n\"\n\
+ append msg \" $dirs\n\n\"\n\
+ append msg \"$errors\n\n\"\n\
+ append msg \"This probably means that Tk wasn't installed properly.\n\"\n\
+ error $msg\n\
+}\n\
+tkInit";
+
diff --git a/generic/tkInt.h b/generic/tkInt.h
new file mode 100644
index 0000000..b5dd92d
--- /dev/null
+++ b/generic/tkInt.h
@@ -0,0 +1,990 @@
+/*
+ * tkInt.h --
+ *
+ * Declarations for things used internally by the Tk
+ * procedures but not exported outside the module.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkInt.h 1.204 97/10/31 09:55:20
+ */
+
+#ifndef _TKINT
+#define _TKINT
+
+#ifndef _TK
+#include "tk.h"
+#endif
+#ifndef _TCL
+#include "tcl.h"
+#endif
+#ifndef _TKPORT
+#include <tkPort.h>
+#endif
+
+/*
+ * Opaque type declarations:
+ */
+
+typedef struct TkColormap TkColormap;
+typedef struct TkGrabEvent TkGrabEvent;
+typedef struct Tk_PostscriptInfo Tk_PostscriptInfo;
+typedef struct TkpCursor_ *TkpCursor;
+typedef struct TkRegion_ *TkRegion;
+typedef struct TkStressedCmap TkStressedCmap;
+typedef struct TkBindInfo_ *TkBindInfo;
+
+/*
+ * Procedure types.
+ */
+
+typedef int (TkBindEvalProc) _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, XEvent *eventPtr, Tk_Window tkwin,
+ KeySym keySym));
+typedef void (TkBindFreeProc) _ANSI_ARGS_((ClientData clientData));
+typedef Window (TkClassCreateProc) _ANSI_ARGS_((Tk_Window tkwin,
+ Window parent, ClientData instanceData));
+typedef void (TkClassGeometryProc) _ANSI_ARGS_((ClientData instanceData));
+typedef void (TkClassModalProc) _ANSI_ARGS_((Tk_Window tkwin,
+ XEvent *eventPtr));
+
+
+/*
+ * Widget class procedures used to implement platform specific widget
+ * behavior.
+ */
+
+typedef struct TkClassProcs {
+ TkClassCreateProc *createProc;
+ /* Procedure to invoke when the
+ platform-dependent window needs to be
+ created. */
+ TkClassGeometryProc *geometryProc;
+ /* Procedure to invoke when the geometry of a
+ window needs to be recalculated as a result
+ of some change in the system. */
+ TkClassModalProc *modalProc;
+ /* Procedure to invoke after all bindings on a
+ widget have been triggered in order to
+ handle a modal loop. */
+} TkClassProcs;
+
+/*
+ * One of the following structures is maintained for each cursor in
+ * use in the system. This structure is used by tkCursor.c and the
+ * various system specific cursor files.
+ */
+
+typedef struct TkCursor {
+ Tk_Cursor cursor; /* System specific identifier for cursor. */
+ int refCount; /* Number of active uses of cursor. */
+ Tcl_HashTable *otherTable; /* Second table (other than idTable) used
+ * to index this entry. */
+ Tcl_HashEntry *hashPtr; /* Entry in otherTable for this structure
+ * (needed when deleting). */
+} TkCursor;
+
+/*
+ * One of the following structures is maintained for each display
+ * containing a window managed by Tk:
+ */
+
+typedef struct TkDisplay {
+ Display *display; /* Xlib's info about display. */
+ struct TkDisplay *nextPtr; /* Next in list of all displays. */
+ char *name; /* Name of display (with any screen
+ * identifier removed). Malloc-ed. */
+ Time lastEventTime; /* Time of last event received for this
+ * display. */
+
+ /*
+ * Information used primarily by tkBind.c:
+ */
+
+ int bindInfoStale; /* Non-zero means the variables in this
+ * part of the structure are potentially
+ * incorrect and should be recomputed. */
+ unsigned int modeModMask; /* Has one bit set to indicate the modifier
+ * corresponding to "mode shift". If no
+ * such modifier, than this is zero. */
+ unsigned int metaModMask; /* Has one bit set to indicate the modifier
+ * corresponding to the "Meta" key. If no
+ * such modifier, then this is zero. */
+ unsigned int altModMask; /* Has one bit set to indicate the modifier
+ * corresponding to the "Meta" key. If no
+ * such modifier, then this is zero. */
+ enum {LU_IGNORE, LU_CAPS, LU_SHIFT} lockUsage;
+ /* Indicates how to interpret lock modifier. */
+ int numModKeyCodes; /* Number of entries in modKeyCodes array
+ * below. */
+ KeyCode *modKeyCodes; /* Pointer to an array giving keycodes for
+ * all of the keys that have modifiers
+ * associated with them. Malloc'ed, but
+ * may be NULL. */
+
+ /*
+ * Information used by tkError.c only:
+ */
+
+ struct TkErrorHandler *errorPtr;
+ /* First in list of error handlers
+ * for this display. NULL means
+ * no handlers exist at present. */
+ int deleteCount; /* Counts # of handlers deleted since
+ * last time inactive handlers were
+ * garbage-collected. When this number
+ * gets big, handlers get cleaned up. */
+
+ /*
+ * Information used by tkSend.c only:
+ */
+
+ Tk_Window commTkwin; /* Window used for communication
+ * between interpreters during "send"
+ * commands. NULL means send info hasn't
+ * been initialized yet. */
+ Atom commProperty; /* X's name for comm property. */
+ Atom registryProperty; /* X's name for property containing
+ * registry of interpreter names. */
+ Atom appNameProperty; /* X's name for property used to hold the
+ * application name on each comm window. */
+
+ /*
+ * Information used by tkSelect.c and tkClipboard.c only:
+ */
+
+ struct TkSelectionInfo *selectionInfoPtr;
+ /* First in list of selection information
+ * records. Each entry contains information
+ * about the current owner of a particular
+ * selection on this display. */
+ Atom multipleAtom; /* Atom for MULTIPLE. None means
+ * selection stuff isn't initialized. */
+ Atom incrAtom; /* Atom for INCR. */
+ Atom targetsAtom; /* Atom for TARGETS. */
+ Atom timestampAtom; /* Atom for TIMESTAMP. */
+ Atom textAtom; /* Atom for TEXT. */
+ Atom compoundTextAtom; /* Atom for COMPOUND_TEXT. */
+ Atom applicationAtom; /* Atom for TK_APPLICATION. */
+ Atom windowAtom; /* Atom for TK_WINDOW. */
+ Atom clipboardAtom; /* Atom for CLIPBOARD. */
+
+ Tk_Window clipWindow; /* Window used for clipboard ownership and to
+ * retrieve selections between processes. NULL
+ * means clipboard info hasn't been
+ * initialized. */
+ int clipboardActive; /* 1 means we currently own the clipboard
+ * selection, 0 means we don't. */
+ struct TkMainInfo *clipboardAppPtr;
+ /* Last application that owned clipboard. */
+ struct TkClipboardTarget *clipTargetPtr;
+ /* First in list of clipboard type information
+ * records. Each entry contains information
+ * about the buffers for a given selection
+ * target. */
+
+ /*
+ * Information used by tkAtom.c only:
+ */
+
+ int atomInit; /* 0 means stuff below hasn't been
+ * initialized yet. */
+ Tcl_HashTable nameTable; /* Maps from names to Atom's. */
+ Tcl_HashTable atomTable; /* Maps from Atom's back to names. */
+
+ /*
+ * Information used by tkCursor.c only:
+ */
+
+ Font cursorFont; /* Font to use for standard cursors.
+ * None means font not loaded yet. */
+
+ /*
+ * Information used by tkGrab.c only:
+ */
+
+ struct TkWindow *grabWinPtr;
+ /* Window in which the pointer is currently
+ * grabbed, or NULL if none. */
+ struct TkWindow *eventualGrabWinPtr;
+ /* Value that grabWinPtr will have once the
+ * grab event queue (below) has been
+ * completely emptied. */
+ struct TkWindow *buttonWinPtr;
+ /* Window in which first mouse button was
+ * pressed while grab was in effect, or NULL
+ * if no such press in effect. */
+ struct TkWindow *serverWinPtr;
+ /* If no application contains the pointer then
+ * this is NULL. Otherwise it contains the
+ * last window for which we've gotten an
+ * Enter or Leave event from the server (i.e.
+ * the last window known to have contained
+ * the pointer). Doesn't reflect events
+ * that were synthesized in tkGrab.c. */
+ TkGrabEvent *firstGrabEventPtr;
+ /* First in list of enter/leave events
+ * synthesized by grab code. These events
+ * must be processed in order before any other
+ * events are processed. NULL means no such
+ * events. */
+ TkGrabEvent *lastGrabEventPtr;
+ /* Last in list of synthesized events, or NULL
+ * if list is empty. */
+ int grabFlags; /* Miscellaneous flag values. See definitions
+ * in tkGrab.c. */
+
+ /*
+ * Information used by tkXId.c only:
+ */
+
+ struct TkIdStack *idStackPtr;
+ /* First in list of chunks of free resource
+ * identifiers, or NULL if there are no free
+ * resources. */
+ XID (*defaultAllocProc) _ANSI_ARGS_((Display *display));
+ /* Default resource allocator for display. */
+ struct TkIdStack *windowStackPtr;
+ /* First in list of chunks of window
+ * identifers that can't be reused right
+ * now. */
+ int idCleanupScheduled; /* 1 means a call to WindowIdCleanup has
+ * already been scheduled, 0 means it
+ * hasn't. */
+
+ /*
+ * Information maintained by tkWindow.c for use later on by tkXId.c:
+ */
+
+
+ int destroyCount; /* Number of Tk_DestroyWindow operations
+ * in progress. */
+ unsigned long lastDestroyRequest;
+ /* Id of most recent XDestroyWindow request;
+ * can re-use ids in windowStackPtr when
+ * server has seen this request and event
+ * queue is empty. */
+
+ /*
+ * Information used by tkVisual.c only:
+ */
+
+ TkColormap *cmapPtr; /* First in list of all non-default colormaps
+ * allocated for this display. */
+
+ /*
+ * Information used by tkFocus.c only:
+ */
+
+ struct TkWindow *implicitWinPtr;
+ /* If the focus arrived at a toplevel window
+ * implicitly via an Enter event (rather
+ * than via a FocusIn event), this points
+ * to the toplevel window. Otherwise it is
+ * NULL. */
+ struct TkWindow *focusPtr; /* Points to the window on this display that
+ * should be receiving keyboard events. When
+ * multiple applications on the display have
+ * the focus, this will refer to the
+ * innermost window in the innermost
+ * application. This information isn't used
+ * under Unix or Windows, but it's needed on
+ * the Macintosh. */
+
+ /*
+ * Used by tkColor.c only:
+ */
+
+ TkStressedCmap *stressPtr; /* First in list of colormaps that have
+ * filled up, so we have to pick an
+ * approximate color. */
+
+ /*
+ * Used by tkEvent.c only:
+ */
+
+ struct TkWindowEvent *delayedMotionPtr;
+ /* Points to a malloc-ed motion event
+ * whose processing has been delayed in
+ * the hopes that another motion event
+ * will come along right away and we can
+ * merge the two of them together. NULL
+ * means that there is no delayed motion
+ * event. */
+
+ /*
+ * Miscellaneous information:
+ */
+
+#ifdef TK_USE_INPUT_METHODS
+ XIM inputMethod; /* Input method for this display */
+#endif /* TK_USE_INPUT_METHODS */
+ Tcl_HashTable winTable; /* Maps from X window ids to TkWindow ptrs. */
+
+ int refCount; /* Reference count of how many Tk applications
+ * are using this display. Used to clean up
+ * the display when we no longer have any
+ * Tk applications using it.
+ */
+} TkDisplay;
+
+/*
+ * One of the following structures exists for each error handler
+ * created by a call to Tk_CreateErrorHandler. The structure
+ * is managed by tkError.c.
+ */
+
+typedef struct TkErrorHandler {
+ TkDisplay *dispPtr; /* Display to which handler applies. */
+ unsigned long firstRequest; /* Only errors with serial numbers
+ * >= to this are considered. */
+ unsigned long lastRequest; /* Only errors with serial numbers
+ * <= to this are considered. This
+ * field is filled in when XUnhandle
+ * is called. -1 means XUnhandle
+ * hasn't been called yet. */
+ int error; /* Consider only errors with this
+ * error_code (-1 means consider
+ * all errors). */
+ int request; /* Consider only errors with this
+ * major request code (-1 means
+ * consider all major codes). */
+ int minorCode; /* Consider only errors with this
+ * minor request code (-1 means
+ * consider all minor codes). */
+ Tk_ErrorProc *errorProc; /* Procedure to invoke when a matching
+ * error occurs. NULL means just ignore
+ * errors. */
+ ClientData clientData; /* Arbitrary value to pass to
+ * errorProc. */
+ struct TkErrorHandler *nextPtr;
+ /* Pointer to next older handler for
+ * this display, or NULL for end of
+ * list. */
+} TkErrorHandler;
+
+/*
+ * One of the following structures exists for each event handler
+ * created by calling Tk_CreateEventHandler. This information
+ * is used by tkEvent.c only.
+ */
+
+typedef struct TkEventHandler {
+ unsigned long mask; /* Events for which to invoke
+ * proc. */
+ Tk_EventProc *proc; /* Procedure to invoke when an event
+ * in mask occurs. */
+ ClientData clientData; /* Argument to pass to proc. */
+ struct TkEventHandler *nextPtr;
+ /* Next in list of handlers
+ * associated with window (NULL means
+ * end of list). */
+} TkEventHandler;
+
+/*
+ * Tk keeps one of the following data structures for each main
+ * window (created by a call to Tk_CreateMainWindow). It stores
+ * information that is shared by all of the windows associated
+ * with a particular main window.
+ */
+
+typedef struct TkMainInfo {
+ int refCount; /* Number of windows whose "mainPtr" fields
+ * point here. When this becomes zero, can
+ * free up the structure (the reference
+ * count is zero because windows can get
+ * deleted in almost any order; the main
+ * window isn't necessarily the last one
+ * deleted). */
+ struct TkWindow *winPtr; /* Pointer to main window. */
+ Tcl_Interp *interp; /* Interpreter associated with application. */
+ Tcl_HashTable nameTable; /* Hash table mapping path names to TkWindow
+ * structs for all windows related to this
+ * main window. Managed by tkWindow.c. */
+ Tk_BindingTable bindingTable;
+ /* Used in conjunction with "bind" command
+ * to bind events to Tcl commands. */
+ TkBindInfo bindInfo; /* Information used by tkBind.c on a per
+ * interpreter basis. */
+ struct TkFontInfo *fontInfoPtr;
+ /* Hold named font tables. Used only by
+ * tkFont.c. */
+
+ /*
+ * Information used only by tkFocus.c and tk*Embed.c:
+ */
+
+ struct TkToplevelFocusInfo *tlFocusPtr;
+ /* First in list of records containing focus
+ * information for each top-level in the
+ * application. Used only by tkFocus.c. */
+ struct TkDisplayFocusInfo *displayFocusPtr;
+ /* First in list of records containing focus
+ * information for each display that this
+ * application has ever used. Used only
+ * by tkFocus.c. */
+
+ struct ElArray *optionRootPtr;
+ /* Top level of option hierarchy for this
+ * main window. NULL means uninitialized.
+ * Managed by tkOption.c. */
+ Tcl_HashTable imageTable; /* Maps from image names to Tk_ImageMaster
+ * structures. Managed by tkImage.c. */
+ int strictMotif; /* This is linked to the tk_strictMotif
+ * global variable. */
+ struct TkMainInfo *nextPtr; /* Next in list of all main windows managed by
+ * this process. */
+} TkMainInfo;
+
+/*
+ * Tk keeps the following data structure for each of it's builtin
+ * bitmaps. This structure is only used by tkBitmap.c and other
+ * platform specific bitmap files.
+ */
+
+typedef struct {
+ char *source; /* Bits for bitmap. */
+ int width, height; /* Dimensions of bitmap. */
+ int native; /* 0 means generic (X style) bitmap,
+ * 1 means native style bitmap. */
+} TkPredefBitmap;
+
+/*
+ * Tk keeps one of the following structures for each window.
+ * Some of the information (like size and location) is a shadow
+ * of information managed by the X server, and some is special
+ * information used here, such as event and geometry management
+ * information. This information is (mostly) managed by tkWindow.c.
+ * WARNING: the declaration below must be kept consistent with the
+ * Tk_FakeWin structure in tk.h. If you change one, be sure to
+ * change the other!!
+ */
+
+typedef struct TkWindow {
+
+ /*
+ * Structural information:
+ */
+
+ Display *display; /* Display containing window. */
+ TkDisplay *dispPtr; /* Tk's information about display
+ * for window. */
+ int screenNum; /* Index of screen for window, among all
+ * those for dispPtr. */
+ Visual *visual; /* Visual to use for window. If not default,
+ * MUST be set before X window is created. */
+ int depth; /* Number of bits/pixel. */
+ Window window; /* X's id for window. NULL means window
+ * hasn't actually been created yet, or it's
+ * been deleted. */
+ struct TkWindow *childList; /* First in list of child windows,
+ * or NULL if no children. List is in
+ * stacking order, lowest window first.*/
+ struct TkWindow *lastChildPtr;
+ /* Last in list of child windows (highest
+ * in stacking order), or NULL if no
+ * children. */
+ struct TkWindow *parentPtr; /* Pointer to parent window (logical
+ * parent, not necessarily X parent). NULL
+ * means either this is the main window, or
+ * the window's parent has already been
+ * deleted. */
+ struct TkWindow *nextPtr; /* Next higher sibling (in stacking order)
+ * in list of children with same parent. NULL
+ * means end of list. */
+ TkMainInfo *mainPtr; /* Information shared by all windows
+ * associated with a particular main
+ * window. NULL means this window is
+ * a rogue that isn't associated with
+ * any application (at present, this
+ * only happens for the dummy windows
+ * used for "send" communication). */
+
+ /*
+ * Name and type information for the window:
+ */
+
+ char *pathName; /* Path name of window (concatenation
+ * of all names between this window and
+ * its top-level ancestor). This is a
+ * pointer into an entry in
+ * mainPtr->nameTable. NULL means that
+ * the window hasn't been completely
+ * created yet. */
+ Tk_Uid nameUid; /* Name of the window within its parent
+ * (unique within the parent). */
+ Tk_Uid classUid; /* Class of the window. NULL means window
+ * hasn't been given a class yet. */
+
+ /*
+ * Geometry and other attributes of window. This information
+ * may not be updated on the server immediately; stuff that
+ * hasn't been reflected in the server yet is called "dirty".
+ * At present, information can be dirty only if the window
+ * hasn't yet been created.
+ */
+
+ XWindowChanges changes; /* Geometry and other info about
+ * window. */
+ unsigned int dirtyChanges; /* Bits indicate fields of "changes"
+ * that are dirty. */
+ XSetWindowAttributes atts; /* Current attributes of window. */
+ unsigned long dirtyAtts; /* Bits indicate fields of "atts"
+ * that are dirty. */
+
+ unsigned int flags; /* Various flag values: these are all
+ * defined in tk.h (confusing, but they're
+ * needed there for some query macros). */
+
+ /*
+ * Information kept by the event manager (tkEvent.c):
+ */
+
+ TkEventHandler *handlerList;/* First in list of event handlers
+ * declared for this window, or
+ * NULL if none. */
+#ifdef TK_USE_INPUT_METHODS
+ XIC inputContext; /* Input context (for input methods). */
+#endif /* TK_USE_INPUT_METHODS */
+
+ /*
+ * Information used for event bindings (see "bind" and "bindtags"
+ * commands in tkCmds.c):
+ */
+
+ ClientData *tagPtr; /* Points to array of tags used for bindings
+ * on this window. Each tag is a Tk_Uid.
+ * Malloc'ed. NULL means no tags. */
+ int numTags; /* Number of tags at *tagPtr. */
+
+ /*
+ * Information used by tkOption.c to manage options for the
+ * window.
+ */
+
+ int optionLevel; /* -1 means no option information is
+ * currently cached for this window.
+ * Otherwise this gives the level in
+ * the option stack at which info is
+ * cached. */
+ /*
+ * Information used by tkSelect.c to manage the selection.
+ */
+
+ struct TkSelHandler *selHandlerList;
+ /* First in list of handlers for
+ * returning the selection in various
+ * forms. */
+
+ /*
+ * Information used by tkGeometry.c for geometry management.
+ */
+
+ Tk_GeomMgr *geomMgrPtr; /* Information about geometry manager for
+ * this window. */
+ ClientData geomData; /* Argument for geometry manager procedures. */
+ int reqWidth, reqHeight; /* Arguments from last call to
+ * Tk_GeometryRequest, or 0's if
+ * Tk_GeometryRequest hasn't been
+ * called. */
+ int internalBorderWidth; /* Width of internal border of window
+ * (0 means no internal border). Geometry
+ * managers should not normally place children
+ * on top of the border. */
+
+ /*
+ * Information maintained by tkWm.c for window manager communication.
+ */
+
+ struct TkWmInfo *wmInfoPtr; /* For top-level windows (and also
+ * for special Unix menubar and wrapper
+ * windows), points to structure with
+ * wm-related info (see tkWm.c). For
+ * other windows, this is NULL. */
+
+ /*
+ * Information used by widget classes.
+ */
+
+ TkClassProcs *classProcsPtr;
+ ClientData instanceData;
+
+ /*
+ * Platform specific information private to each port.
+ */
+
+ struct TkWindowPrivate *privatePtr;
+} TkWindow;
+
+/*
+ * The following structure is used as a two way map between integers
+ * and strings, usually to map between an internal C representation
+ * and the strings used in Tcl.
+ */
+
+typedef struct TkStateMap {
+ int numKey; /* Integer representation of a value. */
+ char *strKey; /* String representation of a value. */
+} TkStateMap;
+
+/*
+ * This structure is used by the Mac and Window porting layers as
+ * the internal representation of a clip_mask in a GC.
+ */
+
+typedef struct TkpClipMask {
+ int type; /* One of TKP_CLIP_PIXMAP or TKP_CLIP_REGION */
+ union {
+ Pixmap pixmap;
+ TkRegion region;
+ } value;
+} TkpClipMask;
+
+#define TKP_CLIP_PIXMAP 0
+#define TKP_CLIP_REGION 1
+
+/*
+ * Pointer to first entry in list of all displays currently known.
+ */
+
+extern TkDisplay *tkDisplayList;
+
+/*
+ * Return values from TkGrabState:
+ */
+
+#define TK_GRAB_NONE 0
+#define TK_GRAB_IN_TREE 1
+#define TK_GRAB_ANCESTOR 2
+#define TK_GRAB_EXCLUDED 3
+
+/*
+ * The macro below is used to modify a "char" value (e.g. by casting
+ * it to an unsigned character) so that it can be used safely with
+ * macros such as isspace.
+ */
+
+#define UCHAR(c) ((unsigned char) (c))
+
+/*
+ * The following symbol is used in the mode field of FocusIn events
+ * generated by an embedded application to request the input focus from
+ * its container.
+ */
+
+#define EMBEDDED_APP_WANTS_FOCUS (NotifyNormal + 20)
+
+/*
+ * Miscellaneous variables shared among Tk modules but not exported
+ * to the outside world:
+ */
+
+extern Tk_Uid tkActiveUid;
+extern Tk_ImageType tkBitmapImageType;
+extern Tk_Uid tkDisabledUid;
+extern Tk_PhotoImageFormat tkImgFmtGIF;
+extern void (*tkHandleEventProc) _ANSI_ARGS_((
+ XEvent* eventPtr));
+extern Tk_PhotoImageFormat tkImgFmtPPM;
+extern TkMainInfo *tkMainWindowList;
+extern Tk_Uid tkNormalUid;
+extern Tk_ImageType tkPhotoImageType;
+extern Tcl_HashTable tkPredefBitmapTable;
+extern int tkSendSerial;
+
+/*
+ * Internal procedures shared among Tk modules but not exported
+ * to the outside world:
+ */
+
+EXTERN char * TkAlignImageData _ANSI_ARGS_((XImage *image,
+ int alignment, int bitOrder));
+EXTERN TkWindow * TkAllocWindow _ANSI_ARGS_((TkDisplay *dispPtr,
+ int screenNum, TkWindow *parentPtr));
+EXTERN int TkAreaToPolygon _ANSI_ARGS_((double *polyPtr,
+ int numPoints, double *rectPtr));
+EXTERN void TkBezierPoints _ANSI_ARGS_((double control[],
+ int numSteps, double *coordPtr));
+EXTERN void TkBezierScreenPoints _ANSI_ARGS_((Tk_Canvas canvas,
+ double control[], int numSteps,
+ XPoint *xPointPtr));
+EXTERN void TkBindDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
+EXTERN void TkBindEventProc _ANSI_ARGS_((TkWindow *winPtr,
+ XEvent *eventPtr));
+EXTERN void TkBindFree _ANSI_ARGS_((TkMainInfo *mainPtr));
+EXTERN void TkBindInit _ANSI_ARGS_((TkMainInfo *mainPtr));
+EXTERN void TkChangeEventWindow _ANSI_ARGS_((XEvent *eventPtr,
+ TkWindow *winPtr));
+#ifndef TkClipBox
+EXTERN void TkClipBox _ANSI_ARGS_((TkRegion rgn,
+ XRectangle* rect_return));
+#endif
+EXTERN int TkClipInit _ANSI_ARGS_((Tcl_Interp *interp,
+ TkDisplay *dispPtr));
+EXTERN void TkComputeAnchor _ANSI_ARGS_((Tk_Anchor anchor,
+ Tk_Window tkwin, int padX, int padY,
+ int innerWidth, int innerHeight, int *xPtr,
+ int *yPtr));
+EXTERN int TkCopyAndGlobalEval _ANSI_ARGS_((Tcl_Interp *interp,
+ char *script));
+EXTERN unsigned long TkCreateBindingProcedure _ANSI_ARGS_((
+ Tcl_Interp *interp, Tk_BindingTable bindingTable,
+ ClientData object, char *eventString,
+ TkBindEvalProc *evalProc, TkBindFreeProc *freeProc,
+ ClientData clientData));
+EXTERN TkCursor * TkCreateCursorFromData _ANSI_ARGS_((Tk_Window tkwin,
+ char *source, char *mask, int width, int height,
+ int xHot, int yHot, XColor fg, XColor bg));
+EXTERN int TkCreateFrame _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv,
+ int toplevel, char *appName));
+EXTERN Tk_Window TkCreateMainWindow _ANSI_ARGS_((Tcl_Interp *interp,
+ char *screenName, char *baseName));
+#ifndef TkCreateRegion
+EXTERN TkRegion TkCreateRegion _ANSI_ARGS_((void));
+#endif
+EXTERN Time TkCurrentTime _ANSI_ARGS_((TkDisplay *dispPtr));
+EXTERN int TkDeadAppCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN void TkDeleteAllImages _ANSI_ARGS_((TkMainInfo *mainPtr));
+#ifndef TkDestroyRegion
+EXTERN void TkDestroyRegion _ANSI_ARGS_((TkRegion rgn));
+#endif
+EXTERN void TkDoConfigureNotify _ANSI_ARGS_((TkWindow *winPtr));
+EXTERN void TkDrawInsetFocusHighlight _ANSI_ARGS_((
+ Tk_Window tkwin, GC gc, int width,
+ Drawable drawable, int padding));
+EXTERN void TkEventCleanupProc _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp));
+EXTERN void TkEventDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
+EXTERN void TkFillPolygon _ANSI_ARGS_((Tk_Canvas canvas,
+ double *coordPtr, int numPoints, Display *display,
+ Drawable drawable, GC gc, GC outlineGC));
+EXTERN int TkFindStateNum _ANSI_ARGS_((Tcl_Interp *interp,
+ CONST char *option, CONST TkStateMap *mapPtr,
+ CONST char *strKey));
+EXTERN char * TkFindStateString _ANSI_ARGS_((
+ CONST TkStateMap *mapPtr, int numKey));
+EXTERN void TkFocusDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
+EXTERN int TkFocusFilterEvent _ANSI_ARGS_((TkWindow *winPtr,
+ XEvent *eventPtr));
+EXTERN TkWindow * TkFocusKeyEvent _ANSI_ARGS_((TkWindow *winPtr,
+ XEvent *eventPtr));
+EXTERN void TkFontPkgInit _ANSI_ARGS_((TkMainInfo *mainPtr));
+EXTERN void TkFontPkgFree _ANSI_ARGS_((TkMainInfo *mainPtr));
+EXTERN void TkFreeBindingTags _ANSI_ARGS_((TkWindow *winPtr));
+EXTERN void TkFreeCursor _ANSI_ARGS_((TkCursor *cursorPtr));
+EXTERN void TkFreeWindowId _ANSI_ARGS_((TkDisplay *dispPtr,
+ Window w));
+EXTERN void TkGenerateActivateEvents _ANSI_ARGS_((
+ TkWindow *winPtr, int active));
+EXTERN char * TkGetBitmapData _ANSI_ARGS_((Tcl_Interp *interp,
+ char *string, char *fileName, int *widthPtr,
+ int *heightPtr, int *hotXPtr, int *hotYPtr));
+EXTERN void TkGetButtPoints _ANSI_ARGS_((double p1[], double p2[],
+ double width, int project, double m1[],
+ double m2[]));
+EXTERN TkCursor * TkGetCursorByName _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_Uid string));
+EXTERN char * TkGetDefaultScreenName _ANSI_ARGS_((Tcl_Interp *interp,
+ char *screenName));
+EXTERN TkDisplay * TkGetDisplay _ANSI_ARGS_((Display *display));
+EXTERN int TkGetDisplayOf _ANSI_ARGS_((Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[],
+ Tk_Window *tkwinPtr));
+EXTERN TkWindow * TkGetFocusWin _ANSI_ARGS_((TkWindow *winPtr));
+EXTERN int TkGetInterpNames _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin));
+EXTERN int TkGetMiterPoints _ANSI_ARGS_((double p1[], double p2[],
+ double p3[], double width, double m1[],
+ double m2[]));
+#ifndef TkGetNativeProlog
+EXTERN int TkGetNativeProlog _ANSI_ARGS_((Tcl_Interp *interp));
+#endif
+EXTERN void TkGetPointerCoords _ANSI_ARGS_((Tk_Window tkwin,
+ int *xPtr, int *yPtr));
+EXTERN int TkGetProlog _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void TkGetServerInfo _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin));
+EXTERN void TkGrabDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
+EXTERN int TkGrabState _ANSI_ARGS_((TkWindow *winPtr));
+EXTERN TkWindow * TkIDToWindow _ANSI_ARGS_((Window window,
+ TkDisplay *display));
+EXTERN void TkIncludePoint _ANSI_ARGS_((Tk_Item *itemPtr,
+ double *pointPtr));
+EXTERN void TkInitXId _ANSI_ARGS_((TkDisplay *dispPtr));
+EXTERN void TkInOutEvents _ANSI_ARGS_((XEvent *eventPtr,
+ TkWindow *sourcePtr, TkWindow *destPtr,
+ int leaveType, int enterType,
+ Tcl_QueuePosition position));
+EXTERN void TkInstallFrameMenu _ANSI_ARGS_((Tk_Window tkwin));
+#ifndef TkIntersectRegion
+EXTERN void TkIntersectRegion _ANSI_ARGS_((TkRegion sra,
+ TkRegion srcb, TkRegion dr_return));
+#endif
+EXTERN char * TkKeysymToString _ANSI_ARGS_((KeySym keysym));
+EXTERN int TkLineToArea _ANSI_ARGS_((double end1Ptr[2],
+ double end2Ptr[2], double rectPtr[4]));
+EXTERN double TkLineToPoint _ANSI_ARGS_((double end1Ptr[2],
+ double end2Ptr[2], double pointPtr[2]));
+EXTERN int TkListAppend _ANSI_ARGS_((void **headPtrPtr,
+ void *itemPtr, size_t size));
+EXTERN int TkListDelete _ANSI_ARGS_((void **headPtrPtr,
+ void *itemPtr, size_t size));
+EXTERN void * TkListFind _ANSI_ARGS_((void *headPtr, void *itemPtr,
+ size_t size));
+EXTERN int TkMakeBezierCurve _ANSI_ARGS_((Tk_Canvas canvas,
+ double *pointPtr, int numPoints, int numSteps,
+ XPoint xPoints[], double dblPoints[]));
+EXTERN void TkMakeBezierPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, double *pointPtr,
+ int numPoints));
+EXTERN void TkOptionClassChanged _ANSI_ARGS_((TkWindow *winPtr));
+EXTERN void TkOptionDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
+EXTERN int TkOvalToArea _ANSI_ARGS_((double *ovalPtr,
+ double *rectPtr));
+EXTERN double TkOvalToPoint _ANSI_ARGS_((double ovalPtr[4],
+ double width, int filled, double pointPtr[2]));
+EXTERN int TkpChangeFocus _ANSI_ARGS_((TkWindow *winPtr,
+ int force));
+EXTERN void TkpCloseDisplay _ANSI_ARGS_((TkDisplay *dispPtr));
+EXTERN void TkpClaimFocus _ANSI_ARGS_((TkWindow *topLevelPtr,
+ int force));
+#ifndef TkpCmapStressed
+EXTERN int TkpCmapStressed _ANSI_ARGS_((Tk_Window tkwin,
+ Colormap colormap));
+#endif
+#ifndef TkpCreateNativeBitmap
+EXTERN Pixmap TkpCreateNativeBitmap _ANSI_ARGS_((Display *display,
+ char * source));
+#endif
+#ifndef TkpDefineNativeBitmaps
+EXTERN void TkpDefineNativeBitmaps _ANSI_ARGS_((void));
+#endif
+EXTERN void TkpDisplayWarning _ANSI_ARGS_((char *msg,
+ char *title));
+EXTERN void TkpGetAppName _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_DString *name));
+EXTERN unsigned long TkpGetMS _ANSI_ARGS_((void));
+#ifndef TkpGetNativeAppBitmap
+EXTERN Pixmap TkpGetNativeAppBitmap _ANSI_ARGS_((Display *display,
+ char *name, int *width, int *height));
+#endif
+EXTERN TkWindow * TkpGetOtherWindow _ANSI_ARGS_((TkWindow *winPtr));
+EXTERN TkWindow * TkpGetWrapperWindow _ANSI_ARGS_((TkWindow *winPtr));
+EXTERN int TkpInit _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void TkpInitializeMenuBindings _ANSI_ARGS_((
+ Tcl_Interp *interp, Tk_BindingTable bindingTable));
+EXTERN void TkpMakeContainer _ANSI_ARGS_((Tk_Window tkwin));
+EXTERN void TkpMakeMenuWindow _ANSI_ARGS_((Tk_Window tkwin,
+ int transient));
+EXTERN Window TkpMakeWindow _ANSI_ARGS_((TkWindow *winPtr,
+ Window parent));
+EXTERN void TkpMenuNotifyToplevelCreate _ANSI_ARGS_((
+ Tcl_Interp *, char *menuName));
+EXTERN TkDisplay * TkpOpenDisplay _ANSI_ARGS_((char *display_name));
+EXTERN void TkPointerDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
+EXTERN int TkPointerEvent _ANSI_ARGS_((XEvent *eventPtr,
+ TkWindow *winPtr));
+EXTERN int TkPolygonToArea _ANSI_ARGS_((double *polyPtr,
+ int numPoints, double *rectPtr));
+EXTERN double TkPolygonToPoint _ANSI_ARGS_((double *polyPtr,
+ int numPoints, double *pointPtr));
+EXTERN int TkPositionInTree _ANSI_ARGS_((TkWindow *winPtr,
+ TkWindow *treePtr));
+#ifndef TkpPrintWindowId
+EXTERN void TkpPrintWindowId _ANSI_ARGS_((char *buf,
+ Window window));
+#endif
+EXTERN void TkpRedirectKeyEvent _ANSI_ARGS_((TkWindow *winPtr,
+ XEvent *eventPtr));
+#ifndef TkpScanWindowId
+EXTERN int TkpScanWindowId _ANSI_ARGS_((Tcl_Interp *interp,
+ char *string, int *idPtr));
+#endif
+EXTERN void TkpSetCapture _ANSI_ARGS_((TkWindow *winPtr));
+EXTERN void TkpSetCursor _ANSI_ARGS_((TkpCursor cursor));
+EXTERN void TkpSetMainMenubar _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, char *menuName));
+#ifndef TkpSync
+EXTERN void TkpSync _ANSI_ARGS_((Display *display));
+#endif
+EXTERN int TkpTestembedCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int TkpUseWindow _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, char *string));
+#ifndef TkPutImage
+EXTERN void TkPutImage _ANSI_ARGS_((unsigned long *colors,
+ int ncolors, Display* display, Drawable d,
+ GC gc, XImage* image, int src_x, int src_y,
+ int dest_x, int dest_y, unsigned int width,
+ unsigned int height));
+#endif
+EXTERN int TkpWindowWasRecentlyDeleted _ANSI_ARGS_((Window win,
+ TkDisplay *dispPtr));
+EXTERN void TkpWmSetState _ANSI_ARGS_((TkWindow *winPtr,
+ int state));
+EXTERN void TkQueueEventForAllChildren _ANSI_ARGS_((
+ TkWindow *winPtr, XEvent *eventPtr));
+#ifndef TkRectInRegion
+EXTERN int TkRectInRegion _ANSI_ARGS_((TkRegion rgn,
+ int x, int y, unsigned int width,
+ unsigned int height));
+#endif
+EXTERN int TkScrollWindow _ANSI_ARGS_((Tk_Window tkwin, GC gc,
+ int x, int y, int width, int height, int dx,
+ int dy, TkRegion damageRgn));
+EXTERN void TkSelDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
+EXTERN void TkSelEventProc _ANSI_ARGS_((Tk_Window tkwin,
+ XEvent *eventPtr));
+EXTERN void TkSelInit _ANSI_ARGS_((Tk_Window tkwin));
+EXTERN void TkSelPropProc _ANSI_ARGS_((XEvent *eventPtr));
+EXTERN void TkSetClassProcs _ANSI_ARGS_((Tk_Window tkwin,
+ TkClassProcs *procs, ClientData instanceData));
+#ifndef TkSetPixmapColormap
+EXTERN void TkSetPixmapColormap _ANSI_ARGS_((Pixmap pixmap,
+ Colormap colormap));
+#endif
+#ifndef TkSetRegion
+EXTERN void TkSetRegion _ANSI_ARGS_((Display* display, GC gc,
+ TkRegion rgn));
+#endif
+EXTERN void TkSetWindowMenuBar _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, char *oldMenuName,
+ char *menuName));
+EXTERN KeySym TkStringToKeysym _ANSI_ARGS_((char *name));
+EXTERN int TkThickPolyLineToArea _ANSI_ARGS_((double *coordPtr,
+ int numPoints, double width, int capStyle,
+ int joinStyle, double *rectPtr));
+#ifndef TkUnionRectWithRegion
+EXTERN void TkUnionRectWithRegion _ANSI_ARGS_((XRectangle* rect,
+ TkRegion src, TkRegion dr_return));
+#endif
+EXTERN void TkWmAddToColormapWindows _ANSI_ARGS_((
+ TkWindow *winPtr));
+EXTERN void TkWmDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
+EXTERN TkWindow * TkWmFocusToplevel _ANSI_ARGS_((TkWindow *winPtr));
+EXTERN void TkWmMapWindow _ANSI_ARGS_((TkWindow *winPtr));
+EXTERN void TkWmNewWindow _ANSI_ARGS_((TkWindow *winPtr));
+EXTERN void TkWmProtocolEventProc _ANSI_ARGS_((TkWindow *winPtr,
+ XEvent *evenvPtr));
+EXTERN void TkWmRemoveFromColormapWindows _ANSI_ARGS_((
+ TkWindow *winPtr));
+EXTERN void TkWmRestackToplevel _ANSI_ARGS_((TkWindow *winPtr,
+ int aboveBelow, TkWindow *otherPtr));
+EXTERN void TkWmSetClass _ANSI_ARGS_((TkWindow *winPtr));
+EXTERN void TkWmUnmapWindow _ANSI_ARGS_((TkWindow *winPtr));
+EXTERN int TkXFileProc _ANSI_ARGS_((ClientData clientData,
+ int mask, int flags));
+
+/*
+ * Unsupported commands.
+ */
+EXTERN int TkUnsupported1Cmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+
+#endif /* _TKINT */
diff --git a/generic/tkListbox.c b/generic/tkListbox.c
new file mode 100644
index 0000000..234130d
--- /dev/null
+++ b/generic/tkListbox.c
@@ -0,0 +1,2335 @@
+/*
+ * tkListbox.c --
+ *
+ * This module implements listbox widgets for the Tk
+ * toolkit. A listbox displays a collection of strings,
+ * one per line, and provides scrolling and selection.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkListbox.c 1.120 97/10/29 13:06:59
+ */
+
+#include "tkPort.h"
+#include "default.h"
+#include "tkInt.h"
+
+/*
+ * One record of the following type is kept for each element
+ * associated with a listbox widget:
+ */
+
+typedef struct Element {
+ int textLength; /* # non-NULL characters in text. */
+ int lBearing; /* Distance from first character's
+ * origin to left edge of character. */
+ int pixelWidth; /* Total width of element in pixels (including
+ * left bearing and right bearing). */
+ int selected; /* 1 means this item is selected, 0 means
+ * it isn't. */
+ struct Element *nextPtr; /* Next in list of all elements of this
+ * listbox, or NULL for last element. */
+ char text[4]; /* Characters of this element, NULL-
+ * terminated. The actual space allocated
+ * here will be as large as needed (> 4,
+ * most likely). Must be the last field
+ * of the record. */
+} Element;
+
+#define ElementSize(stringLength) \
+ ((unsigned) (sizeof(Element) - 3 + stringLength))
+
+/*
+ * A data structure of the following type is kept for each listbox
+ * widget managed by this file:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the listbox. NULL
+ * means that the window has been destroyed
+ * but the data structures haven't yet been
+ * cleaned up.*/
+ Display *display; /* Display containing widget. Used, among
+ * other things, so that resources can be
+ * freed even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with listbox. */
+ Tcl_Command widgetCmd; /* Token for listbox's widget command. */
+ int numElements; /* Total number of elements in this listbox. */
+ Element *firstPtr; /* First in list of elements (NULL if no
+ * elements). */
+ Element *lastPtr; /* Last in list of elements (NULL if no
+ * elements). */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ Tk_3DBorder normalBorder; /* Used for drawing border around whole
+ * window, plus used for background. */
+ int borderWidth; /* Width of 3-D border around window. */
+ int relief; /* 3-D effect: TK_RELIEF_RAISED, etc. */
+ int highlightWidth; /* Width in pixels of highlight to draw
+ * around widget when it has the focus.
+ * <= 0 means don't draw a highlight. */
+ XColor *highlightBgColorPtr;
+ /* Color for drawing traversal highlight
+ * area when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ int inset; /* Total width of all borders, including
+ * traversal highlight and 3-D border.
+ * Indicates how much interior stuff must
+ * be offset from outside edges to leave
+ * room for borders. */
+ Tk_Font tkfont; /* Information about text font, or NULL. */
+ XColor *fgColorPtr; /* Text color in normal mode. */
+ GC textGC; /* For drawing normal text. */
+ Tk_3DBorder selBorder; /* Borders and backgrounds for selected
+ * elements. */
+ int selBorderWidth; /* Width of border around selection. */
+ XColor *selFgColorPtr; /* Foreground color for selected elements. */
+ GC selTextGC; /* For drawing selected text. */
+ int width; /* Desired width of window, in characters. */
+ int height; /* Desired height of window, in lines. */
+ int lineHeight; /* Number of pixels allocated for each line
+ * in display. */
+ int topIndex; /* Index of top-most element visible in
+ * window. */
+ int fullLines; /* Number of lines that fit are completely
+ * visible in window. There may be one
+ * additional line at the bottom that is
+ * partially visible. */
+ int partialLine; /* 0 means that the window holds exactly
+ * fullLines lines. 1 means that there is
+ * one additional line that is partially
+ * visble. */
+ int setGrid; /* Non-zero means pass gridding information
+ * to window manager. */
+
+ /*
+ * Information to support horizontal scrolling:
+ */
+
+ int maxWidth; /* Width (in pixels) of widest string in
+ * listbox. */
+ int xScrollUnit; /* Number of pixels in one "unit" for
+ * horizontal scrolling (window scrolls
+ * horizontally in increments of this size).
+ * This is an average character size. */
+ int xOffset; /* The left edge of each string in the
+ * listbox is offset to the left by this
+ * many pixels (0 means no offset, positive
+ * means there is an offset). */
+
+ /*
+ * Information about what's selected or active, if any.
+ */
+
+ Tk_Uid selectMode; /* Selection style: single, browse, multiple,
+ * or extended. This value isn't used in C
+ * code, but the Tcl bindings use it. */
+ int numSelected; /* Number of elements currently selected. */
+ int selectAnchor; /* Fixed end of selection (i.e. element
+ * at which selection was started.) */
+ int exportSelection; /* Non-zero means tie internal listbox
+ * to X selection. */
+ int active; /* Index of "active" element (the one that
+ * has been selected by keyboard traversal).
+ * -1 means none. */
+
+ /*
+ * Information for scanning:
+ */
+
+ int scanMarkX; /* X-position at which scan started (e.g.
+ * button was pressed here). */
+ int scanMarkY; /* Y-position at which scan started (e.g.
+ * button was pressed here). */
+ int scanMarkXOffset; /* Value of "xOffset" field when scan
+ * started. */
+ int scanMarkYIndex; /* Index of line that was at top of window
+ * when scan started. */
+
+ /*
+ * Miscellaneous information:
+ */
+
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ char *takeFocus; /* Value of -takefocus option; not used in
+ * the C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+ char *yScrollCmd; /* Command prefix for communicating with
+ * vertical scrollbar. NULL means no command
+ * to issue. Malloc'ed. */
+ char *xScrollCmd; /* Command prefix for communicating with
+ * horizontal scrollbar. NULL means no command
+ * to issue. Malloc'ed. */
+ int flags; /* Various flag bits: see below for
+ * definitions. */
+} Listbox;
+
+/*
+ * Flag bits for listboxes:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler
+ * has already been queued to redraw
+ * this window.
+ * UPDATE_V_SCROLLBAR: Non-zero means vertical scrollbar needs
+ * to be updated.
+ * UPDATE_H_SCROLLBAR: Non-zero means horizontal scrollbar needs
+ * to be updated.
+ * GOT_FOCUS: Non-zero means this widget currently
+ * has the input focus.
+ */
+
+#define REDRAW_PENDING 1
+#define UPDATE_V_SCROLLBAR 2
+#define UPDATE_H_SCROLLBAR 4
+#define GOT_FOCUS 8
+
+/*
+ * Information used for argv parsing:
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_LISTBOX_BG_COLOR, Tk_Offset(Listbox, normalBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_LISTBOX_BG_MONO, Tk_Offset(Listbox, normalBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_LISTBOX_BORDER_WIDTH, Tk_Offset(Listbox, borderWidth), 0},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_LISTBOX_CURSOR, Tk_Offset(Listbox, cursor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BOOLEAN, "-exportselection", "exportSelection",
+ "ExportSelection", DEF_LISTBOX_EXPORT_SELECTION,
+ Tk_Offset(Listbox, exportSelection), 0},
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_FONT, "-font", "font", "Font",
+ DEF_LISTBOX_FONT, Tk_Offset(Listbox, tkfont), 0},
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_LISTBOX_FG, Tk_Offset(Listbox, fgColorPtr), 0},
+ {TK_CONFIG_INT, "-height", "height", "Height",
+ DEF_LISTBOX_HEIGHT, Tk_Offset(Listbox, height), 0},
+ {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_LISTBOX_HIGHLIGHT_BG,
+ Tk_Offset(Listbox, highlightBgColorPtr), 0},
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_LISTBOX_HIGHLIGHT, Tk_Offset(Listbox, highlightColorPtr), 0},
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_LISTBOX_HIGHLIGHT_WIDTH, Tk_Offset(Listbox, highlightWidth), 0},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_LISTBOX_RELIEF, Tk_Offset(Listbox, relief), 0},
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_LISTBOX_SELECT_COLOR, Tk_Offset(Listbox, selBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_LISTBOX_SELECT_MONO, Tk_Offset(Listbox, selBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
+ DEF_LISTBOX_SELECT_BD, Tk_Offset(Listbox, selBorderWidth), 0},
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_LISTBOX_SELECT_FG_COLOR, Tk_Offset(Listbox, selFgColorPtr),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_LISTBOX_SELECT_FG_MONO, Tk_Offset(Listbox, selFgColorPtr),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_UID, "-selectmode", "selectMode", "SelectMode",
+ DEF_LISTBOX_SELECT_MODE, Tk_Offset(Listbox, selectMode), 0},
+ {TK_CONFIG_BOOLEAN, "-setgrid", "setGrid", "SetGrid",
+ DEF_LISTBOX_SET_GRID, Tk_Offset(Listbox, setGrid), 0},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_LISTBOX_TAKE_FOCUS, Tk_Offset(Listbox, takeFocus),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_INT, "-width", "width", "Width",
+ DEF_LISTBOX_WIDTH, Tk_Offset(Listbox, width), 0},
+ {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ DEF_LISTBOX_SCROLL_COMMAND, Tk_Offset(Listbox, xScrollCmd),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
+ DEF_LISTBOX_SCROLL_COMMAND, Tk_Offset(Listbox, yScrollCmd),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void ChangeListboxOffset _ANSI_ARGS_((Listbox *listPtr,
+ int offset));
+static void ChangeListboxView _ANSI_ARGS_((Listbox *listPtr,
+ int index));
+static int ConfigureListbox _ANSI_ARGS_((Tcl_Interp *interp,
+ Listbox *listPtr, int argc, char **argv,
+ int flags));
+static void DeleteEls _ANSI_ARGS_((Listbox *listPtr, int first,
+ int last));
+static void DestroyListbox _ANSI_ARGS_((char *memPtr));
+static void DisplayListbox _ANSI_ARGS_((ClientData clientData));
+static int GetListboxIndex _ANSI_ARGS_((Tcl_Interp *interp,
+ Listbox *listPtr, char *string, int endIsSize,
+ int *indexPtr));
+static void InsertEls _ANSI_ARGS_((Listbox *listPtr, int index,
+ int argc, char **argv));
+static void ListboxCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void ListboxComputeGeometry _ANSI_ARGS_((Listbox *listPtr,
+ int fontChanged, int maxIsStale, int updateGrid));
+static void ListboxEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int ListboxFetchSelection _ANSI_ARGS_((
+ ClientData clientData, int offset, char *buffer,
+ int maxBytes));
+static void ListboxLostSelection _ANSI_ARGS_((
+ ClientData clientData));
+static void ListboxRedrawRange _ANSI_ARGS_((Listbox *listPtr,
+ int first, int last));
+static void ListboxScanTo _ANSI_ARGS_((Listbox *listPtr,
+ int x, int y));
+static void ListboxSelect _ANSI_ARGS_((Listbox *listPtr,
+ int first, int last, int select));
+static void ListboxUpdateHScrollbar _ANSI_ARGS_((Listbox *listPtr));
+static void ListboxUpdateVScrollbar _ANSI_ARGS_((Listbox *listPtr));
+static int ListboxWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void ListboxWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+static int NearestListboxElement _ANSI_ARGS_((Listbox *listPtr,
+ int y));
+
+/*
+ * The structure below defines button class behavior by means of procedures
+ * that can be invoked from generic window code.
+ */
+
+static TkClassProcs listboxClass = {
+ NULL, /* createProc. */
+ ListboxWorldChanged, /* geometryProc. */
+ NULL /* modalProc. */
+};
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ListboxCmd --
+ *
+ * This procedure is invoked to process the "listbox" Tcl
+ * command. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_ListboxCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ register Listbox *listPtr;
+ Tk_Window new;
+ Tk_Window tkwin = (Tk_Window) clientData;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " pathName ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Initialize the fields of the structure that won't be initialized
+ * by ConfigureListbox, or that ConfigureListbox requires to be
+ * initialized already (e.g. resource pointers).
+ */
+
+ listPtr = (Listbox *) ckalloc(sizeof(Listbox));
+ listPtr->tkwin = new;
+ listPtr->display = Tk_Display(new);
+ listPtr->interp = interp;
+ listPtr->widgetCmd = Tcl_CreateCommand(interp,
+ Tk_PathName(listPtr->tkwin), ListboxWidgetCmd,
+ (ClientData) listPtr, ListboxCmdDeletedProc);
+ listPtr->numElements = 0;
+ listPtr->firstPtr = NULL;
+ listPtr->lastPtr = NULL;
+ listPtr->normalBorder = NULL;
+ listPtr->borderWidth = 0;
+ listPtr->relief = TK_RELIEF_RAISED;
+ listPtr->highlightWidth = 0;
+ listPtr->highlightBgColorPtr = NULL;
+ listPtr->highlightColorPtr = NULL;
+ listPtr->inset = 0;
+ listPtr->tkfont = NULL;
+ listPtr->fgColorPtr = NULL;
+ listPtr->textGC = None;
+ listPtr->selBorder = NULL;
+ listPtr->selBorderWidth = 0;
+ listPtr->selFgColorPtr = None;
+ listPtr->selTextGC = None;
+ listPtr->width = 0;
+ listPtr->height = 0;
+ listPtr->lineHeight = 0;
+ listPtr->topIndex = 0;
+ listPtr->fullLines = 1;
+ listPtr->partialLine = 0;
+ listPtr->setGrid = 0;
+ listPtr->maxWidth = 0;
+ listPtr->xScrollUnit = 1;
+ listPtr->xOffset = 0;
+ listPtr->selectMode = NULL;
+ listPtr->numSelected = 0;
+ listPtr->selectAnchor = 0;
+ listPtr->exportSelection = 1;
+ listPtr->active = 0;
+ listPtr->scanMarkX = 0;
+ listPtr->scanMarkY = 0;
+ listPtr->scanMarkXOffset = 0;
+ listPtr->scanMarkYIndex = 0;
+ listPtr->cursor = None;
+ listPtr->takeFocus = NULL;
+ listPtr->xScrollCmd = NULL;
+ listPtr->yScrollCmd = NULL;
+ listPtr->flags = 0;
+
+ Tk_SetClass(listPtr->tkwin, "Listbox");
+ TkSetClassProcs(listPtr->tkwin, &listboxClass, (ClientData) listPtr);
+ Tk_CreateEventHandler(listPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ ListboxEventProc, (ClientData) listPtr);
+ Tk_CreateSelHandler(listPtr->tkwin, XA_PRIMARY, XA_STRING,
+ ListboxFetchSelection, (ClientData) listPtr, XA_STRING);
+ if (ConfigureListbox(interp, listPtr, argc-2, argv+2, 0) != TCL_OK) {
+ goto error;
+ }
+
+ interp->result = Tk_PathName(listPtr->tkwin);
+ return TCL_OK;
+
+ error:
+ Tk_DestroyWindow(listPtr->tkwin);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ListboxWidgetCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to a widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ListboxWidgetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about listbox widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ register Listbox *listPtr = (Listbox *) clientData;
+ int result = TCL_OK;
+ size_t length;
+ int c;
+ Tk_FontMetrics fm;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_Preserve((ClientData) listPtr);
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'a') && (strncmp(argv[1], "activate", length) == 0)) {
+ int index;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " activate index\"",
+ (char *) NULL);
+ goto error;
+ }
+ ListboxRedrawRange(listPtr, listPtr->active, listPtr->active);
+ if (GetListboxIndex(interp, listPtr, argv[2], 0, &index) != TCL_OK) {
+ goto error;
+ }
+ if (index >= listPtr->numElements) {
+ index = listPtr->numElements-1;
+ }
+ if (index < 0) {
+ index = 0;
+ }
+ listPtr->active = index;
+ ListboxRedrawRange(listPtr, listPtr->active, listPtr->active);
+ } else if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0)) {
+ int index, x, y, i;
+ Element *elPtr;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " bbox index\"", (char *) NULL);
+ goto error;
+ }
+ if (GetListboxIndex(interp, listPtr, argv[2], 0, &index) != TCL_OK) {
+ goto error;
+ }
+ if ((index >= listPtr->numElements) || (index < 0)) {
+ goto done;
+ }
+ for (i = 0, elPtr = listPtr->firstPtr; i < index;
+ i++, elPtr = elPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ if ((index >= listPtr->topIndex) && (index < listPtr->numElements)
+ && (index < (listPtr->topIndex + listPtr->fullLines
+ + listPtr->partialLine))) {
+ x = listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset;
+ y = ((index - listPtr->topIndex)*listPtr->lineHeight)
+ + listPtr->inset + listPtr->selBorderWidth;
+ Tk_GetFontMetrics(listPtr->tkfont, &fm);
+ sprintf(interp->result, "%d %d %d %d", x, y, elPtr->pixelWidth,
+ fm.linespace);
+ }
+ } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
+ && (length >= 2)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " cget option\"",
+ (char *) NULL);
+ goto error;
+ }
+ result = Tk_ConfigureValue(interp, listPtr->tkwin, configSpecs,
+ (char *) listPtr, argv[2], 0);
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
+ && (length >= 2)) {
+ if (argc == 2) {
+ result = Tk_ConfigureInfo(interp, listPtr->tkwin, configSpecs,
+ (char *) listPtr, (char *) NULL, 0);
+ } else if (argc == 3) {
+ result = Tk_ConfigureInfo(interp, listPtr->tkwin, configSpecs,
+ (char *) listPtr, argv[2], 0);
+ } else {
+ result = ConfigureListbox(interp, listPtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ } else if ((c == 'c') && (strncmp(argv[1], "curselection", length) == 0)
+ && (length >= 2)) {
+ int i, count;
+ char index[20];
+ Element *elPtr;
+
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " curselection\"",
+ (char *) NULL);
+ goto error;
+ }
+ count = 0;
+ for (i = 0, elPtr = listPtr->firstPtr; elPtr != NULL;
+ i++, elPtr = elPtr->nextPtr) {
+ if (elPtr->selected) {
+ sprintf(index, "%d", i);
+ Tcl_AppendElement(interp, index);
+ count++;
+ }
+ }
+ if (count != listPtr->numSelected) {
+ panic("ListboxWidgetCmd: selection count incorrect");
+ }
+ } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) {
+ int first, last;
+
+ if ((argc < 3) || (argc > 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " delete firstIndex ?lastIndex?\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (GetListboxIndex(interp, listPtr, argv[2], 0, &first) != TCL_OK) {
+ goto error;
+ }
+ if (first < listPtr->numElements) {
+ if (argc == 3) {
+ last = first;
+ } else {
+ if (GetListboxIndex(interp, listPtr, argv[3], 0,
+ &last) != TCL_OK) {
+ goto error;
+ }
+ if (last >= listPtr->numElements) {
+ last = listPtr->numElements-1;
+ }
+ }
+ DeleteEls(listPtr, first, last);
+ }
+ } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
+ int first, last, i;
+ Element *elPtr;
+
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " get first ?last?\"", (char *) NULL);
+ goto error;
+ }
+ if (GetListboxIndex(interp, listPtr, argv[2], 0, &first) != TCL_OK) {
+ goto error;
+ }
+ if ((argc == 4) && (GetListboxIndex(interp, listPtr, argv[3],
+ 0, &last) != TCL_OK)) {
+ goto error;
+ }
+ if (first >= listPtr->numElements) {
+ goto done;
+ }
+ if (last >= listPtr->numElements) {
+ last = listPtr->numElements-1;
+ }
+
+ for (elPtr = listPtr->firstPtr, i = 0; i < first;
+ i++, elPtr = elPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ if (elPtr != NULL) {
+ if (argc == 3) {
+ if (first >= 0) {
+ interp->result = elPtr->text;
+ }
+ } else {
+ for ( ; i <= last; i++, elPtr = elPtr->nextPtr) {
+ Tcl_AppendElement(interp, elPtr->text);
+ }
+ }
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
+ && (length >= 3)) {
+ int index;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " index index\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (GetListboxIndex(interp, listPtr, argv[2], 1, &index)
+ != TCL_OK) {
+ goto error;
+ }
+ sprintf(interp->result, "%d", index);
+ } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
+ && (length >= 3)) {
+ int index;
+
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " insert index ?element element ...?\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (GetListboxIndex(interp, listPtr, argv[2], 1, &index)
+ != TCL_OK) {
+ goto error;
+ }
+ InsertEls(listPtr, index, argc-3, argv+3);
+ } else if ((c == 'n') && (strncmp(argv[1], "nearest", length) == 0)) {
+ int index, y;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " nearest y\"", (char *) NULL);
+ goto error;
+ }
+ if (Tcl_GetInt(interp, argv[2], &y) != TCL_OK) {
+ goto error;
+ }
+ index = NearestListboxElement(listPtr, y);
+ sprintf(interp->result, "%d", index);
+ } else if ((c == 's') && (length >= 2)
+ && (strncmp(argv[1], "scan", length) == 0)) {
+ int x, y;
+
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " scan mark|dragto x y\"", (char *) NULL);
+ goto error;
+ }
+ if ((Tcl_GetInt(interp, argv[3], &x) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[4], &y) != TCL_OK)) {
+ goto error;
+ }
+ if ((argv[2][0] == 'm')
+ && (strncmp(argv[2], "mark", strlen(argv[2])) == 0)) {
+ listPtr->scanMarkX = x;
+ listPtr->scanMarkY = y;
+ listPtr->scanMarkXOffset = listPtr->xOffset;
+ listPtr->scanMarkYIndex = listPtr->topIndex;
+ } else if ((argv[2][0] == 'd')
+ && (strncmp(argv[2], "dragto", strlen(argv[2])) == 0)) {
+ ListboxScanTo(listPtr, x, y);
+ } else {
+ Tcl_AppendResult(interp, "bad scan option \"", argv[2],
+ "\": must be mark or dragto", (char *) NULL);
+ goto error;
+ }
+ } else if ((c == 's') && (strncmp(argv[1], "see", length) == 0)
+ && (length >= 3)) {
+ int index, diff;
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " see index\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (GetListboxIndex(interp, listPtr, argv[2], 0, &index) != TCL_OK) {
+ goto error;
+ }
+ if (index >= listPtr->numElements) {
+ index = listPtr->numElements-1;
+ }
+ if (index < 0) {
+ index = 0;
+ }
+ diff = listPtr->topIndex-index;
+ if (diff > 0) {
+ if (diff <= (listPtr->fullLines/3)) {
+ ChangeListboxView(listPtr, index);
+ } else {
+ ChangeListboxView(listPtr, index - (listPtr->fullLines-1)/2);
+ }
+ } else {
+ diff = index - (listPtr->topIndex + listPtr->fullLines - 1);
+ if (diff > 0) {
+ if (diff <= (listPtr->fullLines/3)) {
+ ChangeListboxView(listPtr, listPtr->topIndex + diff);
+ } else {
+ ChangeListboxView(listPtr,
+ index - (listPtr->fullLines-1)/2);
+ }
+ }
+ }
+ } else if ((c == 's') && (length >= 3)
+ && (strncmp(argv[1], "selection", length) == 0)) {
+ int first, last;
+
+ if ((argc != 4) && (argc != 5)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " selection option index ?index?\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (GetListboxIndex(interp, listPtr, argv[3], 0, &first) != TCL_OK) {
+ goto error;
+ }
+ if (argc == 5) {
+ if (GetListboxIndex(interp, listPtr, argv[4], 0, &last) != TCL_OK) {
+ goto error;
+ }
+ } else {
+ last = first;
+ }
+ length = strlen(argv[2]);
+ c = argv[2][0];
+ if ((c == 'a') && (strncmp(argv[2], "anchor", length) == 0)) {
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " selection anchor index\"", (char *) NULL);
+ goto error;
+ }
+ if (first >= listPtr->numElements) {
+ first = listPtr->numElements-1;
+ }
+ if (first < 0) {
+ first = 0;
+ }
+ listPtr->selectAnchor = first;
+ } else if ((c == 'c') && (strncmp(argv[2], "clear", length) == 0)) {
+ ListboxSelect(listPtr, first, last, 0);
+ } else if ((c == 'i') && (strncmp(argv[2], "includes", length) == 0)) {
+ int i;
+ Element *elPtr;
+
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " selection includes index\"", (char *) NULL);
+ goto error;
+ }
+ if ((first < 0) || (first >= listPtr->numElements)) {
+ interp->result = "0";
+ goto done;
+ }
+ for (elPtr = listPtr->firstPtr, i = 0; i < first;
+ i++, elPtr = elPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ if (elPtr->selected) {
+ interp->result = "1";
+ } else {
+ interp->result = "0";
+ }
+ } else if ((c == 's') && (strncmp(argv[2], "set", length) == 0)) {
+ ListboxSelect(listPtr, first, last, 1);
+ } else {
+ Tcl_AppendResult(interp, "bad selection option \"", argv[2],
+ "\": must be anchor, clear, includes, or set",
+ (char *) NULL);
+ goto error;
+ }
+ } else if ((c == 's') && (length >= 2)
+ && (strncmp(argv[1], "size", length) == 0)) {
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " size\"", (char *) NULL);
+ goto error;
+ }
+ sprintf(interp->result, "%d", listPtr->numElements);
+ } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) {
+ int index, count, type, windowWidth, windowUnits;
+ int offset = 0; /* Initialized to stop gcc warnings. */
+ double fraction, fraction2;
+
+ windowWidth = Tk_Width(listPtr->tkwin)
+ - 2*(listPtr->inset + listPtr->selBorderWidth);
+ if (argc == 2) {
+ if (listPtr->maxWidth == 0) {
+ interp->result = "0 1";
+ } else {
+ fraction = listPtr->xOffset/((double) listPtr->maxWidth);
+ fraction2 = (listPtr->xOffset + windowWidth)
+ /((double) listPtr->maxWidth);
+ if (fraction2 > 1.0) {
+ fraction2 = 1.0;
+ }
+ sprintf(interp->result, "%g %g", fraction, fraction2);
+ }
+ } else if (argc == 3) {
+ if (Tcl_GetInt(interp, argv[2], &index) != TCL_OK) {
+ goto error;
+ }
+ ChangeListboxOffset(listPtr, index*listPtr->xScrollUnit);
+ } else {
+ type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ goto error;
+ case TK_SCROLL_MOVETO:
+ offset = (int) (fraction*listPtr->maxWidth + 0.5);
+ break;
+ case TK_SCROLL_PAGES:
+ windowUnits = windowWidth/listPtr->xScrollUnit;
+ if (windowUnits > 2) {
+ offset = listPtr->xOffset
+ + count*listPtr->xScrollUnit*(windowUnits-2);
+ } else {
+ offset = listPtr->xOffset + count*listPtr->xScrollUnit;
+ }
+ break;
+ case TK_SCROLL_UNITS:
+ offset = listPtr->xOffset + count*listPtr->xScrollUnit;
+ break;
+ }
+ ChangeListboxOffset(listPtr, offset);
+ }
+ } else if ((c == 'y') && (strncmp(argv[1], "yview", length) == 0)) {
+ int index, count, type;
+ double fraction, fraction2;
+
+ if (argc == 2) {
+ if (listPtr->numElements == 0) {
+ interp->result = "0 1";
+ } else {
+ fraction = listPtr->topIndex/((double) listPtr->numElements);
+ fraction2 = (listPtr->topIndex+listPtr->fullLines)
+ /((double) listPtr->numElements);
+ if (fraction2 > 1.0) {
+ fraction2 = 1.0;
+ }
+ sprintf(interp->result, "%g %g", fraction, fraction2);
+ }
+ } else if (argc == 3) {
+ if (GetListboxIndex(interp, listPtr, argv[2], 0, &index)
+ != TCL_OK) {
+ goto error;
+ }
+ ChangeListboxView(listPtr, index);
+ } else {
+ type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ goto error;
+ case TK_SCROLL_MOVETO:
+ index = (int) (listPtr->numElements*fraction + 0.5);
+ break;
+ case TK_SCROLL_PAGES:
+ if (listPtr->fullLines > 2) {
+ index = listPtr->topIndex
+ + count*(listPtr->fullLines-2);
+ } else {
+ index = listPtr->topIndex + count;
+ }
+ break;
+ case TK_SCROLL_UNITS:
+ index = listPtr->topIndex + count;
+ break;
+ }
+ ChangeListboxView(listPtr, index);
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be activate, bbox, cget, configure, ",
+ "curselection, delete, get, index, insert, nearest, ",
+ "scan, see, selection, size, ",
+ "xview, or yview", (char *) NULL);
+ goto error;
+ }
+ done:
+ Tcl_Release((ClientData) listPtr);
+ return result;
+
+ error:
+ Tcl_Release((ClientData) listPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyListbox --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a listbox at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the listbox is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyListbox(memPtr)
+ char *memPtr; /* Info about listbox widget. */
+{
+ register Listbox *listPtr = (Listbox *) memPtr;
+ register Element *elPtr, *nextPtr;
+
+ /*
+ * Free up all of the list elements.
+ */
+
+ for (elPtr = listPtr->firstPtr; elPtr != NULL; ) {
+ nextPtr = elPtr->nextPtr;
+ ckfree((char *) elPtr);
+ elPtr = nextPtr;
+ }
+
+ /*
+ * Free up all the stuff that requires special handling, then
+ * let Tk_FreeOptions handle all the standard option-related
+ * stuff.
+ */
+
+ if (listPtr->textGC != None) {
+ Tk_FreeGC(listPtr->display, listPtr->textGC);
+ }
+ if (listPtr->selTextGC != None) {
+ Tk_FreeGC(listPtr->display, listPtr->selTextGC);
+ }
+ Tk_FreeOptions(configSpecs, (char *) listPtr, listPtr->display, 0);
+ ckfree((char *) listPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureListbox --
+ *
+ * This procedure is called to process an argv/argc list, plus
+ * the Tk option database, in order to configure (or reconfigure)
+ * a listbox widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then interp->result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width,
+ * etc. get set for listPtr; old resources get freed,
+ * if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureListbox(interp, listPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register Listbox *listPtr; /* Information about widget; may or may
+ * not already have values for some fields. */
+ int argc; /* Number of valid entries in argv. */
+ char **argv; /* Arguments. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ int oldExport;
+
+ oldExport = listPtr->exportSelection;
+ if (Tk_ConfigureWidget(interp, listPtr->tkwin, configSpecs,
+ argc, argv, (char *) listPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few options need special processing, such as setting the
+ * background from a 3-D border.
+ */
+
+ Tk_SetBackgroundFromBorder(listPtr->tkwin, listPtr->normalBorder);
+
+ if (listPtr->highlightWidth < 0) {
+ listPtr->highlightWidth = 0;
+ }
+ listPtr->inset = listPtr->highlightWidth + listPtr->borderWidth;
+
+ /*
+ * Claim the selection if we've suddenly started exporting it and
+ * there is a selection to export.
+ */
+
+ if (listPtr->exportSelection && !oldExport
+ && (listPtr->numSelected != 0)) {
+ Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY, ListboxLostSelection,
+ (ClientData) listPtr);
+ }
+
+ ListboxWorldChanged((ClientData) listPtr);
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ListboxWorldChanged --
+ *
+ * This procedure is called when the world has changed in some
+ * way and the widget needs to recompute all its graphics contexts
+ * and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Listbox will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+ListboxWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ XGCValues gcValues;
+ GC gc;
+ unsigned long mask;
+ Listbox *listPtr;
+
+ listPtr = (Listbox *) instanceData;
+
+ gcValues.foreground = listPtr->fgColorPtr->pixel;
+ gcValues.font = Tk_FontId(listPtr->tkfont);
+ gcValues.graphics_exposures = False;
+ mask = GCForeground | GCFont | GCGraphicsExposures;
+ gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues);
+ if (listPtr->textGC != None) {
+ Tk_FreeGC(listPtr->display, listPtr->textGC);
+ }
+ listPtr->textGC = gc;
+
+ gcValues.foreground = listPtr->selFgColorPtr->pixel;
+ gcValues.font = Tk_FontId(listPtr->tkfont);
+ mask = GCForeground | GCFont;
+ gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues);
+ if (listPtr->selTextGC != None) {
+ Tk_FreeGC(listPtr->display, listPtr->selTextGC);
+ }
+ listPtr->selTextGC = gc;
+
+ /*
+ * Register the desired geometry for the window and arrange for
+ * the window to be redisplayed.
+ */
+
+ ListboxComputeGeometry(listPtr, 1, 1, 1);
+ listPtr->flags |= UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR;
+ ListboxRedrawRange(listPtr, 0, listPtr->numElements-1);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayListbox --
+ *
+ * This procedure redraws the contents of a listbox window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayListbox(clientData)
+ ClientData clientData; /* Information about window. */
+{
+ register Listbox *listPtr = (Listbox *) clientData;
+ register Tk_Window tkwin = listPtr->tkwin;
+ register Element *elPtr;
+ GC gc;
+ int i, limit, x, y, width, prevSelected;
+ Tk_FontMetrics fm;
+ int left, right; /* Non-zero values here indicate
+ * that the left or right edge of
+ * the listbox is off-screen. */
+ Pixmap pixmap;
+
+ listPtr->flags &= ~REDRAW_PENDING;
+ if (listPtr->flags & UPDATE_V_SCROLLBAR) {
+ ListboxUpdateVScrollbar(listPtr);
+ }
+ if (listPtr->flags & UPDATE_H_SCROLLBAR) {
+ ListboxUpdateHScrollbar(listPtr);
+ }
+ listPtr->flags &= ~(REDRAW_PENDING|UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR);
+ if ((listPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ /*
+ * Redrawing is done in a temporary pixmap that is allocated
+ * here and freed at the end of the procedure. All drawing is
+ * done to the pixmap, and the pixmap is copied to the screen
+ * at the end of the procedure. This provides the smoothest
+ * possible visual effects (no flashing on the screen).
+ */
+
+ pixmap = Tk_GetPixmap(listPtr->display, Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+ Tk_Fill3DRectangle(tkwin, pixmap, listPtr->normalBorder, 0, 0,
+ Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
+
+ /*
+ * Iterate through all of the elements of the listbox, displaying each
+ * in turn. Selected elements use a different GC and have a raised
+ * background.
+ */
+
+ limit = listPtr->topIndex + listPtr->fullLines + listPtr->partialLine - 1;
+ if (limit >= listPtr->numElements) {
+ limit = listPtr->numElements-1;
+ }
+ left = right = 0;
+ if (listPtr->xOffset > 0) {
+ left = listPtr->selBorderWidth+1;
+ }
+ if ((listPtr->maxWidth - listPtr->xOffset) > (Tk_Width(listPtr->tkwin)
+ - 2*(listPtr->inset + listPtr->selBorderWidth))) {
+ right = listPtr->selBorderWidth+1;
+ }
+ prevSelected = 0;
+ for (elPtr = listPtr->firstPtr, i = 0; (elPtr != NULL) && (i <= limit);
+ prevSelected = elPtr->selected, elPtr = elPtr->nextPtr, i++) {
+ if (i < listPtr->topIndex) {
+ continue;
+ }
+ x = listPtr->inset;
+ y = ((i - listPtr->topIndex) * listPtr->lineHeight)
+ + listPtr->inset;
+ gc = listPtr->textGC;
+ if (elPtr->selected) {
+ gc = listPtr->selTextGC;
+ width = Tk_Width(tkwin) - 2*listPtr->inset;
+ Tk_Fill3DRectangle(tkwin, pixmap, listPtr->selBorder, x, y,
+ width, listPtr->lineHeight, 0, TK_RELIEF_FLAT);
+
+ /*
+ * Draw beveled edges around the selection, if there are visible
+ * edges next to this element. Special considerations:
+ * 1. The left and right bevels may not be visible if horizontal
+ * scrolling is enabled (the "left" and "right" variables
+ * are zero to indicate that the corresponding bevel is
+ * visible).
+ * 2. Top and bottom bevels are only drawn if this is the
+ * first or last seleted item.
+ * 3. If the left or right bevel isn't visible, then the "left"
+ * and "right" variables, computed above, have non-zero values
+ * that extend the top and bottom bevels so that the mitered
+ * corners are off-screen.
+ */
+
+ if (left == 0) {
+ Tk_3DVerticalBevel(tkwin, pixmap, listPtr->selBorder,
+ x, y, listPtr->selBorderWidth, listPtr->lineHeight,
+ 1, TK_RELIEF_RAISED);
+ }
+ if (right == 0) {
+ Tk_3DVerticalBevel(tkwin, pixmap, listPtr->selBorder,
+ x + width - listPtr->selBorderWidth, y,
+ listPtr->selBorderWidth, listPtr->lineHeight,
+ 0, TK_RELIEF_RAISED);
+ }
+ if (!prevSelected) {
+ Tk_3DHorizontalBevel(tkwin, pixmap, listPtr->selBorder,
+ x-left, y, width+left+right, listPtr->selBorderWidth,
+ 1, 1, 1, TK_RELIEF_RAISED);
+ }
+ if ((elPtr->nextPtr == NULL) || !elPtr->nextPtr->selected) {
+ Tk_3DHorizontalBevel(tkwin, pixmap, listPtr->selBorder, x-left,
+ y + listPtr->lineHeight - listPtr->selBorderWidth,
+ width+left+right, listPtr->selBorderWidth, 0, 0, 0,
+ TK_RELIEF_RAISED);
+ }
+ }
+ Tk_GetFontMetrics(listPtr->tkfont, &fm);
+ y += fm.ascent + listPtr->selBorderWidth;
+ x = listPtr->inset + listPtr->selBorderWidth - elPtr->lBearing
+ - listPtr->xOffset;
+ Tk_DrawChars(listPtr->display, pixmap, gc, listPtr->tkfont,
+ elPtr->text, elPtr->textLength, x, y);
+
+ /*
+ * If this is the active element, underline it.
+ */
+
+ if ((i == listPtr->active) && (listPtr->flags & GOT_FOCUS)) {
+ Tk_UnderlineChars(listPtr->display, pixmap, gc, listPtr->tkfont,
+ elPtr->text, x, y, 0, elPtr->textLength);
+ }
+ }
+
+ /*
+ * Redraw the border for the listbox to make sure that it's on top
+ * of any of the text of the listbox entries.
+ */
+
+ Tk_Draw3DRectangle(tkwin, pixmap, listPtr->normalBorder,
+ listPtr->highlightWidth, listPtr->highlightWidth,
+ Tk_Width(tkwin) - 2*listPtr->highlightWidth,
+ Tk_Height(tkwin) - 2*listPtr->highlightWidth,
+ listPtr->borderWidth, listPtr->relief);
+ if (listPtr->highlightWidth > 0) {
+ GC gc;
+
+ if (listPtr->flags & GOT_FOCUS) {
+ gc = Tk_GCForColor(listPtr->highlightColorPtr, pixmap);
+ } else {
+ gc = Tk_GCForColor(listPtr->highlightBgColorPtr, pixmap);
+ }
+ Tk_DrawFocusHighlight(tkwin, gc, listPtr->highlightWidth, pixmap);
+ }
+ XCopyArea(listPtr->display, pixmap, Tk_WindowId(tkwin),
+ listPtr->textGC, 0, 0, (unsigned) Tk_Width(tkwin),
+ (unsigned) Tk_Height(tkwin), 0, 0);
+ Tk_FreePixmap(listPtr->display, pixmap);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxComputeGeometry --
+ *
+ * This procedure is invoked to recompute geometry information
+ * such as the sizes of the elements and the overall dimensions
+ * desired for the listbox.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Geometry information is updated and a new requested size is
+ * registered for the widget. Internal border and gridding
+ * information is also set.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ListboxComputeGeometry(listPtr, fontChanged, maxIsStale, updateGrid)
+ Listbox *listPtr; /* Listbox whose geometry is to be
+ * recomputed. */
+ int fontChanged; /* Non-zero means the font may have changed
+ * so per-element width information also
+ * has to be computed. */
+ int maxIsStale; /* Non-zero means the "maxWidth" field may
+ * no longer be up-to-date and must
+ * be recomputed. If fontChanged is 1 then
+ * this must be 1. */
+ int updateGrid; /* Non-zero means call Tk_SetGrid or
+ * Tk_UnsetGrid to update gridding for
+ * the window. */
+{
+ register Element *elPtr;
+ int width, height, pixelWidth, pixelHeight;
+ Tk_FontMetrics fm;
+
+ if (fontChanged || maxIsStale) {
+ listPtr->xScrollUnit = Tk_TextWidth(listPtr->tkfont, "0", 1);
+ if (listPtr->xScrollUnit == 0) {
+ listPtr->xScrollUnit = 1;
+ }
+ listPtr->maxWidth = 0;
+ for (elPtr = listPtr->firstPtr; elPtr != NULL; elPtr = elPtr->nextPtr) {
+ if (fontChanged) {
+ elPtr->pixelWidth = Tk_TextWidth(listPtr->tkfont,
+ elPtr->text, elPtr->textLength);
+ elPtr->lBearing = 0;
+ }
+ if (elPtr->pixelWidth > listPtr->maxWidth) {
+ listPtr->maxWidth = elPtr->pixelWidth;
+ }
+ }
+ }
+
+ Tk_GetFontMetrics(listPtr->tkfont, &fm);
+ listPtr->lineHeight = fm.linespace + 1 + 2*listPtr->selBorderWidth;
+ width = listPtr->width;
+ if (width <= 0) {
+ width = (listPtr->maxWidth + listPtr->xScrollUnit - 1)
+ /listPtr->xScrollUnit;
+ if (width < 1) {
+ width = 1;
+ }
+ }
+ pixelWidth = width*listPtr->xScrollUnit + 2*listPtr->inset
+ + 2*listPtr->selBorderWidth;
+ height = listPtr->height;
+ if (listPtr->height <= 0) {
+ height = listPtr->numElements;
+ if (height < 1) {
+ height = 1;
+ }
+ }
+ pixelHeight = height*listPtr->lineHeight + 2*listPtr->inset;
+ Tk_GeometryRequest(listPtr->tkwin, pixelWidth, pixelHeight);
+ Tk_SetInternalBorder(listPtr->tkwin, listPtr->inset);
+ if (updateGrid) {
+ if (listPtr->setGrid) {
+ Tk_SetGrid(listPtr->tkwin, width, height, listPtr->xScrollUnit,
+ listPtr->lineHeight);
+ } else {
+ Tk_UnsetGrid(listPtr->tkwin);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InsertEls --
+ *
+ * Add new elements to a listbox widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * New information gets added to listPtr; it will be redisplayed
+ * soon, but not immediately.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InsertEls(listPtr, index, argc, argv)
+ register Listbox *listPtr; /* Listbox that is to get the new
+ * elements. */
+ int index; /* Add the new elements before this
+ * element. */
+ int argc; /* Number of new elements to add. */
+ char **argv; /* New elements (one per entry). */
+{
+ register Element *prevPtr, *newPtr;
+ int length, i, oldMaxWidth;
+
+ /*
+ * Find the element before which the new ones will be inserted.
+ */
+
+ if (index <= 0) {
+ index = 0;
+ }
+ if (index > listPtr->numElements) {
+ index = listPtr->numElements;
+ }
+ if (index == 0) {
+ prevPtr = NULL;
+ } else if (index == listPtr->numElements) {
+ prevPtr = listPtr->lastPtr;
+ } else {
+ for (prevPtr = listPtr->firstPtr, i = index - 1; i > 0; i--) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ }
+
+ /*
+ * For each new element, create a record, initialize it, and link
+ * it into the list of elements.
+ */
+
+ oldMaxWidth = listPtr->maxWidth;
+ for (i = argc ; i > 0; i--, argv++, prevPtr = newPtr) {
+ length = strlen(*argv);
+ newPtr = (Element *) ckalloc(ElementSize(length));
+ newPtr->textLength = length;
+ strcpy(newPtr->text, *argv);
+ newPtr->pixelWidth = Tk_TextWidth(listPtr->tkfont, newPtr->text,
+ newPtr->textLength);
+ newPtr->lBearing = 0;
+ if (newPtr->pixelWidth > listPtr->maxWidth) {
+ listPtr->maxWidth = newPtr->pixelWidth;
+ }
+ newPtr->selected = 0;
+ if (prevPtr == NULL) {
+ newPtr->nextPtr = listPtr->firstPtr;
+ listPtr->firstPtr = newPtr;
+ } else {
+ newPtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = newPtr;
+ }
+ }
+ if ((prevPtr != NULL) && (prevPtr->nextPtr == NULL)) {
+ listPtr->lastPtr = prevPtr;
+ }
+ listPtr->numElements += argc;
+
+ /*
+ * Update the selection and other indexes to account for the
+ * renumbering that has just occurred. Then arrange for the new
+ * information to be displayed.
+ */
+
+ if (index <= listPtr->selectAnchor) {
+ listPtr->selectAnchor += argc;
+ }
+ if (index < listPtr->topIndex) {
+ listPtr->topIndex += argc;
+ }
+ if (index <= listPtr->active) {
+ listPtr->active += argc;
+ if ((listPtr->active >= listPtr->numElements)
+ && (listPtr->numElements > 0)) {
+ listPtr->active = listPtr->numElements-1;
+ }
+ }
+ listPtr->flags |= UPDATE_V_SCROLLBAR;
+ if (listPtr->maxWidth != oldMaxWidth) {
+ listPtr->flags |= UPDATE_H_SCROLLBAR;
+ }
+ ListboxComputeGeometry(listPtr, 0, 0, 0);
+ ListboxRedrawRange(listPtr, index, listPtr->numElements-1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteEls --
+ *
+ * Remove one or more elements from a listbox widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory gets freed, the listbox gets modified and (eventually)
+ * redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteEls(listPtr, first, last)
+ register Listbox *listPtr; /* Listbox widget to modify. */
+ int first; /* Index of first element to delete. */
+ int last; /* Index of last element to delete. */
+{
+ register Element *prevPtr, *elPtr;
+ int count, i, widthChanged;
+
+ /*
+ * Adjust the range to fit within the existing elements of the
+ * listbox, and make sure there's something to delete.
+ */
+
+ if (first < 0) {
+ first = 0;
+ }
+ if (last >= listPtr->numElements) {
+ last = listPtr->numElements-1;
+ }
+ count = last + 1 - first;
+ if (count <= 0) {
+ return;
+ }
+
+ /*
+ * Find the element just before the ones to delete.
+ */
+
+ if (first == 0) {
+ prevPtr = NULL;
+ } else {
+ for (i = first-1, prevPtr = listPtr->firstPtr; i > 0; i--) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ }
+
+ /*
+ * Delete the requested number of elements.
+ */
+
+ widthChanged = 0;
+ for (i = count; i > 0; i--) {
+ if (prevPtr == NULL) {
+ elPtr = listPtr->firstPtr;
+ listPtr->firstPtr = elPtr->nextPtr;
+ if (listPtr->firstPtr == NULL) {
+ listPtr->lastPtr = NULL;
+ }
+ } else {
+ elPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = elPtr->nextPtr;
+ if (prevPtr->nextPtr == NULL) {
+ listPtr->lastPtr = prevPtr;
+ }
+ }
+ if (elPtr->pixelWidth == listPtr->maxWidth) {
+ widthChanged = 1;
+ }
+ if (elPtr->selected) {
+ listPtr->numSelected -= 1;
+ }
+ ckfree((char *) elPtr);
+ }
+ listPtr->numElements -= count;
+
+ /*
+ * Update the selection and viewing information to reflect the change
+ * in the element numbering, and redisplay to slide information up over
+ * the elements that were deleted.
+ */
+
+ if (first <= listPtr->selectAnchor) {
+ listPtr->selectAnchor -= count;
+ if (listPtr->selectAnchor < first) {
+ listPtr->selectAnchor = first;
+ }
+ }
+ if (first <= listPtr->topIndex) {
+ listPtr->topIndex -= count;
+ if (listPtr->topIndex < first) {
+ listPtr->topIndex = first;
+ }
+ }
+ if (listPtr->topIndex > (listPtr->numElements - listPtr->fullLines)) {
+ listPtr->topIndex = listPtr->numElements - listPtr->fullLines;
+ if (listPtr->topIndex < 0) {
+ listPtr->topIndex = 0;
+ }
+ }
+ if (listPtr->active > last) {
+ listPtr->active -= count;
+ } else if (listPtr->active >= first) {
+ listPtr->active = first;
+ if ((listPtr->active >= listPtr->numElements)
+ && (listPtr->numElements > 0)) {
+ listPtr->active = listPtr->numElements-1;
+ }
+ }
+ listPtr->flags |= UPDATE_V_SCROLLBAR;
+ ListboxComputeGeometry(listPtr, 0, widthChanged, 0);
+ if (widthChanged) {
+ listPtr->flags |= UPDATE_H_SCROLLBAR;
+ }
+ ListboxRedrawRange(listPtr, first, listPtr->numElements-1);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ListboxEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on listboxes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ListboxEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ Listbox *listPtr = (Listbox *) clientData;
+
+ if (eventPtr->type == Expose) {
+ ListboxRedrawRange(listPtr,
+ NearestListboxElement(listPtr, eventPtr->xexpose.y),
+ NearestListboxElement(listPtr, eventPtr->xexpose.y
+ + eventPtr->xexpose.height));
+ } else if (eventPtr->type == DestroyNotify) {
+ if (listPtr->tkwin != NULL) {
+ if (listPtr->setGrid) {
+ Tk_UnsetGrid(listPtr->tkwin);
+ }
+ listPtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(listPtr->interp, listPtr->widgetCmd);
+ }
+ if (listPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayListbox, (ClientData) listPtr);
+ }
+ Tcl_EventuallyFree((ClientData) listPtr, DestroyListbox);
+ } else if (eventPtr->type == ConfigureNotify) {
+ int vertSpace;
+
+ vertSpace = Tk_Height(listPtr->tkwin) - 2*listPtr->inset;
+ listPtr->fullLines = vertSpace / listPtr->lineHeight;
+ if ((listPtr->fullLines*listPtr->lineHeight) < vertSpace) {
+ listPtr->partialLine = 1;
+ } else {
+ listPtr->partialLine = 0;
+ }
+ listPtr->flags |= UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR;
+ ChangeListboxView(listPtr, listPtr->topIndex);
+ ChangeListboxOffset(listPtr, listPtr->xOffset);
+
+ /*
+ * Redraw the whole listbox. It's hard to tell what needs
+ * to be redrawn (e.g. if the listbox has shrunk then we
+ * may only need to redraw the borders), so just redraw
+ * everything for safety.
+ */
+
+ ListboxRedrawRange(listPtr, 0, listPtr->numElements-1);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ listPtr->flags |= GOT_FOCUS;
+ ListboxRedrawRange(listPtr, 0, listPtr->numElements-1);
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ listPtr->flags &= ~GOT_FOCUS;
+ ListboxRedrawRange(listPtr, 0, listPtr->numElements-1);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxCmdDeletedProc --
+ *
+ * This procedure is invoked when a widget command is deleted. If
+ * the widget isn't already in the process of being destroyed,
+ * this command destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ListboxCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ Listbox *listPtr = (Listbox *) clientData;
+ Tk_Window tkwin = listPtr->tkwin;
+
+ /*
+ * This procedure could be invoked either because the window was
+ * destroyed and the command was then deleted (in which case tkwin
+ * is NULL) or because the command was deleted, and then this procedure
+ * destroys the widget.
+ */
+
+ if (tkwin != NULL) {
+ if (listPtr->setGrid) {
+ Tk_UnsetGrid(listPtr->tkwin);
+ }
+ listPtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetListboxIndex --
+ *
+ * Parse an index into a listbox and return either its value
+ * or an error.
+ *
+ * Results:
+ * A standard Tcl result. If all went well, then *indexPtr is
+ * filled in with the index (into listPtr) corresponding to
+ * string. Otherwise an error message is left in interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetListboxIndex(interp, listPtr, string, endIsSize, indexPtr)
+ Tcl_Interp *interp; /* For error messages. */
+ Listbox *listPtr; /* Listbox for which the index is being
+ * specified. */
+ char *string; /* Specifies an element in the listbox. */
+ int endIsSize; /* If 1, "end" refers to the number of
+ * entries in the listbox. If 0, "end"
+ * refers to 1 less than the number of
+ * entries. */
+ int *indexPtr; /* Where to store converted index. */
+{
+ int c;
+ size_t length;
+
+ length = strlen(string);
+ c = string[0];
+ if ((c == 'a') && (strncmp(string, "active", length) == 0)
+ && (length >= 2)) {
+ *indexPtr = listPtr->active;
+ } else if ((c == 'a') && (strncmp(string, "anchor", length) == 0)
+ && (length >= 2)) {
+ *indexPtr = listPtr->selectAnchor;
+ } else if ((c == 'e') && (strncmp(string, "end", length) == 0)) {
+ if (endIsSize) {
+ *indexPtr = listPtr->numElements;
+ } else {
+ *indexPtr = listPtr->numElements - 1;
+ }
+ } else if (c == '@') {
+ int y;
+ char *p, *end;
+
+ p = string+1;
+ strtol(p, &end, 0);
+ if ((end == p) || (*end != ',')) {
+ goto badIndex;
+ }
+ p = end+1;
+ y = strtol(p, &end, 0);
+ if ((end == p) || (*end != 0)) {
+ goto badIndex;
+ }
+ *indexPtr = NearestListboxElement(listPtr, y);
+ } else {
+ if (Tcl_GetInt(interp, string, indexPtr) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ goto badIndex;
+ }
+ }
+ return TCL_OK;
+
+ badIndex:
+ Tcl_AppendResult(interp, "bad listbox index \"", string,
+ "\": must be active, anchor, end, @x,y, or a number",
+ (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChangeListboxView --
+ *
+ * Change the view on a listbox widget so that a given element
+ * is displayed at the top.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * What's displayed on the screen is changed. If there is a
+ * scrollbar associated with this widget, then the scrollbar
+ * is instructed to change its display too.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ChangeListboxView(listPtr, index)
+ register Listbox *listPtr; /* Information about widget. */
+ int index; /* Index of element in listPtr
+ * that should now appear at the
+ * top of the listbox. */
+{
+ if (index >= (listPtr->numElements - listPtr->fullLines)) {
+ index = listPtr->numElements - listPtr->fullLines;
+ }
+ if (index < 0) {
+ index = 0;
+ }
+ if (listPtr->topIndex != index) {
+ listPtr->topIndex = index;
+ if (!(listPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayListbox, (ClientData) listPtr);
+ listPtr->flags |= REDRAW_PENDING;
+ }
+ listPtr->flags |= UPDATE_V_SCROLLBAR;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChangListboxOffset --
+ *
+ * Change the horizontal offset for a listbox.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The listbox may be redrawn to reflect its new horizontal
+ * offset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ChangeListboxOffset(listPtr, offset)
+ register Listbox *listPtr; /* Information about widget. */
+ int offset; /* Desired new "xOffset" for
+ * listbox. */
+{
+ int maxOffset;
+
+ /*
+ * Make sure that the new offset is within the allowable range, and
+ * round it off to an even multiple of xScrollUnit.
+ */
+
+ maxOffset = listPtr->maxWidth - (Tk_Width(listPtr->tkwin) -
+ 2*listPtr->inset - 2*listPtr->selBorderWidth)
+ + listPtr->xScrollUnit - 1;
+ if (offset > maxOffset) {
+ offset = maxOffset;
+ }
+ if (offset < 0) {
+ offset = 0;
+ }
+ offset -= offset % listPtr->xScrollUnit;
+ if (offset != listPtr->xOffset) {
+ listPtr->xOffset = offset;
+ listPtr->flags |= UPDATE_H_SCROLLBAR;
+ ListboxRedrawRange(listPtr, 0, listPtr->numElements);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxScanTo --
+ *
+ * Given a point (presumably of the curent mouse location)
+ * drag the view in the window to implement the scan operation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The view in the window may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ListboxScanTo(listPtr, x, y)
+ register Listbox *listPtr; /* Information about widget. */
+ int x; /* X-coordinate to use for scan
+ * operation. */
+ int y; /* Y-coordinate to use for scan
+ * operation. */
+{
+ int newTopIndex, newOffset, maxIndex, maxOffset;
+
+ maxIndex = listPtr->numElements - listPtr->fullLines;
+ maxOffset = listPtr->maxWidth + (listPtr->xScrollUnit - 1)
+ - (Tk_Width(listPtr->tkwin) - 2*listPtr->inset
+ - 2*listPtr->selBorderWidth - listPtr->xScrollUnit);
+
+ /*
+ * Compute new top line for screen by amplifying the difference
+ * between the current position and the place where the scan
+ * started (the "mark" position). If we run off the top or bottom
+ * of the list, then reset the mark point so that the current
+ * position continues to correspond to the edge of the window.
+ * This means that the picture will start dragging as soon as the
+ * mouse reverses direction (without this reset, might have to slide
+ * mouse a long ways back before the picture starts moving again).
+ */
+
+ newTopIndex = listPtr->scanMarkYIndex
+ - (10*(y - listPtr->scanMarkY))/listPtr->lineHeight;
+ if (newTopIndex > maxIndex) {
+ newTopIndex = listPtr->scanMarkYIndex = maxIndex;
+ listPtr->scanMarkY = y;
+ } else if (newTopIndex < 0) {
+ newTopIndex = listPtr->scanMarkYIndex = 0;
+ listPtr->scanMarkY = y;
+ }
+ ChangeListboxView(listPtr, newTopIndex);
+
+ /*
+ * Compute new left edge for display in a similar fashion by amplifying
+ * the difference between the current position and the place where the
+ * scan started.
+ */
+
+ newOffset = listPtr->scanMarkXOffset - (10*(x - listPtr->scanMarkX));
+ if (newOffset > maxOffset) {
+ newOffset = listPtr->scanMarkXOffset = maxOffset;
+ listPtr->scanMarkX = x;
+ } else if (newOffset < 0) {
+ newOffset = listPtr->scanMarkXOffset = 0;
+ listPtr->scanMarkX = x;
+ }
+ ChangeListboxOffset(listPtr, newOffset);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NearestListboxElement --
+ *
+ * Given a y-coordinate inside a listbox, compute the index of
+ * the element under that y-coordinate (or closest to that
+ * y-coordinate).
+ *
+ * Results:
+ * The return value is an index of an element of listPtr. If
+ * listPtr has no elements, then 0 is always returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NearestListboxElement(listPtr, y)
+ register Listbox *listPtr; /* Information about widget. */
+ int y; /* Y-coordinate in listPtr's window. */
+{
+ int index;
+
+ index = (y - listPtr->inset)/listPtr->lineHeight;
+ if (index >= (listPtr->fullLines + listPtr->partialLine)) {
+ index = listPtr->fullLines + listPtr->partialLine - 1;
+ }
+ if (index < 0) {
+ index = 0;
+ }
+ index += listPtr->topIndex;
+ if (index >= listPtr->numElements) {
+ index = listPtr->numElements-1;
+ }
+ return index;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxSelect --
+ *
+ * Select or deselect one or more elements in a listbox..
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All of the elements in the range between first and last are
+ * marked as either selected or deselected, depending on the
+ * "select" argument. Any items whose state changes are redisplayed.
+ * The selection is claimed from X when the number of selected
+ * elements changes from zero to non-zero.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ListboxSelect(listPtr, first, last, select)
+ register Listbox *listPtr; /* Information about widget. */
+ int first; /* Index of first element to
+ * select or deselect. */
+ int last; /* Index of last element to
+ * select or deselect. */
+ int select; /* 1 means select items, 0 means
+ * deselect them. */
+{
+ int i, firstRedisplay, increment, oldCount;
+ Element *elPtr;
+
+ if (last < first) {
+ i = first;
+ first = last;
+ last = i;
+ }
+ if ((last < 0) || (first >= listPtr->numElements)) {
+ return;
+ }
+ if (first < 0) {
+ first = 0;
+ }
+ if (last >= listPtr->numElements) {
+ last = listPtr->numElements - 1;
+ }
+ oldCount = listPtr->numSelected;
+ firstRedisplay = -1;
+ increment = select ? 1 : -1;
+ for (i = 0, elPtr = listPtr->firstPtr; i < first;
+ i++, elPtr = elPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ for ( ; i <= last; i++, elPtr = elPtr->nextPtr) {
+ if (elPtr->selected == select) {
+ continue;
+ }
+ listPtr->numSelected += increment;
+ elPtr->selected = select;
+ if (firstRedisplay < 0) {
+ firstRedisplay = i;
+ }
+ }
+ if (firstRedisplay >= 0) {
+ ListboxRedrawRange(listPtr, first, last);
+ }
+ if ((oldCount == 0) && (listPtr->numSelected > 0)
+ && (listPtr->exportSelection)) {
+ Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY, ListboxLostSelection,
+ (ClientData) listPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxFetchSelection --
+ *
+ * This procedure is called back by Tk when the selection is
+ * requested by someone. It returns part or all of the selection
+ * in a buffer provided by the caller.
+ *
+ * Results:
+ * The return value is the number of non-NULL bytes stored
+ * at buffer. Buffer is filled (or partially filled) with a
+ * NULL-terminated string containing part or all of the selection,
+ * as given by offset and maxBytes. The selection is returned
+ * as a Tcl list with one list element for each element in the
+ * listbox.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ListboxFetchSelection(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Information about listbox widget. */
+ int offset; /* Offset within selection of first
+ * byte to be returned. */
+ char *buffer; /* Location in which to place
+ * selection. */
+ int maxBytes; /* Maximum number of bytes to place
+ * at buffer, not including terminating
+ * NULL character. */
+{
+ register Listbox *listPtr = (Listbox *) clientData;
+ register Element *elPtr;
+ Tcl_DString selection;
+ int length, count, needNewline;
+
+ if (!listPtr->exportSelection) {
+ return -1;
+ }
+
+ /*
+ * Use a dynamic string to accumulate the contents of the selection.
+ */
+
+ needNewline = 0;
+ Tcl_DStringInit(&selection);
+ for (elPtr = listPtr->firstPtr; elPtr != NULL; elPtr = elPtr->nextPtr) {
+ if (elPtr->selected) {
+ if (needNewline) {
+ Tcl_DStringAppend(&selection, "\n", 1);
+ }
+ Tcl_DStringAppend(&selection, elPtr->text, elPtr->textLength);
+ needNewline = 1;
+ }
+ }
+
+ length = Tcl_DStringLength(&selection);
+ if (length == 0) {
+ return -1;
+ }
+
+ /*
+ * Copy the requested portion of the selection to the buffer.
+ */
+
+ count = length - offset;
+ if (count <= 0) {
+ count = 0;
+ } else {
+ if (count > maxBytes) {
+ count = maxBytes;
+ }
+ memcpy((VOID *) buffer,
+ (VOID *) (Tcl_DStringValue(&selection) + offset),
+ (size_t) count);
+ }
+ buffer[count] = '\0';
+ Tcl_DStringFree(&selection);
+ return count;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxLostSelection --
+ *
+ * This procedure is called back by Tk when the selection is
+ * grabbed away from a listbox widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The existing selection is unhighlighted, and the window is
+ * marked as not containing a selection.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ListboxLostSelection(clientData)
+ ClientData clientData; /* Information about listbox widget. */
+{
+ register Listbox *listPtr = (Listbox *) clientData;
+
+ if ((listPtr->exportSelection) && (listPtr->numElements > 0)) {
+ ListboxSelect(listPtr, 0, listPtr->numElements-1, 0);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxRedrawRange --
+ *
+ * Ensure that a given range of elements is eventually redrawn on
+ * the display (if those elements in fact appear on the display).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ListboxRedrawRange(listPtr, first, last)
+ register Listbox *listPtr; /* Information about widget. */
+ int first; /* Index of first element in list
+ * that needs to be redrawn. */
+ int last; /* Index of last element in list
+ * that needs to be redrawn. May
+ * be less than first;
+ * these just bracket a range. */
+{
+ if ((listPtr->tkwin == NULL) || !Tk_IsMapped(listPtr->tkwin)
+ || (listPtr->flags & REDRAW_PENDING)) {
+ return;
+ }
+ Tcl_DoWhenIdle(DisplayListbox, (ClientData) listPtr);
+ listPtr->flags |= REDRAW_PENDING;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxUpdateVScrollbar --
+ *
+ * This procedure is invoked whenever information has changed in
+ * a listbox in a way that would invalidate a vertical scrollbar
+ * display. If there is an associated scrollbar, then this command
+ * updates it by invoking a Tcl command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A Tcl command is invoked, and an additional command may be
+ * invoked to process errors in the command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ListboxUpdateVScrollbar(listPtr)
+ register Listbox *listPtr; /* Information about widget. */
+{
+ char string[100];
+ double first, last;
+ int result;
+ Tcl_Interp *interp;
+
+ if (listPtr->yScrollCmd == NULL) {
+ return;
+ }
+ if (listPtr->numElements == 0) {
+ first = 0.0;
+ last = 1.0;
+ } else {
+ first = listPtr->topIndex/((double) listPtr->numElements);
+ last = (listPtr->topIndex+listPtr->fullLines)
+ /((double) listPtr->numElements);
+ if (last > 1.0) {
+ last = 1.0;
+ }
+ }
+ sprintf(string, " %g %g", first, last);
+
+ /*
+ * We must hold onto the interpreter from the listPtr because the data
+ * at listPtr might be freed as a result of the Tcl_VarEval.
+ */
+
+ interp = listPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ result = Tcl_VarEval(interp, listPtr->yScrollCmd, string,
+ (char *) NULL);
+ if (result != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (vertical scrolling command executed by listbox)");
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_Release((ClientData) interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxUpdateHScrollbar --
+ *
+ * This procedure is invoked whenever information has changed in
+ * a listbox in a way that would invalidate a horizontal scrollbar
+ * display. If there is an associated horizontal scrollbar, then
+ * this command updates it by invoking a Tcl command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A Tcl command is invoked, and an additional command may be
+ * invoked to process errors in the command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ListboxUpdateHScrollbar(listPtr)
+ register Listbox *listPtr; /* Information about widget. */
+{
+ char string[60];
+ int result, windowWidth;
+ double first, last;
+ Tcl_Interp *interp;
+
+ if (listPtr->xScrollCmd == NULL) {
+ return;
+ }
+ windowWidth = Tk_Width(listPtr->tkwin) - 2*(listPtr->inset
+ + listPtr->selBorderWidth);
+ if (listPtr->maxWidth == 0) {
+ first = 0;
+ last = 1.0;
+ } else {
+ first = listPtr->xOffset/((double) listPtr->maxWidth);
+ last = (listPtr->xOffset + windowWidth)
+ /((double) listPtr->maxWidth);
+ if (last > 1.0) {
+ last = 1.0;
+ }
+ }
+ sprintf(string, " %g %g", first, last);
+
+ /*
+ * We must hold onto the interpreter because the data referred to at
+ * listPtr might be freed as a result of the call to Tcl_VarEval.
+ */
+
+ interp = listPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ result = Tcl_VarEval(interp, listPtr->xScrollCmd, string,
+ (char *) NULL);
+ if (result != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (horizontal scrolling command executed by listbox)");
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_Release((ClientData) interp);
+}
diff --git a/generic/tkMacWinMenu.c b/generic/tkMacWinMenu.c
new file mode 100644
index 0000000..8ae403b
--- /dev/null
+++ b/generic/tkMacWinMenu.c
@@ -0,0 +1,134 @@
+/*
+ * tkMacWinMenu.c --
+ *
+ * This module implements the common elements of the Mac and Windows
+ * specific features of menus. This file is not used for UNIX.
+ *
+ * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkMacWinMenu.c 1.39 97/04/09 14:56:59
+ */
+
+#include "tkMenu.h"
+
+static int postCommandGeneration;
+
+static int PreprocessMenu _ANSI_ARGS_((TkMenu *menuPtr));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PreprocessMenu --
+ *
+ * The guts of the preprocessing. Recursive.
+ *
+ * Results:
+ * The return value is a standard Tcl result (errors can occur
+ * while the postcommands are being processed).
+ *
+ * Side effects:
+ * Since commands can get executed while this routine is being executed,
+ * the entire world can change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PreprocessMenu(menuPtr)
+ TkMenu *menuPtr;
+{
+ int index, result, finished;
+ TkMenu *cascadeMenuPtr;
+
+ Tcl_Preserve((ClientData) menuPtr);
+
+ /*
+ * First, let's process the post command on ourselves. If this command
+ * destroys this menu, or if there was an error, we are done.
+ */
+
+ result = TkPostCommand(menuPtr);
+ if ((result != TCL_OK) || (menuPtr->tkwin == NULL)) {
+ goto done;
+ }
+
+ /*
+ * Now, we go through structure and process all of the commands.
+ * Since the structure is changing, we stop after we do one command,
+ * and start over. When we get through without doing any, we are done.
+ */
+
+
+ do {
+ finished = 1;
+ for (index = 0; index < menuPtr->numEntries; index++) {
+ if ((menuPtr->entries[index]->type == CASCADE_ENTRY)
+ && (menuPtr->entries[index]->name != NULL)) {
+ if ((menuPtr->entries[index]->childMenuRefPtr != NULL)
+ && (menuPtr->entries[index]->childMenuRefPtr->menuPtr
+ != NULL)) {
+ cascadeMenuPtr =
+ menuPtr->entries[index]->childMenuRefPtr->menuPtr;
+ if (cascadeMenuPtr->postCommandGeneration !=
+ postCommandGeneration) {
+ cascadeMenuPtr->postCommandGeneration =
+ postCommandGeneration;
+ result = PreprocessMenu(cascadeMenuPtr);
+ if (result != TCL_OK) {
+ goto done;
+ }
+ finished = 0;
+ break;
+ }
+ }
+ }
+ }
+ } while (!finished);
+
+ done:
+ Tcl_Release((ClientData)menuPtr);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPreprocessMenu --
+ *
+ * On the Mac and on Windows, all of the postcommand processing has
+ * to be done on the entire tree underneath the main window to be
+ * posted. This means that we have to traverse the menu tree and
+ * issue the postcommands for all of the menus that have cascades
+ * attached. Since the postcommands can change the menu structure while
+ * we are traversing, we have to be extremely careful. Basically, the
+ * idea is to traverse the structure until we succesfully process
+ * one postcommand. Then we start over, and do it again until
+ * we traverse the whole structure without processing any postcommands.
+ *
+ * We are also going to set up the cascade back pointers in here
+ * since we have to traverse the entire structure underneath the menu
+ * anyway, We can clear the postcommand marks while we do that.
+ *
+ * Results:
+ * The return value is a standard Tcl result (errors can occur
+ * while the postcommands are being processed).
+ *
+ * Side effects:
+ * Since commands can get executed while this routine is being executed,
+ * the entire world can change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkPreprocessMenu(menuPtr)
+ TkMenu *menuPtr;
+{
+ postCommandGeneration++;
+ menuPtr->postCommandGeneration = postCommandGeneration;
+ return PreprocessMenu(menuPtr);
+}
diff --git a/generic/tkMain.c b/generic/tkMain.c
new file mode 100644
index 0000000..ed823bd
--- /dev/null
+++ b/generic/tkMain.c
@@ -0,0 +1,390 @@
+/*
+ * tkMain.c --
+ *
+ * This file contains a generic main program for Tk-based applications.
+ * It can be used as-is for many applications, just by supplying a
+ * different appInitProc procedure for each specific application.
+ * Or, it can be used as a template for creating new main programs
+ * for Tk applications.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkMain.c 1.154 97/08/29 10:40:43
+ */
+
+#include <ctype.h>
+#include <stdio.h>
+#include <string.h>
+#include <tcl.h>
+#include <tk.h>
+#ifdef NO_STDLIB_H
+# include "../compat/stdlib.h"
+#else
+# include <stdlib.h>
+#endif
+
+/*
+ * Declarations for various library procedures and variables (don't want
+ * to include tkInt.h or tkPort.h here, because people might copy this
+ * file out of the Tk source directory to make their own modified versions).
+ * Note: don't declare "exit" here even though a declaration is really
+ * needed, because it will conflict with a declaration elsewhere on
+ * some systems.
+ */
+
+extern int isatty _ANSI_ARGS_((int fd));
+#if !defined(__WIN32__) && !defined(_WIN32)
+extern char * strrchr _ANSI_ARGS_((CONST char *string, int c));
+#endif
+extern void TkpDisplayWarning _ANSI_ARGS_((char *msg,
+ char *title));
+
+/*
+ * Global variables used by the main program:
+ */
+
+static Tcl_Interp *interp; /* Interpreter for this application. */
+static Tcl_DString command; /* Used to assemble lines of terminal input
+ * into Tcl commands. */
+static Tcl_DString line; /* Used to read the next line from the
+ * terminal input. */
+static int tty; /* Non-zero means standard input is a
+ * terminal-like device. Zero means it's
+ * a file. */
+
+/*
+ * Forward declarations for procedures defined later in this file.
+ */
+
+static void Prompt _ANSI_ARGS_((Tcl_Interp *interp, int partial));
+static void StdinProc _ANSI_ARGS_((ClientData clientData,
+ int mask));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Main --
+ *
+ * Main program for Wish and most other Tk-based applications.
+ *
+ * Results:
+ * None. This procedure never returns (it exits the process when
+ * it's done.
+ *
+ * Side effects:
+ * This procedure initializes the Tk world and then starts
+ * interpreting commands; almost anything could happen, depending
+ * on the script being interpreted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_Main(argc, argv, appInitProc)
+ int argc; /* Number of arguments. */
+ char **argv; /* Array of argument strings. */
+ Tcl_AppInitProc *appInitProc; /* Application-specific initialization
+ * procedure to call after most
+ * initialization but before starting
+ * to execute commands. */
+{
+ char *args, *fileName;
+ char buf[20];
+ int code;
+ size_t length;
+ Tcl_Channel inChannel, outChannel;
+
+ Tcl_FindExecutable(argv[0]);
+ interp = Tcl_CreateInterp();
+#ifdef TCL_MEM_DEBUG
+ Tcl_InitMemory(interp);
+#endif
+
+ /*
+ * Parse command-line arguments. A leading "-file" argument is
+ * ignored (a historical relic from the distant past). If the
+ * next argument doesn't start with a "-" then strip it off and
+ * use it as the name of a script file to process.
+ */
+
+ fileName = NULL;
+ if (argc > 1) {
+ length = strlen(argv[1]);
+ if ((length >= 2) && (strncmp(argv[1], "-file", length) == 0)) {
+ argc--;
+ argv++;
+ }
+ }
+ if ((argc > 1) && (argv[1][0] != '-')) {
+ fileName = argv[1];
+ argc--;
+ argv++;
+ }
+
+ /*
+ * Make command-line arguments available in the Tcl variables "argc"
+ * and "argv".
+ */
+
+ args = Tcl_Merge(argc-1, argv+1);
+ Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
+ ckfree(args);
+ sprintf(buf, "%d", argc-1);
+ Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
+ TCL_GLOBAL_ONLY);
+
+ /*
+ * Set the "tcl_interactive" variable.
+ */
+
+ /*
+ * For now, under Windows, we assume we are not running as a console mode
+ * app, so we need to use the GUI console. In order to enable this, we
+ * always claim to be running on a tty. This probably isn't the right
+ * way to do it.
+ */
+
+#ifdef __WIN32__
+ tty = 1;
+#else
+ tty = isatty(0);
+#endif
+ Tcl_SetVar(interp, "tcl_interactive",
+ ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
+
+ /*
+ * Invoke application-specific initialization.
+ */
+
+ if ((*appInitProc)(interp) != TCL_OK) {
+ TkpDisplayWarning(interp->result, "Application initialization failed");
+ }
+
+ /*
+ * Invoke the script specified on the command line, if any.
+ */
+
+ if (fileName != NULL) {
+ code = Tcl_EvalFile(interp, fileName);
+ if (code != TCL_OK) {
+ /*
+ * The following statement guarantees that the errorInfo
+ * variable is set properly.
+ */
+
+ Tcl_AddErrorInfo(interp, "");
+ TkpDisplayWarning(Tcl_GetVar(interp, "errorInfo",
+ TCL_GLOBAL_ONLY), "Error in startup script");
+ Tcl_DeleteInterp(interp);
+ Tcl_Exit(1);
+ }
+ tty = 0;
+ } else {
+
+ /*
+ * Evaluate the .rc file, if one has been specified.
+ */
+
+ Tcl_SourceRCFile(interp);
+
+ /*
+ * Establish a channel handler for stdin.
+ */
+
+ inChannel = Tcl_GetStdChannel(TCL_STDIN);
+ if (inChannel) {
+ Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
+ (ClientData) inChannel);
+ }
+ if (tty) {
+ Prompt(interp, 0);
+ }
+ }
+
+ outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+ if (outChannel) {
+ Tcl_Flush(outChannel);
+ }
+ Tcl_DStringInit(&command);
+ Tcl_DStringInit(&line);
+ Tcl_ResetResult(interp);
+
+ /*
+ * Loop infinitely, waiting for commands to execute. When there
+ * are no windows left, Tk_MainLoop returns and we exit.
+ */
+
+ Tk_MainLoop();
+ Tcl_DeleteInterp(interp);
+ Tcl_Exit(0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StdinProc --
+ *
+ * This procedure is invoked by the event dispatcher whenever
+ * standard input becomes readable. It grabs the next line of
+ * input characters, adds them to a command being assembled, and
+ * executes the command if it's complete.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Could be almost arbitrary, depending on the command that's
+ * typed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+StdinProc(clientData, mask)
+ ClientData clientData; /* Not used. */
+ int mask; /* Not used. */
+{
+ static int gotPartial = 0;
+ char *cmd;
+ int code, count;
+ Tcl_Channel chan = (Tcl_Channel) clientData;
+
+ count = Tcl_Gets(chan, &line);
+
+ if (count < 0) {
+ if (!gotPartial) {
+ if (tty) {
+ Tcl_Exit(0);
+ } else {
+ Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
+ }
+ return;
+ }
+ }
+
+ (void) Tcl_DStringAppend(&command, Tcl_DStringValue(&line), -1);
+ cmd = Tcl_DStringAppend(&command, "\n", -1);
+ Tcl_DStringFree(&line);
+ if (!Tcl_CommandComplete(cmd)) {
+ gotPartial = 1;
+ goto prompt;
+ }
+ gotPartial = 0;
+
+ /*
+ * Disable the stdin channel handler while evaluating the command;
+ * otherwise if the command re-enters the event loop we might
+ * process commands from stdin before the current command is
+ * finished. Among other things, this will trash the text of the
+ * command being evaluated.
+ */
+
+ Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan);
+ code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
+
+ chan = Tcl_GetStdChannel(TCL_STDIN);
+ if (chan) {
+ Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
+ (ClientData) chan);
+ }
+ Tcl_DStringFree(&command);
+ if (*interp->result != 0) {
+ if ((code != TCL_OK) || (tty)) {
+ /*
+ * The statement below used to call "printf", but that resulted
+ * in core dumps under Solaris 2.3 if the result was very long.
+ *
+ * NOTE: This probably will not work under Windows either.
+ */
+
+ puts(interp->result);
+ }
+ }
+
+ /*
+ * Output a prompt.
+ */
+
+ prompt:
+ if (tty) {
+ Prompt(interp, gotPartial);
+ }
+ Tcl_ResetResult(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Prompt --
+ *
+ * Issue a prompt on standard output, or invoke a script
+ * to issue the prompt.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A prompt gets output, and a Tcl script may be evaluated
+ * in interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+Prompt(interp, partial)
+ Tcl_Interp *interp; /* Interpreter to use for prompting. */
+ int partial; /* Non-zero means there already
+ * exists a partial command, so use
+ * the secondary prompt. */
+{
+ char *promptCmd;
+ int code;
+ Tcl_Channel outChannel, errChannel;
+
+ promptCmd = Tcl_GetVar(interp,
+ partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY);
+ if (promptCmd == NULL) {
+defaultPrompt:
+ if (!partial) {
+
+ /*
+ * We must check that outChannel is a real channel - it
+ * is possible that someone has transferred stdout out of
+ * this interpreter with "interp transfer".
+ */
+
+ outChannel = Tcl_GetChannel(interp, "stdout", NULL);
+ if (outChannel != (Tcl_Channel) NULL) {
+ Tcl_Write(outChannel, "% ", 2);
+ }
+ }
+ } else {
+ code = Tcl_Eval(interp, promptCmd);
+ if (code != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (script that generates prompt)");
+ /*
+ * We must check that errChannel is a real channel - it
+ * is possible that someone has transferred stderr out of
+ * this interpreter with "interp transfer".
+ */
+
+ errChannel = Tcl_GetChannel(interp, "stderr", NULL);
+ if (errChannel != (Tcl_Channel) NULL) {
+ Tcl_Write(errChannel, interp->result, -1);
+ Tcl_Write(errChannel, "\n", 1);
+ }
+ goto defaultPrompt;
+ }
+ }
+ outChannel = Tcl_GetChannel(interp, "stdout", NULL);
+ if (outChannel != (Tcl_Channel) NULL) {
+ Tcl_Flush(outChannel);
+ }
+}
diff --git a/generic/tkMenu.c b/generic/tkMenu.c
new file mode 100644
index 0000000..05a6b4a
--- /dev/null
+++ b/generic/tkMenu.c
@@ -0,0 +1,3057 @@
+/*
+ * tkMenu.c --
+ *
+ * This file contains most of the code for implementing menus in Tk. It takes
+ * care of all of the generic (platform-independent) parts of menus, and
+ * is supplemented by platform-specific files. The geometry calculation
+ * and drawing code for menus is in the file tkMenuDraw.c
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkMenu.c 1.148 97/10/29 09:22:00
+ */
+
+/*
+ * Notes on implementation of menus:
+ *
+ * Menus can be used in three ways:
+ * - as a popup menu, either as part of a menubutton or standalone.
+ * - as a menubar. The menu's cascade items are arranged according to
+ * the specific platform to provide the user access to the menus at all
+ * times
+ * - as a tearoff palette. This is a window with the menu's items in it.
+ *
+ * The goal is to provide the Tk developer with a way to use a common
+ * set of menus for all of these tasks.
+ *
+ * In order to make the bindings for cascade menus work properly under Unix,
+ * the cascade menus' pathnames must be proper children of the menu that
+ * they are cascade from. So if there is a menu .m, and it has two
+ * cascades labelled "File" and "Edit", the cascade menus might have
+ * the pathnames .m.file and .m.edit. Another constraint is that the menus
+ * used for menubars must be children of the toplevel widget that they
+ * are attached to. And on the Macintosh, the platform specific menu handle
+ * for cascades attached to a menu bar must have a title that matches the
+ * label for the cascade menu.
+ *
+ * To handle all of the constraints, Tk menubars and tearoff menus are
+ * implemented using menu clones. Menu clones are full menus in their own
+ * right; they have a Tk window and pathname associated with them; they have
+ * a TkMenu structure and array of entries. However, they are linked with the
+ * original menu that they were cloned from. The reflect the attributes of
+ * the original, or "master", menu. So if an item is added to a menu, and
+ * that menu has clones, then the item must be added to all of its clones
+ * also. Menus are cloned when a menu is torn-off or when a menu is assigned
+ * as a menubar using the "-menu" option of the toplevel's pathname configure
+ * subcommand. When a clone is destroyed, only the clone is destroyed, but
+ * when the master menu is destroyed, all clones are also destroyed. This
+ * allows the developer to just deal with one set of menus when creating
+ * and destroying.
+ *
+ * Clones are rather tricky when a menu with cascade entries is cloned (such
+ * as a menubar). Not only does the menu have to be cloned, but each cascade
+ * entry's corresponding menu must also be cloned. This maintains the pathname
+ * parent-child hierarchy necessary for menubars and toplevels to work.
+ * This leads to several special cases:
+ *
+ * 1. When a new menu is created, and it is pointed to by cascade entries in
+ * cloned menus, the new menu has to be cloned to parallel the cascade
+ * structure.
+ * 2. When a cascade item is added to a menu that has been cloned, and the
+ * menu that the cascade item points to exists, that menu has to be cloned.
+ * 3. When the menu that a cascade entry points to is changed, the old
+ * cloned cascade menu has to be discarded, and the new one has to be cloned.
+ *
+ */
+
+#include "tkPort.h"
+#include "tkMenu.h"
+
+#define MENU_HASH_KEY "tkMenus"
+
+static int menusInitialized; /* Whether or not the hash tables, etc., have
+ * been setup */
+
+/*
+ * Configuration specs for individual menu entries. If this changes, be sure
+ * to update code in TkpMenuInit that changes the font string entry.
+ */
+
+Tk_ConfigSpec tkMenuEntryConfigSpecs[] = {
+ {TK_CONFIG_BORDER, "-activebackground", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_ACTIVE_BG, Tk_Offset(TkMenuEntry, activeBorder),
+ COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
+ |TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-activeforeground", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_ACTIVE_FG, Tk_Offset(TkMenuEntry, activeFg),
+ COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
+ |TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-accelerator", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_ACCELERATOR, Tk_Offset(TkMenuEntry, accel),
+ COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
+ |TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BORDER, "-background", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_BG, Tk_Offset(TkMenuEntry, border),
+ COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
+ |SEPARATOR_MASK|TEAROFF_MASK|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-bitmap", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_BITMAP, Tk_Offset(TkMenuEntry, bitmap),
+ COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
+ |TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BOOLEAN, "-columnbreak", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_COLUMN_BREAK, Tk_Offset(TkMenuEntry, columnBreak),
+ COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK},
+ {TK_CONFIG_STRING, "-command", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_COMMAND, Tk_Offset(TkMenuEntry, command),
+ COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
+ |TK_CONFIG_NULL_OK},
+ {TK_CONFIG_FONT, "-font", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_FONT, Tk_Offset(TkMenuEntry, tkfont),
+ COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
+ |TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-foreground", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_FG, Tk_Offset(TkMenuEntry, fg),
+ COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
+ |TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BOOLEAN, "-hidemargin", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_HIDE_MARGIN, Tk_Offset(TkMenuEntry, hideMargin),
+ COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
+ |SEPARATOR_MASK|TEAROFF_MASK},
+ {TK_CONFIG_STRING, "-image", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_IMAGE, Tk_Offset(TkMenuEntry, imageString),
+ COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
+ |TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_INDICATOR, Tk_Offset(TkMenuEntry, indicatorOn),
+ CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_STRING, "-label", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_LABEL, Tk_Offset(TkMenuEntry, label),
+ COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK},
+ {TK_CONFIG_STRING, "-menu", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_MENU, Tk_Offset(TkMenuEntry, name),
+ CASCADE_MASK|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-offvalue", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_OFF_VALUE, Tk_Offset(TkMenuEntry, offValue),
+ CHECK_BUTTON_MASK},
+ {TK_CONFIG_STRING, "-onvalue", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_ON_VALUE, Tk_Offset(TkMenuEntry, onValue),
+ CHECK_BUTTON_MASK},
+ {TK_CONFIG_COLOR, "-selectcolor", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_SELECT, Tk_Offset(TkMenuEntry, indicatorFg),
+ CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-selectimage", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_SELECT_IMAGE, Tk_Offset(TkMenuEntry, selectImageString),
+ CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_UID, "-state", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_STATE, Tk_Offset(TkMenuEntry, state),
+ COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
+ |TEAROFF_MASK|TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_STRING, "-value", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_VALUE, Tk_Offset(TkMenuEntry, onValue),
+ RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-variable", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_CHECK_VARIABLE, Tk_Offset(TkMenuEntry, name),
+ CHECK_BUTTON_MASK|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-variable", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_RADIO_VARIABLE, Tk_Offset(TkMenuEntry, name),
+ RADIO_BUTTON_MASK},
+ {TK_CONFIG_INT, "-underline", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_UNDERLINE, Tk_Offset(TkMenuEntry, underline),
+ COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
+ |TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Configuration specs valid for the menu as a whole. If this changes, be sure
+ * to update code in TkpMenuInit that changes the font string entry.
+ */
+
+Tk_ConfigSpec tkMenuConfigSpecs[] = {
+ {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_MENU_ACTIVE_BG_COLOR, Tk_Offset(TkMenu, activeBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_MENU_ACTIVE_BG_MONO, Tk_Offset(TkMenu, activeBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_PIXELS, "-activeborderwidth", "activeBorderWidth",
+ "BorderWidth", DEF_MENU_ACTIVE_BORDER_WIDTH,
+ Tk_Offset(TkMenu, activeBorderWidth), 0},
+ {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",
+ DEF_MENU_ACTIVE_FG_COLOR, Tk_Offset(TkMenu, activeFg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",
+ DEF_MENU_ACTIVE_FG_MONO, Tk_Offset(TkMenu, activeFg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_MENU_BG_COLOR, Tk_Offset(TkMenu, border), TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_MENU_BG_MONO, Tk_Offset(TkMenu, border), TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_MENU_BORDER_WIDTH, Tk_Offset(TkMenu, borderWidth), 0},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_MENU_CURSOR, Tk_Offset(TkMenu, cursor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_MENU_DISABLED_FG_COLOR,
+ Tk_Offset(TkMenu, disabledFg), TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_MENU_DISABLED_FG_MONO,
+ Tk_Offset(TkMenu, disabledFg), TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_FONT, "-font", "font", "Font",
+ DEF_MENU_FONT, Tk_Offset(TkMenu, tkfont), 0},
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_MENU_FG, Tk_Offset(TkMenu, fg), 0},
+ {TK_CONFIG_STRING, "-postcommand", "postCommand", "Command",
+ DEF_MENU_POST_COMMAND, Tk_Offset(TkMenu, postCommand),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_MENU_RELIEF, Tk_Offset(TkMenu, relief), 0},
+ {TK_CONFIG_COLOR, "-selectcolor", "selectColor", "Background",
+ DEF_MENU_SELECT_COLOR, Tk_Offset(TkMenu, indicatorFg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR, "-selectcolor", "selectColor", "Background",
+ DEF_MENU_SELECT_MONO, Tk_Offset(TkMenu, indicatorFg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_MENU_TAKE_FOCUS, Tk_Offset(TkMenu, takeFocus), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BOOLEAN, "-tearoff", "tearOff", "TearOff",
+ DEF_MENU_TEAROFF, Tk_Offset(TkMenu, tearOff), 0},
+ {TK_CONFIG_STRING, "-tearoffcommand", "tearOffCommand", "TearOffCommand",
+ DEF_MENU_TEAROFF_CMD, Tk_Offset(TkMenu, tearOffCommand),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-title", "title", "Title",
+ DEF_MENU_TITLE, Tk_Offset(TkMenu, title), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-type", "type", "Type",
+ DEF_MENU_TYPE, Tk_Offset(TkMenu, menuTypeName), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Prototypes for static procedures in this file:
+ */
+
+static int CloneMenu _ANSI_ARGS_((TkMenu *menuPtr,
+ char *newMenuName, char *newMenuTypeString));
+static int ConfigureMenu _ANSI_ARGS_((Tcl_Interp *interp,
+ TkMenu *menuPtr, int argc, char **argv,
+ int flags));
+static int ConfigureMenuCloneEntries _ANSI_ARGS_((
+ Tcl_Interp *interp, TkMenu *menuPtr, int index,
+ int argc, char **argv, int flags));
+static int ConfigureMenuEntry _ANSI_ARGS_((TkMenuEntry *mePtr,
+ int argc, char **argv, int flags));
+static void DeleteMenuCloneEntries _ANSI_ARGS_((TkMenu *menuPtr,
+ int first, int last));
+static void DestroyMenuHashTable _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp));
+static void DestroyMenuInstance _ANSI_ARGS_((TkMenu *menuPtr));
+static void DestroyMenuEntry _ANSI_ARGS_((char *memPtr));
+static int GetIndexFromCoords
+ _ANSI_ARGS_((Tcl_Interp *interp, TkMenu *menuPtr,
+ char *string, int *indexPtr));
+static int MenuDoYPosition _ANSI_ARGS_((Tcl_Interp *interp,
+ TkMenu *menuPtr, char *arg));
+static int MenuAddOrInsert _ANSI_ARGS_((Tcl_Interp *interp,
+ TkMenu *menuPtr, char *indexString, int argc,
+ char **argv));
+static void MenuCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static TkMenuEntry * MenuNewEntry _ANSI_ARGS_((TkMenu *menuPtr, int index,
+ int type));
+static char * MenuVarProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, char *name1, char *name2,
+ int flags));
+static int MenuWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void MenuWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+static void RecursivelyDeleteMenu _ANSI_ARGS_((TkMenu *menuPtr));
+static void UnhookCascadeEntry _ANSI_ARGS_((TkMenuEntry *mePtr));
+
+/*
+ * The structure below is a list of procs that respond to certain window
+ * manager events. One of these includes a font change, which forces
+ * the geometry proc to be called.
+ */
+
+static TkClassProcs menuClass = {
+ NULL, /* createProc. */
+ MenuWorldChanged /* geometryProc. */
+};
+
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_MenuCmd --
+ *
+ * This procedure is invoked to process the "menu" Tcl
+ * command. See the user documentation for details on
+ * what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_MenuCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ Tk_Window new;
+ register TkMenu *menuPtr;
+ TkMenuReferences *menuRefPtr;
+ int i, len;
+ char *arg, c;
+ int toplevel;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " pathName ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ TkMenuInit();
+
+ toplevel = 1;
+ for (i = 2; i < argc; i += 2) {
+ arg = argv[i];
+ len = strlen(arg);
+ if (len < 2) {
+ continue;
+ }
+ c = arg[1];
+ if ((c == 't') && (strncmp(arg, "-type", strlen(arg)) == 0)
+ && (len >= 3)) {
+ if (strcmp(argv[i + 1], "menubar") == 0) {
+ toplevel = 0;
+ }
+ break;
+ }
+ }
+
+ new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], toplevel ? ""
+ : NULL);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Initialize the data structure for the menu.
+ */
+
+ menuPtr = (TkMenu *) ckalloc(sizeof(TkMenu));
+ menuPtr->tkwin = new;
+ menuPtr->display = Tk_Display(new);
+ menuPtr->interp = interp;
+ menuPtr->widgetCmd = Tcl_CreateCommand(interp,
+ Tk_PathName(menuPtr->tkwin), MenuWidgetCmd,
+ (ClientData) menuPtr, MenuCmdDeletedProc);
+ menuPtr->entries = NULL;
+ menuPtr->numEntries = 0;
+ menuPtr->active = -1;
+ menuPtr->border = NULL;
+ menuPtr->borderWidth = 0;
+ menuPtr->relief = TK_RELIEF_FLAT;
+ menuPtr->activeBorder = NULL;
+ menuPtr->activeBorderWidth = 0;
+ menuPtr->tkfont = NULL;
+ menuPtr->fg = NULL;
+ menuPtr->disabledFg = NULL;
+ menuPtr->activeFg = NULL;
+ menuPtr->indicatorFg = NULL;
+ menuPtr->tearOff = 1;
+ menuPtr->tearOffCommand = NULL;
+ menuPtr->cursor = None;
+ menuPtr->takeFocus = NULL;
+ menuPtr->postCommand = NULL;
+ menuPtr->postCommandGeneration = 0;
+ menuPtr->postedCascade = NULL;
+ menuPtr->nextInstancePtr = NULL;
+ menuPtr->masterMenuPtr = menuPtr;
+ menuPtr->menuType = UNKNOWN_TYPE;
+ menuPtr->menuFlags = 0;
+ menuPtr->parentTopLevelPtr = NULL;
+ menuPtr->menuTypeName = NULL;
+ menuPtr->title = NULL;
+ TkMenuInitializeDrawingFields(menuPtr);
+
+ menuRefPtr = TkCreateMenuReferences(menuPtr->interp,
+ Tk_PathName(menuPtr->tkwin));
+ menuRefPtr->menuPtr = menuPtr;
+ menuPtr->menuRefPtr = menuRefPtr;
+ if (TCL_OK != TkpNewMenu(menuPtr)) {
+ goto error;
+ }
+
+ Tk_SetClass(menuPtr->tkwin, "Menu");
+ TkSetClassProcs(menuPtr->tkwin, &menuClass, (ClientData) menuPtr);
+ Tk_CreateEventHandler(new, ExposureMask|StructureNotifyMask|ActivateMask,
+ TkMenuEventProc, (ClientData) menuPtr);
+ if (ConfigureMenu(interp, menuPtr, argc-2, argv+2, 0) != TCL_OK) {
+ goto error;
+ }
+
+ /*
+ * If a menu has a parent menu pointing to it as a cascade entry, the
+ * parent menu needs to be told that this menu now exists so that
+ * the platform-part of the menu is correctly updated.
+ *
+ * If a menu has an instance and has cascade entries, then each cascade
+ * menu must also have a parallel instance. This is especially true on
+ * the Mac, where each menu has to have a separate title everytime it is in
+ * a menubar. For instance, say you have a menu .m1 with a cascade entry
+ * for .m2, where .m2 does not exist yet. You then put .m1 into a menubar.
+ * This creates a menubar instance for .m1, but since .m2 is not there,
+ * nothing else happens. When we go to create .m2, we hook it up properly
+ * with .m1. However, we now need to clone .m2 and assign the clone of .m2
+ * to be the cascade entry for the clone of .m1. This is special case
+ * #1 listed in the introductory comment.
+ */
+
+ if (menuRefPtr->parentEntryPtr != NULL) {
+ TkMenuEntry *cascadeListPtr = menuRefPtr->parentEntryPtr;
+ TkMenuEntry *nextCascadePtr;
+ char *newMenuName;
+ char *newArgv[2];
+
+ while (cascadeListPtr != NULL) {
+
+ nextCascadePtr = cascadeListPtr->nextCascadePtr;
+
+ /*
+ * If we have a new master menu, and an existing cloned menu
+ * points to this menu in a cascade entry, we have to clone
+ * the new menu and point the entry to the clone instead
+ * of the menu we are creating. Otherwise, ConfigureMenuEntry
+ * will hook up the platform-specific cascade linkages now
+ * that the menu we are creating exists.
+ */
+
+ if ((menuPtr->masterMenuPtr != menuPtr)
+ || ((menuPtr->masterMenuPtr == menuPtr)
+ && ((cascadeListPtr->menuPtr->masterMenuPtr
+ == cascadeListPtr->menuPtr)))) {
+ newArgv[0] = "-menu";
+ newArgv[1] = Tk_PathName(menuPtr->tkwin);
+ ConfigureMenuEntry(cascadeListPtr, 2, newArgv,
+ TK_CONFIG_ARGV_ONLY);
+ } else {
+ newMenuName = TkNewMenuName(menuPtr->interp,
+ Tk_PathName(cascadeListPtr->menuPtr->tkwin),
+ menuPtr);
+ CloneMenu(menuPtr, newMenuName, "normal");
+
+ /*
+ * Now we can set the new menu instance to be the cascade entry
+ * of the parent's instance.
+ */
+
+ newArgv[0] = "-menu";
+ newArgv[1] = newMenuName;
+ ConfigureMenuEntry(cascadeListPtr, 2, newArgv,
+ TK_CONFIG_ARGV_ONLY);
+ if (newMenuName != NULL) {
+ ckfree(newMenuName);
+ }
+ }
+ cascadeListPtr = nextCascadePtr;
+ }
+ }
+
+ /*
+ * If there already exist toplevel widgets that refer to this menu,
+ * find them and notify them so that they can reconfigure their
+ * geometry to reflect the menu.
+ */
+
+ if (menuRefPtr->topLevelListPtr != NULL) {
+ TkMenuTopLevelList *topLevelListPtr = menuRefPtr->topLevelListPtr;
+ TkMenuTopLevelList *nextPtr;
+ Tk_Window listtkwin;
+ while (topLevelListPtr != NULL) {
+
+ /*
+ * Need to get the next pointer first. TkSetWindowMenuBar
+ * changes the list, so that the next pointer is different
+ * after calling it.
+ */
+
+ nextPtr = topLevelListPtr->nextPtr;
+ listtkwin = topLevelListPtr->tkwin;
+ TkSetWindowMenuBar(menuPtr->interp, listtkwin,
+ Tk_PathName(menuPtr->tkwin), Tk_PathName(menuPtr->tkwin));
+ topLevelListPtr = nextPtr;
+ }
+ }
+
+ interp->result = Tk_PathName(menuPtr->tkwin);
+ return TCL_OK;
+
+ error:
+ Tk_DestroyWindow(menuPtr->tkwin);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MenuWidgetCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to a widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+MenuWidgetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about menu widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ register TkMenu *menuPtr = (TkMenu *) clientData;
+ register TkMenuEntry *mePtr;
+ int result = TCL_OK;
+ size_t length;
+ int c;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_Preserve((ClientData) menuPtr);
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'a') && (strncmp(argv[1], "activate", length) == 0)
+ && (length >= 2)) {
+ int index;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " activate index\"", (char *) NULL);
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
+ goto error;
+ }
+ if (menuPtr->active == index) {
+ goto done;
+ }
+ if (index >= 0) {
+ if ((menuPtr->entries[index]->type == SEPARATOR_ENTRY)
+ || (menuPtr->entries[index]->state == tkDisabledUid)) {
+ index = -1;
+ }
+ }
+ result = TkActivateMenuEntry(menuPtr, index);
+ } else if ((c == 'a') && (strncmp(argv[1], "add", length) == 0)
+ && (length >= 2)) {
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " add type ?options?\"", (char *) NULL);
+ goto error;
+ }
+ if (MenuAddOrInsert(interp, menuPtr, (char *) NULL,
+ argc-2, argv+2) != TCL_OK) {
+ goto error;
+ }
+ } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
+ && (length >= 2)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " cget option\"",
+ (char *) NULL);
+ goto error;
+ }
+ result = Tk_ConfigureValue(interp, menuPtr->tkwin, tkMenuConfigSpecs,
+ (char *) menuPtr, argv[2], 0);
+ } else if ((c == 'c') && (strncmp(argv[1], "clone", length) == 0)
+ && (length >=2)) {
+ if ((argc < 3) || (argc > 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " clone newMenuName ?menuType?\"",
+ (char *) NULL);
+ goto error;
+ }
+ result = CloneMenu(menuPtr, argv[2], (argc == 3) ? NULL : argv[3]);
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
+ && (length >= 2)) {
+ if (argc == 2) {
+ result = Tk_ConfigureInfo(interp, menuPtr->tkwin,
+ tkMenuConfigSpecs, (char *) menuPtr, (char *) NULL, 0);
+ } else if (argc == 3) {
+ result = Tk_ConfigureInfo(interp, menuPtr->tkwin,
+ tkMenuConfigSpecs, (char *) menuPtr, argv[2], 0);
+ } else {
+ result = ConfigureMenu(interp, menuPtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) {
+ int first, last;
+
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " delete first ?last?\"", (char *) NULL);
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &first) != TCL_OK) {
+ goto error;
+ }
+ if (argc == 3) {
+ last = first;
+ } else {
+ if (TkGetMenuIndex(interp, menuPtr, argv[3], 0, &last) != TCL_OK) {
+ goto error;
+ }
+ }
+ if (menuPtr->tearOff && (first == 0)) {
+
+ /*
+ * Sorry, can't delete the tearoff entry; must reconfigure
+ * the menu.
+ */
+
+ first = 1;
+ }
+ if ((first < 0) || (last < first)) {
+ goto done;
+ }
+ DeleteMenuCloneEntries(menuPtr, first, last);
+ } else if ((c == 'e') && (length >= 7)
+ && (strncmp(argv[1], "entrycget", length) == 0)) {
+ int index;
+
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " entrycget index option\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
+ goto error;
+ }
+ if (index < 0) {
+ goto done;
+ }
+ mePtr = menuPtr->entries[index];
+ Tcl_Preserve((ClientData) mePtr);
+ result = Tk_ConfigureValue(interp, menuPtr->tkwin,
+ tkMenuEntryConfigSpecs, (char *) mePtr, argv[3],
+ COMMAND_MASK << mePtr->type);
+ Tcl_Release((ClientData) mePtr);
+ } else if ((c == 'e') && (length >= 7)
+ && (strncmp(argv[1], "entryconfigure", length) == 0)) {
+ int index;
+
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " entryconfigure index ?option value ...?\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
+ goto error;
+ }
+ if (index < 0) {
+ goto done;
+ }
+ mePtr = menuPtr->entries[index];
+ Tcl_Preserve((ClientData) mePtr);
+ if (argc == 3) {
+ result = Tk_ConfigureInfo(interp, menuPtr->tkwin,
+ tkMenuEntryConfigSpecs, (char *) mePtr, (char *) NULL,
+ COMMAND_MASK << mePtr->type);
+ } else if (argc == 4) {
+ result = Tk_ConfigureInfo(interp, menuPtr->tkwin,
+ tkMenuEntryConfigSpecs, (char *) mePtr, argv[3],
+ COMMAND_MASK << mePtr->type);
+ } else {
+ result = ConfigureMenuCloneEntries(interp, menuPtr, index,
+ argc-3, argv+3,
+ TK_CONFIG_ARGV_ONLY | COMMAND_MASK << mePtr->type);
+ }
+ Tcl_Release((ClientData) mePtr);
+ } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
+ && (length >= 3)) {
+ int index;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " index string\"", (char *) NULL);
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
+ goto error;
+ }
+ if (index < 0) {
+ interp->result = "none";
+ } else {
+ sprintf(interp->result, "%d", index);
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
+ && (length >= 3)) {
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " insert index type ?options?\"", (char *) NULL);
+ goto error;
+ }
+ if (MenuAddOrInsert(interp, menuPtr, argv[2],
+ argc-3, argv+3) != TCL_OK) {
+ goto error;
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "invoke", length) == 0)
+ && (length >= 3)) {
+ int index;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " invoke index\"", (char *) NULL);
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
+ goto error;
+ }
+ if (index < 0) {
+ goto done;
+ }
+ result = TkInvokeMenu(interp, menuPtr, index);
+ } else if ((c == 'p') && (strncmp(argv[1], "post", length) == 0)
+ && (length == 4)) {
+ int x, y;
+
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " post x y\"", (char *) NULL);
+ goto error;
+ }
+ if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
+ goto error;
+ }
+
+ /*
+ * Tearoff menus are posted differently on Mac and Windows than
+ * non-tearoffs. TkpPostMenu does not actually map the menu's
+ * window on those platforms, and popup menus have to be
+ * handled specially.
+ */
+
+ if (menuPtr->menuType != TEAROFF_MENU) {
+ result = TkpPostMenu(interp, menuPtr, x, y);
+ } else {
+ result = TkPostTearoffMenu(interp, menuPtr, x, y);
+ }
+ } else if ((c == 'p') && (strncmp(argv[1], "postcascade", length) == 0)
+ && (length > 4)) {
+ int index;
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " postcascade index\"", (char *) NULL);
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
+ goto error;
+ }
+ if ((index < 0) || (menuPtr->entries[index]->type != CASCADE_ENTRY)) {
+ result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL);
+ } else {
+ result = TkPostSubmenu(interp, menuPtr, menuPtr->entries[index]);
+ }
+ } else if ((c == 't') && (strncmp(argv[1], "type", length) == 0)) {
+ int index;
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " type index\"", (char *) NULL);
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
+ goto error;
+ }
+ if (index < 0) {
+ goto done;
+ }
+ mePtr = menuPtr->entries[index];
+ switch (mePtr->type) {
+ case COMMAND_ENTRY:
+ interp->result = "command";
+ break;
+ case SEPARATOR_ENTRY:
+ interp->result = "separator";
+ break;
+ case CHECK_BUTTON_ENTRY:
+ interp->result = "checkbutton";
+ break;
+ case RADIO_BUTTON_ENTRY:
+ interp->result = "radiobutton";
+ break;
+ case CASCADE_ENTRY:
+ interp->result = "cascade";
+ break;
+ case TEAROFF_ENTRY:
+ interp->result = "tearoff";
+ break;
+ }
+ } else if ((c == 'u') && (strncmp(argv[1], "unpost", length) == 0)) {
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " unpost\"", (char *) NULL);
+ goto error;
+ }
+ Tk_UnmapWindow(menuPtr->tkwin);
+ result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL);
+ } else if ((c == 'y') && (strncmp(argv[1], "yposition", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " yposition index\"", (char *) NULL);
+ goto error;
+ }
+ result = MenuDoYPosition(interp, menuPtr, argv[2]);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be activate, add, cget, clone, configure, delete, ",
+ "entrycget, entryconfigure, index, insert, invoke, ",
+ "post, postcascade, type, unpost, or yposition",
+ (char *) NULL);
+ goto error;
+ }
+ done:
+ Tcl_Release((ClientData) menuPtr);
+ return result;
+
+ error:
+ Tcl_Release((ClientData) menuPtr);
+ return TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkInvokeMenu --
+ *
+ * Given a menu and an index, takes the appropriate action for the
+ * entry associated with that index.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Commands may get excecuted; variables may get set; sub-menus may
+ * get posted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkInvokeMenu(interp, menuPtr, index)
+ Tcl_Interp *interp; /* The interp that the menu lives in. */
+ TkMenu *menuPtr; /* The menu we are invoking. */
+ int index; /* The zero based index of the item we
+ * are invoking */
+{
+ int result = TCL_OK;
+ TkMenuEntry *mePtr;
+
+ if (index < 0) {
+ goto done;
+ }
+ mePtr = menuPtr->entries[index];
+ if (mePtr->state == tkDisabledUid) {
+ goto done;
+ }
+ Tcl_Preserve((ClientData) mePtr);
+ if (mePtr->type == TEAROFF_ENTRY) {
+ Tcl_DString commandDString;
+
+ Tcl_DStringInit(&commandDString);
+ Tcl_DStringAppendElement(&commandDString, "tkTearOffMenu");
+ Tcl_DStringAppendElement(&commandDString, Tk_PathName(menuPtr->tkwin));
+ result = Tcl_Eval(interp, Tcl_DStringValue(&commandDString));
+ Tcl_DStringFree(&commandDString);
+ } else if (mePtr->type == CHECK_BUTTON_ENTRY) {
+ if (mePtr->entryFlags & ENTRY_SELECTED) {
+ if (Tcl_SetVar(interp, mePtr->name, mePtr->offValue,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
+ }
+ } else {
+ if (Tcl_SetVar(interp, mePtr->name, mePtr->onValue,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
+ }
+ }
+ } else if (mePtr->type == RADIO_BUTTON_ENTRY) {
+ if (Tcl_SetVar(interp, mePtr->name, mePtr->onValue,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
+ }
+ }
+ if ((result == TCL_OK) && (mePtr->command != NULL)) {
+ result = TkCopyAndGlobalEval(interp, mePtr->command);
+ }
+ Tcl_Release((ClientData) mePtr);
+ done:
+ return result;
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyMenuInstance --
+ *
+ * This procedure is invoked by TkDestroyMenu
+ * to clean up the internal structure of a menu at a safe time
+ * (when no-one is using it anymore). Only takes care of one instance
+ * of the menu.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the menu is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyMenuInstance(menuPtr)
+ TkMenu *menuPtr; /* Info about menu widget. */
+{
+ int i, numEntries = menuPtr->numEntries;
+ TkMenu *menuInstancePtr;
+ TkMenuEntry *cascadePtr, *nextCascadePtr;
+ char *newArgv[2];
+ TkMenu *parentMasterMenuPtr;
+ TkMenuEntry *parentMasterEntryPtr;
+ TkMenu *parentMenuPtr;
+
+ /*
+ * If the menu has any cascade menu entries pointing to it, the cascade
+ * entries need to be told that the menu is going away. We need to clear
+ * the menu ptr field in the menu reference at this point in the code
+ * so that everything else can forget about this menu properly. We also
+ * need to reset -menu field of all entries that are not master menus
+ * back to this entry name if this is a master menu pointed to by another
+ * master menu. If there is a clone menu that points to this menu,
+ * then this menu is itself a clone, so when this menu goes away,
+ * the -menu field of the pointing entry must be set back to this
+ * menu's master menu name so that later if another menu is created
+ * the cascade hierarchy can be maintained.
+ */
+
+ TkpDestroyMenu(menuPtr);
+ cascadePtr = menuPtr->menuRefPtr->parentEntryPtr;
+ menuPtr->menuRefPtr->menuPtr = NULL;
+ TkFreeMenuReferences(menuPtr->menuRefPtr);
+
+ for (; cascadePtr != NULL; cascadePtr = nextCascadePtr) {
+ parentMenuPtr = cascadePtr->menuPtr;
+ nextCascadePtr = cascadePtr->nextCascadePtr;
+
+ if (menuPtr->masterMenuPtr != menuPtr) {
+ parentMasterMenuPtr = cascadePtr->menuPtr->masterMenuPtr;
+ parentMasterEntryPtr =
+ parentMasterMenuPtr->entries[cascadePtr->index];
+ newArgv[0] = "-menu";
+ newArgv[1] = parentMasterEntryPtr->name;
+ ConfigureMenuEntry(cascadePtr, 2, newArgv, TK_CONFIG_ARGV_ONLY);
+ } else {
+ ConfigureMenuEntry(cascadePtr, 0, (char **) NULL, 0);
+ }
+ }
+
+ if (menuPtr->masterMenuPtr != menuPtr) {
+ for (menuInstancePtr = menuPtr->masterMenuPtr;
+ menuInstancePtr != NULL;
+ menuInstancePtr = menuInstancePtr->nextInstancePtr) {
+ if (menuInstancePtr->nextInstancePtr == menuPtr) {
+ menuInstancePtr->nextInstancePtr =
+ menuInstancePtr->nextInstancePtr->nextInstancePtr;
+ break;
+ }
+ }
+ } else if (menuPtr->nextInstancePtr != NULL) {
+ panic("Attempting to delete master menu when there are still clones.");
+ }
+
+ /*
+ * Free up all the stuff that requires special handling, then
+ * let Tk_FreeOptions handle all the standard option-related
+ * stuff.
+ */
+
+ for (i = numEntries - 1; i >= 0; i--) {
+ DestroyMenuEntry((char *) menuPtr->entries[i]);
+ }
+ if (menuPtr->entries != NULL) {
+ ckfree((char *) menuPtr->entries);
+ }
+ TkMenuFreeDrawOptions(menuPtr);
+ Tk_FreeOptions(tkMenuConfigSpecs, (char *) menuPtr, menuPtr->display, 0);
+
+ Tcl_EventuallyFree((ClientData) menuPtr, TCL_DYNAMIC);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDestroyMenu --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a menu at a safe time
+ * (when no-one is using it anymore). If called on a master instance,
+ * destroys all of the slave instances. If called on a non-master
+ * instance, just destroys that instance.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the menu is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkDestroyMenu(menuPtr)
+ TkMenu *menuPtr; /* Info about menu widget. */
+{
+ TkMenu *menuInstancePtr;
+ TkMenuTopLevelList *topLevelListPtr, *nextTopLevelPtr;
+
+ if (menuPtr->menuFlags & MENU_DELETION_PENDING) {
+ return;
+ }
+
+ /*
+ * Now destroy all non-tearoff instances of this menu if this is a
+ * parent menu. Is this loop safe enough? Are there going to be
+ * destroy bindings on child menus which kill the parent? If not,
+ * we have to do a slightly more complex scheme.
+ */
+
+ if (menuPtr->masterMenuPtr == menuPtr) {
+ menuPtr->menuFlags |= MENU_DELETION_PENDING;
+ while (menuPtr->nextInstancePtr != NULL) {
+ menuInstancePtr = menuPtr->nextInstancePtr;
+ menuPtr->nextInstancePtr = menuInstancePtr->nextInstancePtr;
+ if (menuInstancePtr->tkwin != NULL) {
+ Tk_DestroyWindow(menuInstancePtr->tkwin);
+ }
+ }
+ menuPtr->menuFlags &= ~MENU_DELETION_PENDING;
+ }
+
+ /*
+ * If any toplevel widgets have this menu as their menubar,
+ * the geometry of the window may have to be recalculated.
+ */
+
+ topLevelListPtr = menuPtr->menuRefPtr->topLevelListPtr;
+ while (topLevelListPtr != NULL) {
+ nextTopLevelPtr = topLevelListPtr->nextPtr;
+ TkpSetWindowMenuBar(topLevelListPtr->tkwin, NULL);
+ topLevelListPtr = nextTopLevelPtr;
+ }
+ DestroyMenuInstance(menuPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UnhookCascadeEntry --
+ *
+ * This entry is removed from the list of entries that point to the
+ * cascade menu. This is done in preparation for changing the menu
+ * that this entry points to.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * The appropriate lists are modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UnhookCascadeEntry(mePtr)
+ TkMenuEntry *mePtr; /* The cascade entry we are removing
+ * from the cascade list. */
+{
+ TkMenuEntry *cascadeEntryPtr;
+ TkMenuEntry *prevCascadePtr;
+ TkMenuReferences *menuRefPtr;
+
+ menuRefPtr = mePtr->childMenuRefPtr;
+ if (menuRefPtr == NULL) {
+ return;
+ }
+
+ cascadeEntryPtr = menuRefPtr->parentEntryPtr;
+ if (cascadeEntryPtr == NULL) {
+ return;
+ }
+
+ /*
+ * Singularly linked list deletion. The two special cases are
+ * 1. one element; 2. The first element is the one we want.
+ */
+
+ if (cascadeEntryPtr == mePtr) {
+ if (cascadeEntryPtr->nextCascadePtr == NULL) {
+
+ /*
+ * This is the last menu entry which points to this
+ * menu, so we need to clear out the list pointer in the
+ * cascade itself.
+ */
+
+ menuRefPtr->parentEntryPtr = NULL;
+ TkFreeMenuReferences(menuRefPtr);
+ } else {
+ menuRefPtr->parentEntryPtr = cascadeEntryPtr->nextCascadePtr;
+ }
+ mePtr->nextCascadePtr = NULL;
+ } else {
+ for (prevCascadePtr = cascadeEntryPtr,
+ cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr;
+ cascadeEntryPtr != NULL;
+ prevCascadePtr = cascadeEntryPtr,
+ cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) {
+ if (cascadeEntryPtr == mePtr){
+ prevCascadePtr->nextCascadePtr =
+ cascadeEntryPtr->nextCascadePtr;
+ cascadeEntryPtr->nextCascadePtr = NULL;
+ break;
+ }
+ }
+ }
+ mePtr->childMenuRefPtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyMenuEntry --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a menu entry at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the menu entry is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyMenuEntry(memPtr)
+ char *memPtr; /* Pointer to entry to be freed. */
+{
+ register TkMenuEntry *mePtr = (TkMenuEntry *) memPtr;
+ TkMenu *menuPtr = mePtr->menuPtr;
+
+ if (menuPtr->postedCascade == mePtr) {
+
+ /*
+ * Ignore errors while unposting the menu, since it's possible
+ * that the menu has already been deleted and the unpost will
+ * generate an error.
+ */
+
+ TkPostSubmenu(menuPtr->interp, menuPtr, (TkMenuEntry *) NULL);
+ }
+
+ /*
+ * Free up all the stuff that requires special handling, then
+ * let Tk_FreeOptions handle all the standard option-related
+ * stuff.
+ */
+
+ if (mePtr->type == CASCADE_ENTRY) {
+ UnhookCascadeEntry(mePtr);
+ }
+ if (mePtr->image != NULL) {
+ Tk_FreeImage(mePtr->image);
+ }
+ if (mePtr->selectImage != NULL) {
+ Tk_FreeImage(mePtr->selectImage);
+ }
+ if (mePtr->name != NULL) {
+ Tcl_UntraceVar(menuPtr->interp, mePtr->name,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuVarProc, (ClientData) mePtr);
+ }
+ TkpDestroyMenuEntry(mePtr);
+ TkMenuEntryFreeDrawOptions(mePtr);
+ Tk_FreeOptions(tkMenuEntryConfigSpecs, (char *) mePtr, menuPtr->display,
+ (COMMAND_MASK << mePtr->type));
+ ckfree((char *) mePtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * MenuWorldChanged --
+ *
+ * This procedure is called when the world has changed in some
+ * way (such as the fonts in the system changing) and the widget needs
+ * to recompute all its graphics contexts and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Menu will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+MenuWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ TkMenu *menuPtr = (TkMenu *) instanceData;
+ int i;
+
+ TkMenuConfigureDrawOptions(menuPtr);
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ TkMenuConfigureEntryDrawOptions(menuPtr->entries[i],
+ menuPtr->entries[i]->index);
+ TkpConfigureMenuEntry(menuPtr->entries[i]);
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureMenu --
+ *
+ * This procedure is called to process an argv/argc list, plus
+ * the Tk option database, in order to configure (or
+ * reconfigure) a menu widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then interp->result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, font, etc. get set
+ * for menuPtr; old resources get freed, if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureMenu(interp, menuPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register TkMenu *menuPtr; /* Information about widget; may or may
+ * not already have values for some fields. */
+ int argc; /* Number of valid entries in argv. */
+ char **argv; /* Arguments. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ int i;
+ TkMenu* menuListPtr;
+
+ for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL;
+ menuListPtr = menuListPtr->nextInstancePtr) {
+
+ if (Tk_ConfigureWidget(interp, menuListPtr->tkwin,
+ tkMenuConfigSpecs, argc, argv, (char *) menuListPtr,
+ flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * When a menu is created, the type is in all of the arguments
+ * to the menu command. Let Tk_ConfigureWidget take care of
+ * parsing them, and then set the type after we can look at
+ * the type string. Once set, a menu's type cannot be changed
+ */
+
+ if (menuListPtr->menuType == UNKNOWN_TYPE) {
+ if (strcmp(menuListPtr->menuTypeName, "menubar") == 0) {
+ menuListPtr->menuType = MENUBAR;
+ } else if (strcmp(menuListPtr->menuTypeName, "tearoff") == 0) {
+ menuListPtr->menuType = TEAROFF_MENU;
+ } else {
+ menuListPtr->menuType = MASTER_MENU;
+ }
+ }
+
+ /*
+ * Depending on the -tearOff option, make sure that there is or
+ * isn't an initial tear-off entry at the beginning of the menu.
+ */
+
+ if (menuListPtr->tearOff) {
+ if ((menuListPtr->numEntries == 0)
+ || (menuListPtr->entries[0]->type != TEAROFF_ENTRY)) {
+ if (MenuNewEntry(menuListPtr, 0, TEAROFF_ENTRY) == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ } else if ((menuListPtr->numEntries > 0)
+ && (menuListPtr->entries[0]->type == TEAROFF_ENTRY)) {
+ int i;
+
+ Tcl_EventuallyFree((ClientData) menuListPtr->entries[0],
+ DestroyMenuEntry);
+ for (i = 0; i < menuListPtr->numEntries - 1; i++) {
+ menuListPtr->entries[i] = menuListPtr->entries[i + 1];
+ menuListPtr->entries[i]->index = i;
+ }
+ menuListPtr->numEntries--;
+ if (menuListPtr->numEntries == 0) {
+ ckfree((char *) menuListPtr->entries);
+ menuListPtr->entries = NULL;
+ }
+ }
+
+ TkMenuConfigureDrawOptions(menuListPtr);
+
+ /*
+ * Configure the new window to be either a pop-up menu
+ * or a tear-off menu.
+ * We don't do this for menubars since they are not toplevel
+ * windows. Also, since this gets called before CloneMenu has
+ * a chance to set the menuType field, we have to look at the
+ * menuTypeName field to tell that this is a menu bar.
+ */
+
+ if (strcmp(menuListPtr->menuTypeName, "normal") == 0) {
+ TkpMakeMenuWindow(menuListPtr->tkwin, 1);
+ } else if (strcmp(menuListPtr->menuTypeName, "tearoff") == 0) {
+ TkpMakeMenuWindow(menuListPtr->tkwin, 0);
+ }
+
+ /*
+ * After reconfiguring a menu, we need to reconfigure all of the
+ * entries in the menu, since some of the things in the children
+ * (such as graphics contexts) may have to change to reflect changes
+ * in the parent.
+ */
+
+ for (i = 0; i < menuListPtr->numEntries; i++) {
+ TkMenuEntry *mePtr;
+
+ mePtr = menuListPtr->entries[i];
+ ConfigureMenuEntry(mePtr, 0,
+ (char **) NULL, TK_CONFIG_ARGV_ONLY
+ | COMMAND_MASK << mePtr->type);
+ }
+
+ TkEventuallyRecomputeMenu(menuListPtr);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureMenuEntry --
+ *
+ * This procedure is called to process an argv/argc list in order
+ * to configure (or reconfigure) one entry in a menu.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then interp->result contains an error message.
+ *
+ * Side effects:
+ * Configuration information such as label and accelerator get
+ * set for mePtr; old resources get freed, if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureMenuEntry(mePtr, argc, argv, flags)
+ register TkMenuEntry *mePtr; /* Information about menu entry; may
+ * or may not already have values for
+ * some fields. */
+ int argc; /* Number of valid entries in argv. */
+ char **argv; /* Arguments. */
+ int flags; /* Additional flags to pass to
+ * Tk_ConfigureWidget. */
+{
+ TkMenu *menuPtr = mePtr->menuPtr;
+ int index = mePtr->index;
+ Tk_Image image;
+
+ /*
+ * If this entry is a check button or radio button, then remove
+ * its old trace procedure.
+ */
+
+ if ((mePtr->name != NULL)
+ && ((mePtr->type == CHECK_BUTTON_ENTRY)
+ || (mePtr->type == RADIO_BUTTON_ENTRY))) {
+ Tcl_UntraceVar(menuPtr->interp, mePtr->name,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuVarProc, (ClientData) mePtr);
+ }
+
+ if (menuPtr->tkwin != NULL) {
+ if (Tk_ConfigureWidget(menuPtr->interp, menuPtr->tkwin,
+ tkMenuEntryConfigSpecs, argc, argv, (char *) mePtr,
+ flags | (COMMAND_MASK << mePtr->type)) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * The code below handles special configuration stuff not taken
+ * care of by Tk_ConfigureWidget, such as special processing for
+ * defaults, sizing strings, graphics contexts, etc.
+ */
+
+ if (mePtr->label == NULL) {
+ mePtr->labelLength = 0;
+ } else {
+ mePtr->labelLength = strlen(mePtr->label);
+ }
+ if (mePtr->accel == NULL) {
+ mePtr->accelLength = 0;
+ } else {
+ mePtr->accelLength = strlen(mePtr->accel);
+ }
+
+ /*
+ * If this is a cascade entry, the platform-specific data of the child
+ * menu has to be updated. Also, the links that point to parents and
+ * cascades have to be updated.
+ */
+
+ if ((mePtr->type == CASCADE_ENTRY) && (mePtr->name != NULL)) {
+ TkMenuEntry *cascadeEntryPtr;
+ TkMenu *cascadeMenuPtr;
+ int alreadyThere;
+ TkMenuReferences *menuRefPtr;
+ char *oldHashKey = NULL; /* Initialization only needed to
+ * prevent compiler warning. */
+
+ /*
+ * This is a cascade entry. If the menu that the cascade entry
+ * is pointing to has changed, we need to remove this entry
+ * from the list of entries pointing to the old menu, and add a
+ * cascade reference to the list of entries pointing to the
+ * new menu.
+ *
+ * BUG: We are not recloning for special case #3 yet.
+ */
+
+ if (mePtr->childMenuRefPtr != NULL) {
+ oldHashKey = Tcl_GetHashKey(TkGetMenuHashTable(menuPtr->interp),
+ mePtr->childMenuRefPtr->hashEntryPtr);
+ if (strcmp(oldHashKey, mePtr->name) != 0) {
+ UnhookCascadeEntry(mePtr);
+ }
+ }
+
+ if ((mePtr->childMenuRefPtr == NULL)
+ || (strcmp(oldHashKey, mePtr->name) != 0)) {
+ menuRefPtr = TkCreateMenuReferences(menuPtr->interp,
+ mePtr->name);
+ cascadeMenuPtr = menuRefPtr->menuPtr;
+ mePtr->childMenuRefPtr = menuRefPtr;
+
+ if (menuRefPtr->parentEntryPtr == NULL) {
+ menuRefPtr->parentEntryPtr = mePtr;
+ } else {
+ alreadyThere = 0;
+ for (cascadeEntryPtr = menuRefPtr->parentEntryPtr;
+ cascadeEntryPtr != NULL;
+ cascadeEntryPtr =
+ cascadeEntryPtr->nextCascadePtr) {
+ if (cascadeEntryPtr == mePtr) {
+ alreadyThere = 1;
+ break;
+ }
+ }
+
+ /*
+ * Put the item at the front of the list.
+ */
+
+ if (!alreadyThere) {
+ mePtr->nextCascadePtr = menuRefPtr->parentEntryPtr;
+ menuRefPtr->parentEntryPtr = mePtr;
+ }
+ }
+ }
+ }
+
+ if (TkMenuConfigureEntryDrawOptions(mePtr, index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (TkpConfigureMenuEntry(mePtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if ((mePtr->type == CHECK_BUTTON_ENTRY)
+ || (mePtr->type == RADIO_BUTTON_ENTRY)) {
+ char *value;
+
+ if (mePtr->name == NULL) {
+ mePtr->name =
+ (char *) ckalloc((unsigned) (mePtr->labelLength + 1));
+ strcpy(mePtr->name, (mePtr->label == NULL) ? "" : mePtr->label);
+ }
+ if (mePtr->onValue == NULL) {
+ mePtr->onValue = (char *) ckalloc((unsigned)
+ (mePtr->labelLength + 1));
+ strcpy(mePtr->onValue, (mePtr->label == NULL) ? "" : mePtr->label);
+ }
+
+ /*
+ * Select the entry if the associated variable has the
+ * appropriate value, initialize the variable if it doesn't
+ * exist, then set a trace on the variable to monitor future
+ * changes to its value.
+ */
+
+ value = Tcl_GetVar(menuPtr->interp, mePtr->name, TCL_GLOBAL_ONLY);
+ mePtr->entryFlags &= ~ENTRY_SELECTED;
+ if (value != NULL) {
+ if (strcmp(value, mePtr->onValue) == 0) {
+ mePtr->entryFlags |= ENTRY_SELECTED;
+ }
+ } else {
+ Tcl_SetVar(menuPtr->interp, mePtr->name,
+ (mePtr->type == CHECK_BUTTON_ENTRY) ? mePtr->offValue : "",
+ TCL_GLOBAL_ONLY);
+ }
+ Tcl_TraceVar(menuPtr->interp, mePtr->name,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuVarProc, (ClientData) mePtr);
+ }
+
+ /*
+ * Get the images for the entry, if there are any. Allocate the
+ * new images before freeing the old ones, so that the reference
+ * counts don't go to zero and cause image data to be discarded.
+ */
+
+ if (mePtr->imageString != NULL) {
+ image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, mePtr->imageString,
+ TkMenuImageProc, (ClientData) mePtr);
+ if (image == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (mePtr->image != NULL) {
+ Tk_FreeImage(mePtr->image);
+ }
+ mePtr->image = image;
+ if (mePtr->selectImageString != NULL) {
+ image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, mePtr->selectImageString,
+ TkMenuSelectImageProc, (ClientData) mePtr);
+ if (image == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (mePtr->selectImage != NULL) {
+ Tk_FreeImage(mePtr->selectImage);
+ }
+ mePtr->selectImage = image;
+
+ TkEventuallyRecomputeMenu(menuPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureMenuCloneEntries --
+ *
+ * Calls ConfigureMenuEntry for each menu in the clone chain.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then interp->result contains an error message.
+ *
+ * Side effects:
+ * Configuration information such as label and accelerator get
+ * set for mePtr; old resources get freed, if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureMenuCloneEntries(interp, menuPtr, index, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ TkMenu *menuPtr; /* Information about whole menu. */
+ int index; /* Index of mePtr within menuPtr's
+ * entries. */
+ int argc; /* Number of valid entries in argv. */
+ char **argv; /* Arguments. */
+ int flags; /* Additional flags to pass to
+ * Tk_ConfigureWidget. */
+{
+ TkMenuEntry *mePtr;
+ TkMenu *menuListPtr;
+ char *oldCascadeName = NULL, *newMenuName = NULL;
+ int cascadeEntryChanged;
+ TkMenuReferences *oldCascadeMenuRefPtr, *cascadeMenuRefPtr = NULL;
+
+ /*
+ * Cascades are kind of tricky here. This is special case #3 in the comment
+ * at the top of this file. Basically, if a menu is the master menu of a
+ * clone chain, and has an entry with a cascade menu, the clones of
+ * the menu will point to clones of the cascade menu. We have
+ * to destroy the clones of the cascades, clone the new cascade
+ * menu, and configure the entry to point to the new clone.
+ */
+
+ mePtr = menuPtr->masterMenuPtr->entries[index];
+ if (mePtr->type == CASCADE_ENTRY) {
+ oldCascadeName = mePtr->name;
+ }
+
+ if (ConfigureMenuEntry(mePtr, argc, argv, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ cascadeEntryChanged = (mePtr->type == CASCADE_ENTRY)
+ && (oldCascadeName != mePtr->name);
+
+ if (cascadeEntryChanged) {
+ newMenuName = mePtr->name;
+ if (newMenuName != NULL) {
+ cascadeMenuRefPtr = TkFindMenuReferences(menuPtr->interp,
+ mePtr->name);
+ }
+ }
+
+ for (menuListPtr = menuPtr->masterMenuPtr->nextInstancePtr;
+ menuListPtr != NULL;
+ menuListPtr = menuListPtr->nextInstancePtr) {
+
+ mePtr = menuListPtr->entries[index];
+
+ if (cascadeEntryChanged && (mePtr->name != NULL)) {
+ oldCascadeMenuRefPtr = TkFindMenuReferences(menuPtr->interp,
+ mePtr->name);
+
+ if ((oldCascadeMenuRefPtr != NULL)
+ && (oldCascadeMenuRefPtr->menuPtr != NULL)) {
+ RecursivelyDeleteMenu(oldCascadeMenuRefPtr->menuPtr);
+ }
+ }
+
+ if (ConfigureMenuEntry(mePtr, argc, argv, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (cascadeEntryChanged && (newMenuName != NULL)) {
+ if (cascadeMenuRefPtr->menuPtr != NULL) {
+ char *newArgV[2];
+ char *newCloneName;
+
+ newCloneName = TkNewMenuName(menuPtr->interp,
+ Tk_PathName(menuListPtr->tkwin),
+ cascadeMenuRefPtr->menuPtr);
+ CloneMenu(cascadeMenuRefPtr->menuPtr, newCloneName,
+ "normal");
+
+ newArgV[0] = "-menu";
+ newArgV[1] = newCloneName;
+ ConfigureMenuEntry(mePtr, 2, newArgV, flags);
+ ckfree(newCloneName);
+ }
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkGetMenuIndex --
+ *
+ * Parse a textual index into a menu and return the numerical
+ * index of the indicated entry.
+ *
+ * Results:
+ * A standard Tcl result. If all went well, then *indexPtr is
+ * filled in with the entry index corresponding to string
+ * (ranges from -1 to the number of entries in the menu minus
+ * one). Otherwise an error message is left in interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkGetMenuIndex(interp, menuPtr, string, lastOK, indexPtr)
+ Tcl_Interp *interp; /* For error messages. */
+ TkMenu *menuPtr; /* Menu for which the index is being
+ * specified. */
+ char *string; /* Specification of an entry in menu. See
+ * manual entry for valid .*/
+ int lastOK; /* Non-zero means its OK to return index
+ * just *after* last entry. */
+ int *indexPtr; /* Where to store converted relief. */
+{
+ int i;
+
+ if ((string[0] == 'a') && (strcmp(string, "active") == 0)) {
+ *indexPtr = menuPtr->active;
+ return TCL_OK;
+ }
+
+ if (((string[0] == 'l') && (strcmp(string, "last") == 0))
+ || ((string[0] == 'e') && (strcmp(string, "end") == 0))) {
+ *indexPtr = menuPtr->numEntries - ((lastOK) ? 0 : 1);
+ return TCL_OK;
+ }
+
+ if ((string[0] == 'n') && (strcmp(string, "none") == 0)) {
+ *indexPtr = -1;
+ return TCL_OK;
+ }
+
+ if (string[0] == '@') {
+ if (GetIndexFromCoords(interp, menuPtr, string, indexPtr)
+ == TCL_OK) {
+ return TCL_OK;
+ }
+ }
+
+ if (isdigit(UCHAR(string[0]))) {
+ if (Tcl_GetInt(interp, string, &i) == TCL_OK) {
+ if (i >= menuPtr->numEntries) {
+ if (lastOK) {
+ i = menuPtr->numEntries;
+ } else {
+ i = menuPtr->numEntries-1;
+ }
+ } else if (i < 0) {
+ i = -1;
+ }
+ *indexPtr = i;
+ return TCL_OK;
+ }
+ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
+ }
+
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ char *label;
+
+ label = menuPtr->entries[i]->label;
+ if ((label != NULL)
+ && (Tcl_StringMatch(menuPtr->entries[i]->label, string))) {
+ *indexPtr = i;
+ return TCL_OK;
+ }
+ }
+
+ Tcl_AppendResult(interp, "bad menu entry index \"",
+ string, "\"", (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenuCmdDeletedProc --
+ *
+ * This procedure is invoked when a widget command is deleted. If
+ * the widget isn't already in the process of being destroyed,
+ * this command destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MenuCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ TkMenu *menuPtr = (TkMenu *) clientData;
+ Tk_Window tkwin = menuPtr->tkwin;
+
+ /*
+ * This procedure could be invoked either because the window was
+ * destroyed and the command was then deleted (in which case tkwin
+ * is NULL) or because the command was deleted, and then this procedure
+ * destroys the widget.
+ */
+
+ if (tkwin != NULL) {
+ menuPtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenuNewEntry --
+ *
+ * This procedure allocates and initializes a new menu entry.
+ *
+ * Results:
+ * The return value is a pointer to a new menu entry structure,
+ * which has been malloc-ed, initialized, and entered into the
+ * entry array for the menu.
+ *
+ * Side effects:
+ * Storage gets allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkMenuEntry *
+MenuNewEntry(menuPtr, index, type)
+ TkMenu *menuPtr; /* Menu that will hold the new entry. */
+ int index; /* Where in the menu the new entry is to
+ * go. */
+ int type; /* The type of the new entry. */
+{
+ TkMenuEntry *mePtr;
+ TkMenuEntry **newEntries;
+ int i;
+
+ /*
+ * Create a new array of entries with an empty slot for the
+ * new entry.
+ */
+
+ newEntries = (TkMenuEntry **) ckalloc((unsigned)
+ ((menuPtr->numEntries+1)*sizeof(TkMenuEntry *)));
+ for (i = 0; i < index; i++) {
+ newEntries[i] = menuPtr->entries[i];
+ }
+ for ( ; i < menuPtr->numEntries; i++) {
+ newEntries[i+1] = menuPtr->entries[i];
+ newEntries[i+1]->index = i + 1;
+ }
+ if (menuPtr->numEntries != 0) {
+ ckfree((char *) menuPtr->entries);
+ }
+ menuPtr->entries = newEntries;
+ menuPtr->numEntries++;
+ mePtr = (TkMenuEntry *) ckalloc(sizeof(TkMenuEntry));
+ menuPtr->entries[index] = mePtr;
+ mePtr->type = type;
+ mePtr->menuPtr = menuPtr;
+ mePtr->label = NULL;
+ mePtr->labelLength = 0;
+ mePtr->underline = -1;
+ mePtr->bitmap = None;
+ mePtr->imageString = NULL;
+ mePtr->image = NULL;
+ mePtr->selectImageString = NULL;
+ mePtr->selectImage = NULL;
+ mePtr->accel = NULL;
+ mePtr->accelLength = 0;
+ mePtr->state = tkNormalUid;
+ mePtr->border = NULL;
+ mePtr->fg = NULL;
+ mePtr->activeBorder = NULL;
+ mePtr->activeFg = NULL;
+ mePtr->tkfont = NULL;
+ mePtr->indicatorOn = 1;
+ mePtr->indicatorFg = NULL;
+ mePtr->columnBreak = 0;
+ mePtr->hideMargin = 0;
+ mePtr->command = NULL;
+ mePtr->name = NULL;
+ mePtr->childMenuRefPtr = NULL;
+ mePtr->onValue = NULL;
+ mePtr->offValue = NULL;
+ mePtr->entryFlags = 0;
+ mePtr->index = index;
+ mePtr->nextCascadePtr = NULL;
+ TkMenuInitializeEntryDrawingFields(mePtr);
+ if (TkpMenuNewEntry(mePtr) != TCL_OK) {
+ ckfree((char *) mePtr);
+ return NULL;
+ }
+
+ return mePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenuAddOrInsert --
+ *
+ * This procedure does all of the work of the "add" and "insert"
+ * widget commands, allowing the code for these to be shared.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * A new menu entry is created in menuPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+MenuAddOrInsert(interp, menuPtr, indexString, argc, argv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ TkMenu *menuPtr; /* Widget in which to create new
+ * entry. */
+ char *indexString; /* String describing index at which
+ * to insert. NULL means insert at
+ * end. */
+ int argc; /* Number of elements in argv. */
+ char **argv; /* Arguments to command: first arg
+ * is type of entry, others are
+ * config options. */
+{
+ int c, type, index;
+ size_t length;
+ TkMenuEntry *mePtr;
+ TkMenu *menuListPtr;
+
+ if (indexString != NULL) {
+ if (TkGetMenuIndex(interp, menuPtr, indexString, 1, &index)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ index = menuPtr->numEntries;
+ }
+ if (index < 0) {
+ Tcl_AppendResult(interp, "bad index \"", indexString, "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (menuPtr->tearOff && (index == 0)) {
+ index = 1;
+ }
+
+ /*
+ * Figure out the type of the new entry.
+ */
+
+ c = argv[0][0];
+ length = strlen(argv[0]);
+ if ((c == 'c') && (strncmp(argv[0], "cascade", length) == 0)
+ && (length >= 2)) {
+ type = CASCADE_ENTRY;
+ } else if ((c == 'c') && (strncmp(argv[0], "checkbutton", length) == 0)
+ && (length >= 2)) {
+ type = CHECK_BUTTON_ENTRY;
+ } else if ((c == 'c') && (strncmp(argv[0], "command", length) == 0)
+ && (length >= 2)) {
+ type = COMMAND_ENTRY;
+ } else if ((c == 'r')
+ && (strncmp(argv[0], "radiobutton", length) == 0)) {
+ type = RADIO_BUTTON_ENTRY;
+ } else if ((c == 's')
+ && (strncmp(argv[0], "separator", length) == 0)) {
+ type = SEPARATOR_ENTRY;
+ } else {
+ Tcl_AppendResult(interp, "bad menu entry type \"",
+ argv[0], "\": must be cascade, checkbutton, ",
+ "command, radiobutton, or separator", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Now we have to add an entry for every instance related to this menu.
+ */
+
+ for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL;
+ menuListPtr = menuListPtr->nextInstancePtr) {
+
+ mePtr = MenuNewEntry(menuListPtr, index, type);
+ if (mePtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (ConfigureMenuEntry(mePtr, argc-1, argv+1, 0) != TCL_OK) {
+ TkMenu *errorMenuPtr;
+ int i;
+
+ for (errorMenuPtr = menuPtr->masterMenuPtr;
+ errorMenuPtr != NULL;
+ errorMenuPtr = errorMenuPtr->nextInstancePtr) {
+ Tcl_EventuallyFree((ClientData) errorMenuPtr->entries[index],
+ DestroyMenuEntry);
+ for (i = index; i < errorMenuPtr->numEntries - 1; i++) {
+ errorMenuPtr->entries[i] = errorMenuPtr->entries[i + 1];
+ errorMenuPtr->entries[i]->index = i;
+ }
+ errorMenuPtr->numEntries--;
+ if (errorMenuPtr->numEntries == 0) {
+ ckfree((char *) errorMenuPtr->entries);
+ errorMenuPtr->entries = NULL;
+ }
+ if (errorMenuPtr == menuListPtr) {
+ break;
+ }
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * If a menu has cascades, then every instance of the menu has
+ * to have its own parallel cascade structure. So adding an
+ * entry to a menu with clones means that the menu that the
+ * entry points to has to be cloned for every clone the
+ * master menu has. This is special case #2 in the comment
+ * at the top of this file.
+ */
+
+ if ((menuPtr != menuListPtr) && (type == CASCADE_ENTRY)) {
+ if ((mePtr->name != NULL) && (mePtr->childMenuRefPtr != NULL)
+ && (mePtr->childMenuRefPtr->menuPtr != NULL)) {
+ TkMenu *cascadeMenuPtr =
+ mePtr->childMenuRefPtr->menuPtr->masterMenuPtr;
+ char *newCascadeName;
+ char *newArgv[2];
+ TkMenuReferences *menuRefPtr;
+
+ newCascadeName = TkNewMenuName(menuListPtr->interp,
+ Tk_PathName(menuListPtr->tkwin),
+ cascadeMenuPtr);
+ CloneMenu(cascadeMenuPtr, newCascadeName, "normal");
+
+ menuRefPtr = TkFindMenuReferences(menuListPtr->interp,
+ newCascadeName);
+ if (menuRefPtr == NULL) {
+ panic("CloneMenu failed inside of MenuAddOrInsert.");
+ }
+ newArgv[0] = "-menu";
+ newArgv[1] = newCascadeName;
+ ConfigureMenuEntry(mePtr, 2, newArgv, 0);
+ ckfree(newCascadeName);
+ }
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MenuVarProc --
+ *
+ * This procedure is invoked when someone changes the
+ * state variable associated with a radiobutton or checkbutton
+ * menu entry. The entry's selected state is set to match
+ * the value of the variable.
+ *
+ * Results:
+ * NULL is always returned.
+ *
+ * Side effects:
+ * The menu entry may become selected or deselected.
+ *
+ *--------------------------------------------------------------
+ */
+
+static char *
+MenuVarProc(clientData, interp, name1, name2, flags)
+ ClientData clientData; /* Information about menu entry. */
+ Tcl_Interp *interp; /* Interpreter containing variable. */
+ char *name1; /* First part of variable's name. */
+ char *name2; /* Second part of variable's name. */
+ int flags; /* Describes what just happened. */
+{
+ TkMenuEntry *mePtr = (TkMenuEntry *) clientData;
+ TkMenu *menuPtr;
+ char *value;
+
+ menuPtr = mePtr->menuPtr;
+
+ /*
+ * If the variable is being unset, then re-establish the
+ * trace unless the whole interpreter is going away.
+ */
+
+ if (flags & TCL_TRACE_UNSETS) {
+ mePtr->entryFlags &= ~ENTRY_SELECTED;
+ if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+ Tcl_TraceVar(interp, mePtr->name,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuVarProc, clientData);
+ }
+ TkpConfigureMenuEntry(mePtr);
+ TkEventuallyRedrawMenu(menuPtr, (TkMenuEntry *) NULL);
+ return (char *) NULL;
+ }
+
+ /*
+ * Use the value of the variable to update the selected status of
+ * the menu entry.
+ */
+
+ value = Tcl_GetVar(interp, mePtr->name, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ value = "";
+ }
+ if (strcmp(value, mePtr->onValue) == 0) {
+ if (mePtr->entryFlags & ENTRY_SELECTED) {
+ return (char *) NULL;
+ }
+ mePtr->entryFlags |= ENTRY_SELECTED;
+ } else if (mePtr->entryFlags & ENTRY_SELECTED) {
+ mePtr->entryFlags &= ~ENTRY_SELECTED;
+ } else {
+ return (char *) NULL;
+ }
+ TkpConfigureMenuEntry(mePtr);
+ TkEventuallyRedrawMenu(menuPtr, mePtr);
+ return (char *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkActivateMenuEntry --
+ *
+ * This procedure is invoked to make a particular menu entry
+ * the active one, deactivating any other entry that might
+ * currently be active.
+ *
+ * Results:
+ * The return value is a standard Tcl result (errors can occur
+ * while posting and unposting submenus).
+ *
+ * Side effects:
+ * Menu entries get redisplayed, and the active entry changes.
+ * Submenus may get posted and unposted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkActivateMenuEntry(menuPtr, index)
+ register TkMenu *menuPtr; /* Menu in which to activate. */
+ int index; /* Index of entry to activate, or
+ * -1 to deactivate all entries. */
+{
+ register TkMenuEntry *mePtr;
+ int result = TCL_OK;
+
+ if (menuPtr->active >= 0) {
+ mePtr = menuPtr->entries[menuPtr->active];
+
+ /*
+ * Don't change the state unless it's currently active (state
+ * might already have been changed to disabled).
+ */
+
+ if (mePtr->state == tkActiveUid) {
+ mePtr->state = tkNormalUid;
+ }
+ TkEventuallyRedrawMenu(menuPtr, menuPtr->entries[menuPtr->active]);
+ }
+ menuPtr->active = index;
+ if (index >= 0) {
+ mePtr = menuPtr->entries[index];
+ mePtr->state = tkActiveUid;
+ TkEventuallyRedrawMenu(menuPtr, mePtr);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPostCommand --
+ *
+ * Execute the postcommand for the given menu.
+ *
+ * Results:
+ * The return value is a standard Tcl result (errors can occur
+ * while the postcommands are being processed).
+ *
+ * Side effects:
+ * Since commands can get executed while this routine is being executed,
+ * the entire world can change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkPostCommand(menuPtr)
+ TkMenu *menuPtr;
+{
+ int result;
+
+ /*
+ * If there is a command for the menu, execute it. This
+ * may change the size of the menu, so be sure to recompute
+ * the menu's geometry if needed.
+ */
+
+ if (menuPtr->postCommand != NULL) {
+ result = TkCopyAndGlobalEval(menuPtr->interp,
+ menuPtr->postCommand);
+ if (result != TCL_OK) {
+ return result;
+ }
+ TkRecomputeMenu(menuPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CloneMenu --
+ *
+ * Creates a child copy of the menu. It will be inserted into
+ * the menu's instance chain. All attributes and entry
+ * attributes will be duplicated.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Allocates storage. After the menu is created, any
+ * configuration done with this menu or any related one
+ * will be reflected in all of them.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CloneMenu(menuPtr, newMenuName, newMenuTypeString)
+ TkMenu *menuPtr; /* The menu we are going to clone */
+ char *newMenuName; /* The name to give the new menu */
+ char *newMenuTypeString; /* What kind of menu is this, a normal menu
+ * a menubar, or a tearoff? */
+{
+ int returnResult;
+ int menuType;
+ size_t length;
+ TkMenuReferences *menuRefPtr;
+ Tcl_Obj *commandObjPtr;
+
+ if (newMenuTypeString == NULL) {
+ menuType = MASTER_MENU;
+ } else {
+ length = strlen(newMenuTypeString);
+ if (strncmp(newMenuTypeString, "normal", length) == 0) {
+ menuType = MASTER_MENU;
+ } else if (strncmp(newMenuTypeString, "tearoff", length) == 0) {
+ menuType = TEAROFF_MENU;
+ } else if (strncmp(newMenuTypeString, "menubar", length) == 0) {
+ menuType = MENUBAR;
+ } else {
+ Tcl_AppendResult(menuPtr->interp,
+ "bad menu type - must be normal, tearoff, or menubar",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ commandObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
+ Tcl_NewStringObj("tkMenuDup", -1));
+ Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
+ Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1));
+ Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
+ Tcl_NewStringObj(newMenuName, -1));
+ if ((newMenuTypeString == NULL) || (newMenuTypeString[0] == '\0')) {
+ Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
+ Tcl_NewStringObj("normal", -1));
+ } else {
+ Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
+ Tcl_NewStringObj(newMenuTypeString, -1));
+ }
+ Tcl_IncrRefCount(commandObjPtr);
+ Tcl_Preserve((ClientData) menuPtr);
+ returnResult = Tcl_EvalObj(menuPtr->interp, commandObjPtr);
+ Tcl_DecrRefCount(commandObjPtr);
+
+ /*
+ * Make sure the tcl command actually created the clone.
+ */
+
+ if ((returnResult == TCL_OK) &&
+ ((menuRefPtr = TkFindMenuReferences(menuPtr->interp, newMenuName))
+ != (TkMenuReferences *) NULL)
+ && (menuPtr->numEntries == menuRefPtr->menuPtr->numEntries)) {
+ TkMenu *newMenuPtr = menuRefPtr->menuPtr;
+ char *newArgv[3];
+ int i, numElements;
+
+ /*
+ * Now put this newly created menu into the parent menu's instance
+ * chain.
+ */
+
+ if (menuPtr->nextInstancePtr == NULL) {
+ menuPtr->nextInstancePtr = newMenuPtr;
+ newMenuPtr->masterMenuPtr = menuPtr->masterMenuPtr;
+ } else {
+ TkMenu *masterMenuPtr;
+
+ masterMenuPtr = menuPtr->masterMenuPtr;
+ newMenuPtr->nextInstancePtr = masterMenuPtr->nextInstancePtr;
+ masterMenuPtr->nextInstancePtr = newMenuPtr;
+ newMenuPtr->masterMenuPtr = masterMenuPtr;
+ }
+
+ /*
+ * Add the master menu's window to the bind tags for this window
+ * after this window's tag. This is so the user can bind to either
+ * this clone (which may not be easy to do) or the entire menu
+ * clone structure.
+ */
+
+ newArgv[0] = "bindtags";
+ newArgv[1] = Tk_PathName(newMenuPtr->tkwin);
+ if (Tk_BindtagsCmd((ClientData)newMenuPtr->tkwin,
+ newMenuPtr->interp, 2, newArgv) == TCL_OK) {
+ char *windowName;
+ Tcl_Obj *bindingsPtr =
+ Tcl_NewStringObj(newMenuPtr->interp->result, -1);
+ Tcl_Obj *elementPtr;
+
+ Tcl_ListObjLength(newMenuPtr->interp, bindingsPtr, &numElements);
+ for (i = 0; i < numElements; i++) {
+ Tcl_ListObjIndex(newMenuPtr->interp, bindingsPtr, i,
+ &elementPtr);
+ windowName = Tcl_GetStringFromObj(elementPtr, NULL);
+ if (strcmp(windowName, Tk_PathName(newMenuPtr->tkwin))
+ == 0) {
+ Tcl_Obj *newElementPtr = Tcl_NewStringObj(
+ Tk_PathName(newMenuPtr->masterMenuPtr->tkwin), -1);
+ Tcl_ListObjReplace(menuPtr->interp, bindingsPtr,
+ i + 1, 0, 1, &newElementPtr);
+ newArgv[2] = Tcl_GetStringFromObj(bindingsPtr, NULL);
+ Tk_BindtagsCmd((ClientData)newMenuPtr->tkwin,
+ menuPtr->interp, 3, newArgv);
+ break;
+ }
+ }
+ Tcl_DecrRefCount(bindingsPtr);
+ }
+ Tcl_ResetResult(menuPtr->interp);
+
+ /*
+ * Clone all of the cascade menus that this menu points to.
+ */
+
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ char *newCascadeName;
+ TkMenuReferences *cascadeRefPtr;
+ TkMenu *oldCascadePtr;
+
+ if ((menuPtr->entries[i]->type == CASCADE_ENTRY)
+ && (menuPtr->entries[i]->name != NULL)) {
+ cascadeRefPtr =
+ TkFindMenuReferences(menuPtr->interp,
+ menuPtr->entries[i]->name);
+ if ((cascadeRefPtr != NULL) && (cascadeRefPtr->menuPtr)) {
+ char *nameString;
+
+ oldCascadePtr = cascadeRefPtr->menuPtr;
+
+ nameString = Tk_PathName(newMenuPtr->tkwin);
+ newCascadeName = TkNewMenuName(menuPtr->interp,
+ nameString, oldCascadePtr);
+ CloneMenu(oldCascadePtr, newCascadeName, NULL);
+
+ newArgv[0] = "-menu";
+ newArgv[1] = newCascadeName;
+ ConfigureMenuEntry(newMenuPtr->entries[i], 2, newArgv,
+ TK_CONFIG_ARGV_ONLY);
+ ckfree(newCascadeName);
+ }
+ }
+ }
+
+ returnResult = TCL_OK;
+ } else {
+ returnResult = TCL_ERROR;
+ }
+ Tcl_Release((ClientData) menuPtr);
+ return returnResult;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenuDoYPosition --
+ *
+ * Given arguments from an option command line, returns the Y position.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_Error
+ *
+ * Side effects:
+ * yPosition is set to the Y-position of the menu entry.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+MenuDoYPosition(interp, menuPtr, arg)
+ Tcl_Interp *interp;
+ TkMenu *menuPtr;
+ char *arg;
+{
+ int index;
+
+ TkRecomputeMenu(menuPtr);
+ if (TkGetMenuIndex(interp, menuPtr, arg, 0, &index) != TCL_OK) {
+ goto error;
+ }
+ if (index < 0) {
+ interp->result = "0";
+ } else {
+ sprintf(interp->result, "%d", menuPtr->entries[index]->y);
+ }
+ return TCL_OK;
+
+error:
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetIndexFromCoords --
+ *
+ * Given a string of the form "@int", return the menu item corresponding
+ * to int.
+ *
+ * Results:
+ * If int is a valid number, *indexPtr will be the number of the menuentry
+ * that is the correct height. If int is invaled, *indexPtr will be
+ * unchanged. Returns appropriate Tcl error number.
+ *
+ * Side effects:
+ * If int is invalid, interp's result will set to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetIndexFromCoords(interp, menuPtr, string, indexPtr)
+ Tcl_Interp *interp; /* interp of menu */
+ TkMenu *menuPtr; /* the menu we are searching */
+ char *string; /* The @string we are parsing */
+ int *indexPtr; /* The index of the item that matches */
+{
+ int x, y, i;
+ char *p, *end;
+
+ TkRecomputeMenu(menuPtr);
+ p = string + 1;
+ y = strtol(p, &end, 0);
+ if (end == p) {
+ goto error;
+ }
+ if (*end == ',') {
+ x = y;
+ p = end + 1;
+ y = strtol(p, &end, 0);
+ if (end == p) {
+ goto error;
+ }
+ } else {
+ x = menuPtr->borderWidth;
+ }
+
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ if ((x >= menuPtr->entries[i]->x) && (y >= menuPtr->entries[i]->y)
+ && (x < (menuPtr->entries[i]->x + menuPtr->entries[i]->width))
+ && (y < (menuPtr->entries[i]->y
+ + menuPtr->entries[i]->height))) {
+ break;
+ }
+ }
+ if (i >= menuPtr->numEntries) {
+ /* i = menuPtr->numEntries - 1; */
+ i = -1;
+ }
+ *indexPtr = i;
+ return TCL_OK;
+
+ error:
+ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RecursivelyDeleteMenu --
+ *
+ * Deletes a menu and any cascades underneath it. Used for deleting
+ * instances when a menu is no longer being used as a menubar,
+ * for instance.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Destroys the menu and all cascade menus underneath it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RecursivelyDeleteMenu(menuPtr)
+ TkMenu *menuPtr; /* The menubar instance we are deleting */
+{
+ int i;
+ TkMenuEntry *mePtr;
+
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ mePtr = menuPtr->entries[i];
+ if ((mePtr->type == CASCADE_ENTRY)
+ && (mePtr->childMenuRefPtr != NULL)
+ && (mePtr->childMenuRefPtr->menuPtr != NULL)) {
+ RecursivelyDeleteMenu(mePtr->childMenuRefPtr->menuPtr);
+ }
+ }
+ Tk_DestroyWindow(menuPtr->tkwin);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkNewMenuName --
+ *
+ * Makes a new unique name for a cloned menu. Will be a child
+ * of oldName.
+ *
+ * Results:
+ * Returns a char * which has been allocated; caller must free.
+ *
+ * Side effects:
+ * Memory is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkNewMenuName(interp, parentName, menuPtr)
+ Tcl_Interp *interp; /* The interp the new name has to live in.*/
+ char *parentName; /* The prefix path of the new name. */
+ TkMenu *menuPtr; /* The menu we are cloning. */
+{
+ Tcl_DString resultDString;
+ Tcl_DString childDString;
+ char *destString;
+ int offset, i;
+ int doDot = parentName[strlen(parentName) - 1] != '.';
+ Tcl_CmdInfo cmdInfo;
+ char *returnString;
+ Tcl_HashTable *nameTablePtr = NULL;
+ TkWindow *winPtr = (TkWindow *) menuPtr->tkwin;
+ if (winPtr->mainPtr != NULL) {
+ nameTablePtr = &(winPtr->mainPtr->nameTable);
+ }
+
+ Tcl_DStringInit(&childDString);
+ Tcl_DStringAppend(&childDString, Tk_PathName(menuPtr->tkwin), -1);
+ for (destString = Tcl_DStringValue(&childDString);
+ *destString != '\0'; destString++) {
+ if (*destString == '.') {
+ *destString = '#';
+ }
+ }
+
+ offset = 0;
+
+ for (i = 0; ; i++) {
+ if (i == 0) {
+ Tcl_DStringInit(&resultDString);
+ Tcl_DStringAppend(&resultDString, parentName, -1);
+ if (doDot) {
+ Tcl_DStringAppend(&resultDString, ".", -1);
+ }
+ Tcl_DStringAppend(&resultDString,
+ Tcl_DStringValue(&childDString), -1);
+ destString = Tcl_DStringValue(&resultDString);
+ } else {
+ if (i == 1) {
+ offset = Tcl_DStringLength(&resultDString);
+ Tcl_DStringSetLength(&resultDString, offset + 10);
+ destString = Tcl_DStringValue(&resultDString);
+ }
+ sprintf(destString + offset, "%d", i);
+ }
+ if ((Tcl_GetCommandInfo(interp, destString, &cmdInfo) == 0)
+ && ((nameTablePtr == NULL)
+ || (Tcl_FindHashEntry(nameTablePtr, destString) == NULL))) {
+ break;
+ }
+ }
+ returnString = ckalloc(strlen(destString) + 1);
+ strcpy(returnString, destString);
+ Tcl_DStringFree(&resultDString);
+ Tcl_DStringFree(&childDString);
+ return returnString;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSetWindowMenuBar --
+ *
+ * Associates a menu with a window. Called by ConfigureFrame in
+ * in response to a "-menu .foo" configuration option for a top
+ * level.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The old menu clones for the menubar are thrown away, and a
+ * handler is set up to allocate the new ones.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TkSetWindowMenuBar(interp, tkwin, oldMenuName, menuName)
+ Tcl_Interp *interp; /* The interpreter the toplevel lives in. */
+ Tk_Window tkwin; /* The toplevel window */
+ char *oldMenuName; /* The name of the menubar previously set in
+ * this toplevel. NULL means no menu was
+ * set previously. */
+ char *menuName; /* The name of the new menubar that the
+ * toplevel needs to be set to. NULL means
+ * that their is no menu now. */
+{
+ TkMenuTopLevelList *topLevelListPtr, *prevTopLevelPtr;
+ TkMenu *menuPtr;
+ TkMenuReferences *menuRefPtr;
+
+ TkMenuInit();
+
+ /*
+ * Destroy the menubar instances of the old menu. Take this window
+ * out of the old menu's top level reference list.
+ */
+
+ if (oldMenuName != NULL) {
+ menuRefPtr = TkFindMenuReferences(interp, oldMenuName);
+ if (menuRefPtr != NULL) {
+
+ /*
+ * Find the menubar instance that is to be removed. Destroy
+ * it and all of the cascades underneath it.
+ */
+
+ if (menuRefPtr->menuPtr != NULL) {
+ TkMenu *instancePtr;
+
+ menuPtr = menuRefPtr->menuPtr;
+
+ for (instancePtr = menuPtr->masterMenuPtr;
+ instancePtr != NULL;
+ instancePtr = instancePtr->nextInstancePtr) {
+ if (instancePtr->menuType == MENUBAR
+ && instancePtr->parentTopLevelPtr == tkwin) {
+ RecursivelyDeleteMenu(instancePtr);
+ break;
+ }
+ }
+ }
+
+ /*
+ * Now we need to remove this toplevel from the list of toplevels
+ * that reference this menu.
+ */
+
+ for (topLevelListPtr = menuRefPtr->topLevelListPtr,
+ prevTopLevelPtr = NULL;
+ (topLevelListPtr != NULL)
+ && (topLevelListPtr->tkwin != tkwin);
+ prevTopLevelPtr = topLevelListPtr,
+ topLevelListPtr = topLevelListPtr->nextPtr) {
+
+ /*
+ * Empty loop body.
+ */
+
+ }
+
+ /*
+ * Now we have found the toplevel reference that matches the
+ * tkwin; remove this reference from the list.
+ */
+
+ if (topLevelListPtr != NULL) {
+ if (prevTopLevelPtr == NULL) {
+ menuRefPtr->topLevelListPtr =
+ menuRefPtr->topLevelListPtr->nextPtr;
+ } else {
+ prevTopLevelPtr->nextPtr = topLevelListPtr->nextPtr;
+ }
+ ckfree((char *) topLevelListPtr);
+ TkFreeMenuReferences(menuRefPtr);
+ }
+ }
+ }
+
+ /*
+ * Now, add the clone references for the new menu.
+ */
+
+ if (menuName != NULL && menuName[0] != 0) {
+ TkMenu *menuBarPtr = NULL;
+
+ menuRefPtr = TkCreateMenuReferences(interp, menuName);
+
+ menuPtr = menuRefPtr->menuPtr;
+ if (menuPtr != NULL) {
+ char *cloneMenuName;
+ TkMenuReferences *cloneMenuRefPtr;
+ char *newArgv[4];
+
+ /*
+ * Clone the menu and all of the cascades underneath it.
+ */
+
+ cloneMenuName = TkNewMenuName(interp, Tk_PathName(tkwin),
+ menuPtr);
+ CloneMenu(menuPtr, cloneMenuName, "menubar");
+
+ cloneMenuRefPtr = TkFindMenuReferences(interp, cloneMenuName);
+ if ((cloneMenuRefPtr != NULL)
+ && (cloneMenuRefPtr->menuPtr != NULL)) {
+ cloneMenuRefPtr->menuPtr->parentTopLevelPtr = tkwin;
+ menuBarPtr = cloneMenuRefPtr->menuPtr;
+ newArgv[0] = "-cursor";
+ newArgv[1] = "";
+ ConfigureMenu(menuPtr->interp, cloneMenuRefPtr->menuPtr,
+ 2, newArgv, TK_CONFIG_ARGV_ONLY);
+ }
+
+ TkpSetWindowMenuBar(tkwin, menuBarPtr);
+
+ ckfree(cloneMenuName);
+ } else {
+ TkpSetWindowMenuBar(tkwin, NULL);
+ }
+
+
+ /*
+ * Add this window to the menu's list of windows that refer
+ * to this menu.
+ */
+
+ topLevelListPtr = (TkMenuTopLevelList *)
+ ckalloc(sizeof(TkMenuTopLevelList));
+ topLevelListPtr->tkwin = tkwin;
+ topLevelListPtr->nextPtr = menuRefPtr->topLevelListPtr;
+ menuRefPtr->topLevelListPtr = topLevelListPtr;
+ } else {
+ TkpSetWindowMenuBar(tkwin, NULL);
+ }
+ TkpSetMainMenubar(interp, tkwin, menuName);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyMenuHashTable --
+ *
+ * Called when an interp is deleted and a menu hash table has
+ * been set in it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The hash table is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyMenuHashTable(clientData, interp)
+ ClientData clientData; /* The menu hash table we are destroying */
+ Tcl_Interp *interp; /* The interpreter we are destroying */
+{
+ Tcl_DeleteHashTable((Tcl_HashTable *) clientData);
+ ckfree((char *) clientData);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetMenuHashTable --
+ *
+ * For a given interp, give back the menu hash table that goes with
+ * it. If the hash table does not exist, it is created.
+ *
+ * Results:
+ * Returns a hash table pointer.
+ *
+ * Side effects:
+ * A new hash table is created if there were no table in the interp
+ * originally.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_HashTable *
+TkGetMenuHashTable(interp)
+ Tcl_Interp *interp; /* The interp we need the hash table in.*/
+{
+ Tcl_HashTable *menuTablePtr;
+
+ menuTablePtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, MENU_HASH_KEY,
+ NULL);
+ if (menuTablePtr == NULL) {
+ menuTablePtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(menuTablePtr, TCL_STRING_KEYS);
+ Tcl_SetAssocData(interp, MENU_HASH_KEY, DestroyMenuHashTable,
+ (ClientData) menuTablePtr);
+ }
+ return menuTablePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCreateMenuReferences --
+ *
+ * Given a pathname, gives back a pointer to a TkMenuReferences structure.
+ * If a reference is not already in the hash table, one is created.
+ *
+ * Results:
+ * Returns a pointer to a menu reference structure. Should not
+ * be freed by calller; when a field of the reference is cleared,
+ * TkFreeMenuReferences should be called.
+ *
+ * Side effects:
+ * A new hash table entry is created if there were no references
+ * to the menu originally.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkMenuReferences *
+TkCreateMenuReferences(interp, pathName)
+ Tcl_Interp *interp;
+ char *pathName; /* The path of the menu widget */
+{
+ Tcl_HashEntry *hashEntryPtr;
+ TkMenuReferences *menuRefPtr;
+ int newEntry;
+ Tcl_HashTable *menuTablePtr = TkGetMenuHashTable(interp);
+
+ hashEntryPtr = Tcl_CreateHashEntry(menuTablePtr, pathName, &newEntry);
+ if (newEntry) {
+ menuRefPtr = (TkMenuReferences *) ckalloc(sizeof(TkMenuReferences));
+ menuRefPtr->menuPtr = NULL;
+ menuRefPtr->topLevelListPtr = NULL;
+ menuRefPtr->parentEntryPtr = NULL;
+ menuRefPtr->hashEntryPtr = hashEntryPtr;
+ Tcl_SetHashValue(hashEntryPtr, (char *) menuRefPtr);
+ } else {
+ menuRefPtr = (TkMenuReferences *) Tcl_GetHashValue(hashEntryPtr);
+ }
+ return menuRefPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFindMenuReferences --
+ *
+ * Given a pathname, gives back a pointer to the TkMenuReferences
+ * structure.
+ *
+ * Results:
+ * Returns a pointer to a menu reference structure. Should not
+ * be freed by calller; when a field of the reference is cleared,
+ * TkFreeMenuReferences should be called. Returns NULL if no reference
+ * with this pathname exists.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkMenuReferences *
+TkFindMenuReferences(interp, pathName)
+ Tcl_Interp *interp; /* The interp the menu is living in. */
+ char *pathName; /* The path of the menu widget */
+{
+ Tcl_HashEntry *hashEntryPtr;
+ TkMenuReferences *menuRefPtr = NULL;
+ Tcl_HashTable *menuTablePtr;
+
+ menuTablePtr = TkGetMenuHashTable(interp);
+ hashEntryPtr = Tcl_FindHashEntry(menuTablePtr, pathName);
+ if (hashEntryPtr != NULL) {
+ menuRefPtr = (TkMenuReferences *) Tcl_GetHashValue(hashEntryPtr);
+ }
+ return menuRefPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFreeMenuReferences --
+ *
+ * This is called after one of the fields in a menu reference
+ * is cleared. It cleans up the ref if it is now empty.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If this is the last field to be cleared, the menu ref is
+ * taken out of the hash table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFreeMenuReferences(menuRefPtr)
+ TkMenuReferences *menuRefPtr; /* The menu reference to
+ * free */
+{
+ if ((menuRefPtr->menuPtr == NULL)
+ && (menuRefPtr->parentEntryPtr == NULL)
+ && (menuRefPtr->topLevelListPtr == NULL)) {
+ Tcl_DeleteHashEntry(menuRefPtr->hashEntryPtr);
+ ckfree((char *) menuRefPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteMenuCloneEntries --
+ *
+ * For every clone in this clone chain, delete the menu entries
+ * given by the parameters.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The appropriate entries are deleted from all clones of this menu.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteMenuCloneEntries(menuPtr, first, last)
+ TkMenu *menuPtr; /* the menu the command was issued with */
+ int first; /* the zero-based first entry in the set
+ * of entries to delete. */
+ int last; /* the zero-based last entry */
+{
+
+ TkMenu *menuListPtr;
+ int numDeleted, i;
+
+ numDeleted = last + 1 - first;
+ for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL;
+ menuListPtr = menuListPtr->nextInstancePtr) {
+ for (i = last; i >= first; i--) {
+ Tcl_EventuallyFree((ClientData) menuListPtr->entries[i],
+ DestroyMenuEntry);
+ }
+ for (i = last + 1; i < menuListPtr->numEntries; i++) {
+ menuListPtr->entries[i - numDeleted] = menuListPtr->entries[i];
+ menuListPtr->entries[i - numDeleted]->index = i;
+ }
+ menuListPtr->numEntries -= numDeleted;
+ if (menuListPtr->numEntries == 0) {
+ ckfree((char *) menuListPtr->entries);
+ menuListPtr->entries = NULL;
+ }
+ if ((menuListPtr->active >= first)
+ && (menuListPtr->active <= last)) {
+ menuListPtr->active = -1;
+ } else if (menuListPtr->active > last) {
+ menuListPtr->active -= numDeleted;
+ }
+ TkEventuallyRecomputeMenu(menuListPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuInit --
+ *
+ * Sets up the hash tables and the variables used by the menu package.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * lastMenuID gets initialized, and the parent hash and the command hash
+ * are allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMenuInit()
+{
+ if (!menusInitialized) {
+ TkpMenuInit();
+ menusInitialized = 1;
+ }
+}
diff --git a/generic/tkMenu.h b/generic/tkMenu.h
new file mode 100644
index 0000000..6f30d72
--- /dev/null
+++ b/generic/tkMenu.h
@@ -0,0 +1,541 @@
+/*
+ * tkMenu.h --
+ *
+ * Declarations shared among all of the files that implement menu widgets.
+ *
+ * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkMenu.h 1.60 97/06/20 14:43:21
+ */
+
+#ifndef _TKMENU
+#define _TKMENU
+
+#ifndef _TK
+#include "tk.h"
+#endif
+
+#ifndef _TKINT
+#include "tkInt.h"
+#endif
+
+#ifndef _DEFAULT
+#include "default.h"
+#endif
+
+/*
+ * Dummy types used by the platform menu code.
+ */
+
+typedef struct TkMenuPlatformData_ *TkMenuPlatformData;
+typedef struct TkMenuPlatformEntryData_ *TkMenuPlatformEntryData;
+
+/*
+ * One of the following data structures is kept for each entry of each
+ * menu managed by this file:
+ */
+
+typedef struct TkMenuEntry {
+ int type; /* Type of menu entry; see below for
+ * valid types. */
+ struct TkMenu *menuPtr; /* Menu with which this entry is associated. */
+ char *label; /* Main text label displayed in entry (NULL
+ * if no label). Malloc'ed. */
+ int labelLength; /* Number of non-NULL characters in label. */
+ Tk_Uid state; /* State of button for display purposes:
+ * normal, active, or disabled. */
+ int underline; /* Index of character to underline. */
+ Pixmap bitmap; /* Bitmap to display in menu entry, or None.
+ * If not None then label is ignored. */
+ char *imageString; /* Name of image to display (malloc'ed), or
+ * NULL. If non-NULL, bitmap, text, and
+ * textVarName are ignored. */
+ Tk_Image image; /* Image to display in menu entry, or NULL if
+ * none. */
+ char *selectImageString; /* Name of image to display when selected
+ * (malloc'ed), or NULL. */
+ Tk_Image selectImage; /* Image to display in entry when selected,
+ * or NULL if none. Ignored if image is
+ * NULL. */
+ char *accel; /* Accelerator string displayed at right
+ * of menu entry. NULL means no such
+ * accelerator. Malloc'ed. */
+ int accelLength; /* Number of non-NULL characters in
+ * accelerator. */
+ int indicatorOn; /* True means draw indicator, false means
+ * don't draw it. */
+ /*
+ * Display attributes
+ */
+
+ Tk_3DBorder border; /* Structure used to draw background for
+ * entry. NULL means use overall border
+ * for menu. */
+ XColor *fg; /* Foreground color to use for entry. NULL
+ * means use foreground color from menu. */
+ Tk_3DBorder activeBorder; /* Used to draw background and border when
+ * element is active. NULL means use
+ * activeBorder from menu. */
+ XColor *activeFg; /* Foreground color to use when entry is
+ * active. NULL means use active foreground
+ * from menu. */
+ XColor *indicatorFg; /* Color for indicators in radio and check
+ * button entries. NULL means use indicatorFg
+ * GC from menu. */
+ Tk_Font tkfont; /* Text font for menu entries. NULL means
+ * use overall font for menu. */
+ int columnBreak; /* If this is 0, this item appears below
+ * the item in front of it. If this is
+ * 1, this item starts a new column. */
+ int hideMargin; /* If this is 0, then the item has enough
+ * margin to accomodate a standard check
+ * mark and a default right margin. If this
+ * is 1, then the item has no such margins.
+ * and checkbuttons and radiobuttons with
+ * this set will have a rectangle drawn
+ * in the indicator around the item if
+ * the item is checked.
+ * This is useful palette menus.*/
+ int indicatorSpace; /* The width of the indicator space for this
+ * entry.
+ */
+ int labelWidth; /* Number of pixels to allow for displaying
+ * labels in menu entries. */
+
+ /*
+ * Information used to implement this entry's action:
+ */
+
+ char *command; /* Command to invoke when entry is invoked.
+ * Malloc'ed. */
+ char *name; /* Name of variable (for check buttons and
+ * radio buttons) or menu (for cascade
+ * entries). Malloc'ed.*/
+ char *onValue; /* Value to store in variable when selected
+ * (only for radio and check buttons).
+ * Malloc'ed. */
+ char *offValue; /* Value to store in variable when not
+ * selected (only for check buttons).
+ * Malloc'ed. */
+
+ /*
+ * Information used for drawing this menu entry.
+ */
+
+ int width; /* Number of pixels occupied by entry in
+ * horizontal dimension. Not used except
+ * in menubars. The width of norma menus
+ * is dependent on the rest of the menu. */
+ int x; /* X-coordinate of leftmost pixel in entry */
+ int height; /* Number of pixels occupied by entry in
+ * vertical dimension, including raised
+ * border drawn around entry when active. */
+ int y; /* Y-coordinate of topmost pixel in entry. */
+ GC textGC; /* GC for drawing text in entry. NULL means
+ * use overall textGC for menu. */
+ GC activeGC; /* GC for drawing text in entry when active.
+ * NULL means use overall activeGC for
+ * menu. */
+ GC disabledGC; /* Used to produce disabled effect for entry.
+ * NULL means use overall disabledGC from
+ * menu structure. See comments for
+ * disabledFg in menu structure for more
+ * information. */
+ GC indicatorGC; /* For drawing indicators. None means use
+ * GC from menu. */
+
+ /*
+ * Miscellaneous fields.
+ */
+
+ int entryFlags; /* Various flags. See below for
+ definitions. */
+ int index; /* Need to know which index we are. This
+ * is zero-based. This is the top-left entry
+ * of the menu. */
+
+ /*
+ * Bookeeping for master menus and cascade menus.
+ */
+
+ struct TkMenuReferences *childMenuRefPtr;
+ /* A pointer to the hash table entry for
+ * the child menu. Stored here when the menu
+ * entry is configured so that a hash lookup
+ * is not necessary later.*/
+ struct TkMenuEntry *nextCascadePtr;
+ /* The next cascade entry that is a parent of
+ * this entry's child cascade menu. NULL
+ * end of list, this is not a cascade entry,
+ * or the menu that this entry point to
+ * does not yet exist. */
+ TkMenuPlatformEntryData platformEntryData;
+ /* The data for the specific type of menu.
+ * Depends on platform and menu type what
+ * kind of options are in this structure.
+ */
+} TkMenuEntry;
+
+/*
+ * Flag values defined for menu entries:
+ *
+ * ENTRY_SELECTED: Non-zero means this is a radio or check
+ * button and that it should be drawn in
+ * the "selected" state.
+ * ENTRY_NEEDS_REDISPLAY: Non-zero means the entry should be redisplayed.
+ * ENTRY_LAST_COLUMN: Used by the drawing code. If the entry is in the
+ * last column, the space to its right needs to
+ * be filled.
+ * ENTRY_PLATFORM_FLAG1 - 4 These flags are reserved for use by the
+ * platform-dependent implementation of menus
+ * and should not be used by anything else.
+ */
+
+#define ENTRY_SELECTED 1
+#define ENTRY_NEEDS_REDISPLAY 2
+#define ENTRY_LAST_COLUMN 4
+#define ENTRY_PLATFORM_FLAG1 (1 << 30)
+#define ENTRY_PLATFORM_FLAG2 (1 << 29)
+#define ENTRY_PLATFORM_FLAG3 (1 << 28)
+#define ENTRY_PLATFORM_FLAG4 (1 << 27)
+
+/*
+ * Types defined for MenuEntries:
+ */
+
+#define COMMAND_ENTRY 0
+#define SEPARATOR_ENTRY 1
+#define CHECK_BUTTON_ENTRY 2
+#define RADIO_BUTTON_ENTRY 3
+#define CASCADE_ENTRY 4
+#define TEAROFF_ENTRY 5
+
+/*
+ * Mask bits for above types:
+ */
+
+#define COMMAND_MASK TK_CONFIG_USER_BIT
+#define SEPARATOR_MASK (TK_CONFIG_USER_BIT << 1)
+#define CHECK_BUTTON_MASK (TK_CONFIG_USER_BIT << 2)
+#define RADIO_BUTTON_MASK (TK_CONFIG_USER_BIT << 3)
+#define CASCADE_MASK (TK_CONFIG_USER_BIT << 4)
+#define TEAROFF_MASK (TK_CONFIG_USER_BIT << 5)
+#define ALL_MASK (COMMAND_MASK | SEPARATOR_MASK \
+ | CHECK_BUTTON_MASK | RADIO_BUTTON_MASK | CASCADE_MASK | TEAROFF_MASK)
+
+/*
+ * A data structure of the following type is kept for each
+ * menu widget:
+ */
+
+typedef struct TkMenu {
+ Tk_Window tkwin; /* Window that embodies the pane. NULL
+ * means that the window has been destroyed
+ * but the data structures haven't yet been
+ * cleaned up.*/
+ Display *display; /* Display containing widget. Needed, among
+ * other things, so that resources can be
+ * freed up even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with menu. */
+ Tcl_Command widgetCmd; /* Token for menu's widget command. */
+ TkMenuEntry **entries; /* Array of pointers to all the entries
+ * in the menu. NULL means no entries. */
+ int numEntries; /* Number of elements in entries. */
+ int active; /* Index of active entry. -1 means
+ * nothing active. */
+ int menuType; /* MASTER_MENU, TEAROFF_MENU, or MENUBAR.
+ * See below for definitions. */
+ char *menuTypeName; /* Used to control whether created tkwin
+ * is a toplevel or not. "normal", "menubar",
+ * or "toplevel" */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ Tk_3DBorder border; /* Structure used to draw 3-D
+ * border and background for menu. */
+ int borderWidth; /* Width of border around whole menu. */
+ Tk_3DBorder activeBorder; /* Used to draw background and border for
+ * active element (if any). */
+ int activeBorderWidth; /* Width of border around active element. */
+ int relief; /* 3-d effect: TK_RELIEF_RAISED, etc. */
+ Tk_Font tkfont; /* Text font for menu entries. */
+ XColor *fg; /* Foreground color for entries. */
+ XColor *disabledFg; /* Foreground color when disabled. NULL
+ * means use normalFg with a 50% stipple
+ * instead. */
+ XColor *activeFg; /* Foreground color for active entry. */
+ XColor *indicatorFg; /* Color for indicators in radio and check
+ * button entries. */
+ Pixmap gray; /* Bitmap for drawing disabled entries in
+ * a stippled fashion. None means not
+ * allocated yet. */
+ GC textGC; /* GC for drawing text and other features
+ * of menu entries. */
+ GC disabledGC; /* Used to produce disabled effect. If
+ * disabledFg isn't NULL, this GC is used to
+ * draw text and icons for disabled entries.
+ * Otherwise text and icons are drawn with
+ * normalGC and this GC is used to stipple
+ * background across them. */
+ GC activeGC; /* GC for drawing active entry. */
+ GC indicatorGC; /* For drawing indicators. */
+ GC disabledImageGC; /* Used for drawing disabled images. They
+ * have to be stippled. This is created
+ * when the image is about to be drawn the
+ * first time. */
+
+ /*
+ * Information about geometry of menu.
+ */
+
+ int totalWidth; /* Width of entire menu */
+ int totalHeight; /* Height of entire menu */
+
+ /*
+ * Miscellaneous information:
+ */
+
+ int tearOff; /* 1 means this menu can be torn off. On some
+ * platforms, the user can drag an outline
+ * of the menu by just dragging outside of
+ * the menu, and the tearoff is created where
+ * the mouse is released. On others, an
+ * indicator (such as a dashed stripe) is
+ * drawn, and when the menu is selected, the
+ * tearoff is created. */
+ char *title; /* The title to use when this menu is torn
+ * off. If this is NULL, a default scheme
+ * will be used to generate a title for
+ * tearoff. */
+ char *tearOffCommand; /* If non-NULL, points to a command to
+ * run whenever the menu is torn-off. */
+ char *takeFocus; /* Value of -takefocus option; not used in
+ * the C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ char *postCommand; /* Used to detect cycles in cascade hierarchy
+ * trees when preprocessing postcommands
+ * on some platforms. See PostMenu for
+ * more details. */
+ int postCommandGeneration; /* Need to do pre-invocation post command
+ * traversal */
+ int menuFlags; /* Flags for use by X; see below for
+ definition */
+ TkMenuEntry *postedCascade; /* Points to menu entry for cascaded submenu
+ * that is currently posted or NULL if no
+ * submenu posted. */
+ struct TkMenu *nextInstancePtr;
+ /* The next instance of this menu in the
+ * chain. */
+ struct TkMenu *masterMenuPtr;
+ /* A pointer to the original menu for this
+ * clone chain. Points back to this structure
+ * if this menu is a master menu. */
+ Tk_Window parentTopLevelPtr;/* If this menu is a menubar, this is the
+ * toplevel that owns the menu. Only applicable
+ * for menubar clones.
+ */
+ struct TkMenuReferences *menuRefPtr;
+ /* Each menu is hashed into a table with the
+ * name of the menu's window as the key.
+ * The information in this hash table includes
+ * a pointer to the menu (so that cascades
+ * can find this menu), a pointer to the
+ * list of toplevel widgets that have this
+ * menu as its menubar, and a list of menu
+ * entries that have this menu specified
+ * as a cascade. */
+ TkMenuPlatformData platformData;
+ /* The data for the specific type of menu.
+ * Depends on platform and menu type what
+ * kind of options are in this structure.
+ */
+} TkMenu;
+
+/*
+ * When the toplevel configure -menu command is executed, the menu may not
+ * exist yet. We need to keep a linked list of windows that reference
+ * a particular menu.
+ */
+
+typedef struct TkMenuTopLevelList {
+ struct TkMenuTopLevelList *nextPtr;
+ /* The next window in the list */
+ Tk_Window tkwin; /* The window that has this menu as its
+ * menubar. */
+} TkMenuTopLevelList;
+
+/*
+ * The following structure is used to keep track of things which
+ * reference a menu. It is created when:
+ * - a menu is created.
+ * - a cascade entry is added to a menu with a non-null name
+ * - the "-menu" configuration option is used on a toplevel widget
+ * with a non-null parameter.
+ *
+ * One of these three fields must be non-NULL, but any of the fields may
+ * be NULL. This structure makes it easy to determine whether or not
+ * anything like recalculating platform data or geometry is necessary
+ * when one of the three actions above is performed.
+ */
+
+typedef struct TkMenuReferences {
+ struct TkMenu *menuPtr; /* The menu data structure. This is NULL
+ * if the menu does not exist. */
+ TkMenuTopLevelList *topLevelListPtr;
+ /* First in the list of all toplevels that
+ * have this menu as its menubar. NULL if no
+ * toplevel widgets have this menu as its
+ * menubar. */
+ TkMenuEntry *parentEntryPtr;/* First in the list of all cascade menu
+ * entries that have this menu as their child.
+ * NULL means no cascade entries. */
+ Tcl_HashEntry *hashEntryPtr;/* This is needed because the pathname of the
+ * window (which is what we hash on) may not
+ * be around when we are deleting.
+ */
+} TkMenuReferences;
+
+/*
+ * Flag bits for menus:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler
+ * has already been queued to redraw
+ * this window.
+ * RESIZE_PENDING: Non-zero means a call to ComputeMenuGeometry
+ * has already been scheduled.
+ * MENU_DELETION_PENDING Non-zero means that we are currently destroying
+ * this menu. This is useful when we are in the
+ * middle of cleaning this master menu's chain of
+ * menus up when TkDestroyMenu was called again on
+ * this menu (via a destroy binding or somesuch).
+ * MENU_PLATFORM_FLAG1... Reserved for use by the platform-specific menu
+ * code.
+ */
+
+#define REDRAW_PENDING 1
+#define RESIZE_PENDING 2
+#define MENU_DELETION_PENDING 4
+#define MENU_PLATFORM_FLAG1 (1 << 30)
+#define MENU_PLATFORM_FLAG2 (1 << 29)
+#define MENU_PLATFORM_FLAG3 (1 << 28)
+
+/*
+ * Each menu created by the user is a MASTER_MENU. When a menu is torn off,
+ * a TEAROFF_MENU instance is created. When a menu is assigned to a toplevel
+ * as a menu bar, a MENUBAR instance is created. All instances have the same
+ * configuration information. If the master instance is deleted, all instances
+ * are deleted. If one of the other instances is deleted, only that instance
+ * is deleted.
+ */
+
+#define UNKNOWN_TYPE -1
+#define MASTER_MENU 0
+#define TEAROFF_MENU 1
+#define MENUBAR 2
+
+/*
+ * Various geometry definitions:
+ */
+
+#define CASCADE_ARROW_HEIGHT 10
+#define CASCADE_ARROW_WIDTH 8
+#define DECORATION_BORDER_WIDTH 2
+
+/*
+ * Configuration specs. Needed for platform-specific default initializations.
+ */
+
+EXTERN Tk_ConfigSpec tkMenuEntryConfigSpecs[];
+EXTERN Tk_ConfigSpec tkMenuConfigSpecs[];
+
+/*
+ * Menu-related procedures that are shared among Tk modules but not exported
+ * to the outside world:
+ */
+
+EXTERN int TkActivateMenuEntry _ANSI_ARGS_((TkMenu *menuPtr,
+ int index));
+EXTERN void TkBindMenu _ANSI_ARGS_((
+ Tk_Window tkwin, TkMenu *menuPtr));
+EXTERN TkMenuReferences *
+ TkCreateMenuReferences _ANSI_ARGS_((Tcl_Interp *interp,
+ char *pathName));
+EXTERN void TkDestroyMenu _ANSI_ARGS_((TkMenu *menuPtr));
+EXTERN void TkEventuallyRecomputeMenu _ANSI_ARGS_((TkMenu *menuPtr));
+EXTERN void TkEventuallyRedrawMenu _ANSI_ARGS_((
+ TkMenu *menuPtr, TkMenuEntry *mePtr));
+EXTERN TkMenuReferences *
+ TkFindMenuReferences _ANSI_ARGS_((Tcl_Interp *interp,
+ char *pathName));
+EXTERN void TkFreeMenuReferences _ANSI_ARGS_((
+ TkMenuReferences *menuRefPtr));
+EXTERN Tcl_HashTable * TkGetMenuHashTable _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int TkGetMenuIndex _ANSI_ARGS_((Tcl_Interp *interp,
+ TkMenu *menuPtr, char *string, int lastOK,
+ int *indexPtr));
+EXTERN void TkMenuInitializeDrawingFields _ANSI_ARGS_((TkMenu *menuPtr));
+EXTERN void TkMenuInitializeEntryDrawingFields _ANSI_ARGS_((
+ TkMenuEntry *mePtr));
+EXTERN int TkInvokeMenu _ANSI_ARGS_((Tcl_Interp *interp,
+ TkMenu *menuPtr, int index));
+EXTERN void TkMenuConfigureDrawOptions _ANSI_ARGS_((
+ TkMenu *menuPtr));
+EXTERN int TkMenuConfigureEntryDrawOptions _ANSI_ARGS_((
+ TkMenuEntry *mePtr, int index));
+EXTERN void TkMenuFreeDrawOptions _ANSI_ARGS_((TkMenu *menuPtr));
+EXTERN void TkMenuEntryFreeDrawOptions _ANSI_ARGS_((
+ TkMenuEntry *mePtr));
+EXTERN void TkMenuEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+EXTERN void TkMenuImageProc _ANSI_ARGS_((
+ ClientData clientData, int x, int y, int width,
+ int height, int imgWidth, int imgHeight));
+EXTERN void TkMenuInit _ANSI_ARGS_((void));
+EXTERN void TkMenuSelectImageProc _ANSI_ARGS_
+ ((ClientData clientData, int x, int y,
+ int width, int height, int imgWidth,
+ int imgHeight));
+EXTERN char * TkNewMenuName _ANSI_ARGS_((Tcl_Interp *interp,
+ char *parentName, TkMenu *menuPtr));
+EXTERN int TkPostCommand _ANSI_ARGS_((TkMenu *menuPtr));
+EXTERN int TkPostSubmenu _ANSI_ARGS_((Tcl_Interp *interp,
+ TkMenu *menuPtr, TkMenuEntry *mePtr));
+EXTERN int TkPostTearoffMenu _ANSI_ARGS_((Tcl_Interp *interp,
+ TkMenu *menuPtr, int x, int y));
+EXTERN int TkPreprocessMenu _ANSI_ARGS_((TkMenu *menuPtr));
+EXTERN void TkRecomputeMenu _ANSI_ARGS_((TkMenu *menuPtr));
+
+/*
+ * These routines are the platform-dependent routines called by the
+ * common code.
+ */
+
+EXTERN void TkpComputeMenubarGeometry _ANSI_ARGS_((TkMenu *menuPtr));
+EXTERN void TkpComputeStandardMenuGeometry _ANSI_ARGS_
+ ((TkMenu *menuPtr));
+EXTERN int TkpConfigureMenuEntry
+ _ANSI_ARGS_((TkMenuEntry *mePtr));
+EXTERN void TkpDestroyMenu _ANSI_ARGS_((TkMenu *menuPtr));
+EXTERN void TkpDestroyMenuEntry
+ _ANSI_ARGS_((TkMenuEntry *mEntryPtr));
+EXTERN void TkpDrawMenuEntry _ANSI_ARGS_((TkMenuEntry *mePtr,
+ Drawable d, Tk_Font tkfont,
+ CONST Tk_FontMetrics *menuMetricsPtr, int x,
+ int y, int width, int height, int strictMotif,
+ int drawArrow));
+EXTERN void TkpMenuInit _ANSI_ARGS_((void));
+EXTERN int TkpMenuNewEntry _ANSI_ARGS_((TkMenuEntry *mePtr));
+EXTERN int TkpNewMenu _ANSI_ARGS_((TkMenu *menuPtr));
+EXTERN int TkpPostMenu _ANSI_ARGS_((Tcl_Interp *interp,
+ TkMenu *menuPtr, int x, int y));
+EXTERN void TkpSetWindowMenuBar _ANSI_ARGS_((Tk_Window tkwin,
+ TkMenu *menuPtr));
+
+#endif /* _TKMENU */
+
diff --git a/generic/tkMenuDraw.c b/generic/tkMenuDraw.c
new file mode 100644
index 0000000..be218a0
--- /dev/null
+++ b/generic/tkMenuDraw.c
@@ -0,0 +1,1018 @@
+/*
+ * tkMenuDraw.c --
+ *
+ * This module implements the platform-independent drawing and
+ * geometry calculations of menu widgets.
+ *
+ * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkMenuDraw.c 1.46 97/10/28 14:26:00
+ */
+
+#include "tkMenu.h"
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void AdjustMenuCoords _ANSI_ARGS_ ((TkMenu *menuPtr,
+ TkMenuEntry *mePtr, int *xPtr, int *yPtr,
+ char *string));
+static void ComputeMenuGeometry _ANSI_ARGS_((
+ ClientData clientData));
+static void DisplayMenu _ANSI_ARGS_((ClientData clientData));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuInitializeDrawingFields --
+ *
+ * Fills in drawing fields of a new menu. Called when new menu is
+ * created by Tk_MenuCmd.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * menuPtr fields are initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMenuInitializeDrawingFields(menuPtr)
+ TkMenu *menuPtr; /* The menu we are initializing. */
+{
+ menuPtr->textGC = None;
+ menuPtr->gray = None;
+ menuPtr->disabledGC = None;
+ menuPtr->activeGC = None;
+ menuPtr->indicatorGC = None;
+ menuPtr->disabledImageGC = None;
+ menuPtr->totalWidth = menuPtr->totalHeight = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuInitializeEntryDrawingFields --
+ *
+ * Fills in drawing fields of a new menu entry. Called when an
+ * entry is created.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMenuInitializeEntryDrawingFields(mePtr)
+ TkMenuEntry *mePtr; /* The menu we are initializing. */
+{
+ mePtr->width = 0;
+ mePtr->height = 0;
+ mePtr->x = 0;
+ mePtr->y = 0;
+ mePtr->indicatorSpace = 0;
+ mePtr->labelWidth = 0;
+ mePtr->textGC = None;
+ mePtr->activeGC = None;
+ mePtr->disabledGC = None;
+ mePtr->indicatorGC = None;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuFreeDrawOptions --
+ *
+ * Frees up any structures allocated for the drawing of a menu.
+ * Called when menu is deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Storage is released.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMenuFreeDrawOptions(menuPtr)
+ TkMenu *menuPtr;
+{
+ if (menuPtr->textGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->textGC);
+ }
+ if (menuPtr->disabledImageGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->disabledImageGC);
+ }
+ if (menuPtr->gray != None) {
+ Tk_FreeBitmap(menuPtr->display, menuPtr->gray);
+ }
+ if (menuPtr->disabledGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->disabledGC);
+ }
+ if (menuPtr->activeGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->activeGC);
+ }
+ if (menuPtr->indicatorGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->indicatorGC);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuEntryFreeDrawOptions --
+ *
+ * Frees up drawing structures for a menu entry. Called when
+ * menu entry is freed.
+ *
+ * RESULTS:
+ * None.
+ *
+ * Side effects:
+ * Storage is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMenuEntryFreeDrawOptions(mePtr)
+ TkMenuEntry *mePtr;
+{
+ if (mePtr->textGC != None) {
+ Tk_FreeGC(mePtr->menuPtr->display, mePtr->textGC);
+ }
+ if (mePtr->disabledGC != None) {
+ Tk_FreeGC(mePtr->menuPtr->display, mePtr->disabledGC);
+ }
+ if (mePtr->activeGC != None) {
+ Tk_FreeGC(mePtr->menuPtr->display, mePtr->activeGC);
+ }
+ if (mePtr->indicatorGC != None) {
+ Tk_FreeGC(mePtr->menuPtr->display, mePtr->indicatorGC);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuConfigureDrawOptions --
+ *
+ * Sets the menu's drawing attributes in preparation for drawing
+ * the menu.
+ *
+ * RESULTS:
+ * None.
+ *
+ * Side effects:
+ * Storage is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMenuConfigureDrawOptions(menuPtr)
+ TkMenu *menuPtr; /* The menu we are configuring. */
+{
+ XGCValues gcValues;
+ GC newGC;
+ unsigned long mask;
+
+ /*
+ * A few options need special processing, such as setting the
+ * background from a 3-D border, or filling in complicated
+ * defaults that couldn't be specified to Tk_ConfigureWidget.
+ */
+
+ Tk_SetBackgroundFromBorder(menuPtr->tkwin, menuPtr->border);
+
+ gcValues.font = Tk_FontId(menuPtr->tkfont);
+ gcValues.foreground = menuPtr->fg->pixel;
+ gcValues.background = Tk_3DBorderColor(menuPtr->border)->pixel;
+ newGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCFont,
+ &gcValues);
+ if (menuPtr->textGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->textGC);
+ }
+ menuPtr->textGC = newGC;
+
+ gcValues.font = Tk_FontId(menuPtr->tkfont);
+ gcValues.background = Tk_3DBorderColor(menuPtr->border)->pixel;
+ if (menuPtr->disabledFg != NULL) {
+ gcValues.foreground = menuPtr->disabledFg->pixel;
+ mask = GCForeground|GCBackground|GCFont;
+ } else {
+ gcValues.foreground = gcValues.background;
+ mask = GCForeground;
+ if (menuPtr->gray == None) {
+ menuPtr->gray = Tk_GetBitmap(menuPtr->interp, menuPtr->tkwin,
+ Tk_GetUid("gray50"));
+ }
+ if (menuPtr->gray != None) {
+ gcValues.fill_style = FillStippled;
+ gcValues.stipple = menuPtr->gray;
+ mask = GCForeground|GCFillStyle|GCStipple;
+ }
+ }
+ newGC = Tk_GetGC(menuPtr->tkwin, mask, &gcValues);
+ if (menuPtr->disabledGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->disabledGC);
+ }
+ menuPtr->disabledGC = newGC;
+
+ gcValues.foreground = Tk_3DBorderColor(menuPtr->border)->pixel;
+ if (menuPtr->gray == None) {
+ menuPtr->gray = Tk_GetBitmap(menuPtr->interp, menuPtr->tkwin,
+ Tk_GetUid("gray50"));
+ }
+ if (menuPtr->gray != None) {
+ gcValues.fill_style = FillStippled;
+ gcValues.stipple = menuPtr->gray;
+ newGC = Tk_GetGC(menuPtr->tkwin,
+ GCForeground|GCFillStyle|GCStipple, &gcValues);
+ }
+ if (menuPtr->disabledImageGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->disabledImageGC);
+ }
+ menuPtr->disabledImageGC = newGC;
+
+ gcValues.font = Tk_FontId(menuPtr->tkfont);
+ gcValues.foreground = menuPtr->activeFg->pixel;
+ gcValues.background =
+ Tk_3DBorderColor(menuPtr->activeBorder)->pixel;
+ newGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCFont,
+ &gcValues);
+ if (menuPtr->activeGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->activeGC);
+ }
+ menuPtr->activeGC = newGC;
+
+ gcValues.foreground = menuPtr->indicatorFg->pixel;
+ gcValues.background = Tk_3DBorderColor(menuPtr->border)->pixel;
+ newGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCFont,
+ &gcValues);
+ if (menuPtr->indicatorGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->indicatorGC);
+ }
+ menuPtr->indicatorGC = newGC;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuConfigureEntryDrawOptions --
+ *
+ * Calculates any entry-specific draw options for the given menu
+ * entry.
+ *
+ * Results:
+ * Returns a standard Tcl error.
+ *
+ * Side effects:
+ * Storage may be allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkMenuConfigureEntryDrawOptions(mePtr, index)
+ TkMenuEntry *mePtr;
+ int index;
+{
+
+ XGCValues gcValues;
+ GC newGC, newActiveGC, newDisabledGC, newIndicatorGC;
+ unsigned long mask;
+ Tk_Font tkfont;
+ TkMenu *menuPtr = mePtr->menuPtr;
+
+ tkfont = (mePtr->tkfont == NULL) ? menuPtr->tkfont : mePtr->tkfont;
+
+ if (mePtr->state == tkActiveUid) {
+ if (index != menuPtr->active) {
+ TkActivateMenuEntry(menuPtr, index);
+ }
+ } else {
+ if (index == menuPtr->active) {
+ TkActivateMenuEntry(menuPtr, -1);
+ }
+ if ((mePtr->state != tkNormalUid)
+ && (mePtr->state != tkDisabledUid)) {
+ Tcl_AppendResult(menuPtr->interp, "bad state value \"",
+ mePtr->state,
+ "\": must be normal, active, or disabled", (char *) NULL);
+ mePtr->state = tkNormalUid;
+ return TCL_ERROR;
+ }
+ }
+
+ if ((mePtr->tkfont != NULL)
+ || (mePtr->border != NULL)
+ || (mePtr->fg != NULL)
+ || (mePtr->activeBorder != NULL)
+ || (mePtr->activeFg != NULL)
+ || (mePtr->indicatorFg != NULL)) {
+ gcValues.foreground = (mePtr->fg != NULL)
+ ? mePtr->fg->pixel
+ : menuPtr->fg->pixel;
+ gcValues.background = Tk_3DBorderColor(
+ (mePtr->border != NULL)
+ ? mePtr->border
+ : menuPtr->border)
+ ->pixel;
+
+ gcValues.font = Tk_FontId(tkfont);
+
+ /*
+ * Note: disable GraphicsExpose events; we know there won't be
+ * obscured areas when copying from an off-screen pixmap to the
+ * screen and this gets rid of unnecessary events.
+ */
+
+ gcValues.graphics_exposures = False;
+ newGC = Tk_GetGC(menuPtr->tkwin,
+ GCForeground|GCBackground|GCFont|GCGraphicsExposures,
+ &gcValues);
+
+ if (mePtr->indicatorFg != NULL) {
+ gcValues.foreground = mePtr->indicatorFg->pixel;
+ } else if (menuPtr->indicatorFg != NULL) {
+ gcValues.foreground = menuPtr->indicatorFg->pixel;
+ }
+ newIndicatorGC = Tk_GetGC(menuPtr->tkwin,
+ GCForeground|GCBackground|GCGraphicsExposures,
+ &gcValues);
+
+ if ((menuPtr->disabledFg != NULL) || (mePtr->image != NULL)) {
+ gcValues.foreground = menuPtr->disabledFg->pixel;
+ mask = GCForeground|GCBackground|GCFont|GCGraphicsExposures;
+ } else {
+ gcValues.foreground = gcValues.background;
+ gcValues.fill_style = FillStippled;
+ gcValues.stipple = menuPtr->gray;
+ mask = GCForeground|GCFillStyle|GCStipple;
+ }
+ newDisabledGC = Tk_GetGC(menuPtr->tkwin, mask, &gcValues);
+
+ gcValues.foreground = (mePtr->activeFg != NULL)
+ ? mePtr->activeFg->pixel
+ : menuPtr->activeFg->pixel;
+ gcValues.background = Tk_3DBorderColor(
+ (mePtr->activeBorder != NULL)
+ ? mePtr->activeBorder
+ : menuPtr->activeBorder)->pixel;
+ newActiveGC = Tk_GetGC(menuPtr->tkwin,
+ GCForeground|GCBackground|GCFont|GCGraphicsExposures,
+ &gcValues);
+ } else {
+ newGC = None;
+ newActiveGC = None;
+ newDisabledGC = None;
+ newIndicatorGC = None;
+ }
+ if (mePtr->textGC != None) {
+ Tk_FreeGC(menuPtr->display, mePtr->textGC);
+ }
+ mePtr->textGC = newGC;
+ if (mePtr->activeGC != None) {
+ Tk_FreeGC(menuPtr->display, mePtr->activeGC);
+ }
+ mePtr->activeGC = newActiveGC;
+ if (mePtr->disabledGC != None) {
+ Tk_FreeGC(menuPtr->display, mePtr->disabledGC);
+ }
+ mePtr->disabledGC = newDisabledGC;
+ if (mePtr->indicatorGC != None) {
+ Tk_FreeGC(menuPtr->display, mePtr->indicatorGC);
+ }
+ mePtr->indicatorGC = newIndicatorGC;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkEventuallyRecomputeMenu --
+ *
+ * Tells Tcl to redo the geometry because this menu has changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Menu geometry is recomputed at idle time, and the menu will be
+ * redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkEventuallyRecomputeMenu(menuPtr)
+ TkMenu *menuPtr;
+{
+ if (!(menuPtr->menuFlags & RESIZE_PENDING)) {
+ menuPtr->menuFlags |= RESIZE_PENDING;
+ Tcl_DoWhenIdle(ComputeMenuGeometry, (ClientData) menuPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkRecomputeMenu --
+ *
+ * Tells Tcl to redo the geometry because this menu has changed.
+ * Does it now; removes any ComputeMenuGeometries from the idler.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Menu geometry is immediately reconfigured.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkRecomputeMenu(menuPtr)
+ TkMenu *menuPtr;
+{
+ if (menuPtr->menuFlags & RESIZE_PENDING) {
+ Tcl_CancelIdleCall(ComputeMenuGeometry, (ClientData) menuPtr);
+ ComputeMenuGeometry((ClientData) menuPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkEventuallyRedrawMenu --
+ *
+ * Arrange for an entry of a menu, or the whole menu, to be
+ * redisplayed at some point in the future.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A when-idle hander is scheduled to do the redisplay, if there
+ * isn't one already scheduled.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkEventuallyRedrawMenu(menuPtr, mePtr)
+ register TkMenu *menuPtr; /* Information about menu to redraw. */
+ register TkMenuEntry *mePtr; /* Entry to redraw. NULL means redraw
+ * all the entries in the menu. */
+{
+ int i;
+
+ if (menuPtr->tkwin == NULL) {
+ return;
+ }
+ if (mePtr != NULL) {
+ mePtr->entryFlags |= ENTRY_NEEDS_REDISPLAY;
+ } else {
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ menuPtr->entries[i]->entryFlags |= ENTRY_NEEDS_REDISPLAY;
+ }
+ }
+ if (!Tk_IsMapped(menuPtr->tkwin)
+ || (menuPtr->menuFlags & REDRAW_PENDING)) {
+ return;
+ }
+ Tcl_DoWhenIdle(DisplayMenu, (ClientData) menuPtr);
+ menuPtr->menuFlags |= REDRAW_PENDING;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeMenuGeometry --
+ *
+ * This procedure is invoked to recompute the size and
+ * layout of a menu. It is called as a when-idle handler so
+ * that it only gets done once, even if a group of changes is
+ * made to the menu.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Fields of menu entries are changed to reflect their
+ * current positions, and the size of the menu window
+ * itself may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputeMenuGeometry(clientData)
+ ClientData clientData; /* Structure describing menu. */
+{
+ TkMenu *menuPtr = (TkMenu *) clientData;
+
+ if (menuPtr->tkwin == NULL) {
+ return;
+ }
+
+ if (menuPtr->menuType == MENUBAR) {
+ TkpComputeMenubarGeometry(menuPtr);
+ } else {
+ TkpComputeStandardMenuGeometry(menuPtr);
+ }
+
+ if ((menuPtr->totalWidth != Tk_ReqWidth(menuPtr->tkwin)) ||
+ (menuPtr->totalHeight != Tk_ReqHeight(menuPtr->tkwin))) {
+ Tk_GeometryRequest(menuPtr->tkwin, menuPtr->totalWidth,
+ menuPtr->totalHeight);
+ }
+
+ /*
+ * Must always force a redisplay here if the window is mapped
+ * (even if the size didn't change, something else might have
+ * changed in the menu, such as a label or accelerator). The
+ * resize will force a redisplay above.
+ */
+
+ TkEventuallyRedrawMenu(menuPtr, (TkMenuEntry *) NULL);
+
+ menuPtr->menuFlags &= ~RESIZE_PENDING;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuSelectImageProc --
+ *
+ * This procedure is invoked by the image code whenever the manager
+ * for an image does something that affects the size of contents
+ * of an image displayed in a menu entry when it is selected.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for the menu to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMenuSelectImageProc(clientData, x, y, width, height, imgWidth,
+ imgHeight)
+ ClientData clientData; /* Pointer to widget record. */
+ int x, y; /* Upper left pixel (within image)
+ * that must be redisplayed. */
+ int width, height; /* Dimensions of area to redisplay
+ * (may be <= 0). */
+ int imgWidth, imgHeight; /* New dimensions of image. */
+{
+ register TkMenuEntry *mePtr = (TkMenuEntry *) clientData;
+
+ if ((mePtr->entryFlags & ENTRY_SELECTED)
+ && !(mePtr->menuPtr->menuFlags &
+ REDRAW_PENDING)) {
+ mePtr->menuPtr->menuFlags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayMenu, (ClientData) mePtr->menuPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplayMenu --
+ *
+ * This procedure is invoked to display a menu widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplayMenu(clientData)
+ ClientData clientData; /* Information about widget. */
+{
+ register TkMenu *menuPtr = (TkMenu *) clientData;
+ register TkMenuEntry *mePtr;
+ register Tk_Window tkwin = menuPtr->tkwin;
+ int index, strictMotif;
+ Tk_Font tkfont = menuPtr->tkfont;
+ Tk_FontMetrics menuMetrics;
+ int width;
+
+ menuPtr->menuFlags &= ~REDRAW_PENDING;
+ if ((menuPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ if (menuPtr->menuType == MENUBAR) {
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), menuPtr->border,
+ menuPtr->borderWidth, menuPtr->borderWidth,
+ Tk_Width(tkwin) - 2 * menuPtr->borderWidth,
+ Tk_Height(tkwin) - 2 * menuPtr->borderWidth, 0,
+ TK_RELIEF_FLAT);
+ }
+
+ strictMotif = Tk_StrictMotif(menuPtr->tkwin);
+
+ /*
+ * See note in ComputeMenuGeometry. We don't want to be doing font metrics
+ * all of the time.
+ */
+
+ Tk_GetFontMetrics(menuPtr->tkfont, &menuMetrics);
+
+ /*
+ * Loop through all of the entries, drawing them one at a time.
+ */
+
+ for (index = 0; index < menuPtr->numEntries; index++) {
+ mePtr = menuPtr->entries[index];
+ if (menuPtr->menuType != MENUBAR) {
+ if (!(mePtr->entryFlags & ENTRY_NEEDS_REDISPLAY)) {
+ continue;
+ }
+ }
+ mePtr->entryFlags &= ~ENTRY_NEEDS_REDISPLAY;
+
+ if (menuPtr->menuType == MENUBAR) {
+ width = mePtr->width;
+ } else {
+ if (mePtr->entryFlags & ENTRY_LAST_COLUMN) {
+ width = Tk_Width(menuPtr->tkwin) - mePtr->x
+ - menuPtr->activeBorderWidth;
+ } else {
+ width = mePtr->width + menuPtr->borderWidth;
+ }
+ }
+ TkpDrawMenuEntry(mePtr, Tk_WindowId(menuPtr->tkwin), tkfont,
+ &menuMetrics, mePtr->x, mePtr->y, width,
+ mePtr->height, strictMotif, 1);
+ if ((index > 0) && (menuPtr->menuType != MENUBAR)
+ && mePtr->columnBreak) {
+ mePtr = menuPtr->entries[index - 1];
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), menuPtr->border,
+ mePtr->x, mePtr->y + mePtr->height,
+ mePtr->width,
+ Tk_Height(tkwin) - mePtr->y - mePtr->height
+ - menuPtr->activeBorderWidth, 0,
+ TK_RELIEF_FLAT);
+ }
+ }
+
+ if (menuPtr->menuType != MENUBAR) {
+ int x, y, height;
+
+ if (menuPtr->numEntries == 0) {
+ x = y = menuPtr->borderWidth;
+ width = Tk_Width(tkwin) - 2 * menuPtr->activeBorderWidth;
+ height = Tk_Height(tkwin) - 2 * menuPtr->activeBorderWidth;
+ } else {
+ mePtr = menuPtr->entries[menuPtr->numEntries - 1];
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin),
+ menuPtr->border, mePtr->x, mePtr->y + mePtr->height,
+ mePtr->width, Tk_Height(tkwin) - mePtr->y - mePtr->height
+ - menuPtr->activeBorderWidth, 0,
+ TK_RELIEF_FLAT);
+ x = mePtr->x + mePtr->width;
+ y = mePtr->y + mePtr->height;
+ width = Tk_Width(tkwin) - x - menuPtr->activeBorderWidth;
+ height = Tk_Height(tkwin) - y - menuPtr->activeBorderWidth;
+ }
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), menuPtr->border, x, y,
+ width, height, 0, TK_RELIEF_FLAT);
+ }
+
+ Tk_Draw3DRectangle(menuPtr->tkwin, Tk_WindowId(tkwin),
+ menuPtr->border, 0, 0, Tk_Width(tkwin), Tk_Height(tkwin),
+ menuPtr->borderWidth, menuPtr->relief);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkMenuEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on menus.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkMenuEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TkMenu *menuPtr = (TkMenu *) clientData;
+
+ if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
+ TkEventuallyRedrawMenu(menuPtr, (TkMenuEntry *) NULL);
+ } else if (eventPtr->type == ConfigureNotify) {
+ TkEventuallyRecomputeMenu(menuPtr);
+ TkEventuallyRedrawMenu(menuPtr, (TkMenuEntry *) NULL);
+ } else if (eventPtr->type == ActivateNotify) {
+ if (menuPtr->menuType == TEAROFF_MENU) {
+ TkpSetMainMenubar(menuPtr->interp, menuPtr->tkwin, NULL);
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ if (menuPtr->tkwin != NULL) {
+ menuPtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(menuPtr->interp, menuPtr->widgetCmd);
+ }
+ if (menuPtr->menuFlags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayMenu, (ClientData) menuPtr);
+ }
+ if (menuPtr->menuFlags & RESIZE_PENDING) {
+ Tcl_CancelIdleCall(ComputeMenuGeometry, (ClientData) menuPtr);
+ }
+ TkDestroyMenu(menuPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuImageProc --
+ *
+ * This procedure is invoked by the image code whenever the manager
+ * for an image does something that affects the size of contents
+ * of an image displayed in a menu entry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for the menu to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMenuImageProc(clientData, x, y, width, height, imgWidth,
+ imgHeight)
+ ClientData clientData; /* Pointer to widget record. */
+ int x, y; /* Upper left pixel (within image)
+ * that must be redisplayed. */
+ int width, height; /* Dimensions of area to redisplay
+ * (may be <= 0). */
+ int imgWidth, imgHeight; /* New dimensions of image. */
+{
+ register TkMenu *menuPtr = ((TkMenuEntry *)clientData)->menuPtr;
+
+ if ((menuPtr->tkwin != NULL) && !(menuPtr->menuFlags
+ & RESIZE_PENDING)) {
+ menuPtr->menuFlags |= RESIZE_PENDING;
+ Tcl_DoWhenIdle(ComputeMenuGeometry, (ClientData) menuPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPostTearoffMenu --
+ *
+ * Posts a menu on the screen. Used to post tearoff menus. On Unix,
+ * all menus are posted this way. Adjusts the menu's position
+ * so that it fits on the screen, and maps and raises the menu.
+ *
+ * Results:
+ * Returns a standard Tcl Error.
+ *
+ * Side effects:
+ * The menu is posted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkPostTearoffMenu(interp, menuPtr, x, y)
+ Tcl_Interp *interp; /* The interpreter of the menu */
+ TkMenu *menuPtr; /* The menu we are posting */
+ int x; /* The root X coordinate where we
+ * are posting */
+ int y; /* The root Y coordinate where we
+ * are posting */
+{
+ int vRootX, vRootY, vRootWidth, vRootHeight;
+ int tmp, result;
+
+ TkActivateMenuEntry(menuPtr, -1);
+ TkRecomputeMenu(menuPtr);
+ result = TkPostCommand(menuPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ /*
+ * The post commands could have deleted the menu, which means
+ * we are dead and should go away.
+ */
+
+ if (menuPtr->tkwin == NULL) {
+ return TCL_OK;
+ }
+
+ /*
+ * Adjust the position of the menu if necessary to keep it
+ * visible on the screen. There are two special tricks to
+ * make this work right:
+ *
+ * 1. If a virtual root window manager is being used then
+ * the coordinates are in the virtual root window of
+ * menuPtr's parent; since the menu uses override-redirect
+ * mode it will be in the *real* root window for the screen,
+ * so we have to map the coordinates from the virtual root
+ * (if any) to the real root. Can't get the virtual root
+ * from the menu itself (it will never be seen by the wm)
+ * so use its parent instead (it would be better to have an
+ * an option that names a window to use for this...).
+ * 2. The menu may not have been mapped yet, so its current size
+ * might be the default 1x1. To compute how much space it
+ * needs, use its requested size, not its actual size.
+ *
+ * Note that this code assumes square screen regions and all
+ * positive coordinates. This does not work on a Mac with
+ * multiple monitors. But then again, Tk has other problems
+ * with this.
+ */
+
+ Tk_GetVRootGeometry(Tk_Parent(menuPtr->tkwin), &vRootX, &vRootY,
+ &vRootWidth, &vRootHeight);
+ x += vRootX;
+ y += vRootY;
+ tmp = WidthOfScreen(Tk_Screen(menuPtr->tkwin))
+ - Tk_ReqWidth(menuPtr->tkwin);
+ if (x > tmp) {
+ x = tmp;
+ }
+ if (x < 0) {
+ x = 0;
+ }
+ tmp = HeightOfScreen(Tk_Screen(menuPtr->tkwin))
+ - Tk_ReqHeight(menuPtr->tkwin);
+ if (y > tmp) {
+ y = tmp;
+ }
+ if (y < 0) {
+ y = 0;
+ }
+ Tk_MoveToplevelWindow(menuPtr->tkwin, x, y);
+ if (!Tk_IsMapped(menuPtr->tkwin)) {
+ Tk_MapWindow(menuPtr->tkwin);
+ }
+ TkWmRestackToplevel((TkWindow *) menuPtr->tkwin, Above, NULL);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkPostSubmenu --
+ *
+ * This procedure arranges for a particular submenu (i.e. the
+ * menu corresponding to a given cascade entry) to be
+ * posted.
+ *
+ * Results:
+ * A standard Tcl return result. Errors may occur in the
+ * Tcl commands generated to post and unpost submenus.
+ *
+ * Side effects:
+ * If there is already a submenu posted, it is unposted.
+ * The new submenu is then posted.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkPostSubmenu(interp, menuPtr, mePtr)
+ Tcl_Interp *interp; /* Used for invoking sub-commands and
+ * reporting errors. */
+ register TkMenu *menuPtr; /* Information about menu as a whole. */
+ register TkMenuEntry *mePtr; /* Info about submenu that is to be
+ * posted. NULL means make sure that
+ * no submenu is posted. */
+{
+ char string[30];
+ int result, x, y;
+
+ if (mePtr == menuPtr->postedCascade) {
+ return TCL_OK;
+ }
+
+ if (menuPtr->postedCascade != NULL) {
+
+ /*
+ * Note: when unposting a submenu, we have to redraw the entire
+ * parent menu. This is because of a combination of the following
+ * things:
+ * (a) the submenu partially overlaps the parent.
+ * (b) the submenu specifies "save under", which causes the X
+ * server to make a copy of the information under it when it
+ * is posted. When the submenu is unposted, the X server
+ * copies this data back and doesn't generate any Expose
+ * events for the parent.
+ * (c) the parent may have redisplayed itself after the submenu
+ * was posted, in which case the saved information is no
+ * longer correct.
+ * The simplest solution is just force a complete redisplay of
+ * the parent.
+ */
+
+ TkEventuallyRedrawMenu(menuPtr, (TkMenuEntry *) NULL);
+ result = Tcl_VarEval(interp, menuPtr->postedCascade->name,
+ " unpost", (char *) NULL);
+ menuPtr->postedCascade = NULL;
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+
+ if ((mePtr != NULL) && (mePtr->name != NULL)
+ && Tk_IsMapped(menuPtr->tkwin)) {
+
+ /*
+ * Position the cascade with its upper left corner slightly
+ * below and to the left of the upper right corner of the
+ * menu entry (this is an attempt to match Motif behavior).
+ *
+ * The menu has to redrawn so that the entry can change relief.
+ */
+
+ Tk_GetRootCoords(menuPtr->tkwin, &x, &y);
+ AdjustMenuCoords(menuPtr, mePtr, &x, &y, string);
+ result = Tcl_VarEval(interp, mePtr->name, " post ", string,
+ (char *) NULL);
+ if (result != TCL_OK) {
+ return result;
+ }
+ menuPtr->postedCascade = mePtr;
+ TkEventuallyRedrawMenu(menuPtr, mePtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AdjustMenuCoords --
+ *
+ * Adjusts the given coordinates down and the left to give a Motif
+ * look.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The menu is eventually redrawn if necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AdjustMenuCoords(menuPtr, mePtr, xPtr, yPtr, string)
+ TkMenu *menuPtr;
+ TkMenuEntry *mePtr;
+ int *xPtr;
+ int *yPtr;
+ char *string;
+{
+ if (menuPtr->menuType == MENUBAR) {
+ *xPtr += mePtr->x;
+ *yPtr += mePtr->y + mePtr->height;
+ } else {
+ *xPtr += Tk_Width(menuPtr->tkwin) - menuPtr->borderWidth
+ - menuPtr->activeBorderWidth - 2;
+ *yPtr += mePtr->y
+ + menuPtr->activeBorderWidth + 2;
+ }
+ sprintf(string, "%d %d", *xPtr, *yPtr);
+}
diff --git a/generic/tkMenubutton.c b/generic/tkMenubutton.c
new file mode 100644
index 0000000..ca2070e
--- /dev/null
+++ b/generic/tkMenubutton.c
@@ -0,0 +1,865 @@
+/*
+ * tkMenubutton.c --
+ *
+ * This module implements button-like widgets that are used
+ * to invoke pull-down menus.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkMenubutton.c 1.94 97/07/31 09:10:37
+ */
+
+#include "tkMenubutton.h"
+#include "tkPort.h"
+#include "default.h"
+
+/*
+ * Uids internal to menubuttons.
+ */
+
+static Tk_Uid aboveUid = NULL;
+static Tk_Uid belowUid = NULL;
+static Tk_Uid leftUid = NULL;
+static Tk_Uid rightUid = NULL;
+static Tk_Uid flushUid = NULL;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_MENUBUTTON_ACTIVE_BG_COLOR, Tk_Offset(TkMenuButton, activeBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_MENUBUTTON_ACTIVE_BG_MONO, Tk_Offset(TkMenuButton, activeBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",
+ DEF_MENUBUTTON_ACTIVE_FG_COLOR, Tk_Offset(TkMenuButton, activeFg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",
+ DEF_MENUBUTTON_ACTIVE_FG_MONO, Tk_Offset(TkMenuButton, activeFg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor",
+ DEF_MENUBUTTON_ANCHOR, Tk_Offset(TkMenuButton, anchor), 0},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_MENUBUTTON_BG_COLOR, Tk_Offset(TkMenuButton, normalBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_MENUBUTTON_BG_MONO, Tk_Offset(TkMenuButton, normalBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_BITMAP, "-bitmap", "bitmap", "Bitmap",
+ DEF_MENUBUTTON_BITMAP, Tk_Offset(TkMenuButton, bitmap),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_MENUBUTTON_BORDER_WIDTH, Tk_Offset(TkMenuButton, borderWidth), 0},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_MENUBUTTON_CURSOR, Tk_Offset(TkMenuButton, cursor),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_UID, "-direction", "direction", "Direction",
+ DEF_MENUBUTTON_DIRECTION, Tk_Offset(TkMenuButton, direction),
+ 0},
+ {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_MENUBUTTON_DISABLED_FG_COLOR,
+ Tk_Offset(TkMenuButton, disabledFg),
+ TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_MENUBUTTON_DISABLED_FG_MONO,
+ Tk_Offset(TkMenuButton, disabledFg),
+ TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_FONT, "-font", "font", "Font",
+ DEF_MENUBUTTON_FONT, Tk_Offset(TkMenuButton, tkfont), 0},
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_MENUBUTTON_FG, Tk_Offset(TkMenuButton, normalFg), 0},
+ {TK_CONFIG_STRING, "-height", "height", "Height",
+ DEF_MENUBUTTON_HEIGHT, Tk_Offset(TkMenuButton, heightString), 0},
+ {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_MENUBUTTON_HIGHLIGHT_BG,
+ Tk_Offset(TkMenuButton, highlightBgColorPtr), 0},
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_MENUBUTTON_HIGHLIGHT, Tk_Offset(TkMenuButton, highlightColorPtr),
+ 0},
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_MENUBUTTON_HIGHLIGHT_WIDTH,
+ Tk_Offset(TkMenuButton, highlightWidth), 0},
+ {TK_CONFIG_STRING, "-image", "image", "Image",
+ DEF_MENUBUTTON_IMAGE, Tk_Offset(TkMenuButton, imageString),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn",
+ DEF_MENUBUTTON_INDICATOR, Tk_Offset(TkMenuButton, indicatorOn), 0},
+ {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_MENUBUTTON_JUSTIFY, Tk_Offset(TkMenuButton, justify), 0},
+ {TK_CONFIG_STRING, "-menu", "menu", "Menu",
+ DEF_MENUBUTTON_MENU, Tk_Offset(TkMenuButton, menuName),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
+ DEF_MENUBUTTON_PADX, Tk_Offset(TkMenuButton, padX), 0},
+ {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
+ DEF_MENUBUTTON_PADY, Tk_Offset(TkMenuButton, padY), 0},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_MENUBUTTON_RELIEF, Tk_Offset(TkMenuButton, relief), 0},
+ {TK_CONFIG_UID, "-state", "state", "State",
+ DEF_MENUBUTTON_STATE, Tk_Offset(TkMenuButton, state), 0},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_MENUBUTTON_TAKE_FOCUS, Tk_Offset(TkMenuButton, takeFocus),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-text", "text", "Text",
+ DEF_MENUBUTTON_TEXT, Tk_Offset(TkMenuButton, text), 0},
+ {TK_CONFIG_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_MENUBUTTON_TEXT_VARIABLE, Tk_Offset(TkMenuButton, textVarName),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_INT, "-underline", "underline", "Underline",
+ DEF_MENUBUTTON_UNDERLINE, Tk_Offset(TkMenuButton, underline), 0},
+ {TK_CONFIG_STRING, "-width", "width", "Width",
+ DEF_MENUBUTTON_WIDTH, Tk_Offset(TkMenuButton, widthString), 0},
+ {TK_CONFIG_PIXELS, "-wraplength", "wrapLength", "WrapLength",
+ DEF_MENUBUTTON_WRAP_LENGTH, Tk_Offset(TkMenuButton, wrapLength), 0},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void MenuButtonCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void MenuButtonEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void MenuButtonImageProc _ANSI_ARGS_((ClientData clientData,
+ int x, int y, int width, int height, int imgWidth,
+ int imgHeight));
+static char * MenuButtonTextVarProc _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp,
+ char *name1, char *name2, int flags));
+static int MenuButtonWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static int ConfigureMenuButton _ANSI_ARGS_((Tcl_Interp *interp,
+ TkMenuButton *mbPtr, int argc, char **argv,
+ int flags));
+static void DestroyMenuButton _ANSI_ARGS_((char *memPtr));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_MenubuttonCmd --
+ *
+ * This procedure is invoked to process the "button", "label",
+ * "radiobutton", and "checkbutton" Tcl commands. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_MenubuttonCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ register TkMenuButton *mbPtr;
+ Tk_Window tkwin = (Tk_Window) clientData;
+ Tk_Window new;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " pathName ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the new window.
+ */
+
+ new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+
+ Tk_SetClass(new, "Menubutton");
+ mbPtr = TkpCreateMenuButton(new);
+
+ TkSetClassProcs(new, &tkpMenubuttonClass, (ClientData) mbPtr);
+
+ /*
+ * Initialize the data structure for the button.
+ */
+
+ mbPtr->tkwin = new;
+ mbPtr->display = Tk_Display (new);
+ mbPtr->interp = interp;
+ mbPtr->widgetCmd = Tcl_CreateCommand(interp, Tk_PathName(mbPtr->tkwin),
+ MenuButtonWidgetCmd, (ClientData) mbPtr, MenuButtonCmdDeletedProc);
+ mbPtr->menuName = NULL;
+ mbPtr->text = NULL;
+ mbPtr->underline = -1;
+ mbPtr->textVarName = NULL;
+ mbPtr->bitmap = None;
+ mbPtr->imageString = NULL;
+ mbPtr->image = NULL;
+ mbPtr->state = tkNormalUid;
+ mbPtr->normalBorder = NULL;
+ mbPtr->activeBorder = NULL;
+ mbPtr->borderWidth = 0;
+ mbPtr->relief = TK_RELIEF_FLAT;
+ mbPtr->highlightWidth = 0;
+ mbPtr->highlightBgColorPtr = NULL;
+ mbPtr->highlightColorPtr = NULL;
+ mbPtr->inset = 0;
+ mbPtr->tkfont = NULL;
+ mbPtr->normalFg = NULL;
+ mbPtr->activeFg = NULL;
+ mbPtr->disabledFg = NULL;
+ mbPtr->normalTextGC = None;
+ mbPtr->activeTextGC = None;
+ mbPtr->gray = None;
+ mbPtr->disabledGC = None;
+ mbPtr->leftBearing = 0;
+ mbPtr->rightBearing = 0;
+ mbPtr->widthString = NULL;
+ mbPtr->heightString = NULL;
+ mbPtr->width = 0;
+ mbPtr->width = 0;
+ mbPtr->wrapLength = 0;
+ mbPtr->padX = 0;
+ mbPtr->padY = 0;
+ mbPtr->anchor = TK_ANCHOR_CENTER;
+ mbPtr->justify = TK_JUSTIFY_CENTER;
+ mbPtr->textLayout = NULL;
+ mbPtr->indicatorOn = 0;
+ mbPtr->indicatorWidth = 0;
+ mbPtr->indicatorHeight = 0;
+ mbPtr->cursor = None;
+ mbPtr->takeFocus = NULL;
+ mbPtr->flags = 0;
+ if (aboveUid == NULL) {
+ aboveUid = Tk_GetUid("above");
+ belowUid = Tk_GetUid("below");
+ leftUid = Tk_GetUid("left");
+ rightUid = Tk_GetUid("right");
+ flushUid = Tk_GetUid("flush");
+ }
+ mbPtr->direction = flushUid;
+
+ Tk_CreateEventHandler(mbPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ MenuButtonEventProc, (ClientData) mbPtr);
+ if (ConfigureMenuButton(interp, mbPtr, argc-2, argv+2, 0) != TCL_OK) {
+ Tk_DestroyWindow(mbPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ interp->result = Tk_PathName(mbPtr->tkwin);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MenuButtonWidgetCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to a widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+MenuButtonWidgetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about button widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ register TkMenuButton *mbPtr = (TkMenuButton *) clientData;
+ int result;
+ size_t length;
+ int c;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_Preserve((ClientData) mbPtr);
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
+ && (length >= 2)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " cget option\"",
+ (char *) NULL);
+ result = TCL_ERROR;
+ } else {
+ result = Tk_ConfigureValue(interp, mbPtr->tkwin, configSpecs,
+ (char *) mbPtr, argv[2], 0);
+ }
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
+ && (length >= 2)) {
+ if (argc == 2) {
+ result = Tk_ConfigureInfo(interp, mbPtr->tkwin, configSpecs,
+ (char *) mbPtr, (char *) NULL, 0);
+ } else if (argc == 3) {
+ result = Tk_ConfigureInfo(interp, mbPtr->tkwin, configSpecs,
+ (char *) mbPtr, argv[2], 0);
+ } else {
+ result = ConfigureMenuButton(interp, mbPtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be cget or configure",
+ (char *) NULL);
+ result = TCL_ERROR;
+ }
+ Tcl_Release((ClientData) mbPtr);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyMenuButton --
+ *
+ * This procedure is invoked to recycle all of the resources
+ * associated with a button widget. It is invoked as a
+ * when-idle handler in order to make sure that there is no
+ * other use of the button pending at the time of the deletion.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the widget is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyMenuButton(memPtr)
+ char *memPtr; /* Info about button widget. */
+{
+ register TkMenuButton *mbPtr = (TkMenuButton *) memPtr;
+
+ /*
+ * Free up all the stuff that requires special handling, then
+ * let Tk_FreeOptions handle all the standard option-related
+ * stuff.
+ */
+
+ if (mbPtr->textVarName != NULL) {
+ Tcl_UntraceVar(mbPtr->interp, mbPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuButtonTextVarProc, (ClientData) mbPtr);
+ }
+ if (mbPtr->image != NULL) {
+ Tk_FreeImage(mbPtr->image);
+ }
+ if (mbPtr->normalTextGC != None) {
+ Tk_FreeGC(mbPtr->display, mbPtr->normalTextGC);
+ }
+ if (mbPtr->activeTextGC != None) {
+ Tk_FreeGC(mbPtr->display, mbPtr->activeTextGC);
+ }
+ if (mbPtr->gray != None) {
+ Tk_FreeBitmap(mbPtr->display, mbPtr->gray);
+ }
+ if (mbPtr->disabledGC != None) {
+ Tk_FreeGC(mbPtr->display, mbPtr->disabledGC);
+ }
+ Tk_FreeTextLayout(mbPtr->textLayout);
+ Tk_FreeOptions(configSpecs, (char *) mbPtr, mbPtr->display, 0);
+ ckfree((char *) mbPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureMenuButton --
+ *
+ * This procedure is called to process an argv/argc list, plus
+ * the Tk option database, in order to configure (or
+ * reconfigure) a menubutton widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then interp->result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as text string, colors, font,
+ * etc. get set for mbPtr; old resources get freed, if there
+ * were any. The menubutton is redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureMenuButton(interp, mbPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register TkMenuButton *mbPtr; /* Information about widget; may or may
+ * not already have values for some fields. */
+ int argc; /* Number of valid entries in argv. */
+ char **argv; /* Arguments. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ int result;
+ Tk_Image image;
+
+ /*
+ * Eliminate any existing trace on variables monitored by the menubutton.
+ */
+
+ if (mbPtr->textVarName != NULL) {
+ Tcl_UntraceVar(interp, mbPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuButtonTextVarProc, (ClientData) mbPtr);
+ }
+
+ result = Tk_ConfigureWidget(interp, mbPtr->tkwin, configSpecs,
+ argc, argv, (char *) mbPtr, flags);
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few options need special processing, such as setting the
+ * background from a 3-D border, or filling in complicated
+ * defaults that couldn't be specified to Tk_ConfigureWidget.
+ */
+
+ if ((mbPtr->state == tkActiveUid) && !Tk_StrictMotif(mbPtr->tkwin)) {
+ Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->activeBorder);
+ } else {
+ Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->normalBorder);
+ if ((mbPtr->state != tkNormalUid) && (mbPtr->state != tkActiveUid)
+ && (mbPtr->state != tkDisabledUid)) {
+ Tcl_AppendResult(interp, "bad state value \"", mbPtr->state,
+ "\": must be normal, active, or disabled", (char *) NULL);
+ mbPtr->state = tkNormalUid;
+ return TCL_ERROR;
+ }
+ }
+
+ if ((mbPtr->direction != aboveUid) && (mbPtr->direction != belowUid)
+ && (mbPtr->direction != leftUid) && (mbPtr->direction != rightUid)
+ && (mbPtr->direction != flushUid)) {
+ Tcl_AppendResult(interp, "bad direction value \"", mbPtr->direction,
+ "\": must be above, below, left, right, or flush",
+ (char *) NULL);
+ mbPtr->direction = belowUid;
+ return TCL_ERROR;
+ }
+
+ if (mbPtr->highlightWidth < 0) {
+ mbPtr->highlightWidth = 0;
+ }
+
+ if (mbPtr->padX < 0) {
+ mbPtr->padX = 0;
+ }
+ if (mbPtr->padY < 0) {
+ mbPtr->padY = 0;
+ }
+
+ /*
+ * Get the image for the widget, if there is one. Allocate the
+ * new image before freeing the old one, so that the reference
+ * count doesn't go to zero and cause image data to be discarded.
+ */
+
+ if (mbPtr->imageString != NULL) {
+ image = Tk_GetImage(mbPtr->interp, mbPtr->tkwin,
+ mbPtr->imageString, MenuButtonImageProc, (ClientData) mbPtr);
+ if (image == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (mbPtr->image != NULL) {
+ Tk_FreeImage(mbPtr->image);
+ }
+ mbPtr->image = image;
+
+ if ((mbPtr->image == NULL) && (mbPtr->bitmap == None)
+ && (mbPtr->textVarName != NULL)) {
+ /*
+ * The menubutton displays a variable. Set up a trace to watch
+ * for any changes in it.
+ */
+
+ char *value;
+
+ value = Tcl_GetVar(interp, mbPtr->textVarName, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ Tcl_SetVar(interp, mbPtr->textVarName, mbPtr->text,
+ TCL_GLOBAL_ONLY);
+ } else {
+ if (mbPtr->text != NULL) {
+ ckfree(mbPtr->text);
+ }
+ mbPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1));
+ strcpy(mbPtr->text, value);
+ }
+ Tcl_TraceVar(interp, mbPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuButtonTextVarProc, (ClientData) mbPtr);
+ }
+
+ /*
+ * Recompute the geometry for the button.
+ */
+
+ if ((mbPtr->bitmap != None) || (mbPtr->image != NULL)) {
+ if (Tk_GetPixels(interp, mbPtr->tkwin, mbPtr->widthString,
+ &mbPtr->width) != TCL_OK) {
+ widthError:
+ Tcl_AddErrorInfo(interp, "\n (processing -width option)");
+ return TCL_ERROR;
+ }
+ if (Tk_GetPixels(interp, mbPtr->tkwin, mbPtr->heightString,
+ &mbPtr->height) != TCL_OK) {
+ heightError:
+ Tcl_AddErrorInfo(interp, "\n (processing -height option)");
+ return TCL_ERROR;
+ }
+ } else {
+ if (Tcl_GetInt(interp, mbPtr->widthString, &mbPtr->width)
+ != TCL_OK) {
+ goto widthError;
+ }
+ if (Tcl_GetInt(interp, mbPtr->heightString, &mbPtr->height)
+ != TCL_OK) {
+ goto heightError;
+ }
+ }
+ TkMenuButtonWorldChanged((ClientData) mbPtr);
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkMenuButtonWorldChanged --
+ *
+ * This procedure is called when the world has changed in some
+ * way and the widget needs to recompute all its graphics contexts
+ * and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * TkMenuButton will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkMenuButtonWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ XGCValues gcValues;
+ GC gc;
+ unsigned long mask;
+ TkMenuButton *mbPtr;
+
+ mbPtr = (TkMenuButton *) instanceData;
+
+ gcValues.font = Tk_FontId(mbPtr->tkfont);
+ gcValues.foreground = mbPtr->normalFg->pixel;
+ gcValues.background = Tk_3DBorderColor(mbPtr->normalBorder)->pixel;
+
+ /*
+ * Note: GraphicsExpose events are disabled in GC's because they're
+ * used to copy stuff from an off-screen pixmap onto the screen (we know
+ * that there's no problem with obscured areas).
+ */
+
+ gcValues.graphics_exposures = False;
+ mask = GCForeground | GCBackground | GCFont | GCGraphicsExposures;
+ gc = Tk_GetGC(mbPtr->tkwin, mask, &gcValues);
+ if (mbPtr->normalTextGC != None) {
+ Tk_FreeGC(mbPtr->display, mbPtr->normalTextGC);
+ }
+ mbPtr->normalTextGC = gc;
+
+ gcValues.font = Tk_FontId(mbPtr->tkfont);
+ gcValues.foreground = mbPtr->activeFg->pixel;
+ gcValues.background = Tk_3DBorderColor(mbPtr->activeBorder)->pixel;
+ mask = GCForeground | GCBackground | GCFont;
+ gc = Tk_GetGC(mbPtr->tkwin, mask, &gcValues);
+ if (mbPtr->activeTextGC != None) {
+ Tk_FreeGC(mbPtr->display, mbPtr->activeTextGC);
+ }
+ mbPtr->activeTextGC = gc;
+
+ gcValues.font = Tk_FontId(mbPtr->tkfont);
+ gcValues.background = Tk_3DBorderColor(mbPtr->normalBorder)->pixel;
+ if ((mbPtr->disabledFg != NULL) && (mbPtr->imageString == NULL)) {
+ gcValues.foreground = mbPtr->disabledFg->pixel;
+ mask = GCForeground | GCBackground | GCFont;
+ } else {
+ gcValues.foreground = gcValues.background;
+ mask = GCForeground;
+ if (mbPtr->gray == None) {
+ mbPtr->gray = Tk_GetBitmap(NULL, mbPtr->tkwin,
+ Tk_GetUid("gray50"));
+ }
+ if (mbPtr->gray != None) {
+ gcValues.fill_style = FillStippled;
+ gcValues.stipple = mbPtr->gray;
+ mask |= GCFillStyle | GCStipple;
+ }
+ }
+ gc = Tk_GetGC(mbPtr->tkwin, mask, &gcValues);
+ if (mbPtr->disabledGC != None) {
+ Tk_FreeGC(mbPtr->display, mbPtr->disabledGC);
+ }
+ mbPtr->disabledGC = gc;
+
+ TkpComputeMenuButtonGeometry(mbPtr);
+
+ /*
+ * Lastly, arrange for the button to be redisplayed.
+ */
+
+ if (Tk_IsMapped(mbPtr->tkwin) && !(mbPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayMenuButton, (ClientData) mbPtr);
+ mbPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MenuButtonEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on buttons.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+MenuButtonEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TkMenuButton *mbPtr = (TkMenuButton *) clientData;
+ if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
+ goto redraw;
+ } else if (eventPtr->type == ConfigureNotify) {
+ /*
+ * Must redraw after size changes, since layout could have changed
+ * and borders will need to be redrawn.
+ */
+
+ goto redraw;
+ } else if (eventPtr->type == DestroyNotify) {
+ TkpDestroyMenuButton(mbPtr);
+ if (mbPtr->tkwin != NULL) {
+ mbPtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(mbPtr->interp, mbPtr->widgetCmd);
+ }
+ if (mbPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(TkpDisplayMenuButton, (ClientData) mbPtr);
+ }
+ Tcl_EventuallyFree((ClientData) mbPtr, DestroyMenuButton);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ mbPtr->flags |= GOT_FOCUS;
+ if (mbPtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ mbPtr->flags &= ~GOT_FOCUS;
+ if (mbPtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ }
+ return;
+
+ redraw:
+ if ((mbPtr->tkwin != NULL) && !(mbPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayMenuButton, (ClientData) mbPtr);
+ mbPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenuButtonCmdDeletedProc --
+ *
+ * This procedure is invoked when a widget command is deleted. If
+ * the widget isn't already in the process of being destroyed,
+ * this command destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MenuButtonCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ TkMenuButton *mbPtr = (TkMenuButton *) clientData;
+ Tk_Window tkwin = mbPtr->tkwin;
+
+ /*
+ * This procedure could be invoked either because the window was
+ * destroyed and the command was then deleted (in which case tkwin
+ * is NULL) or because the command was deleted, and then this procedure
+ * destroys the widget.
+ */
+
+ if (tkwin != NULL) {
+ mbPtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MenuButtonTextVarProc --
+ *
+ * This procedure is invoked when someone changes the variable
+ * whose contents are to be displayed in a menu button.
+ *
+ * Results:
+ * NULL is always returned.
+ *
+ * Side effects:
+ * The text displayed in the menu button will change to match the
+ * variable.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+MenuButtonTextVarProc(clientData, interp, name1, name2, flags)
+ ClientData clientData; /* Information about button. */
+ Tcl_Interp *interp; /* Interpreter containing variable. */
+ char *name1; /* Name of variable. */
+ char *name2; /* Second part of variable name. */
+ int flags; /* Information about what happened. */
+{
+ register TkMenuButton *mbPtr = (TkMenuButton *) clientData;
+ char *value;
+
+ /*
+ * If the variable is unset, then immediately recreate it unless
+ * the whole interpreter is going away.
+ */
+
+ if (flags & TCL_TRACE_UNSETS) {
+ if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+ Tcl_SetVar(interp, mbPtr->textVarName, mbPtr->text,
+ TCL_GLOBAL_ONLY);
+ Tcl_TraceVar(interp, mbPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuButtonTextVarProc, clientData);
+ }
+ return (char *) NULL;
+ }
+
+ value = Tcl_GetVar(interp, mbPtr->textVarName, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ value = "";
+ }
+ if (mbPtr->text != NULL) {
+ ckfree(mbPtr->text);
+ }
+ mbPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1));
+ strcpy(mbPtr->text, value);
+ TkpComputeMenuButtonGeometry(mbPtr);
+
+ if ((mbPtr->tkwin != NULL) && Tk_IsMapped(mbPtr->tkwin)
+ && !(mbPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayMenuButton, (ClientData) mbPtr);
+ mbPtr->flags |= REDRAW_PENDING;
+ }
+ return (char *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenuButtonImageProc --
+ *
+ * This procedure is invoked by the image code whenever the manager
+ * for an image does something that affects the size of contents
+ * of an image displayed in a button.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for the button to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MenuButtonImageProc(clientData, x, y, width, height, imgWidth, imgHeight)
+ ClientData clientData; /* Pointer to widget record. */
+ int x, y; /* Upper left pixel (within image)
+ * that must be redisplayed. */
+ int width, height; /* Dimensions of area to redisplay
+ * (may be <= 0). */
+ int imgWidth, imgHeight; /* New dimensions of image. */
+{
+ register TkMenuButton *mbPtr = (TkMenuButton *) clientData;
+
+ if (mbPtr->tkwin != NULL) {
+ TkpComputeMenuButtonGeometry(mbPtr);
+ if (Tk_IsMapped(mbPtr->tkwin) && !(mbPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayMenuButton, (ClientData) mbPtr);
+ mbPtr->flags |= REDRAW_PENDING;
+ }
+ }
+}
diff --git a/generic/tkMenubutton.h b/generic/tkMenubutton.h
new file mode 100644
index 0000000..0fb0f65
--- /dev/null
+++ b/generic/tkMenubutton.h
@@ -0,0 +1,207 @@
+/*
+ * tkMenubutton.h --
+ *
+ * Declarations of types and functions used to implement
+ * the menubutton widget.
+ *
+ * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkMenubutton.h 1.3 97/04/11 11:24:15
+ */
+
+#ifndef _TKMENUBUTTON
+#define _TKMENUBUTTON
+
+#ifndef _TKINT
+#include "tkInt.h"
+#endif
+
+/*
+ * A data structure of the following type is kept for each
+ * widget managed by this file:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the widget. NULL
+ * means that the window has been destroyed
+ * but the data structures haven't yet been
+ * cleaned up.*/
+ Display *display; /* Display containing widget. Needed, among
+ * other things, so that resources can bee
+ * freed up even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with menubutton. */
+ Tcl_Command widgetCmd; /* Token for menubutton's widget command. */
+ char *menuName; /* Name of menu associated with widget.
+ * Malloc-ed. */
+
+ /*
+ * Information about what's displayed in the menu button:
+ */
+
+ char *text; /* Text to display in button (malloc'ed)
+ * or NULL. */
+ int underline; /* Index of character to underline. */
+ char *textVarName; /* Name of variable (malloc'ed) or NULL.
+ * If non-NULL, button displays the contents
+ * of this variable. */
+ Pixmap bitmap; /* Bitmap to display or None. If not None
+ * then text and textVar and underline
+ * are ignored. */
+ char *imageString; /* Name of image to display (malloc'ed), or
+ * NULL. If non-NULL, bitmap, text, and
+ * textVarName are ignored. */
+ Tk_Image image; /* Image to display in window, or NULL if
+ * none. */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ Tk_Uid state; /* State of button for display purposes:
+ * normal, active, or disabled. */
+ Tk_3DBorder normalBorder; /* Structure used to draw 3-D
+ * border and background when window
+ * isn't active. NULL means no such
+ * border exists. */
+ Tk_3DBorder activeBorder; /* Structure used to draw 3-D
+ * border and background when window
+ * is active. NULL means no such
+ * border exists. */
+ int borderWidth; /* Width of border. */
+ int relief; /* 3-d effect: TK_RELIEF_RAISED, etc. */
+ int highlightWidth; /* Width in pixels of highlight to draw
+ * around widget when it has the focus.
+ * <= 0 means don't draw a highlight. */
+ XColor *highlightBgColorPtr;
+ /* Color for drawing traversal highlight
+ * area when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ int inset; /* Total width of all borders, including
+ * traversal highlight and 3-D border.
+ * Indicates how much interior stuff must
+ * be offset from outside edges to leave
+ * room for borders. */
+ Tk_Font tkfont; /* Information about text font, or NULL. */
+ XColor *normalFg; /* Foreground color in normal mode. */
+ XColor *activeFg; /* Foreground color in active mode. NULL
+ * means use normalFg instead. */
+ XColor *disabledFg; /* Foreground color when disabled. NULL
+ * means use normalFg with a 50% stipple
+ * instead. */
+ GC normalTextGC; /* GC for drawing text in normal mode. */
+ GC activeTextGC; /* GC for drawing text in active mode (NULL
+ * means use normalTextGC). */
+ Pixmap gray; /* Pixmap for displaying disabled text/icon if
+ * disabledFg is NULL. */
+ GC disabledGC; /* Used to produce disabled effect. If
+ * disabledFg isn't NULL, this GC is used to
+ * draw button text or icon. Otherwise
+ * text or icon is drawn with normalGC and
+ * this GC is used to stipple background
+ * across it. */
+ int leftBearing; /* Distance from text origin to leftmost drawn
+ * pixel (positive means to right). */
+ int rightBearing; /* Amount text sticks right from its origin. */
+ char *widthString; /* Value of -width option. Malloc'ed. */
+ char *heightString; /* Value of -height option. Malloc'ed. */
+ int width, height; /* If > 0, these specify dimensions to request
+ * for window, in characters for text and in
+ * pixels for bitmaps. In this case the actual
+ * size of the text string or bitmap is
+ * ignored in computing desired window size. */
+ int wrapLength; /* Line length (in pixels) at which to wrap
+ * onto next line. <= 0 means don't wrap
+ * except at newlines. */
+ int padX, padY; /* Extra space around text or bitmap (pixels
+ * on each side). */
+ Tk_Anchor anchor; /* Where text/bitmap should be displayed
+ * inside window region. */
+ Tk_Justify justify; /* Justification to use for multi-line text. */
+ int textWidth; /* Width needed to display text as requested,
+ * in pixels. */
+ int textHeight; /* Height needed to display text as requested,
+ * in pixels. */
+ Tk_TextLayout textLayout; /* Saved text layout information. */
+ int indicatorOn; /* Non-zero means display indicator; 0 means
+ * don't display. */
+ int indicatorHeight; /* Height of indicator in pixels. This same
+ * amount of extra space is also left on each
+ * side of the indicator. 0 if no indicator. */
+ int indicatorWidth; /* Width of indicator in pixels, including
+ * indicatorHeight in padding on each side.
+ * 0 if no indicator. */
+
+ /*
+ * Miscellaneous information:
+ */
+
+ Tk_Uid direction; /* Direction for where to pop the menu.
+ * Valid directions are "above", "below",
+ * "left", "right", and "flush". "flush"
+ * means that the upper left corner of the
+ * menubutton is where the menu pops up.
+ * "above" and "below" will attempt to pop
+ * the menu compleletly above or below
+ * the menu respectively.
+ * "left" and "right" will pop the menu
+ * left or right, and the active item
+ * will be next to the button. */
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ char *takeFocus; /* Value of -takefocus option; not used in
+ * the C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+ int flags; /* Various flags; see below for
+ * definitions. */
+} TkMenuButton;
+
+/*
+ * Flag bits for buttons:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler
+ * has already been queued to redraw
+ * this window.
+ * POSTED: Non-zero means that the menu associated
+ * with this button has been posted (typically
+ * because of an active button press).
+ * GOT_FOCUS: Non-zero means this button currently
+ * has the input focus.
+ */
+
+#define REDRAW_PENDING 1
+#define POSTED 2
+#define GOT_FOCUS 4
+
+/*
+ * The following constants define the dimensions of the cascade indicator,
+ * which is displayed if the "-indicatoron" option is true. The units for
+ * these options are 1/10 millimeters.
+ */
+
+#define INDICATOR_WIDTH 40
+#define INDICATOR_HEIGHT 17
+
+/*
+ * Declaration of variables shared between the files in the button module.
+ */
+
+extern TkClassProcs tkpMenubuttonClass;
+
+/*
+ * Declaration of procedures used in the implementation of the button
+ * widget.
+ */
+
+EXTERN void TkpComputeMenuButtonGeometry _ANSI_ARGS_((
+ TkMenuButton *mbPtr));
+EXTERN TkMenuButton * TkpCreateMenuButton _ANSI_ARGS_((Tk_Window tkwin));
+EXTERN void TkpDisplayMenuButton _ANSI_ARGS_((
+ ClientData clientData));
+EXTERN void TkpDestroyMenuButton _ANSI_ARGS_((
+ TkMenuButton *mbPtr));
+EXTERN void TkMenuButtonWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+
+#endif /* _TKMENUBUTTON */
diff --git a/generic/tkMessage.c b/generic/tkMessage.c
new file mode 100644
index 0000000..1984bac
--- /dev/null
+++ b/generic/tkMessage.c
@@ -0,0 +1,848 @@
+/*
+ * tkMessage.c --
+ *
+ * This module implements a message widgets for the Tk
+ * toolkit. A message widget displays a multi-line string
+ * in a window according to a particular aspect ratio.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkMessage.c 1.75 97/07/31 09:11:14
+ */
+
+#include "tkPort.h"
+#include "default.h"
+#include "tkInt.h"
+
+/*
+ * A data structure of the following type is kept for each message
+ * widget managed by this file:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the message. NULL
+ * means that the window has been destroyed
+ * but the data structures haven't yet been
+ * cleaned up.*/
+ Display *display; /* Display containing widget. Used, among
+ * other things, so that resources can be
+ * freed even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with message. */
+ Tcl_Command widgetCmd; /* Token for message's widget command. */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ char *string; /* String displayed in message. */
+ int numChars; /* Number of characters in string, not
+ * including terminating NULL character. */
+ char *textVarName; /* Name of variable (malloc'ed) or NULL.
+ * If non-NULL, message displays the contents
+ * of this variable. */
+ Tk_3DBorder border; /* Structure used to draw 3-D border and
+ * background. NULL means a border hasn't
+ * been created yet. */
+ int borderWidth; /* Width of border. */
+ int relief; /* 3-D effect: TK_RELIEF_RAISED, etc. */
+ int highlightWidth; /* Width in pixels of highlight to draw
+ * around widget when it has the focus.
+ * <= 0 means don't draw a highlight. */
+ XColor *highlightBgColorPtr;
+ /* Color for drawing traversal highlight
+ * area when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ Tk_Font tkfont; /* Information about text font, or NULL. */
+ XColor *fgColorPtr; /* Foreground color in normal mode. */
+ int padX, padY; /* User-requested extra space around text. */
+ int width; /* User-requested width, in pixels. 0 means
+ * compute width using aspect ratio below. */
+ int aspect; /* Desired aspect ratio for window
+ * (100*width/height). */
+ int msgWidth; /* Width in pixels needed to display
+ * message. */
+ int msgHeight; /* Height in pixels needed to display
+ * message. */
+ Tk_Anchor anchor; /* Where to position text within window region
+ * if window is larger or smaller than
+ * needed. */
+ Tk_Justify justify; /* Justification for text. */
+
+ GC textGC; /* GC for drawing text in normal mode. */
+ Tk_TextLayout textLayout; /* Saved layout information. */
+
+ /*
+ * Miscellaneous information:
+ */
+
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ char *takeFocus; /* Value of -takefocus option; not used in
+ * the C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+ int flags; /* Various flags; see below for
+ * definitions. */
+} Message;
+
+/*
+ * Flag bits for messages:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler
+ * has already been queued to redraw
+ * this window.
+ * GOT_FOCUS: Non-zero means this button currently
+ * has the input focus.
+ */
+
+#define REDRAW_PENDING 1
+#define GOT_FOCUS 4
+
+/*
+ * Information used for argv parsing.
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor",
+ DEF_MESSAGE_ANCHOR, Tk_Offset(Message, anchor), 0},
+ {TK_CONFIG_INT, "-aspect", "aspect", "Aspect",
+ DEF_MESSAGE_ASPECT, Tk_Offset(Message, aspect), 0},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_MESSAGE_BG_COLOR, Tk_Offset(Message, border),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_MESSAGE_BG_MONO, Tk_Offset(Message, border),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_MESSAGE_BORDER_WIDTH, Tk_Offset(Message, borderWidth), 0},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_MESSAGE_CURSOR, Tk_Offset(Message, cursor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_FONT, "-font", "font", "Font",
+ DEF_MESSAGE_FONT, Tk_Offset(Message, tkfont), 0},
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_MESSAGE_FG, Tk_Offset(Message, fgColorPtr), 0},
+ {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_MESSAGE_HIGHLIGHT_BG,
+ Tk_Offset(Message, highlightBgColorPtr), 0},
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_MESSAGE_HIGHLIGHT, Tk_Offset(Message, highlightColorPtr), 0},
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_MESSAGE_HIGHLIGHT_WIDTH, Tk_Offset(Message, highlightWidth), 0},
+ {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_MESSAGE_JUSTIFY, Tk_Offset(Message, justify), 0},
+ {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
+ DEF_MESSAGE_PADX, Tk_Offset(Message, padX), 0},
+ {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
+ DEF_MESSAGE_PADY, Tk_Offset(Message, padY), 0},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_MESSAGE_RELIEF, Tk_Offset(Message, relief), 0},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_MESSAGE_TAKE_FOCUS, Tk_Offset(Message, takeFocus),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-text", "text", "Text",
+ DEF_MESSAGE_TEXT, Tk_Offset(Message, string), 0},
+ {TK_CONFIG_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_MESSAGE_TEXT_VARIABLE, Tk_Offset(Message, textVarName),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-width", "width", "Width",
+ DEF_MESSAGE_WIDTH, Tk_Offset(Message, width), 0},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void MessageCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void MessageEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static char * MessageTextVarProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, char *name1, char *name2,
+ int flags));
+static int MessageWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void MessageWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+static void ComputeMessageGeometry _ANSI_ARGS_((Message *msgPtr));
+static int ConfigureMessage _ANSI_ARGS_((Tcl_Interp *interp,
+ Message *msgPtr, int argc, char **argv,
+ int flags));
+static void DestroyMessage _ANSI_ARGS_((char *memPtr));
+static void DisplayMessage _ANSI_ARGS_((ClientData clientData));
+
+/*
+ * The structure below defines message class behavior by means of procedures
+ * that can be invoked from generic window code.
+ */
+
+static TkClassProcs messageClass = {
+ NULL, /* createProc. */
+ MessageWorldChanged, /* geometryProc. */
+ NULL /* modalProc. */
+};
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_MessageCmd --
+ *
+ * This procedure is invoked to process the "message" Tcl
+ * command. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_MessageCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ register Message *msgPtr;
+ Tk_Window new;
+ Tk_Window tkwin = (Tk_Window) clientData;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " pathName ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+
+ msgPtr = (Message *) ckalloc(sizeof(Message));
+ msgPtr->tkwin = new;
+ msgPtr->display = Tk_Display(new);
+ msgPtr->interp = interp;
+ msgPtr->widgetCmd = Tcl_CreateCommand(interp, Tk_PathName(msgPtr->tkwin),
+ MessageWidgetCmd, (ClientData) msgPtr, MessageCmdDeletedProc);
+ msgPtr->textLayout = NULL;
+ msgPtr->string = NULL;
+ msgPtr->numChars = 0;
+ msgPtr->textVarName = NULL;
+ msgPtr->border = NULL;
+ msgPtr->borderWidth = 0;
+ msgPtr->relief = TK_RELIEF_FLAT;
+ msgPtr->highlightWidth = 0;
+ msgPtr->highlightBgColorPtr = NULL;
+ msgPtr->highlightColorPtr = NULL;
+ msgPtr->tkfont = NULL;
+ msgPtr->fgColorPtr = NULL;
+ msgPtr->textGC = None;
+ msgPtr->padX = 0;
+ msgPtr->padY = 0;
+ msgPtr->anchor = TK_ANCHOR_CENTER;
+ msgPtr->width = 0;
+ msgPtr->aspect = 150;
+ msgPtr->msgWidth = 0;
+ msgPtr->msgHeight = 0;
+ msgPtr->justify = TK_JUSTIFY_LEFT;
+ msgPtr->cursor = None;
+ msgPtr->takeFocus = NULL;
+ msgPtr->flags = 0;
+
+ Tk_SetClass(msgPtr->tkwin, "Message");
+ TkSetClassProcs(msgPtr->tkwin, &messageClass, (ClientData) msgPtr);
+ Tk_CreateEventHandler(msgPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ MessageEventProc, (ClientData) msgPtr);
+ if (ConfigureMessage(interp, msgPtr, argc-2, argv+2, 0) != TCL_OK) {
+ goto error;
+ }
+
+ interp->result = Tk_PathName(msgPtr->tkwin);
+ return TCL_OK;
+
+ error:
+ Tk_DestroyWindow(msgPtr->tkwin);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MessageWidgetCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to a widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+MessageWidgetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about message widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ register Message *msgPtr = (Message *) clientData;
+ size_t length;
+ int c;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
+ && (length >= 2)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " cget option\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return Tk_ConfigureValue(interp, msgPtr->tkwin, configSpecs,
+ (char *) msgPtr, argv[2], 0);
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
+ && (length >= 2)) {
+ if (argc == 2) {
+ return Tk_ConfigureInfo(interp, msgPtr->tkwin, configSpecs,
+ (char *) msgPtr, (char *) NULL, 0);
+ } else if (argc == 3) {
+ return Tk_ConfigureInfo(interp, msgPtr->tkwin, configSpecs,
+ (char *) msgPtr, argv[2], 0);
+ } else {
+ return ConfigureMessage(interp, msgPtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be cget or configure", (char *) NULL);
+ return TCL_ERROR;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyMessage --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a message at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the message is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyMessage(memPtr)
+ char *memPtr; /* Info about message widget. */
+{
+ register Message *msgPtr = (Message *) memPtr;
+
+ /*
+ * Free up all the stuff that requires special handling, then
+ * let Tk_FreeOptions handle all the standard option-related
+ * stuff.
+ */
+
+ Tk_FreeTextLayout(msgPtr->textLayout);
+ if (msgPtr->textVarName != NULL) {
+ Tcl_UntraceVar(msgPtr->interp, msgPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MessageTextVarProc, (ClientData) msgPtr);
+ }
+ if (msgPtr->textGC != None) {
+ Tk_FreeGC(msgPtr->display, msgPtr->textGC);
+ }
+ Tk_FreeOptions(configSpecs, (char *) msgPtr, msgPtr->display, 0);
+ ckfree((char *) msgPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureMessage --
+ *
+ * This procedure is called to process an argv/argc list, plus
+ * the Tk option database, in order to configure (or
+ * reconfigure) a message widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then interp->result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as text string, colors, font,
+ * etc. get set for msgPtr; old resources get freed, if there
+ * were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureMessage(interp, msgPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register Message *msgPtr; /* Information about widget; may or may
+ * not already have values for some fields. */
+ int argc; /* Number of valid entries in argv. */
+ char **argv; /* Arguments. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ /*
+ * Eliminate any existing trace on a variable monitored by the message.
+ */
+
+ if (msgPtr->textVarName != NULL) {
+ Tcl_UntraceVar(interp, msgPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MessageTextVarProc, (ClientData) msgPtr);
+ }
+
+ if (Tk_ConfigureWidget(interp, msgPtr->tkwin, configSpecs,
+ argc, argv, (char *) msgPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the message is to display the value of a variable, then set up
+ * a trace on the variable's value, create the variable if it doesn't
+ * exist, and fetch its current value.
+ */
+
+ if (msgPtr->textVarName != NULL) {
+ char *value;
+
+ value = Tcl_GetVar(interp, msgPtr->textVarName, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ Tcl_SetVar(interp, msgPtr->textVarName, msgPtr->string,
+ TCL_GLOBAL_ONLY);
+ } else {
+ if (msgPtr->string != NULL) {
+ ckfree(msgPtr->string);
+ }
+ msgPtr->string = strcpy(ckalloc(strlen(value) + 1), value);
+ }
+ Tcl_TraceVar(interp, msgPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MessageTextVarProc, (ClientData) msgPtr);
+ }
+
+ /*
+ * A few other options need special processing, such as setting
+ * the background from a 3-D border or handling special defaults
+ * that couldn't be specified to Tk_ConfigureWidget.
+ */
+
+ msgPtr->numChars = strlen(msgPtr->string);
+
+ Tk_SetBackgroundFromBorder(msgPtr->tkwin, msgPtr->border);
+
+ if (msgPtr->highlightWidth < 0) {
+ msgPtr->highlightWidth = 0;
+ }
+
+ MessageWorldChanged((ClientData) msgPtr);
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * MessageWorldChanged --
+ *
+ * This procedure is called when the world has changed in some
+ * way and the widget needs to recompute all its graphics contexts
+ * and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Message will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+MessageWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ XGCValues gcValues;
+ GC gc;
+ Tk_FontMetrics fm;
+ Message *msgPtr;
+
+ msgPtr = (Message *) instanceData;
+
+ gcValues.font = Tk_FontId(msgPtr->tkfont);
+ gcValues.foreground = msgPtr->fgColorPtr->pixel;
+ gc = Tk_GetGC(msgPtr->tkwin, GCForeground | GCFont, &gcValues);
+ if (msgPtr->textGC != None) {
+ Tk_FreeGC(msgPtr->display, msgPtr->textGC);
+ }
+ msgPtr->textGC = gc;
+
+ Tk_GetFontMetrics(msgPtr->tkfont, &fm);
+ if (msgPtr->padX < 0) {
+ msgPtr->padX = fm.ascent / 2;
+ }
+ if (msgPtr->padY == -1) {
+ msgPtr->padY = fm.ascent / 4;
+ }
+
+ /*
+ * Recompute the desired geometry for the window, and arrange for
+ * the window to be redisplayed.
+ */
+
+ ComputeMessageGeometry(msgPtr);
+ if ((msgPtr->tkwin != NULL) && Tk_IsMapped(msgPtr->tkwin)
+ && !(msgPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayMessage, (ClientData) msgPtr);
+ msgPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeMessageGeometry --
+ *
+ * Compute the desired geometry for a message window,
+ * taking into account the desired aspect ratio for the
+ * window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Tk_GeometryRequest is called to inform the geometry
+ * manager of the desired geometry for this window.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputeMessageGeometry(msgPtr)
+ register Message *msgPtr; /* Information about window. */
+{
+ int width, inc, height;
+ int thisWidth, thisHeight, maxWidth;
+ int aspect, lowerBound, upperBound, inset;
+
+ Tk_FreeTextLayout(msgPtr->textLayout);
+
+ inset = msgPtr->borderWidth + msgPtr->highlightWidth;
+
+ /*
+ * Compute acceptable bounds for the final aspect ratio.
+ */
+
+ aspect = msgPtr->aspect/10;
+ if (aspect < 5) {
+ aspect = 5;
+ }
+ lowerBound = msgPtr->aspect - aspect;
+ upperBound = msgPtr->aspect + aspect;
+
+ /*
+ * Do the computation in multiple passes: start off with
+ * a very wide window, and compute its height. Then change
+ * the width and try again. Reduce the size of the change
+ * and iterate until dimensions are found that approximate
+ * the desired aspect ratio. Or, if the user gave an explicit
+ * width then just use that.
+ */
+
+ if (msgPtr->width > 0) {
+ width = msgPtr->width;
+ inc = 0;
+ } else {
+ width = WidthOfScreen(Tk_Screen(msgPtr->tkwin))/2;
+ inc = width/2;
+ }
+
+ for ( ; ; inc /= 2) {
+ msgPtr->textLayout = Tk_ComputeTextLayout(msgPtr->tkfont,
+ msgPtr->string, msgPtr->numChars, width, msgPtr->justify,
+ 0, &thisWidth, &thisHeight);
+ maxWidth = thisWidth + 2 * (inset + msgPtr->padX);
+ height = thisHeight + 2 * (inset + msgPtr->padY);
+
+ if (inc <= 2) {
+ break;
+ }
+ aspect = (100 * maxWidth) / height;
+
+ if (aspect < lowerBound) {
+ width += inc;
+ } else if (aspect > upperBound) {
+ width -= inc;
+ } else {
+ break;
+ }
+ Tk_FreeTextLayout(msgPtr->textLayout);
+ }
+ msgPtr->msgWidth = thisWidth;
+ msgPtr->msgHeight = thisHeight;
+ Tk_GeometryRequest(msgPtr->tkwin, maxWidth, height);
+ Tk_SetInternalBorder(msgPtr->tkwin, inset);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayMessage --
+ *
+ * This procedure redraws the contents of a message window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayMessage(clientData)
+ ClientData clientData; /* Information about window. */
+{
+ register Message *msgPtr = (Message *) clientData;
+ register Tk_Window tkwin = msgPtr->tkwin;
+ int x, y;
+
+ msgPtr->flags &= ~REDRAW_PENDING;
+ if ((msgPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), msgPtr->border, 0, 0,
+ Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
+
+ /*
+ * Compute starting y-location for message based on message size
+ * and anchor option.
+ */
+
+ TkComputeAnchor(msgPtr->anchor, tkwin, msgPtr->padX, msgPtr->padY,
+ msgPtr->msgWidth, msgPtr->msgHeight, &x, &y);
+ Tk_DrawTextLayout(Tk_Display(tkwin), Tk_WindowId(tkwin), msgPtr->textGC,
+ msgPtr->textLayout, x, y, 0, -1);
+
+ if (msgPtr->relief != TK_RELIEF_FLAT) {
+ Tk_Draw3DRectangle(tkwin, Tk_WindowId(tkwin), msgPtr->border,
+ msgPtr->highlightWidth, msgPtr->highlightWidth,
+ Tk_Width(tkwin) - 2*msgPtr->highlightWidth,
+ Tk_Height(tkwin) - 2*msgPtr->highlightWidth,
+ msgPtr->borderWidth, msgPtr->relief);
+ }
+ if (msgPtr->highlightWidth != 0) {
+ GC gc;
+
+ if (msgPtr->flags & GOT_FOCUS) {
+ gc = Tk_GCForColor(msgPtr->highlightColorPtr, Tk_WindowId(tkwin));
+ } else {
+ gc = Tk_GCForColor(msgPtr->highlightBgColorPtr, Tk_WindowId(tkwin));
+ }
+ Tk_DrawFocusHighlight(tkwin, gc, msgPtr->highlightWidth,
+ Tk_WindowId(tkwin));
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MessageEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on messages.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+MessageEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ Message *msgPtr = (Message *) clientData;
+
+ if (((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0))
+ || (eventPtr->type == ConfigureNotify)) {
+ goto redraw;
+ } else if (eventPtr->type == DestroyNotify) {
+ if (msgPtr->tkwin != NULL) {
+ msgPtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(msgPtr->interp, msgPtr->widgetCmd);
+ }
+ if (msgPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayMessage, (ClientData) msgPtr);
+ }
+ Tcl_EventuallyFree((ClientData) msgPtr, DestroyMessage);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ msgPtr->flags |= GOT_FOCUS;
+ if (msgPtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ msgPtr->flags &= ~GOT_FOCUS;
+ if (msgPtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ }
+ return;
+
+ redraw:
+ if ((msgPtr->tkwin != NULL) && !(msgPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayMessage, (ClientData) msgPtr);
+ msgPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MessageCmdDeletedProc --
+ *
+ * This procedure is invoked when a widget command is deleted. If
+ * the widget isn't already in the process of being destroyed,
+ * this command destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MessageCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ Message *msgPtr = (Message *) clientData;
+ Tk_Window tkwin = msgPtr->tkwin;
+
+ /*
+ * This procedure could be invoked either because the window was
+ * destroyed and the command was then deleted (in which case tkwin
+ * is NULL) or because the command was deleted, and then this procedure
+ * destroys the widget.
+ */
+
+ if (tkwin != NULL) {
+ msgPtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MessageTextVarProc --
+ *
+ * This procedure is invoked when someone changes the variable
+ * whose contents are to be displayed in a message.
+ *
+ * Results:
+ * NULL is always returned.
+ *
+ * Side effects:
+ * The text displayed in the message will change to match the
+ * variable.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+MessageTextVarProc(clientData, interp, name1, name2, flags)
+ ClientData clientData; /* Information about message. */
+ Tcl_Interp *interp; /* Interpreter containing variable. */
+ char *name1; /* Name of variable. */
+ char *name2; /* Second part of variable name. */
+ int flags; /* Information about what happened. */
+{
+ register Message *msgPtr = (Message *) clientData;
+ char *value;
+
+ /*
+ * If the variable is unset, then immediately recreate it unless
+ * the whole interpreter is going away.
+ */
+
+ if (flags & TCL_TRACE_UNSETS) {
+ if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+ Tcl_SetVar(interp, msgPtr->textVarName, msgPtr->string,
+ TCL_GLOBAL_ONLY);
+ Tcl_TraceVar(interp, msgPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MessageTextVarProc, clientData);
+ }
+ return (char *) NULL;
+ }
+
+ value = Tcl_GetVar(interp, msgPtr->textVarName, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ value = "";
+ }
+ if (msgPtr->string != NULL) {
+ ckfree(msgPtr->string);
+ }
+ msgPtr->numChars = strlen(value);
+ msgPtr->string = (char *) ckalloc((unsigned) (msgPtr->numChars + 1));
+ strcpy(msgPtr->string, value);
+ ComputeMessageGeometry(msgPtr);
+
+ if ((msgPtr->tkwin != NULL) && Tk_IsMapped(msgPtr->tkwin)
+ && !(msgPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayMessage, (ClientData) msgPtr);
+ msgPtr->flags |= REDRAW_PENDING;
+ }
+ return (char *) NULL;
+}
diff --git a/generic/tkOption.c b/generic/tkOption.c
new file mode 100644
index 0000000..b2bef64
--- /dev/null
+++ b/generic/tkOption.c
@@ -0,0 +1,1397 @@
+/*
+ * tkOption.c --
+ *
+ * This module contains procedures to manage the option
+ * database, which allows various strings to be associated
+ * with windows either by name or by class or both.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkOption.c 1.57 96/10/17 15:16:45
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * The option database is stored as one tree for each main window.
+ * Each name or class field in an option is associated with a node or
+ * leaf of the tree. For example, the options "x.y.z" and "x.y*a"
+ * each correspond to three nodes in the tree; they share the nodes
+ * "x" and "x.y", but have different leaf nodes. One of the following
+ * structures exists for each node or leaf in the option tree. It is
+ * actually stored as part of the parent node, and describes a particular
+ * child of the parent.
+ */
+
+typedef struct Element {
+ Tk_Uid nameUid; /* Name or class from one element of
+ * an option spec. */
+ union {
+ struct ElArray *arrayPtr; /* If this is an intermediate node,
+ * a pointer to a structure describing
+ * the remaining elements of all
+ * options whose prefixes are the
+ * same up through this element. */
+ Tk_Uid valueUid; /* For leaf nodes, this is the string
+ * value of the option. */
+ } child;
+ int priority; /* Used to select among matching
+ * options. Includes both the
+ * priority level and a serial #.
+ * Greater value means higher
+ * priority. Irrelevant except in
+ * leaf nodes. */
+ int flags; /* OR-ed combination of bits. See
+ * below for values. */
+} Element;
+
+/*
+ * Flags in Element structures:
+ *
+ * CLASS - Non-zero means this element refers to a class,
+ * Zero means this element refers to a name.
+ * NODE - Zero means this is a leaf element (the child
+ * field is a value, not a pointer to another node).
+ * One means this is a node element.
+ * WILDCARD - Non-zero means this there was a star in the
+ * original specification just before this element.
+ * Zero means there was a dot.
+ */
+
+#define TYPE_MASK 0x7
+
+#define CLASS 0x1
+#define NODE 0x2
+#define WILDCARD 0x4
+
+#define EXACT_LEAF_NAME 0x0
+#define EXACT_LEAF_CLASS 0x1
+#define EXACT_NODE_NAME 0x2
+#define EXACT_NODE_CLASS 0x3
+#define WILDCARD_LEAF_NAME 0x4
+#define WILDCARD_LEAF_CLASS 0x5
+#define WILDCARD_NODE_NAME 0x6
+#define WILDCARD_NODE_CLASS 0x7
+
+/*
+ * The following structure is used to manage a dynamic array of
+ * Elements. These structures are used for two purposes: to store
+ * the contents of a node in the option tree, and for the option
+ * stacks described below.
+ */
+
+typedef struct ElArray {
+ int arraySize; /* Number of elements actually
+ * allocated in the "els" array. */
+ int numUsed; /* Number of elements currently in
+ * use out of els. */
+ Element *nextToUse; /* Pointer to &els[numUsed]. */
+ Element els[1]; /* Array of structures describing
+ * children of this node. The
+ * array will actually contain enough
+ * elements for all of the children
+ * (and even a few extras, perhaps).
+ * This must be the last field in
+ * the structure. */
+} ElArray;
+
+#define EL_ARRAY_SIZE(numEls) ((unsigned) (sizeof(ElArray) \
+ + ((numEls)-1)*sizeof(Element)))
+#define INITIAL_SIZE 5
+
+/*
+ * In addition to the option tree, which is a relatively static structure,
+ * there are eight additional structures called "stacks", which are used
+ * to speed up queries into the option database. The stack structures
+ * are designed for the situation where an individual widget makes repeated
+ * requests for its particular options. The requests differ only in
+ * their last name/class, so during the first request we extract all
+ * the options pertaining to the particular widget and save them in a
+ * stack-like cache; subsequent requests for the same widget can search
+ * the cache relatively quickly. In fact, the cache is a hierarchical
+ * one, storing a list of relevant options for this widget and all of
+ * its ancestors up to the application root; hence the name "stack".
+ *
+ * Each of the eight stacks consists of an array of Elements, ordered in
+ * terms of levels in the window hierarchy. All the elements relevant
+ * for the top-level widget appear first in the array, followed by all
+ * those from the next-level widget on the path to the current widget,
+ * etc. down to those for the current widget.
+ *
+ * Cached information is divided into eight stacks according to the
+ * CLASS, NODE, and WILDCARD flags. Leaf and non-leaf information is
+ * kept separate to speed up individual probes (non-leaf information is
+ * only relevant when building the stacks, but isn't relevant when
+ * making probes; similarly, only non-leaf information is relevant
+ * when the stacks are being extended to the next widget down in the
+ * widget hierarchy). Wildcard elements are handled separately from
+ * "exact" elements because once they appear at a particular level in
+ * the stack they remain active for all deeper levels; exact elements
+ * are only relevant at a particular level. For example, when searching
+ * for options relevant in a particular window, the entire wildcard
+ * stacks get checked, but only the portions of the exact stacks that
+ * pertain to the window's parent. Lastly, name and class stacks are
+ * kept separate because different search keys are used when searching
+ * them; keeping them separate speeds up the searches.
+ */
+
+#define NUM_STACKS 8
+static ElArray *stacks[NUM_STACKS];
+static TkWindow *cachedWindow = NULL; /* Lowest-level window currently
+ * loaded in stacks at present.
+ * NULL means stacks have never
+ * been used, or have been
+ * invalidated because of a change
+ * to the database. */
+
+/*
+ * One of the following structures is used to keep track of each
+ * level in the stacks.
+ */
+
+typedef struct StackLevel {
+ TkWindow *winPtr; /* Window corresponding to this stack
+ * level. */
+ int bases[NUM_STACKS]; /* For each stack, index of first
+ * element on stack corresponding to
+ * this level (used to restore "numUsed"
+ * fields when popping out of a level. */
+} StackLevel;
+
+/*
+ * Information about all of the stack levels that are currently
+ * active. This array grows dynamically to become as large as needed.
+ */
+
+static StackLevel *levels = NULL;
+ /* Array describing current stack. */
+static int numLevels = 0; /* Total space allocated. */
+static int curLevel = -1; /* Highest level currently in use. Note:
+ * curLevel is never 0! (I don't remember
+ * why anymore...) */
+
+/*
+ * The variable below is a serial number for all options entered into
+ * the database so far. It increments on each addition to the option
+ * database. It is used in computing option priorities, so that the
+ * most recent entry wins when choosing between options at the same
+ * priority level.
+ */
+
+static int serial = 0;
+
+/*
+ * Special "no match" Element to use as default for searches.
+ */
+
+static Element defaultMatch;
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static int AddFromString _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, char *string, int priority));
+static void ClearOptionTree _ANSI_ARGS_((ElArray *arrayPtr));
+static ElArray * ExtendArray _ANSI_ARGS_((ElArray *arrayPtr,
+ Element *elPtr));
+static void ExtendStacks _ANSI_ARGS_((ElArray *arrayPtr,
+ int leaf));
+static int GetDefaultOptions _ANSI_ARGS_((Tcl_Interp *interp,
+ TkWindow *winPtr));
+static ElArray * NewArray _ANSI_ARGS_((int numEls));
+static void OptionInit _ANSI_ARGS_((TkMainInfo *mainPtr));
+static int ParsePriority _ANSI_ARGS_((Tcl_Interp *interp,
+ char *string));
+static int ReadOptionFile _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, char *fileName, int priority));
+static void SetupStacks _ANSI_ARGS_((TkWindow *winPtr, int leaf));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_AddOption --
+ *
+ * Add a new option to the option database.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information is added to the option database.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_AddOption(tkwin, name, value, priority)
+ Tk_Window tkwin; /* Window token; option will be associated
+ * with main window for this window. */
+ char *name; /* Multi-element name of option. */
+ char *value; /* String value for option. */
+ int priority; /* Overall priority level to use for
+ * this option, such as TK_USER_DEFAULT_PRIO
+ * or TK_INTERACTIVE_PRIO. Must be between
+ * 0 and TK_MAX_PRIO. */
+{
+ TkWindow *winPtr = ((TkWindow *) tkwin)->mainPtr->winPtr;
+ register ElArray **arrayPtrPtr;
+ register Element *elPtr;
+ Element newEl;
+ register char *p;
+ char *field;
+ int count, firstField, length;
+#define TMP_SIZE 100
+ char tmp[TMP_SIZE+1];
+
+ if (winPtr->mainPtr->optionRootPtr == NULL) {
+ OptionInit(winPtr->mainPtr);
+ }
+ cachedWindow = NULL; /* Invalidate the cache. */
+
+ /*
+ * Compute the priority for the new element, including both the
+ * overall level and the serial number (to disambiguate with the
+ * level).
+ */
+
+ if (priority < 0) {
+ priority = 0;
+ } else if (priority > TK_MAX_PRIO) {
+ priority = TK_MAX_PRIO;
+ }
+ newEl.priority = (priority << 24) + serial;
+ serial++;
+
+ /*
+ * Parse the option one field at a time.
+ */
+
+ arrayPtrPtr = &(((TkWindow *) tkwin)->mainPtr->optionRootPtr);
+ p = name;
+ for (firstField = 1; ; firstField = 0) {
+
+ /*
+ * Scan the next field from the name and convert it to a Tk_Uid.
+ * Must copy the field before calling Tk_Uid, so that a terminating
+ * NULL may be added without modifying the source string.
+ */
+
+ if (*p == '*') {
+ newEl.flags = WILDCARD;
+ p++;
+ } else {
+ newEl.flags = 0;
+ }
+ field = p;
+ while ((*p != 0) && (*p != '.') && (*p != '*')) {
+ p++;
+ }
+ length = p - field;
+ if (length > TMP_SIZE) {
+ length = TMP_SIZE;
+ }
+ strncpy(tmp, field, (size_t) length);
+ tmp[length] = 0;
+ newEl.nameUid = Tk_GetUid(tmp);
+ if (isupper(UCHAR(*field))) {
+ newEl.flags |= CLASS;
+ }
+
+ if (*p != 0) {
+
+ /*
+ * New element will be a node. If this option can't possibly
+ * apply to this main window, then just skip it. Otherwise,
+ * add it to the parent, if it isn't already there, and descend
+ * into it.
+ */
+
+ newEl.flags |= NODE;
+ if (firstField && !(newEl.flags & WILDCARD)
+ && (newEl.nameUid != winPtr->nameUid)
+ && (newEl.nameUid != winPtr->classUid)) {
+ return;
+ }
+ for (elPtr = (*arrayPtrPtr)->els, count = (*arrayPtrPtr)->numUsed;
+ ; elPtr++, count--) {
+ if (count == 0) {
+ newEl.child.arrayPtr = NewArray(5);
+ *arrayPtrPtr = ExtendArray(*arrayPtrPtr, &newEl);
+ arrayPtrPtr = &((*arrayPtrPtr)->nextToUse[-1].child.arrayPtr);
+ break;
+ }
+ if ((elPtr->nameUid == newEl.nameUid)
+ && (elPtr->flags == newEl.flags)) {
+ arrayPtrPtr = &(elPtr->child.arrayPtr);
+ break;
+ }
+ }
+ if (*p == '.') {
+ p++;
+ }
+ } else {
+
+ /*
+ * New element is a leaf. Add it to the parent, if it isn't
+ * already there. If it exists already, keep whichever value
+ * has highest priority.
+ */
+
+ newEl.child.valueUid = Tk_GetUid(value);
+ for (elPtr = (*arrayPtrPtr)->els, count = (*arrayPtrPtr)->numUsed;
+ ; elPtr++, count--) {
+ if (count == 0) {
+ *arrayPtrPtr = ExtendArray(*arrayPtrPtr, &newEl);
+ return;
+ }
+ if ((elPtr->nameUid == newEl.nameUid)
+ && (elPtr->flags == newEl.flags)) {
+ if (elPtr->priority < newEl.priority) {
+ elPtr->priority = newEl.priority;
+ elPtr->child.valueUid = newEl.child.valueUid;
+ }
+ return;
+ }
+ }
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetOption --
+ *
+ * Retrieve an option from the option database.
+ *
+ * Results:
+ * The return value is the value specified in the option
+ * database for the given name and class on the given
+ * window. If there is nothing specified in the database
+ * for that option, then NULL is returned.
+ *
+ * Side effects:
+ * The internal caches used to speed up option mapping
+ * may be modified, if this tkwin is different from the
+ * last tkwin used for option retrieval.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_Uid
+Tk_GetOption(tkwin, name, className)
+ Tk_Window tkwin; /* Token for window that option is
+ * associated with. */
+ char *name; /* Name of option. */
+ char *className; /* Class of option. NULL means there
+ * is no class for this option: just
+ * check for name. */
+{
+ Tk_Uid nameId, classId;
+ register Element *elPtr, *bestPtr;
+ register int count;
+
+ /*
+ * Note: no need to call OptionInit here: it will be done by
+ * the SetupStacks call below (squeeze out those nanoseconds).
+ */
+
+ if (tkwin != (Tk_Window) cachedWindow) {
+ SetupStacks((TkWindow *) tkwin, 1);
+ }
+
+ nameId = Tk_GetUid(name);
+ bestPtr = &defaultMatch;
+ for (elPtr = stacks[EXACT_LEAF_NAME]->els,
+ count = stacks[EXACT_LEAF_NAME]->numUsed; count > 0;
+ elPtr++, count--) {
+ if ((elPtr->nameUid == nameId)
+ && (elPtr->priority > bestPtr->priority)) {
+ bestPtr = elPtr;
+ }
+ }
+ for (elPtr = stacks[WILDCARD_LEAF_NAME]->els,
+ count = stacks[WILDCARD_LEAF_NAME]->numUsed; count > 0;
+ elPtr++, count--) {
+ if ((elPtr->nameUid == nameId)
+ && (elPtr->priority > bestPtr->priority)) {
+ bestPtr = elPtr;
+ }
+ }
+ if (className != NULL) {
+ classId = Tk_GetUid(className);
+ for (elPtr = stacks[EXACT_LEAF_CLASS]->els,
+ count = stacks[EXACT_LEAF_CLASS]->numUsed; count > 0;
+ elPtr++, count--) {
+ if ((elPtr->nameUid == classId)
+ && (elPtr->priority > bestPtr->priority)) {
+ bestPtr = elPtr;
+ }
+ }
+ for (elPtr = stacks[WILDCARD_LEAF_CLASS]->els,
+ count = stacks[WILDCARD_LEAF_CLASS]->numUsed; count > 0;
+ elPtr++, count--) {
+ if ((elPtr->nameUid == classId)
+ && (elPtr->priority > bestPtr->priority)) {
+ bestPtr = elPtr;
+ }
+ }
+ }
+ return bestPtr->child.valueUid;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_OptionCmd --
+ *
+ * This procedure is invoked to process the "option" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_OptionCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ size_t length;
+ char c;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " cmd arg ?arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'a') && (strncmp(argv[1], "add", length) == 0)) {
+ int priority;
+
+ if ((argc != 4) && (argc != 5)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " add pattern value ?priority?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc == 4) {
+ priority = TK_INTERACTIVE_PRIO;
+ } else {
+ priority = ParsePriority(interp, argv[4]);
+ if (priority < 0) {
+ return TCL_ERROR;
+ }
+ }
+ Tk_AddOption(tkwin, argv[2], argv[3], priority);
+ return TCL_OK;
+ } else if ((c == 'c') && (strncmp(argv[1], "clear", length) == 0)) {
+ TkMainInfo *mainPtr;
+
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " clear\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ mainPtr = ((TkWindow *) tkwin)->mainPtr;
+ if (mainPtr->optionRootPtr != NULL) {
+ ClearOptionTree(mainPtr->optionRootPtr);
+ mainPtr->optionRootPtr = NULL;
+ }
+ cachedWindow = NULL;
+ return TCL_OK;
+ } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
+ Tk_Window window;
+ Tk_Uid value;
+
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " get window name class\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ window = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (window == NULL) {
+ return TCL_ERROR;
+ }
+ value = Tk_GetOption(window, argv[3], argv[4]);
+ if (value != NULL) {
+ interp->result = value;
+ }
+ return TCL_OK;
+ } else if ((c == 'r') && (strncmp(argv[1], "readfile", length) == 0)) {
+ int priority;
+
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " readfile fileName ?priority?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc == 4) {
+ priority = ParsePriority(interp, argv[3]);
+ if (priority < 0) {
+ return TCL_ERROR;
+ }
+ } else {
+ priority = TK_INTERACTIVE_PRIO;
+ }
+ return ReadOptionFile(interp, tkwin, argv[2], priority);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be add, clear, get, or readfile", (char *) NULL);
+ return TCL_ERROR;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkOptionDeadWindow --
+ *
+ * This procedure is called whenever a window is deleted.
+ * It cleans up any option-related stuff associated with
+ * the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Option-related resources are freed. See code below
+ * for details.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkOptionDeadWindow(winPtr)
+ register TkWindow *winPtr; /* Window to be cleaned up. */
+{
+ /*
+ * If this window is in the option stacks, then clear the stacks.
+ */
+
+ if (winPtr->optionLevel != -1) {
+ int i;
+
+ for (i = 1; i <= curLevel; i++) {
+ levels[i].winPtr->optionLevel = -1;
+ }
+ curLevel = -1;
+ cachedWindow = NULL;
+ }
+
+ /*
+ * If this window was a main window, then delete its option
+ * database.
+ */
+
+ if ((winPtr->mainPtr->winPtr == winPtr)
+ && (winPtr->mainPtr->optionRootPtr != NULL)) {
+ ClearOptionTree(winPtr->mainPtr->optionRootPtr);
+ winPtr->mainPtr->optionRootPtr = NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkOptionClassChanged --
+ *
+ * This procedure is invoked when a window's class changes. If
+ * the window is on the option cache, this procedure flushes
+ * any information for the window, since the new class could change
+ * what is relevant.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The option cache may be flushed in part or in whole.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkOptionClassChanged(winPtr)
+ TkWindow *winPtr; /* Window whose class changed. */
+{
+ int i, j, *basePtr;
+ ElArray *arrayPtr;
+
+ if (winPtr->optionLevel == -1) {
+ return;
+ }
+
+ /*
+ * Find the lowest stack level that refers to this window, then
+ * flush all of the levels above the matching one.
+ */
+
+ for (i = 1; i <= curLevel; i++) {
+ if (levels[i].winPtr == winPtr) {
+ for (j = i; j <= curLevel; j++) {
+ levels[j].winPtr->optionLevel = -1;
+ }
+ curLevel = i-1;
+ basePtr = levels[i].bases;
+ for (j = 0; j < NUM_STACKS; j++) {
+ arrayPtr = stacks[j];
+ arrayPtr->numUsed = basePtr[j];
+ arrayPtr->nextToUse = &arrayPtr->els[arrayPtr->numUsed];
+ }
+ if (curLevel <= 0) {
+ cachedWindow = NULL;
+ } else {
+ cachedWindow = levels[curLevel].winPtr;
+ }
+ break;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParsePriority --
+ *
+ * Parse a string priority value.
+ *
+ * Results:
+ * The return value is the integer priority level corresponding
+ * to string, or -1 if string doesn't point to a valid priority level.
+ * In this case, an error message is left in interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParsePriority(interp, string)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ char *string; /* Describes a priority level, either
+ * symbolically or numerically. */
+{
+ int priority, c;
+ size_t length;
+
+ c = string[0];
+ length = strlen(string);
+ if ((c == 'w')
+ && (strncmp(string, "widgetDefault", length) == 0)) {
+ return TK_WIDGET_DEFAULT_PRIO;
+ } else if ((c == 's')
+ && (strncmp(string, "startupFile", length) == 0)) {
+ return TK_STARTUP_FILE_PRIO;
+ } else if ((c == 'u')
+ && (strncmp(string, "userDefault", length) == 0)) {
+ return TK_USER_DEFAULT_PRIO;
+ } else if ((c == 'i')
+ && (strncmp(string, "interactive", length) == 0)) {
+ return TK_INTERACTIVE_PRIO;
+ } else {
+ char *end;
+
+ priority = strtoul(string, &end, 0);
+ if ((end == string) || (*end != 0) || (priority < 0)
+ || (priority > 100)) {
+ Tcl_AppendResult(interp, "bad priority level \"", string,
+ "\": must be widgetDefault, startupFile, userDefault, ",
+ "interactive, or a number between 0 and 100",
+ (char *) NULL);
+ return -1;
+ }
+ }
+ return priority;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AddFromString --
+ *
+ * Given a string containing lines in the standard format for
+ * X resources (see other documentation for details on what this
+ * is), parse the resource specifications and enter them as options
+ * for tkwin's main window.
+ *
+ * Results:
+ * The return value is a standard Tcl return code. In the case of
+ * an error in parsing string, TCL_ERROR will be returned and an
+ * error message will be left in interp->result. The memory at
+ * string is totally trashed by this procedure. If you care about
+ * its contents, make a copy before calling here.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+AddFromString(interp, tkwin, string, priority)
+ Tcl_Interp *interp; /* Interpreter to use for reporting results. */
+ Tk_Window tkwin; /* Token for window: options are entered
+ * for this window's main window. */
+ char *string; /* String containing option specifiers. */
+ int priority; /* Priority level to use for options in
+ * this string, such as TK_USER_DEFAULT_PRIO
+ * or TK_INTERACTIVE_PRIO. Must be between
+ * 0 and TK_MAX_PRIO. */
+{
+ register char *src, *dst;
+ char *name, *value;
+ int lineNum;
+
+ src = string;
+ lineNum = 1;
+ while (1) {
+
+ /*
+ * Skip leading white space and empty lines and comment lines, and
+ * check for the end of the spec.
+ */
+
+ while ((*src == ' ') || (*src == '\t')) {
+ src++;
+ }
+ if ((*src == '#') || (*src == '!')) {
+ do {
+ src++;
+ if ((src[0] == '\\') && (src[1] == '\n')) {
+ src += 2;
+ lineNum++;
+ }
+ } while ((*src != '\n') && (*src != 0));
+ }
+ if (*src == '\n') {
+ src++;
+ lineNum++;
+ continue;
+ }
+ if (*src == '\0') {
+ break;
+ }
+
+ /*
+ * Parse off the option name, collapsing out backslash-newline
+ * sequences of course.
+ */
+
+ dst = name = src;
+ while (*src != ':') {
+ if ((*src == '\0') || (*src == '\n')) {
+ sprintf(interp->result, "missing colon on line %d",
+ lineNum);
+ return TCL_ERROR;
+ }
+ if ((src[0] == '\\') && (src[1] == '\n')) {
+ src += 2;
+ lineNum++;
+ } else {
+ *dst = *src;
+ dst++;
+ src++;
+ }
+ }
+
+ /*
+ * Eliminate trailing white space on the name, and null-terminate
+ * it.
+ */
+
+ while ((dst != name) && ((dst[-1] == ' ') || (dst[-1] == '\t'))) {
+ dst--;
+ }
+ *dst = '\0';
+
+ /*
+ * Skip white space between the name and the value.
+ */
+
+ src++;
+ while ((*src == ' ') || (*src == '\t')) {
+ src++;
+ }
+ if (*src == '\0') {
+ sprintf(interp->result, "missing value on line %d", lineNum);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse off the value, squeezing out backslash-newline sequences
+ * along the way.
+ */
+
+ dst = value = src;
+ while (*src != '\n') {
+ if (*src == '\0') {
+ sprintf(interp->result, "missing newline on line %d",
+ lineNum);
+ return TCL_ERROR;
+ }
+ if ((src[0] == '\\') && (src[1] == '\n')) {
+ src += 2;
+ lineNum++;
+ } else {
+ *dst = *src;
+ dst++;
+ src++;
+ }
+ }
+ *dst = 0;
+
+ /*
+ * Enter the option into the database.
+ */
+
+ Tk_AddOption(tkwin, name, value, priority);
+ src++;
+ lineNum++;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadOptionFile --
+ *
+ * Read a file of options ("resources" in the old X terminology)
+ * and load them into the option database.
+ *
+ * Results:
+ * The return value is a standard Tcl return code. In the case of
+ * an error in parsing string, TCL_ERROR will be returned and an
+ * error message will be left in interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadOptionFile(interp, tkwin, fileName, priority)
+ Tcl_Interp *interp; /* Interpreter to use for reporting results. */
+ Tk_Window tkwin; /* Token for window: options are entered
+ * for this window's main window. */
+ char *fileName; /* Name of file containing options. */
+ int priority; /* Priority level to use for options in
+ * this file, such as TK_USER_DEFAULT_PRIO
+ * or TK_INTERACTIVE_PRIO. Must be between
+ * 0 and TK_MAX_PRIO. */
+{
+ char *realName, *buffer;
+ int result, bufferSize;
+ Tcl_Channel chan;
+ Tcl_DString newName;
+
+ /*
+ * Prevent file system access in a safe interpreter.
+ */
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_AppendResult(interp, "can't read options from a file in a",
+ " safe interpreter", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ realName = Tcl_TranslateFileName(interp, fileName, &newName);
+ if (realName == NULL) {
+ return TCL_ERROR;
+ }
+ chan = Tcl_OpenFileChannel(interp, realName, "r", 0);
+ Tcl_DStringFree(&newName);
+ if (chan == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "couldn't open \"", fileName,
+ "\": ", Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Compute size of file by seeking to the end of the file. This will
+ * overallocate if we are performing CRLF translation.
+ */
+
+ bufferSize = Tcl_Seek(chan, 0L, SEEK_END);
+ (void) Tcl_Seek(chan, 0L, SEEK_SET);
+
+ if (bufferSize < 0) {
+ Tcl_AppendResult(interp, "error seeking to end of file \"",
+ fileName, "\":", Tcl_PosixError(interp), (char *) NULL);
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+
+ }
+ buffer = (char *) ckalloc((unsigned) bufferSize+1);
+ bufferSize = Tcl_Read(chan, buffer, bufferSize);
+ if (bufferSize < 0) {
+ Tcl_AppendResult(interp, "error reading file \"", fileName, "\":",
+ Tcl_PosixError(interp), (char *) NULL);
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+ Tcl_Close(NULL, chan);
+ buffer[bufferSize] = 0;
+ result = AddFromString(interp, tkwin, buffer, priority);
+ ckfree(buffer);
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * NewArray --
+ *
+ * Create a new ElArray structure of a given size.
+ *
+ * Results:
+ * The return value is a pointer to a properly initialized
+ * element array with "numEls" space. The array is marked
+ * as having no active elements.
+ *
+ * Side effects:
+ * Memory is allocated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static ElArray *
+NewArray(numEls)
+ int numEls; /* How many elements of space to allocate. */
+{
+ register ElArray *arrayPtr;
+
+ arrayPtr = (ElArray *) ckalloc(EL_ARRAY_SIZE(numEls));
+ arrayPtr->arraySize = numEls;
+ arrayPtr->numUsed = 0;
+ arrayPtr->nextToUse = arrayPtr->els;
+ return arrayPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ExtendArray --
+ *
+ * Add a new element to an array, extending the array if
+ * necessary.
+ *
+ * Results:
+ * The return value is a pointer to the new array, which
+ * will be different from arrayPtr if the array got expanded.
+ *
+ * Side effects:
+ * Memory may be allocated or freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static ElArray *
+ExtendArray(arrayPtr, elPtr)
+ register ElArray *arrayPtr; /* Array to be extended. */
+ register Element *elPtr; /* Element to be copied into array. */
+{
+ /*
+ * If the current array has filled up, make it bigger.
+ */
+
+ if (arrayPtr->numUsed >= arrayPtr->arraySize) {
+ register ElArray *newPtr;
+
+ newPtr = (ElArray *) ckalloc(EL_ARRAY_SIZE(2*arrayPtr->arraySize));
+ newPtr->arraySize = 2*arrayPtr->arraySize;
+ newPtr->numUsed = arrayPtr->numUsed;
+ newPtr->nextToUse = &newPtr->els[newPtr->numUsed];
+ memcpy((VOID *) newPtr->els, (VOID *) arrayPtr->els,
+ (arrayPtr->arraySize*sizeof(Element)));
+ ckfree((char *) arrayPtr);
+ arrayPtr = newPtr;
+ }
+
+ *arrayPtr->nextToUse = *elPtr;
+ arrayPtr->nextToUse++;
+ arrayPtr->numUsed++;
+ return arrayPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SetupStacks --
+ *
+ * Arrange the stacks so that they cache all the option
+ * information for a particular window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The stacks are modified to hold information for tkwin
+ * and all its ancestors in the window hierarchy.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+SetupStacks(winPtr, leaf)
+ TkWindow *winPtr; /* Window for which information is to
+ * be cached. */
+ int leaf; /* Non-zero means this is the leaf
+ * window being probed. Zero means this
+ * is an ancestor of the desired leaf. */
+{
+ int level, i, *iPtr;
+ register StackLevel *levelPtr;
+ register ElArray *arrayPtr;
+
+ /*
+ * The following array defines the order in which the current
+ * stacks are searched to find matching entries to add to the
+ * stacks. Given the current priority-based scheme, the order
+ * below is no longer relevant; all that matters is that an
+ * element is on the list *somewhere*. The ordering is a relic
+ * of the old days when priorities were determined differently.
+ */
+
+ static int searchOrder[] = {WILDCARD_NODE_CLASS, WILDCARD_NODE_NAME,
+ EXACT_NODE_CLASS, EXACT_NODE_NAME, -1};
+
+ if (winPtr->mainPtr->optionRootPtr == NULL) {
+ OptionInit(winPtr->mainPtr);
+ }
+
+ /*
+ * Step 1: make sure that options are cached for this window's
+ * parent.
+ */
+
+ if (winPtr->parentPtr != NULL) {
+ level = winPtr->parentPtr->optionLevel;
+ if ((level == -1) || (cachedWindow == NULL)) {
+ SetupStacks(winPtr->parentPtr, 0);
+ level = winPtr->parentPtr->optionLevel;
+ }
+ level++;
+ } else {
+ level = 1;
+ }
+
+ /*
+ * Step 2: pop extra unneeded information off the stacks and
+ * mark those windows as no longer having cached information.
+ */
+
+ if (curLevel >= level) {
+ while (curLevel >= level) {
+ levels[curLevel].winPtr->optionLevel = -1;
+ curLevel--;
+ }
+ levelPtr = &levels[level];
+ for (i = 0; i < NUM_STACKS; i++) {
+ arrayPtr = stacks[i];
+ arrayPtr->numUsed = levelPtr->bases[i];
+ arrayPtr->nextToUse = &arrayPtr->els[arrayPtr->numUsed];
+ }
+ }
+ curLevel = winPtr->optionLevel = level;
+
+ /*
+ * Step 3: if the root database information isn't loaded or
+ * isn't valid, initialize level 0 of the stack from the
+ * database root (this only happens if winPtr is a main window).
+ */
+
+ if ((curLevel == 1)
+ && ((cachedWindow == NULL)
+ || (cachedWindow->mainPtr != winPtr->mainPtr))) {
+ for (i = 0; i < NUM_STACKS; i++) {
+ arrayPtr = stacks[i];
+ arrayPtr->numUsed = 0;
+ arrayPtr->nextToUse = arrayPtr->els;
+ }
+ ExtendStacks(winPtr->mainPtr->optionRootPtr, 0);
+ }
+
+ /*
+ * Step 4: create a new stack level; grow the level array if
+ * we've run out of levels. Clear the stacks for EXACT_LEAF_NAME
+ * and EXACT_LEAF_CLASS (anything that was there is of no use
+ * any more).
+ */
+
+ if (curLevel >= numLevels) {
+ StackLevel *newLevels;
+
+ newLevels = (StackLevel *) ckalloc((unsigned)
+ (numLevels*2*sizeof(StackLevel)));
+ memcpy((VOID *) newLevels, (VOID *) levels,
+ (numLevels*sizeof(StackLevel)));
+ ckfree((char *) levels);
+ numLevels *= 2;
+ levels = newLevels;
+ }
+ levelPtr = &levels[curLevel];
+ levelPtr->winPtr = winPtr;
+ arrayPtr = stacks[EXACT_LEAF_NAME];
+ arrayPtr->numUsed = 0;
+ arrayPtr->nextToUse = arrayPtr->els;
+ arrayPtr = stacks[EXACT_LEAF_CLASS];
+ arrayPtr->numUsed = 0;
+ arrayPtr->nextToUse = arrayPtr->els;
+ levelPtr->bases[EXACT_LEAF_NAME] = stacks[EXACT_LEAF_NAME]->numUsed;
+ levelPtr->bases[EXACT_LEAF_CLASS] = stacks[EXACT_LEAF_CLASS]->numUsed;
+ levelPtr->bases[EXACT_NODE_NAME] = stacks[EXACT_NODE_NAME]->numUsed;
+ levelPtr->bases[EXACT_NODE_CLASS] = stacks[EXACT_NODE_CLASS]->numUsed;
+ levelPtr->bases[WILDCARD_LEAF_NAME] = stacks[WILDCARD_LEAF_NAME]->numUsed;
+ levelPtr->bases[WILDCARD_LEAF_CLASS] = stacks[WILDCARD_LEAF_CLASS]->numUsed;
+ levelPtr->bases[WILDCARD_NODE_NAME] = stacks[WILDCARD_NODE_NAME]->numUsed;
+ levelPtr->bases[WILDCARD_NODE_CLASS] = stacks[WILDCARD_NODE_CLASS]->numUsed;
+
+
+ /*
+ * Step 5: scan the current stack level looking for matches to this
+ * window's name or class; where found, add new information to the
+ * stacks.
+ */
+
+ for (iPtr = searchOrder; *iPtr != -1; iPtr++) {
+ register Element *elPtr;
+ int count;
+ Tk_Uid id;
+
+ i = *iPtr;
+ if (i & CLASS) {
+ id = winPtr->classUid;
+ } else {
+ id = winPtr->nameUid;
+ }
+ elPtr = stacks[i]->els;
+ count = levelPtr->bases[i];
+
+ /*
+ * For wildcard stacks, check all entries; for non-wildcard
+ * stacks, only check things that matched in the parent.
+ */
+
+ if (!(i & WILDCARD)) {
+ elPtr += levelPtr[-1].bases[i];
+ count -= levelPtr[-1].bases[i];
+ }
+ for ( ; count > 0; elPtr++, count--) {
+ if (elPtr->nameUid != id) {
+ continue;
+ }
+ ExtendStacks(elPtr->child.arrayPtr, leaf);
+ }
+ }
+ cachedWindow = winPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ExtendStacks --
+ *
+ * Given an element array, copy all the elements from the
+ * array onto the system stacks (except for irrelevant leaf
+ * elements).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The option stacks are extended.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ExtendStacks(arrayPtr, leaf)
+ ElArray *arrayPtr; /* Array of elements to copy onto stacks. */
+ int leaf; /* If zero, then don't copy exact leaf
+ * elements. */
+{
+ register int count;
+ register Element *elPtr;
+
+ for (elPtr = arrayPtr->els, count = arrayPtr->numUsed;
+ count > 0; elPtr++, count--) {
+ if (!(elPtr->flags & (NODE|WILDCARD)) && !leaf) {
+ continue;
+ }
+ stacks[elPtr->flags] = ExtendArray(stacks[elPtr->flags], elPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * OptionInit --
+ *
+ * Initialize data structures for option handling.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Option-related data structures get initialized.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+OptionInit(mainPtr)
+ register TkMainInfo *mainPtr; /* Top-level information about
+ * window that isn't initialized
+ * yet. */
+{
+ int i;
+ Tcl_Interp *interp;
+
+ /*
+ * First, once-only initialization.
+ */
+
+ if (numLevels == 0) {
+
+ numLevels = 5;
+ levels = (StackLevel *) ckalloc((unsigned) (5*sizeof(StackLevel)));
+ for (i = 0; i < NUM_STACKS; i++) {
+ stacks[i] = NewArray(10);
+ levels[0].bases[i] = 0;
+ }
+
+ defaultMatch.nameUid = NULL;
+ defaultMatch.child.valueUid = NULL;
+ defaultMatch.priority = -1;
+ defaultMatch.flags = 0;
+ }
+
+ /*
+ * Then, per-main-window initialization. Create and delete dummy
+ * interpreter for message logging.
+ */
+
+ mainPtr->optionRootPtr = NewArray(20);
+ interp = Tcl_CreateInterp();
+ (void) GetDefaultOptions(interp, mainPtr->winPtr);
+ Tcl_DeleteInterp(interp);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ClearOptionTree --
+ *
+ * This procedure is called to erase everything in a
+ * hierarchical option database.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All the options associated with arrayPtr are deleted,
+ * along with all option subtrees. The space pointed to
+ * by arrayPtr is freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ClearOptionTree(arrayPtr)
+ ElArray *arrayPtr; /* Array of options; delete everything
+ * referred to recursively by this. */
+{
+ register Element *elPtr;
+ int count;
+
+ for (count = arrayPtr->numUsed, elPtr = arrayPtr->els; count > 0;
+ count--, elPtr++) {
+ if (elPtr->flags & NODE) {
+ ClearOptionTree(elPtr->child.arrayPtr);
+ }
+ }
+ ckfree((char *) arrayPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetDefaultOptions --
+ *
+ * This procedure is invoked to load the default set of options
+ * for a window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Options are added to those for winPtr's main window. If
+ * there exists a RESOURCE_MANAGER proprety for winPtr's
+ * display, that is used. Otherwise, the .Xdefaults file in
+ * the user's home directory is used.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetDefaultOptions(interp, winPtr)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ TkWindow *winPtr; /* Fetch option defaults for main window
+ * associated with this. */
+{
+ char *regProp;
+ int result, actualFormat;
+ unsigned long numItems, bytesAfter;
+ Atom actualType;
+
+ /*
+ * Try the RESOURCE_MANAGER property on the root window first.
+ */
+
+ regProp = NULL;
+ result = XGetWindowProperty(winPtr->display,
+ RootWindow(winPtr->display, 0),
+ XA_RESOURCE_MANAGER, 0, 100000,
+ False, XA_STRING, &actualType, &actualFormat,
+ &numItems, &bytesAfter, (unsigned char **) &regProp);
+
+ if ((result == Success) && (actualType == XA_STRING)
+ && (actualFormat == 8)) {
+ result = AddFromString(interp, (Tk_Window) winPtr, regProp,
+ TK_USER_DEFAULT_PRIO);
+ XFree(regProp);
+ return result;
+ }
+
+ /*
+ * No luck there. Try a .Xdefaults file in the user's home
+ * directory.
+ */
+
+ if (regProp != NULL) {
+ XFree(regProp);
+ }
+ result = ReadOptionFile(interp, (Tk_Window) winPtr, "~/.Xdefaults",
+ TK_USER_DEFAULT_PRIO);
+ return result;
+}
diff --git a/generic/tkPack.c b/generic/tkPack.c
new file mode 100644
index 0000000..4ff1049
--- /dev/null
+++ b/generic/tkPack.c
@@ -0,0 +1,1727 @@
+/*
+ * tkPack.c --
+ *
+ * This file contains code to implement the "packer"
+ * geometry manager for Tk.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkPack.c 1.64 96/05/03 10:51:52
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+typedef enum {TOP, BOTTOM, LEFT, RIGHT} Side;
+
+/* For each window that the packer cares about (either because
+ * the window is managed by the packer or because the window
+ * has slaves that are managed by the packer), there is a
+ * structure of the following type:
+ */
+
+typedef struct Packer {
+ Tk_Window tkwin; /* Tk token for window. NULL means that
+ * the window has been deleted, but the
+ * packet hasn't had a chance to clean up
+ * yet because the structure is still in
+ * use. */
+ struct Packer *masterPtr; /* Master window within which this window
+ * is packed (NULL means this window
+ * isn't managed by the packer). */
+ struct Packer *nextPtr; /* Next window packed within same
+ * parent. List is priority-ordered:
+ * first on list gets packed first. */
+ struct Packer *slavePtr; /* First in list of slaves packed
+ * inside this window (NULL means
+ * no packed slaves). */
+ Side side; /* Side of parent against which
+ * this window is packed. */
+ Tk_Anchor anchor; /* If frame allocated for window is larger
+ * than window needs, this indicates how
+ * where to position window in frame. */
+ int padX, padY; /* Total additional pixels to leave around the
+ * window (half of this space is left on each
+ * side). This is space *outside* the window:
+ * we'll allocate extra space in frame but
+ * won't enlarge window). */
+ int iPadX, iPadY; /* Total extra pixels to allocate inside the
+ * window (half this amount will appear on
+ * each side). */
+ int doubleBw; /* Twice the window's last known border
+ * width. If this changes, the window
+ * must be repacked within its parent. */
+ int *abortPtr; /* If non-NULL, it means that there is a nested
+ * call to ArrangePacking already working on
+ * this window. *abortPtr may be set to 1 to
+ * abort that nested call. This happens, for
+ * example, if tkwin or any of its slaves
+ * is deleted. */
+ int flags; /* Miscellaneous flags; see below
+ * for definitions. */
+} Packer;
+
+/*
+ * Flag values for Packer structures:
+ *
+ * REQUESTED_REPACK: 1 means a Tcl_DoWhenIdle request
+ * has already been made to repack
+ * all the slaves of this window.
+ * FILLX: 1 means if frame allocated for window
+ * is wider than window needs, expand window
+ * to fill frame. 0 means don't make window
+ * any larger than needed.
+ * FILLY: Same as FILLX, except for height.
+ * EXPAND: 1 means this window's frame will absorb any
+ * extra space in the parent window.
+ * OLD_STYLE: 1 means this window is being managed with
+ * the old-style packer algorithms (before
+ * Tk version 3.3). The main difference is
+ * that padding and filling are done differently.
+ * DONT_PROPAGATE: 1 means don't set this window's requested
+ * size. 0 means if this window is a master
+ * then Tk will set its requested size to fit
+ * the needs of its slaves.
+ */
+
+#define REQUESTED_REPACK 1
+#define FILLX 2
+#define FILLY 4
+#define EXPAND 8
+#define OLD_STYLE 16
+#define DONT_PROPAGATE 32
+
+/*
+ * Hash table used to map from Tk_Window tokens to corresponding
+ * Packer structures:
+ */
+
+static Tcl_HashTable packerHashTable;
+
+/*
+ * Have statics in this module been initialized?
+ */
+
+static int initialized = 0;
+
+/*
+ * The following structure is the official type record for the
+ * packer:
+ */
+
+static void PackReqProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+static void PackLostSlaveProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+
+static Tk_GeomMgr packerType = {
+ "pack", /* name */
+ PackReqProc, /* requestProc */
+ PackLostSlaveProc, /* lostSlaveProc */
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void ArrangePacking _ANSI_ARGS_((ClientData clientData));
+static int ConfigureSlaves _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, int argc, char *argv[]));
+static void DestroyPacker _ANSI_ARGS_((char *memPtr));
+static Packer * GetPacker _ANSI_ARGS_((Tk_Window tkwin));
+static int PackAfter _ANSI_ARGS_((Tcl_Interp *interp,
+ Packer *prevPtr, Packer *masterPtr, int argc,
+ char **argv));
+static void PackReqProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+static void PackStructureProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void Unlink _ANSI_ARGS_((Packer *packPtr));
+static int XExpansion _ANSI_ARGS_((Packer *slavePtr,
+ int cavityWidth));
+static int YExpansion _ANSI_ARGS_((Packer *slavePtr,
+ int cavityHeight));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PackCmd --
+ *
+ * This procedure is invoked to process the "pack" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_PackCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ size_t length;
+ int c;
+
+ if ((argc >= 2) && (argv[1][0] == '.')) {
+ return ConfigureSlaves(interp, tkwin, argc-1, argv+1);
+ }
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " option arg ?arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'a') && (length >= 2)
+ && (strncmp(argv[1], "after", length) == 0)) {
+ Packer *prevPtr;
+ Tk_Window tkwin2;
+
+ tkwin2 = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (tkwin2 == NULL) {
+ return TCL_ERROR;
+ }
+ prevPtr = GetPacker(tkwin2);
+ if (prevPtr->masterPtr == NULL) {
+ Tcl_AppendResult(interp, "window \"", argv[2],
+ "\" isn't packed", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return PackAfter(interp, prevPtr, prevPtr->masterPtr, argc-3, argv+3);
+ } else if ((c == 'a') && (length >= 2)
+ && (strncmp(argv[1], "append", length) == 0)) {
+ Packer *masterPtr;
+ register Packer *prevPtr;
+ Tk_Window tkwin2;
+
+ tkwin2 = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (tkwin2 == NULL) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetPacker(tkwin2);
+ prevPtr = masterPtr->slavePtr;
+ if (prevPtr != NULL) {
+ while (prevPtr->nextPtr != NULL) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ }
+ return PackAfter(interp, prevPtr, masterPtr, argc-3, argv+3);
+ } else if ((c == 'b') && (strncmp(argv[1], "before", length) == 0)) {
+ Packer *packPtr, *masterPtr;
+ register Packer *prevPtr;
+ Tk_Window tkwin2;
+
+ tkwin2 = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (tkwin2 == NULL) {
+ return TCL_ERROR;
+ }
+ packPtr = GetPacker(tkwin2);
+ if (packPtr->masterPtr == NULL) {
+ Tcl_AppendResult(interp, "window \"", argv[2],
+ "\" isn't packed", (char *) NULL);
+ return TCL_ERROR;
+ }
+ masterPtr = packPtr->masterPtr;
+ prevPtr = masterPtr->slavePtr;
+ if (prevPtr == packPtr) {
+ prevPtr = NULL;
+ } else {
+ for ( ; ; prevPtr = prevPtr->nextPtr) {
+ if (prevPtr == NULL) {
+ panic("\"pack before\" couldn't find predecessor");
+ }
+ if (prevPtr->nextPtr == packPtr) {
+ break;
+ }
+ }
+ }
+ return PackAfter(interp, prevPtr, masterPtr, argc-3, argv+3);
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)) {
+ if (argv[2][0] != '.') {
+ Tcl_AppendResult(interp, "bad argument \"", argv[2],
+ "\": must be name of window", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return ConfigureSlaves(interp, tkwin, argc-2, argv+2);
+ } else if ((c == 'f') && (strncmp(argv[1], "forget", length) == 0)) {
+ Tk_Window slave;
+ Packer *slavePtr;
+ int i;
+
+ for (i = 2; i < argc; i++) {
+ slave = Tk_NameToWindow(interp, argv[i], tkwin);
+ if (slave == NULL) {
+ continue;
+ }
+ slavePtr = GetPacker(slave);
+ if ((slavePtr != NULL) && (slavePtr->masterPtr != NULL)) {
+ Tk_ManageGeometry(slave, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin,
+ slavePtr->masterPtr->tkwin);
+ }
+ Unlink(slavePtr);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ }
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "info", length) == 0)) {
+ register Packer *slavePtr;
+ Tk_Window slave;
+ char buffer[300];
+ static char *sideNames[] = {"top", "bottom", "left", "right"};
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " info window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ slave = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (slave == NULL) {
+ return TCL_ERROR;
+ }
+ slavePtr = GetPacker(slave);
+ if (slavePtr->masterPtr == NULL) {
+ Tcl_AppendResult(interp, "window \"", argv[2],
+ "\" isn't packed", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_AppendElement(interp, "-in");
+ Tcl_AppendElement(interp, Tk_PathName(slavePtr->masterPtr->tkwin));
+ Tcl_AppendElement(interp, "-anchor");
+ Tcl_AppendElement(interp, Tk_NameOfAnchor(slavePtr->anchor));
+ Tcl_AppendResult(interp, " -expand ",
+ (slavePtr->flags & EXPAND) ? "1" : "0", " -fill ",
+ (char *) NULL);
+ switch (slavePtr->flags & (FILLX|FILLY)) {
+ case 0:
+ Tcl_AppendResult(interp, "none", (char *) NULL);
+ break;
+ case FILLX:
+ Tcl_AppendResult(interp, "x", (char *) NULL);
+ break;
+ case FILLY:
+ Tcl_AppendResult(interp, "y", (char *) NULL);
+ break;
+ case FILLX|FILLY:
+ Tcl_AppendResult(interp, "both", (char *) NULL);
+ break;
+ }
+ sprintf(buffer, " -ipadx %d -ipady %d -padx %d -pady %d",
+ slavePtr->iPadX/2, slavePtr->iPadY/2, slavePtr->padX/2,
+ slavePtr->padY/2);
+ Tcl_AppendResult(interp, buffer, " -side ", sideNames[slavePtr->side],
+ (char *) NULL);
+ } else if ((c == 'p') && (strncmp(argv[1], "propagate", length) == 0)) {
+ Tk_Window master;
+ Packer *masterPtr;
+ int propagate;
+
+ if (argc > 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " propagate window ?boolean?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ master = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (master == NULL) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetPacker(master);
+ if (argc == 3) {
+ if (masterPtr->flags & DONT_PROPAGATE) {
+ interp->result = "0";
+ } else {
+ interp->result = "1";
+ }
+ return TCL_OK;
+ }
+ if (Tcl_GetBoolean(interp, argv[3], &propagate) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (propagate) {
+ masterPtr->flags &= ~DONT_PROPAGATE;
+
+ /*
+ * Repack the master to allow new geometry information to
+ * propagate upwards to the master's master.
+ */
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ if (!(masterPtr->flags & REQUESTED_REPACK)) {
+ masterPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, (ClientData) masterPtr);
+ }
+ } else {
+ masterPtr->flags |= DONT_PROPAGATE;
+ }
+ } else if ((c == 's') && (strncmp(argv[1], "slaves", length) == 0)) {
+ Tk_Window master;
+ Packer *masterPtr, *slavePtr;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " slaves window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ master = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (master == NULL) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetPacker(master);
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ Tcl_AppendElement(interp, Tk_PathName(slavePtr->tkwin));
+ }
+ } else if ((c == 'u') && (strncmp(argv[1], "unpack", length) == 0)) {
+ Tk_Window tkwin2;
+ Packer *packPtr;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " unpack window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ tkwin2 = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (tkwin2 == NULL) {
+ return TCL_ERROR;
+ }
+ packPtr = GetPacker(tkwin2);
+ if ((packPtr != NULL) && (packPtr->masterPtr != NULL)) {
+ Tk_ManageGeometry(tkwin2, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ if (packPtr->masterPtr->tkwin != Tk_Parent(packPtr->tkwin)) {
+ Tk_UnmaintainGeometry(packPtr->tkwin,
+ packPtr->masterPtr->tkwin);
+ }
+ Unlink(packPtr);
+ Tk_UnmapWindow(packPtr->tkwin);
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be configure, forget, info, ",
+ "propagate, or slaves", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PackReqProc --
+ *
+ * This procedure is invoked by Tk_GeometryRequest for
+ * windows managed by the packer.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for tkwin, and all its managed siblings, to
+ * be re-packed at the next idle point.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+PackReqProc(clientData, tkwin)
+ ClientData clientData; /* Packer's information about
+ * window that got new preferred
+ * geometry. */
+ Tk_Window tkwin; /* Other Tk-related information
+ * about the window. */
+{
+ register Packer *packPtr = (Packer *) clientData;
+
+ packPtr = packPtr->masterPtr;
+ if (!(packPtr->flags & REQUESTED_REPACK)) {
+ packPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, (ClientData) packPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PackLostSlaveProc --
+ *
+ * This procedure is invoked by Tk whenever some other geometry
+ * claims control over a slave that used to be managed by us.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Forgets all packer-related information about the slave.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+PackLostSlaveProc(clientData, tkwin)
+ ClientData clientData; /* Packer structure for slave window that
+ * was stolen away. */
+ Tk_Window tkwin; /* Tk's handle for the slave window. */
+{
+ register Packer *slavePtr = (Packer *) clientData;
+
+ if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, slavePtr->masterPtr->tkwin);
+ }
+ Unlink(slavePtr);
+ Tk_UnmapWindow(slavePtr->tkwin);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArrangePacking --
+ *
+ * This procedure is invoked (using the Tcl_DoWhenIdle
+ * mechanism) to re-layout a set of windows managed by
+ * the packer. It is invoked at idle time so that a
+ * series of packer requests can be merged into a single
+ * layout operation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The packed slaves of masterPtr may get resized or
+ * moved.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ArrangePacking(clientData)
+ ClientData clientData; /* Structure describing parent whose slaves
+ * are to be re-layed out. */
+{
+ register Packer *masterPtr = (Packer *) clientData;
+ register Packer *slavePtr;
+ int cavityX, cavityY, cavityWidth, cavityHeight;
+ /* These variables keep track of the
+ * as-yet-unallocated space remaining in
+ * the middle of the parent window. */
+ int frameX, frameY, frameWidth, frameHeight;
+ /* These variables keep track of the frame
+ * allocated to the current window. */
+ int x, y, width, height; /* These variables are used to hold the
+ * actual geometry of the current window. */
+ int intBWidth; /* Width of internal border in parent window,
+ * if any. */
+ int abort; /* May get set to non-zero to abort this
+ * repacking operation. */
+ int borderX, borderY;
+ int maxWidth, maxHeight, tmp;
+
+ masterPtr->flags &= ~REQUESTED_REPACK;
+
+ /*
+ * If the parent has no slaves anymore, then don't do anything
+ * at all: just leave the parent's size as-is.
+ */
+
+ if (masterPtr->slavePtr == NULL) {
+ return;
+ }
+
+ /*
+ * Abort any nested call to ArrangePacking for this window, since
+ * we'll do everything necessary here, and set up so this call
+ * can be aborted if necessary.
+ */
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ masterPtr->abortPtr = &abort;
+ abort = 0;
+ Tcl_Preserve((ClientData) masterPtr);
+
+ /*
+ * Pass #1: scan all the slaves to figure out the total amount
+ * of space needed. Two separate width and height values are
+ * computed:
+ *
+ * width - Holds the sum of the widths (plus padding) of
+ * all the slaves seen so far that were packed LEFT
+ * or RIGHT.
+ * height - Holds the sum of the heights (plus padding) of
+ * all the slaves seen so far that were packed TOP
+ * or BOTTOM.
+ *
+ * maxWidth - Gradually builds up the width needed by the master
+ * to just barely satisfy all the slave's needs. For
+ * each slave, the code computes the width needed for
+ * all the slaves so far and updates maxWidth if the
+ * new value is greater.
+ * maxHeight - Same as maxWidth, except keeps height info.
+ */
+
+ intBWidth = Tk_InternalBorderWidth(masterPtr->tkwin);
+ width = height = maxWidth = maxHeight = 2*intBWidth;
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ if ((slavePtr->side == TOP) || (slavePtr->side == BOTTOM)) {
+ tmp = Tk_ReqWidth(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padX + slavePtr->iPadX + width;
+ if (tmp > maxWidth) {
+ maxWidth = tmp;
+ }
+ height += Tk_ReqHeight(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padY + slavePtr->iPadY;
+ } else {
+ tmp = Tk_ReqHeight(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padY + slavePtr->iPadY + height;
+ if (tmp > maxHeight) {
+ maxHeight = tmp;
+ }
+ width += Tk_ReqWidth(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padX + slavePtr->iPadX;
+ }
+ }
+ if (width > maxWidth) {
+ maxWidth = width;
+ }
+ if (height > maxHeight) {
+ maxHeight = height;
+ }
+
+ /*
+ * If the total amount of space needed in the parent window has
+ * changed, and if we're propagating geometry information, then
+ * notify the next geometry manager up and requeue ourselves to
+ * start again after the parent has had a chance to
+ * resize us.
+ */
+
+ if (((maxWidth != Tk_ReqWidth(masterPtr->tkwin))
+ || (maxHeight != Tk_ReqHeight(masterPtr->tkwin)))
+ && !(masterPtr->flags & DONT_PROPAGATE)) {
+ Tk_GeometryRequest(masterPtr->tkwin, maxWidth, maxHeight);
+ masterPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, (ClientData) masterPtr);
+ goto done;
+ }
+
+ /*
+ * Pass #2: scan the slaves a second time assigning
+ * new sizes. The "cavity" variables keep track of the
+ * unclaimed space in the cavity of the window; this
+ * shrinks inward as we allocate windows around the
+ * edges. The "frame" variables keep track of the space
+ * allocated to the current window and its frame. The
+ * current window is then placed somewhere inside the
+ * frame, depending on anchor.
+ */
+
+ cavityX = cavityY = x = y = intBWidth;
+ cavityWidth = Tk_Width(masterPtr->tkwin) - 2*intBWidth;
+ cavityHeight = Tk_Height(masterPtr->tkwin) - 2*intBWidth;
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ if ((slavePtr->side == TOP) || (slavePtr->side == BOTTOM)) {
+ frameWidth = cavityWidth;
+ frameHeight = Tk_ReqHeight(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padY + slavePtr->iPadY;
+ if (slavePtr->flags & EXPAND) {
+ frameHeight += YExpansion(slavePtr, cavityHeight);
+ }
+ cavityHeight -= frameHeight;
+ if (cavityHeight < 0) {
+ frameHeight += cavityHeight;
+ cavityHeight = 0;
+ }
+ frameX = cavityX;
+ if (slavePtr->side == TOP) {
+ frameY = cavityY;
+ cavityY += frameHeight;
+ } else {
+ frameY = cavityY + cavityHeight;
+ }
+ } else {
+ frameHeight = cavityHeight;
+ frameWidth = Tk_ReqWidth(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padX + slavePtr->iPadX;
+ if (slavePtr->flags & EXPAND) {
+ frameWidth += XExpansion(slavePtr, cavityWidth);
+ }
+ cavityWidth -= frameWidth;
+ if (cavityWidth < 0) {
+ frameWidth += cavityWidth;
+ cavityWidth = 0;
+ }
+ frameY = cavityY;
+ if (slavePtr->side == LEFT) {
+ frameX = cavityX;
+ cavityX += frameWidth;
+ } else {
+ frameX = cavityX + cavityWidth;
+ }
+ }
+
+ /*
+ * Now that we've got the size of the frame for the window,
+ * compute the window's actual size and location using the
+ * fill, padding, and frame factors. The variables "borderX"
+ * and "borderY" are used to handle the differences between
+ * old-style packing and the new style (in old-style, iPadX
+ * and iPadY are always zero and padding is completely ignored
+ * except when computing frame size).
+ */
+
+ if (slavePtr->flags & OLD_STYLE) {
+ borderX = borderY = 0;
+ } else {
+ borderX = slavePtr->padX;
+ borderY = slavePtr->padY;
+ }
+ width = Tk_ReqWidth(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->iPadX;
+ if ((slavePtr->flags & FILLX)
+ || (width > (frameWidth - borderX))) {
+ width = frameWidth - borderX;
+ }
+ height = Tk_ReqHeight(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->iPadY;
+ if ((slavePtr->flags & FILLY)
+ || (height > (frameHeight - borderY))) {
+ height = frameHeight - borderY;
+ }
+ borderX /= 2;
+ borderY /= 2;
+ switch (slavePtr->anchor) {
+ case TK_ANCHOR_N:
+ x = frameX + (frameWidth - width)/2;
+ y = frameY + borderY;
+ break;
+ case TK_ANCHOR_NE:
+ x = frameX + frameWidth - width - borderX;
+ y = frameY + borderY;
+ break;
+ case TK_ANCHOR_E:
+ x = frameX + frameWidth - width - borderX;
+ y = frameY + (frameHeight - height)/2;
+ break;
+ case TK_ANCHOR_SE:
+ x = frameX + frameWidth - width - borderX;
+ y = frameY + frameHeight - height - borderY;
+ break;
+ case TK_ANCHOR_S:
+ x = frameX + (frameWidth - width)/2;
+ y = frameY + frameHeight - height - borderY;
+ break;
+ case TK_ANCHOR_SW:
+ x = frameX + borderX;
+ y = frameY + frameHeight - height - borderY;
+ break;
+ case TK_ANCHOR_W:
+ x = frameX + borderX;
+ y = frameY + (frameHeight - height)/2;
+ break;
+ case TK_ANCHOR_NW:
+ x = frameX + borderX;
+ y = frameY + borderY;
+ break;
+ case TK_ANCHOR_CENTER:
+ x = frameX + (frameWidth - width)/2;
+ y = frameY + (frameHeight - height)/2;
+ break;
+ default:
+ panic("bad frame factor in ArrangePacking");
+ }
+ width -= slavePtr->doubleBw;
+ height -= slavePtr->doubleBw;
+
+ /*
+ * The final step is to set the position, size, and mapped/unmapped
+ * state of the slave. If the slave is a child of the master, then
+ * do this here. Otherwise let Tk_MaintainGeometry do the work.
+ */
+
+ if (masterPtr->tkwin == Tk_Parent(slavePtr->tkwin)) {
+ if ((width <= 0) || (height <= 0)) {
+ Tk_UnmapWindow(slavePtr->tkwin);
+ } else {
+ if ((x != Tk_X(slavePtr->tkwin))
+ || (y != Tk_Y(slavePtr->tkwin))
+ || (width != Tk_Width(slavePtr->tkwin))
+ || (height != Tk_Height(slavePtr->tkwin))) {
+ Tk_MoveResizeWindow(slavePtr->tkwin, x, y, width, height);
+ }
+ if (abort) {
+ goto done;
+ }
+
+ /*
+ * Don't map the slave if the master isn't mapped: wait
+ * until the master gets mapped later.
+ */
+
+ if (Tk_IsMapped(masterPtr->tkwin)) {
+ Tk_MapWindow(slavePtr->tkwin);
+ }
+ }
+ } else {
+ if ((width <= 0) || (height <= 0)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, masterPtr->tkwin);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ } else {
+ Tk_MaintainGeometry(slavePtr->tkwin, masterPtr->tkwin,
+ x, y, width, height);
+ }
+ }
+
+ /*
+ * Changes to the window's structure could cause almost anything
+ * to happen, including deleting the parent or child. If this
+ * happens, we'll be told to abort.
+ */
+
+ if (abort) {
+ goto done;
+ }
+ }
+
+ done:
+ masterPtr->abortPtr = NULL;
+ Tcl_Release((ClientData) masterPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XExpansion --
+ *
+ * Given a list of packed slaves, the first of which is packed
+ * on the left or right and is expandable, compute how much to
+ * expand the child.
+ *
+ * Results:
+ * The return value is the number of additional pixels to give to
+ * the child.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+XExpansion(slavePtr, cavityWidth)
+ register Packer *slavePtr; /* First in list of remaining
+ * slaves. */
+ int cavityWidth; /* Horizontal space left for all
+ * remaining slaves. */
+{
+ int numExpand, minExpand, curExpand;
+ int childWidth;
+
+ /*
+ * This procedure is tricky because windows packed top or bottom can
+ * be interspersed among expandable windows packed left or right.
+ * Scan through the list, keeping a running sum of the widths of
+ * all left and right windows (actually, count the cavity space not
+ * allocated) and a running count of all expandable left and right
+ * windows. At each top or bottom window, and at the end of the
+ * list, compute the expansion factor that seems reasonable at that
+ * point. Return the smallest factor seen at any of these points.
+ */
+
+ minExpand = cavityWidth;
+ numExpand = 0;
+ for ( ; slavePtr != NULL; slavePtr = slavePtr->nextPtr) {
+ childWidth = Tk_ReqWidth(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padX + slavePtr->iPadX;
+ if ((slavePtr->side == TOP) || (slavePtr->side == BOTTOM)) {
+ curExpand = (cavityWidth - childWidth)/numExpand;
+ if (curExpand < minExpand) {
+ minExpand = curExpand;
+ }
+ } else {
+ cavityWidth -= childWidth;
+ if (slavePtr->flags & EXPAND) {
+ numExpand++;
+ }
+ }
+ }
+ curExpand = cavityWidth/numExpand;
+ if (curExpand < minExpand) {
+ minExpand = curExpand;
+ }
+ return (minExpand < 0) ? 0 : minExpand;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * YExpansion --
+ *
+ * Given a list of packed slaves, the first of which is packed
+ * on the top or bottom and is expandable, compute how much to
+ * expand the child.
+ *
+ * Results:
+ * The return value is the number of additional pixels to give to
+ * the child.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+YExpansion(slavePtr, cavityHeight)
+ register Packer *slavePtr; /* First in list of remaining
+ * slaves. */
+ int cavityHeight; /* Vertical space left for all
+ * remaining slaves. */
+{
+ int numExpand, minExpand, curExpand;
+ int childHeight;
+
+ /*
+ * See comments for XExpansion.
+ */
+
+ minExpand = cavityHeight;
+ numExpand = 0;
+ for ( ; slavePtr != NULL; slavePtr = slavePtr->nextPtr) {
+ childHeight = Tk_ReqHeight(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padY + slavePtr->iPadY;
+ if ((slavePtr->side == LEFT) || (slavePtr->side == RIGHT)) {
+ curExpand = (cavityHeight - childHeight)/numExpand;
+ if (curExpand < minExpand) {
+ minExpand = curExpand;
+ }
+ } else {
+ cavityHeight -= childHeight;
+ if (slavePtr->flags & EXPAND) {
+ numExpand++;
+ }
+ }
+ }
+ curExpand = cavityHeight/numExpand;
+ if (curExpand < minExpand) {
+ minExpand = curExpand;
+ }
+ return (minExpand < 0) ? 0 : minExpand;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetPacker --
+ *
+ * This internal procedure is used to locate a Packer
+ * structure for a given window, creating one if one
+ * doesn't exist already.
+ *
+ * Results:
+ * The return value is a pointer to the Packer structure
+ * corresponding to tkwin.
+ *
+ * Side effects:
+ * A new packer structure may be created. If so, then
+ * a callback is set up to clean things up when the
+ * window is deleted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Packer *
+GetPacker(tkwin)
+ Tk_Window tkwin; /* Token for window for which
+ * packer structure is desired. */
+{
+ register Packer *packPtr;
+ Tcl_HashEntry *hPtr;
+ int new;
+
+ if (!initialized) {
+ initialized = 1;
+ Tcl_InitHashTable(&packerHashTable, TCL_ONE_WORD_KEYS);
+ }
+
+ /*
+ * See if there's already packer for this window. If not,
+ * then create a new one.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&packerHashTable, (char *) tkwin, &new);
+ if (!new) {
+ return (Packer *) Tcl_GetHashValue(hPtr);
+ }
+ packPtr = (Packer *) ckalloc(sizeof(Packer));
+ packPtr->tkwin = tkwin;
+ packPtr->masterPtr = NULL;
+ packPtr->nextPtr = NULL;
+ packPtr->slavePtr = NULL;
+ packPtr->side = TOP;
+ packPtr->anchor = TK_ANCHOR_CENTER;
+ packPtr->padX = packPtr->padY = 0;
+ packPtr->iPadX = packPtr->iPadY = 0;
+ packPtr->doubleBw = 2*Tk_Changes(tkwin)->border_width;
+ packPtr->abortPtr = NULL;
+ packPtr->flags = 0;
+ Tcl_SetHashValue(hPtr, packPtr);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ PackStructureProc, (ClientData) packPtr);
+ return packPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PackAfter --
+ *
+ * This procedure does most of the real work of adding
+ * one or more windows into the packing order for its parent.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * The geometry of the specified windows may change, both now and
+ * again in the future.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+PackAfter(interp, prevPtr, masterPtr, argc, argv)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Packer *prevPtr; /* Pack windows in argv just after this
+ * window; NULL means pack as first
+ * child of masterPtr. */
+ Packer *masterPtr; /* Master in which to pack windows. */
+ int argc; /* Number of elements in argv. */
+ char **argv; /* Array of lists, each containing 2
+ * elements: window name and side
+ * against which to pack. */
+{
+ register Packer *packPtr;
+ Tk_Window tkwin, ancestor, parent;
+ size_t length;
+ char **options;
+ int index, tmp, optionCount, c;
+
+ /*
+ * Iterate over all of the window specifiers, each consisting of
+ * two arguments. The first argument contains the window name and
+ * the additional arguments contain options such as "top" or
+ * "padx 20".
+ */
+
+ for ( ; argc > 0; argc -= 2, argv += 2, prevPtr = packPtr) {
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: window \"",
+ argv[0], "\" should be followed by options",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Find the packer for the window to be packed, and make sure
+ * that the window in which it will be packed is either its
+ * or a descendant of its parent.
+ */
+
+ tkwin = Tk_NameToWindow(interp, argv[0], masterPtr->tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ parent = Tk_Parent(tkwin);
+ for (ancestor = masterPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ if (((Tk_FakeWin *) (ancestor))->flags & TK_TOP_LEVEL) {
+ badWindow:
+ Tcl_AppendResult(interp, "can't pack ", argv[0],
+ " inside ", Tk_PathName(masterPtr->tkwin),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (((Tk_FakeWin *) (tkwin))->flags & TK_TOP_LEVEL) {
+ goto badWindow;
+ }
+ if (tkwin == masterPtr->tkwin) {
+ goto badWindow;
+ }
+ packPtr = GetPacker(tkwin);
+
+ /*
+ * Process options for this window.
+ */
+
+ if (Tcl_SplitList(interp, argv[1], &optionCount, &options) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ packPtr->side = TOP;
+ packPtr->anchor = TK_ANCHOR_CENTER;
+ packPtr->padX = packPtr->padY = 0;
+ packPtr->iPadX = packPtr->iPadY = 0;
+ packPtr->flags &= ~(FILLX|FILLY|EXPAND);
+ packPtr->flags |= OLD_STYLE;
+ for (index = 0 ; index < optionCount; index++) {
+ char *curOpt = options[index];
+
+ c = curOpt[0];
+ length = strlen(curOpt);
+
+ if ((c == 't')
+ && (strncmp(curOpt, "top", length)) == 0) {
+ packPtr->side = TOP;
+ } else if ((c == 'b')
+ && (strncmp(curOpt, "bottom", length)) == 0) {
+ packPtr->side = BOTTOM;
+ } else if ((c == 'l')
+ && (strncmp(curOpt, "left", length)) == 0) {
+ packPtr->side = LEFT;
+ } else if ((c == 'r')
+ && (strncmp(curOpt, "right", length)) == 0) {
+ packPtr->side = RIGHT;
+ } else if ((c == 'e')
+ && (strncmp(curOpt, "expand", length)) == 0) {
+ packPtr->flags |= EXPAND;
+ } else if ((c == 'f')
+ && (strcmp(curOpt, "fill")) == 0) {
+ packPtr->flags |= FILLX|FILLY;
+ } else if ((length == 5) && (strcmp(curOpt, "fillx")) == 0) {
+ packPtr->flags |= FILLX;
+ } else if ((length == 5) && (strcmp(curOpt, "filly")) == 0) {
+ packPtr->flags |= FILLY;
+ } else if ((c == 'p') && (strcmp(curOpt, "padx")) == 0) {
+ if (optionCount < (index+2)) {
+ missingPad:
+ Tcl_AppendResult(interp, "wrong # args: \"", curOpt,
+ "\" option must be followed by screen distance",
+ (char *) NULL);
+ goto error;
+ }
+ if ((Tk_GetPixels(interp, tkwin, options[index+1], &tmp)
+ != TCL_OK) || (tmp < 0)) {
+ badPad:
+ Tcl_AppendResult(interp, "bad pad value \"",
+ options[index+1],
+ "\": must be positive screen distance",
+ (char *) NULL);
+ goto error;
+ }
+ packPtr->padX = tmp;
+ packPtr->iPadX = 0;
+ index++;
+ } else if ((c == 'p') && (strcmp(curOpt, "pady")) == 0) {
+ if (optionCount < (index+2)) {
+ goto missingPad;
+ }
+ if ((Tk_GetPixels(interp, tkwin, options[index+1], &tmp)
+ != TCL_OK) || (tmp < 0)) {
+ goto badPad;
+ }
+ packPtr->padY = tmp;
+ packPtr->iPadY = 0;
+ index++;
+ } else if ((c == 'f') && (length > 1)
+ && (strncmp(curOpt, "frame", length) == 0)) {
+ if (optionCount < (index+2)) {
+ Tcl_AppendResult(interp, "wrong # args: \"frame\" ",
+ "option must be followed by anchor point",
+ (char *) NULL);
+ goto error;
+ }
+ if (Tk_GetAnchor(interp, options[index+1],
+ &packPtr->anchor) != TCL_OK) {
+ goto error;
+ }
+ index++;
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", curOpt,
+ "\": should be top, bottom, left, right, ",
+ "expand, fill, fillx, filly, padx, pady, or frame",
+ (char *) NULL);
+ goto error;
+ }
+ }
+
+ if (packPtr != prevPtr) {
+
+ /*
+ * Unpack this window if it's currently packed.
+ */
+
+ if (packPtr->masterPtr != NULL) {
+ if ((packPtr->masterPtr != masterPtr) &&
+ (packPtr->masterPtr->tkwin
+ != Tk_Parent(packPtr->tkwin))) {
+ Tk_UnmaintainGeometry(packPtr->tkwin,
+ packPtr->masterPtr->tkwin);
+ }
+ Unlink(packPtr);
+ }
+
+ /*
+ * Add the window in the correct place in its parent's
+ * packing order, then make sure that the window is
+ * managed by us.
+ */
+
+ packPtr->masterPtr = masterPtr;
+ if (prevPtr == NULL) {
+ packPtr->nextPtr = masterPtr->slavePtr;
+ masterPtr->slavePtr = packPtr;
+ } else {
+ packPtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = packPtr;
+ }
+ Tk_ManageGeometry(tkwin, &packerType, (ClientData) packPtr);
+ }
+ ckfree((char *) options);
+ }
+
+ /*
+ * Arrange for the parent to be re-packed at the first
+ * idle moment.
+ */
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ if (!(masterPtr->flags & REQUESTED_REPACK)) {
+ masterPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, (ClientData) masterPtr);
+ }
+ return TCL_OK;
+
+ error:
+ ckfree((char *) options);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Unlink --
+ *
+ * Remove a packer from its parent's list of slaves.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The parent will be scheduled for repacking.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+Unlink(packPtr)
+ register Packer *packPtr; /* Window to unlink. */
+{
+ register Packer *masterPtr, *packPtr2;
+
+ masterPtr = packPtr->masterPtr;
+ if (masterPtr == NULL) {
+ return;
+ }
+ if (masterPtr->slavePtr == packPtr) {
+ masterPtr->slavePtr = packPtr->nextPtr;
+ } else {
+ for (packPtr2 = masterPtr->slavePtr; ; packPtr2 = packPtr2->nextPtr) {
+ if (packPtr2 == NULL) {
+ panic("Unlink couldn't find previous window");
+ }
+ if (packPtr2->nextPtr == packPtr) {
+ packPtr2->nextPtr = packPtr->nextPtr;
+ break;
+ }
+ }
+ }
+ if (!(masterPtr->flags & REQUESTED_REPACK)) {
+ masterPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, (ClientData) masterPtr);
+ }
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+
+ packPtr->masterPtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyPacker --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a packer at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the packer is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyPacker(memPtr)
+ char *memPtr; /* Info about packed window that
+ * is now dead. */
+{
+ register Packer *packPtr = (Packer *) memPtr;
+ ckfree((char *) packPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PackStructureProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher in response
+ * to StructureNotify events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If a window was just deleted, clean up all its packer-related
+ * information. If it was just resized, repack its slaves, if
+ * any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PackStructureProc(clientData, eventPtr)
+ ClientData clientData; /* Our information about window
+ * referred to by eventPtr. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ register Packer *packPtr = (Packer *) clientData;
+ if (eventPtr->type == ConfigureNotify) {
+ if ((packPtr->slavePtr != NULL)
+ && !(packPtr->flags & REQUESTED_REPACK)) {
+ packPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, (ClientData) packPtr);
+ }
+ if (packPtr->doubleBw != 2*Tk_Changes(packPtr->tkwin)->border_width) {
+ if ((packPtr->masterPtr != NULL)
+ && !(packPtr->masterPtr->flags & REQUESTED_REPACK)) {
+ packPtr->doubleBw = 2*Tk_Changes(packPtr->tkwin)->border_width;
+ packPtr->masterPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, (ClientData) packPtr->masterPtr);
+ }
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ register Packer *slavePtr, *nextPtr;
+
+ if (packPtr->masterPtr != NULL) {
+ Unlink(packPtr);
+ }
+ for (slavePtr = packPtr->slavePtr; slavePtr != NULL;
+ slavePtr = nextPtr) {
+ Tk_ManageGeometry(slavePtr->tkwin, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ slavePtr->masterPtr = NULL;
+ nextPtr = slavePtr->nextPtr;
+ slavePtr->nextPtr = NULL;
+ }
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&packerHashTable,
+ (char *) packPtr->tkwin));
+ if (packPtr->flags & REQUESTED_REPACK) {
+ Tcl_CancelIdleCall(ArrangePacking, (ClientData) packPtr);
+ }
+ packPtr->tkwin = NULL;
+ Tcl_EventuallyFree((ClientData) packPtr, DestroyPacker);
+ } else if (eventPtr->type == MapNotify) {
+ /*
+ * When a master gets mapped, must redo the geometry computation
+ * so that all of its slaves get remapped.
+ */
+
+ if ((packPtr->slavePtr != NULL)
+ && !(packPtr->flags & REQUESTED_REPACK)) {
+ packPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, (ClientData) packPtr);
+ }
+ } else if (eventPtr->type == UnmapNotify) {
+ Packer *packPtr2;
+
+ /*
+ * Unmap all of the slaves when the master gets unmapped,
+ * so that they don't bother to keep redisplaying
+ * themselves.
+ */
+
+ for (packPtr2 = packPtr->slavePtr; packPtr2 != NULL;
+ packPtr2 = packPtr2->nextPtr) {
+ Tk_UnmapWindow(packPtr2->tkwin);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureSlaves --
+ *
+ * This implements the guts of the "pack configure" command. Given
+ * a list of slaves and configuration options, it arranges for the
+ * packer to manage the slaves and sets the specified options.
+ *
+ * Results:
+ * TCL_OK is returned if all went well. Otherwise, TCL_ERROR is
+ * returned and interp->result is set to contain an error message.
+ *
+ * Side effects:
+ * Slave windows get taken over by the packer.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureSlaves(interp, tkwin, argc, argv)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Window tkwin; /* Any window in application containing
+ * slaves. Used to look up slave names. */
+ int argc; /* Number of elements in argv. */
+ char *argv[]; /* Argument strings: contains one or more
+ * window names followed by any number
+ * of "option value" pairs. Caller must
+ * make sure that there is at least one
+ * window name. */
+{
+ Packer *masterPtr, *slavePtr, *prevPtr, *otherPtr;
+ Tk_Window other, slave, parent, ancestor;
+ int i, j, numWindows, c, tmp, positionGiven;
+ size_t length;
+
+ /*
+ * Find out how many windows are specified.
+ */
+
+ for (numWindows = 0; numWindows < argc; numWindows++) {
+ if (argv[numWindows][0] != '.') {
+ break;
+ }
+ }
+
+ /*
+ * Iterate over all of the slave windows, parsing the configuration
+ * options for each slave. It's a bit wasteful to re-parse the
+ * options for each slave, but things get too messy if we try to
+ * parse the arguments just once at the beginning. For example,
+ * if a slave already is packed we want to just change a few
+ * existing values without resetting everything. If there are
+ * multiple windows, the -after, -before, and -in options only
+ * get processed for the first window.
+ */
+
+ masterPtr = NULL;
+ prevPtr = NULL;
+ positionGiven = 0;
+ for (j = 0; j < numWindows; j++) {
+ slave = Tk_NameToWindow(interp, argv[j], tkwin);
+ if (slave == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tk_IsTopLevel(slave)) {
+ Tcl_AppendResult(interp, "can't pack \"", argv[j],
+ "\": it's a top-level window", (char *) NULL);
+ return TCL_ERROR;
+ }
+ slavePtr = GetPacker(slave);
+ slavePtr->flags &= ~OLD_STYLE;
+
+ /*
+ * If the slave isn't currently packed, reset all of its
+ * configuration information to default values (there could
+ * be old values left from a previous packing).
+ */
+
+ if (slavePtr->masterPtr == NULL) {
+ slavePtr->side = TOP;
+ slavePtr->anchor = TK_ANCHOR_CENTER;
+ slavePtr->padX = slavePtr->padY = 0;
+ slavePtr->iPadX = slavePtr->iPadY = 0;
+ slavePtr->flags &= ~(FILLX|FILLY|EXPAND);
+ }
+
+ for (i = numWindows; i < argc; i+=2) {
+ if ((i+2) > argc) {
+ Tcl_AppendResult(interp, "extra option \"", argv[i],
+ "\" (option with no value?)", (char *) NULL);
+ return TCL_ERROR;
+ }
+ length = strlen(argv[i]);
+ if (length < 2) {
+ goto badOption;
+ }
+ c = argv[i][1];
+ if ((c == 'a') && (strncmp(argv[i], "-after", length) == 0)
+ && (length >= 2)) {
+ if (j == 0) {
+ other = Tk_NameToWindow(interp, argv[i+1], tkwin);
+ if (other == NULL) {
+ return TCL_ERROR;
+ }
+ prevPtr = GetPacker(other);
+ if (prevPtr->masterPtr == NULL) {
+ notPacked:
+ Tcl_AppendResult(interp, "window \"", argv[i+1],
+ "\" isn't packed", (char *) NULL);
+ return TCL_ERROR;
+ }
+ masterPtr = prevPtr->masterPtr;
+ positionGiven = 1;
+ }
+ } else if ((c == 'a') && (strncmp(argv[i], "-anchor", length) == 0)
+ && (length >= 2)) {
+ if (Tk_GetAnchor(interp, argv[i+1], &slavePtr->anchor)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else if ((c == 'b')
+ && (strncmp(argv[i], "-before", length) == 0)) {
+ if (j == 0) {
+ other = Tk_NameToWindow(interp, argv[i+1], tkwin);
+ if (other == NULL) {
+ return TCL_ERROR;
+ }
+ otherPtr = GetPacker(other);
+ if (otherPtr->masterPtr == NULL) {
+ goto notPacked;
+ }
+ masterPtr = otherPtr->masterPtr;
+ prevPtr = masterPtr->slavePtr;
+ if (prevPtr == otherPtr) {
+ prevPtr = NULL;
+ } else {
+ while (prevPtr->nextPtr != otherPtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ }
+ positionGiven = 1;
+ }
+ } else if ((c == 'e')
+ && (strncmp(argv[i], "-expand", length) == 0)) {
+ if (Tcl_GetBoolean(interp, argv[i+1], &tmp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ slavePtr->flags &= ~EXPAND;
+ if (tmp) {
+ slavePtr->flags |= EXPAND;
+ }
+ } else if ((c == 'f') && (strncmp(argv[i], "-fill", length) == 0)) {
+ if (strcmp(argv[i+1], "none") == 0) {
+ slavePtr->flags &= ~(FILLX|FILLY);
+ } else if (strcmp(argv[i+1], "x") == 0) {
+ slavePtr->flags = (slavePtr->flags & ~FILLY) | FILLX;
+ } else if (strcmp(argv[i+1], "y") == 0) {
+ slavePtr->flags = (slavePtr->flags & ~FILLX) | FILLY;
+ } else if (strcmp(argv[i+1], "both") == 0) {
+ slavePtr->flags |= FILLX|FILLY;
+ } else {
+ Tcl_AppendResult(interp, "bad fill style \"", argv[i+1],
+ "\": must be none, x, y, or both", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if ((c == 'i') && (strcmp(argv[i], "-in") == 0)) {
+ if (j == 0) {
+ other = Tk_NameToWindow(interp, argv[i+1], tkwin);
+ if (other == NULL) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetPacker(other);
+ prevPtr = masterPtr->slavePtr;
+ if (prevPtr != NULL) {
+ while (prevPtr->nextPtr != NULL) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ }
+ positionGiven = 1;
+ }
+ } else if ((c == 'i') && (strcmp(argv[i], "-ipadx") == 0)) {
+ if ((Tk_GetPixels(interp, slave, argv[i+1], &tmp) != TCL_OK)
+ || (tmp < 0)) {
+ badPad:
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad pad value \"", argv[i+1],
+ "\": must be positive screen distance",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->iPadX = tmp*2;
+ } else if ((c == 'i') && (strcmp(argv[i], "-ipady") == 0)) {
+ if ((Tk_GetPixels(interp, slave, argv[i+1], &tmp) != TCL_OK)
+ || (tmp< 0)) {
+ goto badPad;
+ }
+ slavePtr->iPadY = tmp*2;
+ } else if ((c == 'p') && (strcmp(argv[i], "-padx") == 0)) {
+ if ((Tk_GetPixels(interp, slave, argv[i+1], &tmp) != TCL_OK)
+ || (tmp< 0)) {
+ goto badPad;
+ }
+ slavePtr->padX = tmp*2;
+ } else if ((c == 'p') && (strcmp(argv[i], "-pady") == 0)) {
+ if ((Tk_GetPixels(interp, slave, argv[i+1], &tmp) != TCL_OK)
+ || (tmp< 0)) {
+ goto badPad;
+ }
+ slavePtr->padY = tmp*2;
+ } else if ((c == 's') && (strncmp(argv[i], "-side", length) == 0)) {
+ c = argv[i+1][0];
+ if ((c == 't') && (strcmp(argv[i+1], "top") == 0)) {
+ slavePtr->side = TOP;
+ } else if ((c == 'b') && (strcmp(argv[i+1], "bottom") == 0)) {
+ slavePtr->side = BOTTOM;
+ } else if ((c == 'l') && (strcmp(argv[i+1], "left") == 0)) {
+ slavePtr->side = LEFT;
+ } else if ((c == 'r') && (strcmp(argv[i+1], "right") == 0)) {
+ slavePtr->side = RIGHT;
+ } else {
+ Tcl_AppendResult(interp, "bad side \"", argv[i+1],
+ "\": must be top, bottom, left, or right",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ badOption:
+ Tcl_AppendResult(interp, "unknown or ambiguous option \"",
+ argv[i], "\": must be -after, -anchor, -before, ",
+ "-expand, -fill, -in, -ipadx, -ipady, -padx, ",
+ "-pady, or -side", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * If no position in a packing list was specified and the slave
+ * is already packed, then leave it in its current location in
+ * its current packing list.
+ */
+
+ if (!positionGiven && (slavePtr->masterPtr != NULL)) {
+ masterPtr = slavePtr->masterPtr;
+ goto scheduleLayout;
+ }
+
+ /*
+ * If the slave is going to be put back after itself then
+ * skip the whole operation, since it won't work anyway.
+ */
+
+ if (prevPtr == slavePtr) {
+ masterPtr = slavePtr->masterPtr;
+ goto scheduleLayout;
+ }
+
+ /*
+ * If none of the "-in", "-before", or "-after" options has
+ * been specified, arrange for the slave to go at the end of
+ * the order for its parent.
+ */
+
+ if (!positionGiven) {
+ masterPtr = GetPacker(Tk_Parent(slave));
+ prevPtr = masterPtr->slavePtr;
+ if (prevPtr != NULL) {
+ while (prevPtr->nextPtr != NULL) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ }
+ }
+
+ /*
+ * Make sure that the slave's parent is either the master or
+ * an ancestor of the master, and that the master and slave
+ * aren't the same.
+ */
+
+ parent = Tk_Parent(slave);
+ for (ancestor = masterPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ if (Tk_IsTopLevel(ancestor)) {
+ Tcl_AppendResult(interp, "can't pack ", argv[j],
+ " inside ", Tk_PathName(masterPtr->tkwin),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (slave == masterPtr->tkwin) {
+ Tcl_AppendResult(interp, "can't pack ", argv[j],
+ " inside itself", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Unpack the slave if it's currently packed, then position it
+ * after prevPtr.
+ */
+
+ if (slavePtr->masterPtr != NULL) {
+ if ((slavePtr->masterPtr != masterPtr) &&
+ (slavePtr->masterPtr->tkwin
+ != Tk_Parent(slavePtr->tkwin))) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin,
+ slavePtr->masterPtr->tkwin);
+ }
+ Unlink(slavePtr);
+ }
+ slavePtr->masterPtr = masterPtr;
+ if (prevPtr == NULL) {
+ slavePtr->nextPtr = masterPtr->slavePtr;
+ masterPtr->slavePtr = slavePtr;
+ } else {
+ slavePtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = slavePtr;
+ }
+ Tk_ManageGeometry(slave, &packerType, (ClientData) slavePtr);
+ prevPtr = slavePtr;
+
+ /*
+ * Arrange for the parent to be re-packed at the first
+ * idle moment.
+ */
+
+ scheduleLayout:
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ if (!(masterPtr->flags & REQUESTED_REPACK)) {
+ masterPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, (ClientData) masterPtr);
+ }
+ }
+ return TCL_OK;
+}
diff --git a/generic/tkPlace.c b/generic/tkPlace.c
new file mode 100644
index 0000000..15ddcef
--- /dev/null
+++ b/generic/tkPlace.c
@@ -0,0 +1,1060 @@
+/*
+ * tkPlace.c --
+ *
+ * This file contains code to implement a simple geometry manager
+ * for Tk based on absolute placement or "rubber-sheet" placement.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkPlace.c 1.27 96/08/20 17:05:31
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * Border modes for relative placement:
+ *
+ * BM_INSIDE: relative distances computed using area inside
+ * all borders of master window.
+ * BM_OUTSIDE: relative distances computed using outside area
+ * that includes all borders of master.
+ * BM_IGNORE: border issues are ignored: place relative to
+ * master's actual window size.
+ */
+
+typedef enum {BM_INSIDE, BM_OUTSIDE, BM_IGNORE} BorderMode;
+
+/*
+ * For each window whose geometry is managed by the placer there is
+ * a structure of the following type:
+ */
+
+typedef struct Slave {
+ Tk_Window tkwin; /* Tk's token for window. */
+ struct Master *masterPtr; /* Pointer to information for window
+ * relative to which tkwin is placed.
+ * This isn't necessarily the logical
+ * parent of tkwin. NULL means the
+ * master was deleted or never assigned. */
+ struct Slave *nextPtr; /* Next in list of windows placed relative
+ * to same master (NULL for end of list). */
+
+ /*
+ * Geometry information for window; where there are both relative
+ * and absolute values for the same attribute (e.g. x and relX) only
+ * one of them is actually used, depending on flags.
+ */
+
+ int x, y; /* X and Y pixel coordinates for tkwin. */
+ float relX, relY; /* X and Y coordinates relative to size of
+ * master. */
+ int width, height; /* Absolute dimensions for tkwin. */
+ float relWidth, relHeight; /* Dimensions for tkwin relative to size of
+ * master. */
+ Tk_Anchor anchor; /* Which point on tkwin is placed at the
+ * given position. */
+ BorderMode borderMode; /* How to treat borders of master window. */
+ int flags; /* Various flags; see below for bit
+ * definitions. */
+} Slave;
+
+/*
+ * Flag definitions for Slave structures:
+ *
+ * CHILD_WIDTH - 1 means -width was specified;
+ * CHILD_REL_WIDTH - 1 means -relwidth was specified.
+ * CHILD_HEIGHT - 1 means -height was specified;
+ * CHILD_REL_HEIGHT - 1 means -relheight was specified.
+ */
+
+#define CHILD_WIDTH 1
+#define CHILD_REL_WIDTH 2
+#define CHILD_HEIGHT 4
+#define CHILD_REL_HEIGHT 8
+
+/*
+ * For each master window that has a slave managed by the placer there
+ * is a structure of the following form:
+ */
+
+typedef struct Master {
+ Tk_Window tkwin; /* Tk's token for master window. */
+ struct Slave *slavePtr; /* First in linked list of slaves
+ * placed relative to this master. */
+ int flags; /* See below for bit definitions. */
+} Master;
+
+/*
+ * Flag definitions for masters:
+ *
+ * PARENT_RECONFIG_PENDING - 1 means that a call to RecomputePlacement
+ * is already pending via a Do_When_Idle handler.
+ */
+
+#define PARENT_RECONFIG_PENDING 1
+
+/*
+ * The hash tables below both use Tk_Window tokens as keys. They map
+ * from Tk_Windows to Slave and Master structures for windows, if they
+ * exist.
+ */
+
+static int initialized = 0;
+static Tcl_HashTable masterTable;
+static Tcl_HashTable slaveTable;
+/*
+ * The following structure is the official type record for the
+ * placer:
+ */
+
+static void PlaceRequestProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+static void PlaceLostSlaveProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+
+static Tk_GeomMgr placerType = {
+ "place", /* name */
+ PlaceRequestProc, /* requestProc */
+ PlaceLostSlaveProc, /* lostSlaveProc */
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void SlaveStructureProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int ConfigureSlave _ANSI_ARGS_((Tcl_Interp *interp,
+ Slave *slavePtr, int argc, char **argv));
+static Slave * FindSlave _ANSI_ARGS_((Tk_Window tkwin));
+static Master * FindMaster _ANSI_ARGS_((Tk_Window tkwin));
+static void MasterStructureProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void RecomputePlacement _ANSI_ARGS_((ClientData clientData));
+static void UnlinkSlave _ANSI_ARGS_((Slave *slavePtr));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PlaceCmd --
+ *
+ * This procedure is invoked to process the "place" Tcl
+ * commands. See the user documentation for details on
+ * what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_PlaceCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window tkwin;
+ Slave *slavePtr;
+ Tcl_HashEntry *hPtr;
+ size_t length;
+ int c;
+
+ /*
+ * Initialize, if that hasn't been done yet.
+ */
+
+ if (!initialized) {
+ Tcl_InitHashTable(&masterTable, TCL_ONE_WORD_KEYS);
+ Tcl_InitHashTable(&slaveTable, TCL_ONE_WORD_KEYS);
+ initialized = 1;
+ }
+
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " option|pathName args", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = argv[1][0];
+ length = strlen(argv[1]);
+
+ /*
+ * Handle special shortcut where window name is first argument.
+ */
+
+ if (c == '.') {
+ tkwin = Tk_NameToWindow(interp, argv[1], (Tk_Window) clientData);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ slavePtr = FindSlave(tkwin);
+ return ConfigureSlave(interp, slavePtr, argc-2, argv+2);
+ }
+
+ /*
+ * Handle more general case of option followed by window name followed
+ * by possible additional arguments.
+ */
+
+ tkwin = Tk_NameToWindow(interp, argv[2], (Tk_Window) clientData);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)) {
+ if (argc < 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0],
+ " configure pathName option value ?option value ...?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ slavePtr = FindSlave(tkwin);
+ return ConfigureSlave(interp, slavePtr, argc-3, argv+3);
+ } else if ((c == 'f') && (strncmp(argv[1], "forget", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " forget pathName\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ hPtr = Tcl_FindHashEntry(&slaveTable, (char *) tkwin);
+ if (hPtr == NULL) {
+ return TCL_OK;
+ }
+ slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
+ if ((slavePtr->masterPtr != NULL) &&
+ (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin))) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin,
+ slavePtr->masterPtr->tkwin);
+ }
+ UnlinkSlave(slavePtr);
+ Tcl_DeleteHashEntry(hPtr);
+ Tk_DeleteEventHandler(tkwin, StructureNotifyMask, SlaveStructureProc,
+ (ClientData) slavePtr);
+ Tk_ManageGeometry(tkwin, (Tk_GeomMgr *) NULL, (ClientData) NULL);
+ Tk_UnmapWindow(tkwin);
+ ckfree((char *) slavePtr);
+ } else if ((c == 'i') && (strncmp(argv[1], "info", length) == 0)) {
+ char buffer[50];
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " info pathName\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ hPtr = Tcl_FindHashEntry(&slaveTable, (char *) tkwin);
+ if (hPtr == NULL) {
+ return TCL_OK;
+ }
+ slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
+ sprintf(buffer, "-x %d", slavePtr->x);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ sprintf(buffer, " -relx %.4g", slavePtr->relX);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ sprintf(buffer, " -y %d", slavePtr->y);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ sprintf(buffer, " -rely %.4g", slavePtr->relY);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ if (slavePtr->flags & CHILD_WIDTH) {
+ sprintf(buffer, " -width %d", slavePtr->width);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, " -width {}", (char *) NULL);
+ }
+ if (slavePtr->flags & CHILD_REL_WIDTH) {
+ sprintf(buffer, " -relwidth %.4g", slavePtr->relWidth);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, " -relwidth {}", (char *) NULL);
+ }
+ if (slavePtr->flags & CHILD_HEIGHT) {
+ sprintf(buffer, " -height %d", slavePtr->height);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, " -height {}", (char *) NULL);
+ }
+ if (slavePtr->flags & CHILD_REL_HEIGHT) {
+ sprintf(buffer, " -relheight %.4g", slavePtr->relHeight);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, " -relheight {}", (char *) NULL);
+ }
+
+ Tcl_AppendResult(interp, " -anchor ", Tk_NameOfAnchor(slavePtr->anchor),
+ (char *) NULL);
+ if (slavePtr->borderMode == BM_OUTSIDE) {
+ Tcl_AppendResult(interp, " -bordermode outside", (char *) NULL);
+ } else if (slavePtr->borderMode == BM_IGNORE) {
+ Tcl_AppendResult(interp, " -bordermode ignore", (char *) NULL);
+ }
+ if ((slavePtr->masterPtr != NULL)
+ && (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin))) {
+ Tcl_AppendResult(interp, " -in ",
+ Tk_PathName(slavePtr->masterPtr->tkwin), (char *) NULL);
+ }
+ } else if ((c == 's') && (strncmp(argv[1], "slaves", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " slaves pathName\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ hPtr = Tcl_FindHashEntry(&masterTable, (char *) tkwin);
+ if (hPtr != NULL) {
+ Master *masterPtr;
+ masterPtr = (Master *) Tcl_GetHashValue(hPtr);
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ Tcl_AppendElement(interp, Tk_PathName(slavePtr->tkwin));
+ }
+ }
+ } else {
+ Tcl_AppendResult(interp, "unknown or ambiguous option \"", argv[1],
+ "\": must be configure, forget, info, or slaves",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindSlave --
+ *
+ * Given a Tk_Window token, find the Slave structure corresponding
+ * to that token (making a new one if necessary).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new Slave structure may be created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Slave *
+FindSlave(tkwin)
+ Tk_Window tkwin; /* Token for desired slave. */
+{
+ Tcl_HashEntry *hPtr;
+ register Slave *slavePtr;
+ int new;
+
+ hPtr = Tcl_CreateHashEntry(&slaveTable, (char *) tkwin, &new);
+ if (new) {
+ slavePtr = (Slave *) ckalloc(sizeof(Slave));
+ slavePtr->tkwin = tkwin;
+ slavePtr->masterPtr = NULL;
+ slavePtr->nextPtr = NULL;
+ slavePtr->x = slavePtr->y = 0;
+ slavePtr->relX = slavePtr->relY = (float) 0.0;
+ slavePtr->width = slavePtr->height = 0;
+ slavePtr->relWidth = slavePtr->relHeight = (float) 0.0;
+ slavePtr->anchor = TK_ANCHOR_NW;
+ slavePtr->borderMode = BM_INSIDE;
+ slavePtr->flags = 0;
+ Tcl_SetHashValue(hPtr, slavePtr);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask, SlaveStructureProc,
+ (ClientData) slavePtr);
+ Tk_ManageGeometry(tkwin, &placerType, (ClientData) slavePtr);
+ } else {
+ slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
+ }
+ return slavePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UnlinkSlave --
+ *
+ * This procedure removes a slave window from the chain of slaves
+ * in its master.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The slave list of slavePtr's master changes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UnlinkSlave(slavePtr)
+ Slave *slavePtr; /* Slave structure to be unlinked. */
+{
+ register Master *masterPtr;
+ register Slave *prevPtr;
+
+ masterPtr = slavePtr->masterPtr;
+ if (masterPtr == NULL) {
+ return;
+ }
+ if (masterPtr->slavePtr == slavePtr) {
+ masterPtr->slavePtr = slavePtr->nextPtr;
+ } else {
+ for (prevPtr = masterPtr->slavePtr; ;
+ prevPtr = prevPtr->nextPtr) {
+ if (prevPtr == NULL) {
+ panic("UnlinkSlave couldn't find slave to unlink");
+ }
+ if (prevPtr->nextPtr == slavePtr) {
+ prevPtr->nextPtr = slavePtr->nextPtr;
+ break;
+ }
+ }
+ }
+ slavePtr->masterPtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindMaster --
+ *
+ * Given a Tk_Window token, find the Master structure corresponding
+ * to that token (making a new one if necessary).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new Master structure may be created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Master *
+FindMaster(tkwin)
+ Tk_Window tkwin; /* Token for desired master. */
+{
+ Tcl_HashEntry *hPtr;
+ register Master *masterPtr;
+ int new;
+
+ hPtr = Tcl_CreateHashEntry(&masterTable, (char *) tkwin, &new);
+ if (new) {
+ masterPtr = (Master *) ckalloc(sizeof(Master));
+ masterPtr->tkwin = tkwin;
+ masterPtr->slavePtr = NULL;
+ masterPtr->flags = 0;
+ Tcl_SetHashValue(hPtr, masterPtr);
+ Tk_CreateEventHandler(masterPtr->tkwin, StructureNotifyMask,
+ MasterStructureProc, (ClientData) masterPtr);
+ } else {
+ masterPtr = (Master *) Tcl_GetHashValue(hPtr);
+ }
+ return masterPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureSlave --
+ *
+ * This procedure is called to process an argv/argc list to
+ * reconfigure the placement of a window.
+ *
+ * Results:
+ * A standard Tcl result. If an error occurs then a message is
+ * left in interp->result.
+ *
+ * Side effects:
+ * Information in slavePtr may change, and slavePtr's master is
+ * scheduled for reconfiguration.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureSlave(interp, slavePtr, argc, argv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Slave *slavePtr; /* Pointer to current information
+ * about slave. */
+ int argc; /* Number of config arguments. */
+ char **argv; /* String values for arguments. */
+{
+ register Master *masterPtr;
+ int c, result;
+ size_t length;
+ double d;
+
+ result = TCL_OK;
+ if (Tk_IsTopLevel(slavePtr->tkwin)) {
+ Tcl_AppendResult(interp, "can't use placer on top-level window \"",
+ Tk_PathName(slavePtr->tkwin), "\"; use wm command instead",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ for ( ; argc > 0; argc -= 2, argv += 2) {
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "extra option \"", argv[0],
+ "\" (option with no value?)", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ length = strlen(argv[0]);
+ c = argv[0][1];
+ if ((c == 'a') && (strncmp(argv[0], "-anchor", length) == 0)) {
+ if (Tk_GetAnchor(interp, argv[1], &slavePtr->anchor) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else if ((c == 'b')
+ && (strncmp(argv[0], "-bordermode", length) == 0)) {
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'i') && (strncmp(argv[1], "ignore", length) == 0)
+ && (length >= 2)) {
+ slavePtr->borderMode = BM_IGNORE;
+ } else if ((c == 'i') && (strncmp(argv[1], "inside", length) == 0)
+ && (length >= 2)) {
+ slavePtr->borderMode = BM_INSIDE;
+ } else if ((c == 'o')
+ && (strncmp(argv[1], "outside", length) == 0)) {
+ slavePtr->borderMode = BM_OUTSIDE;
+ } else {
+ Tcl_AppendResult(interp, "bad border mode \"", argv[1],
+ "\": must be ignore, inside, or outside",
+ (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else if ((c == 'h') && (strncmp(argv[0], "-height", length) == 0)) {
+ if (argv[1][0] == 0) {
+ slavePtr->flags &= ~CHILD_HEIGHT;
+ } else {
+ if (Tk_GetPixels(interp, slavePtr->tkwin, argv[1],
+ &slavePtr->height) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ slavePtr->flags |= CHILD_HEIGHT;
+ }
+ } else if ((c == 'i') && (strncmp(argv[0], "-in", length) == 0)) {
+ Tk_Window tkwin;
+ Tk_Window ancestor;
+
+ tkwin = Tk_NameToWindow(interp, argv[1], slavePtr->tkwin);
+ if (tkwin == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * Make sure that the new master is either the logical parent
+ * of the slave or a descendant of that window, and that the
+ * master and slave aren't the same.
+ */
+
+ for (ancestor = tkwin; ; ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == Tk_Parent(slavePtr->tkwin)) {
+ break;
+ }
+ if (Tk_IsTopLevel(ancestor)) {
+ Tcl_AppendResult(interp, "can't place ",
+ Tk_PathName(slavePtr->tkwin), " relative to ",
+ Tk_PathName(tkwin), (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ }
+ if (slavePtr->tkwin == tkwin) {
+ Tcl_AppendResult(interp, "can't place ",
+ Tk_PathName(slavePtr->tkwin), " relative to itself",
+ (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if ((slavePtr->masterPtr != NULL)
+ && (slavePtr->masterPtr->tkwin == tkwin)) {
+ /*
+ * Re-using same old master. Nothing to do.
+ */
+ } else {
+ if ((slavePtr->masterPtr != NULL)
+ && (slavePtr->masterPtr->tkwin
+ != Tk_Parent(slavePtr->tkwin))) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin,
+ slavePtr->masterPtr->tkwin);
+ }
+ UnlinkSlave(slavePtr);
+ slavePtr->masterPtr = FindMaster(tkwin);
+ slavePtr->nextPtr = slavePtr->masterPtr->slavePtr;
+ slavePtr->masterPtr->slavePtr = slavePtr;
+ }
+ } else if ((c == 'r') && (strncmp(argv[0], "-relheight", length) == 0)
+ && (length >= 5)) {
+ if (argv[1][0] == 0) {
+ slavePtr->flags &= ~CHILD_REL_HEIGHT;
+ } else {
+ if (Tcl_GetDouble(interp, argv[1], &d) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ slavePtr->relHeight = (float) d;
+ slavePtr->flags |= CHILD_REL_HEIGHT;
+ }
+ } else if ((c == 'r') && (strncmp(argv[0], "-relwidth", length) == 0)
+ && (length >= 5)) {
+ if (argv[1][0] == 0) {
+ slavePtr->flags &= ~CHILD_REL_WIDTH;
+ } else {
+ if (Tcl_GetDouble(interp, argv[1], &d) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ slavePtr->relWidth = (float) d;
+ slavePtr->flags |= CHILD_REL_WIDTH;
+ }
+ } else if ((c == 'r') && (strncmp(argv[0], "-relx", length) == 0)
+ && (length >= 5)) {
+ if (Tcl_GetDouble(interp, argv[1], &d) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ slavePtr->relX = (float) d;
+ } else if ((c == 'r') && (strncmp(argv[0], "-rely", length) == 0)
+ && (length >= 5)) {
+ if (Tcl_GetDouble(interp, argv[1], &d) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ slavePtr->relY = (float) d;
+ } else if ((c == 'w') && (strncmp(argv[0], "-width", length) == 0)) {
+ if (argv[1][0] == 0) {
+ slavePtr->flags &= ~CHILD_WIDTH;
+ } else {
+ if (Tk_GetPixels(interp, slavePtr->tkwin, argv[1],
+ &slavePtr->width) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ slavePtr->flags |= CHILD_WIDTH;
+ }
+ } else if ((c == 'x') && (strncmp(argv[0], "-x", length) == 0)) {
+ if (Tk_GetPixels(interp, slavePtr->tkwin, argv[1],
+ &slavePtr->x) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else if ((c == 'y') && (strncmp(argv[0], "-y", length) == 0)) {
+ if (Tk_GetPixels(interp, slavePtr->tkwin, argv[1],
+ &slavePtr->y) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else {
+ Tcl_AppendResult(interp, "unknown or ambiguous option \"",
+ argv[0], "\": must be -anchor, -bordermode, -height, ",
+ "-in, -relheight, -relwidth, -relx, -rely, -width, ",
+ "-x, or -y", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ }
+
+ /*
+ * If there's no master specified for this slave, use its Tk_Parent.
+ * Then arrange for a placement recalculation in the master.
+ */
+
+ done:
+ masterPtr = slavePtr->masterPtr;
+ if (masterPtr == NULL) {
+ masterPtr = FindMaster(Tk_Parent(slavePtr->tkwin));
+ slavePtr->masterPtr = masterPtr;
+ slavePtr->nextPtr = masterPtr->slavePtr;
+ masterPtr->slavePtr = slavePtr;
+ }
+ if (!(masterPtr->flags & PARENT_RECONFIG_PENDING)) {
+ masterPtr->flags |= PARENT_RECONFIG_PENDING;
+ Tcl_DoWhenIdle(RecomputePlacement, (ClientData) masterPtr);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RecomputePlacement --
+ *
+ * This procedure is called as a when-idle handler. It recomputes
+ * the geometries of all the slaves of a given master.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Windows may change size or shape.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RecomputePlacement(clientData)
+ ClientData clientData; /* Pointer to Master record. */
+{
+ register Master *masterPtr = (Master *) clientData;
+ register Slave *slavePtr;
+ int x, y, width, height, tmp;
+ int masterWidth, masterHeight, masterBW;
+ double x1, y1, x2, y2;
+
+ masterPtr->flags &= ~PARENT_RECONFIG_PENDING;
+
+ /*
+ * Iterate over all the slaves for the master. Each slave's
+ * geometry can be computed independently of the other slaves.
+ */
+
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ /*
+ * Step 1: compute size and borderwidth of master, taking into
+ * account desired border mode.
+ */
+
+ masterBW = 0;
+ masterWidth = Tk_Width(masterPtr->tkwin);
+ masterHeight = Tk_Height(masterPtr->tkwin);
+ if (slavePtr->borderMode == BM_INSIDE) {
+ masterBW = Tk_InternalBorderWidth(masterPtr->tkwin);
+ } else if (slavePtr->borderMode == BM_OUTSIDE) {
+ masterBW = -Tk_Changes(masterPtr->tkwin)->border_width;
+ }
+ masterWidth -= 2*masterBW;
+ masterHeight -= 2*masterBW;
+
+ /*
+ * Step 2: compute size of slave (outside dimensions including
+ * border) and location of anchor point within master.
+ */
+
+ x1 = slavePtr->x + masterBW + (slavePtr->relX*masterWidth);
+ x = (int) (x1 + ((x1 > 0) ? 0.5 : -0.5));
+ y1 = slavePtr->y + masterBW + (slavePtr->relY*masterHeight);
+ y = (int) (y1 + ((y1 > 0) ? 0.5 : -0.5));
+ if (slavePtr->flags & (CHILD_WIDTH|CHILD_REL_WIDTH)) {
+ width = 0;
+ if (slavePtr->flags & CHILD_WIDTH) {
+ width += slavePtr->width;
+ }
+ if (slavePtr->flags & CHILD_REL_WIDTH) {
+ /*
+ * The code below is a bit tricky. In order to round
+ * correctly when both relX and relWidth are specified,
+ * compute the location of the right edge and round that,
+ * then compute width. If we compute the width and round
+ * it, rounding errors in relX and relWidth accumulate.
+ */
+
+ x2 = x1 + (slavePtr->relWidth*masterWidth);
+ tmp = (int) (x2 + ((x2 > 0) ? 0.5 : -0.5));
+ width += tmp - x;
+ }
+ } else {
+ width = Tk_ReqWidth(slavePtr->tkwin)
+ + 2*Tk_Changes(slavePtr->tkwin)->border_width;
+ }
+ if (slavePtr->flags & (CHILD_HEIGHT|CHILD_REL_HEIGHT)) {
+ height = 0;
+ if (slavePtr->flags & CHILD_HEIGHT) {
+ height += slavePtr->height;
+ }
+ if (slavePtr->flags & CHILD_REL_HEIGHT) {
+ /*
+ * See note above for rounding errors in width computation.
+ */
+
+ y2 = y1 + (slavePtr->relHeight*masterHeight);
+ tmp = (int) (y2 + ((y2 > 0) ? 0.5 : -0.5));
+ height += tmp - y;
+ }
+ } else {
+ height = Tk_ReqHeight(slavePtr->tkwin)
+ + 2*Tk_Changes(slavePtr->tkwin)->border_width;
+ }
+
+ /*
+ * Step 3: adjust the x and y positions so that the desired
+ * anchor point on the slave appears at that position. Also
+ * adjust for the border mode and master's border.
+ */
+
+ switch (slavePtr->anchor) {
+ case TK_ANCHOR_N:
+ x -= width/2;
+ break;
+ case TK_ANCHOR_NE:
+ x -= width;
+ break;
+ case TK_ANCHOR_E:
+ x -= width;
+ y -= height/2;
+ break;
+ case TK_ANCHOR_SE:
+ x -= width;
+ y -= height;
+ break;
+ case TK_ANCHOR_S:
+ x -= width/2;
+ y -= height;
+ break;
+ case TK_ANCHOR_SW:
+ y -= height;
+ break;
+ case TK_ANCHOR_W:
+ y -= height/2;
+ break;
+ case TK_ANCHOR_NW:
+ break;
+ case TK_ANCHOR_CENTER:
+ x -= width/2;
+ y -= height/2;
+ break;
+ }
+
+ /*
+ * Step 4: adjust width and height again to reflect inside dimensions
+ * of window rather than outside. Also make sure that the width and
+ * height aren't zero.
+ */
+
+ width -= 2*Tk_Changes(slavePtr->tkwin)->border_width;
+ height -= 2*Tk_Changes(slavePtr->tkwin)->border_width;
+ if (width <= 0) {
+ width = 1;
+ }
+ if (height <= 0) {
+ height = 1;
+ }
+
+ /*
+ * Step 5: reconfigure the window and map it if needed. If the
+ * slave is a child of the master, we do this ourselves. If the
+ * slave isn't a child of the master, let Tk_MaintainWindow do
+ * the work (it will re-adjust things as relevant windows map,
+ * unmap, and move).
+ */
+
+ if (masterPtr->tkwin == Tk_Parent(slavePtr->tkwin)) {
+ if ((x != Tk_X(slavePtr->tkwin))
+ || (y != Tk_Y(slavePtr->tkwin))
+ || (width != Tk_Width(slavePtr->tkwin))
+ || (height != Tk_Height(slavePtr->tkwin))) {
+ Tk_MoveResizeWindow(slavePtr->tkwin, x, y, width, height);
+ }
+
+ /*
+ * Don't map the slave unless the master is mapped: the slave
+ * will get mapped later, when the master is mapped.
+ */
+
+ if (Tk_IsMapped(masterPtr->tkwin)) {
+ Tk_MapWindow(slavePtr->tkwin);
+ }
+ } else {
+ if ((width <= 0) || (height <= 0)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, masterPtr->tkwin);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ } else {
+ Tk_MaintainGeometry(slavePtr->tkwin, masterPtr->tkwin,
+ x, y, width, height);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MasterStructureProc --
+ *
+ * This procedure is invoked by the Tk event handler when
+ * StructureNotify events occur for a master window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Structures get cleaned up if the window was deleted. If the
+ * window was resized then slave geometries get recomputed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MasterStructureProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to Master structure for window
+ * referred to by eventPtr. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ register Master *masterPtr = (Master *) clientData;
+ register Slave *slavePtr, *nextPtr;
+
+ if (eventPtr->type == ConfigureNotify) {
+ if ((masterPtr->slavePtr != NULL)
+ && !(masterPtr->flags & PARENT_RECONFIG_PENDING)) {
+ masterPtr->flags |= PARENT_RECONFIG_PENDING;
+ Tcl_DoWhenIdle(RecomputePlacement, (ClientData) masterPtr);
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = nextPtr) {
+ slavePtr->masterPtr = NULL;
+ nextPtr = slavePtr->nextPtr;
+ slavePtr->nextPtr = NULL;
+ }
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&masterTable,
+ (char *) masterPtr->tkwin));
+ if (masterPtr->flags & PARENT_RECONFIG_PENDING) {
+ Tcl_CancelIdleCall(RecomputePlacement, (ClientData) masterPtr);
+ }
+ masterPtr->tkwin = NULL;
+ ckfree((char *) masterPtr);
+ } else if (eventPtr->type == MapNotify) {
+ /*
+ * When a master gets mapped, must redo the geometry computation
+ * so that all of its slaves get remapped.
+ */
+
+ if ((masterPtr->slavePtr != NULL)
+ && !(masterPtr->flags & PARENT_RECONFIG_PENDING)) {
+ masterPtr->flags |= PARENT_RECONFIG_PENDING;
+ Tcl_DoWhenIdle(RecomputePlacement, (ClientData) masterPtr);
+ }
+ } else if (eventPtr->type == UnmapNotify) {
+ /*
+ * Unmap all of the slaves when the master gets unmapped,
+ * so that they don't keep redisplaying themselves.
+ */
+
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ Tk_UnmapWindow(slavePtr->tkwin);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SlaveStructureProc --
+ *
+ * This procedure is invoked by the Tk event handler when
+ * StructureNotify events occur for a slave window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Structures get cleaned up if the window was deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SlaveStructureProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to Slave structure for window
+ * referred to by eventPtr. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ register Slave *slavePtr = (Slave *) clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ UnlinkSlave(slavePtr);
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&slaveTable,
+ (char *) slavePtr->tkwin));
+ ckfree((char *) slavePtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PlaceRequestProc --
+ *
+ * This procedure is invoked by Tk whenever a slave managed by us
+ * changes its requested geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window will get relayed out, if its requested size has
+ * anything to do with its actual size.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+PlaceRequestProc(clientData, tkwin)
+ ClientData clientData; /* Pointer to our record for slave. */
+ Tk_Window tkwin; /* Window that changed its desired
+ * size. */
+{
+ Slave *slavePtr = (Slave *) clientData;
+ Master *masterPtr;
+
+ if (((slavePtr->flags & (CHILD_WIDTH|CHILD_REL_WIDTH)) != 0)
+ && ((slavePtr->flags & (CHILD_HEIGHT|CHILD_REL_HEIGHT)) != 0)) {
+ return;
+ }
+ masterPtr = slavePtr->masterPtr;
+ if (masterPtr == NULL) {
+ return;
+ }
+ if (!(masterPtr->flags & PARENT_RECONFIG_PENDING)) {
+ masterPtr->flags |= PARENT_RECONFIG_PENDING;
+ Tcl_DoWhenIdle(RecomputePlacement, (ClientData) masterPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PlaceLostSlaveProc --
+ *
+ * This procedure is invoked by Tk whenever some other geometry
+ * claims control over a slave that used to be managed by us.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Forgets all placer-related information about the slave.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+PlaceLostSlaveProc(clientData, tkwin)
+ ClientData clientData; /* Slave structure for slave window that
+ * was stolen away. */
+ Tk_Window tkwin; /* Tk's handle for the slave window. */
+{
+ register Slave *slavePtr = (Slave *) clientData;
+
+ if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, slavePtr->masterPtr->tkwin);
+ }
+ Tk_UnmapWindow(tkwin);
+ UnlinkSlave(slavePtr);
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&slaveTable, (char *) tkwin));
+ Tk_DeleteEventHandler(tkwin, StructureNotifyMask, SlaveStructureProc,
+ (ClientData) slavePtr);
+ ckfree((char *) slavePtr);
+}
diff --git a/generic/tkPointer.c b/generic/tkPointer.c
new file mode 100644
index 0000000..36814bf
--- /dev/null
+++ b/generic/tkPointer.c
@@ -0,0 +1,623 @@
+/*
+ * tkPointer.c --
+ *
+ * This file contains functions for emulating the X server
+ * pointer and grab state machine. This file is used by the
+ * Mac and Windows platforms to generate appropriate enter/leave
+ * events, and to update the global grab window information.
+ *
+ * Copyright (c) 1996 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkPointer.c 1.12 97/10/31 17:06:24
+ */
+
+#include "tkInt.h"
+
+#ifdef MAC_TCL
+#define Cursor XCursor
+#endif
+
+/*
+ * Mask that selects any of the state bits corresponding to buttons,
+ * plus masks that select individual buttons' bits:
+ */
+
+#define ALL_BUTTONS \
+ (Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask)
+static unsigned int buttonMasks[] = {
+ Button1Mask, Button2Mask, Button3Mask, Button4Mask, Button5Mask
+};
+#define ButtonMask(b) (buttonMasks[(b)-Button1])
+
+/*
+ * Declarations of static variables used in the pointer module.
+ */
+
+static TkWindow *cursorWinPtr = NULL; /* Window that is currently
+ * controlling the global cursor. */
+static TkWindow *grabWinPtr = NULL; /* Window that defines the top of the
+ * grab tree in a global grab. */
+static XPoint lastPos = { 0, 0}; /* Last reported mouse position. */
+static int lastState = 0; /* Last known state flags. */
+static TkWindow *lastWinPtr = NULL; /* Last reported mouse window. */
+static TkWindow *restrictWinPtr = NULL; /* Window to which all mouse events
+ * will be reported. */
+
+/*
+ * Forward declarations of procedures used in this file.
+ */
+
+static int GenerateEnterLeave _ANSI_ARGS_((TkWindow *winPtr,
+ int x, int y, int state));
+static void InitializeEvent _ANSI_ARGS_((XEvent* eventPtr,
+ TkWindow *winPtr, int type, int x, int y,
+ int state, int detail));
+static void UpdateCursor _ANSI_ARGS_((TkWindow *winPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitializeEvent --
+ *
+ * Initializes the common fields for several X events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Fills in the specified event structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitializeEvent(eventPtr, winPtr, type, x, y, state, detail)
+ XEvent* eventPtr; /* Event structure to initialize. */
+ TkWindow *winPtr; /* Window to make event relative to. */
+ int type; /* Message type. */
+ int x, y; /* Root coords of event. */
+ int state; /* State flags. */
+ int detail; /* Detail value. */
+{
+ eventPtr->type = type;
+ eventPtr->xany.serial = LastKnownRequestProcessed(winPtr->display);
+ eventPtr->xany.send_event = False;
+ eventPtr->xany.display = winPtr->display;
+
+ eventPtr->xcrossing.root = RootWindow(winPtr->display, winPtr->screenNum);
+ eventPtr->xcrossing.time = TkpGetMS();
+ eventPtr->xcrossing.x_root = x;
+ eventPtr->xcrossing.y_root = y;
+
+ switch (type) {
+ case EnterNotify:
+ case LeaveNotify:
+ eventPtr->xcrossing.mode = NotifyNormal;
+ eventPtr->xcrossing.state = state;
+ eventPtr->xcrossing.detail = detail;
+ eventPtr->xcrossing.focus = False;
+ break;
+ case MotionNotify:
+ eventPtr->xmotion.state = state;
+ eventPtr->xmotion.is_hint = detail;
+ break;
+ case ButtonPress:
+ case ButtonRelease:
+ eventPtr->xbutton.state = state;
+ eventPtr->xbutton.button = detail;
+ break;
+ }
+ TkChangeEventWindow(eventPtr, winPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateEnterLeave --
+ *
+ * Update the current mouse window and position, and generate
+ * any enter/leave events that are needed.
+ *
+ * Results:
+ * Returns 1 if enter/leave events were generated.
+ *
+ * Side effects:
+ * May insert events into the Tk event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GenerateEnterLeave(winPtr, x, y, state)
+ TkWindow *winPtr; /* Current Tk window (or NULL). */
+ int x,y; /* Current mouse position in root coords. */
+ int state; /* State flags. */
+{
+ int crossed = 0; /* 1 if mouse crossed a window boundary */
+
+ if (winPtr != lastWinPtr) {
+ if (restrictWinPtr) {
+ int newPos, oldPos;
+
+ newPos = TkPositionInTree(winPtr, restrictWinPtr);
+ oldPos = TkPositionInTree(lastWinPtr, restrictWinPtr);
+
+ /*
+ * Check if the mouse crossed into or out of the restrict
+ * window. If so, we need to generate an Enter or Leave event.
+ */
+
+ if ((newPos != oldPos) && ((newPos == TK_GRAB_IN_TREE)
+ || (oldPos == TK_GRAB_IN_TREE))) {
+ XEvent event;
+ int type, detail;
+
+ if (newPos == TK_GRAB_IN_TREE) {
+ type = EnterNotify;
+ } else {
+ type = LeaveNotify;
+ }
+ if ((oldPos == TK_GRAB_ANCESTOR)
+ || (newPos == TK_GRAB_ANCESTOR)) {
+ detail = NotifyAncestor;
+ } else {
+ detail = NotifyVirtual;
+ }
+ InitializeEvent(&event, restrictWinPtr, type, x, y,
+ state, detail);
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ }
+
+ } else {
+ TkWindow *targetPtr;
+
+ if ((lastWinPtr == NULL)
+ || (lastWinPtr->window == None)) {
+ targetPtr = winPtr;
+ } else {
+ targetPtr = lastWinPtr;
+ }
+
+ if (targetPtr && (targetPtr->window != None)) {
+ XEvent event;
+
+ /*
+ * Generate appropriate Enter/Leave events.
+ */
+
+ InitializeEvent(&event, targetPtr, LeaveNotify, x, y, state,
+ NotifyNormal);
+
+ TkInOutEvents(&event, lastWinPtr, winPtr, LeaveNotify,
+ EnterNotify, TCL_QUEUE_TAIL);
+ crossed = 1;
+ }
+ }
+ lastWinPtr = winPtr;
+ }
+
+ return crossed;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_UpdatePointer --
+ *
+ * This function updates the pointer state machine given an
+ * the current window, position and modifier state.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May queue new events and update the grab state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_UpdatePointer(tkwin, x, y, state)
+ Tk_Window tkwin; /* Window to which pointer event
+ * is reported. May be NULL. */
+ int x, y; /* Pointer location in root coords. */
+ int state; /* Modifier state mask. */
+{
+ TkWindow *winPtr = (TkWindow *)tkwin;
+ TkWindow *targetWinPtr;
+ XPoint pos;
+ XEvent event;
+ int changes = (state ^ lastState) & ALL_BUTTONS;
+ int type, b, mask;
+
+ pos.x = x;
+ pos.y = y;
+
+ /*
+ * Use the current keyboard state, but the old mouse button
+ * state since we haven't generated the button events yet.
+ */
+
+ lastState = (state & ~ALL_BUTTONS) | (lastState & ALL_BUTTONS);
+
+ /*
+ * Generate Enter/Leave events. If the pointer has crossed window
+ * boundaries, update the current mouse position so we don't generate
+ * redundant motion events.
+ */
+
+ if (GenerateEnterLeave(winPtr, x, y, lastState)) {
+ lastPos = pos;
+ }
+
+ /*
+ * Generate ButtonPress/ButtonRelease events based on the differences
+ * between the current button state and the last known button state.
+ */
+
+ for (b = Button1; b <= Button3; b++) {
+ mask = ButtonMask(b);
+ if (changes & mask) {
+ if (state & mask) {
+ type = ButtonPress;
+
+ /*
+ * ButtonPress - Set restrict window if we aren't grabbed, or
+ * if this is the first button down.
+ */
+
+ if (!restrictWinPtr) {
+ if (!grabWinPtr) {
+
+ /*
+ * Mouse is not grabbed, so set a button grab.
+ */
+
+ restrictWinPtr = winPtr;
+ TkpSetCapture(restrictWinPtr);
+
+ } else if ((lastState & ALL_BUTTONS) == 0) {
+
+ /*
+ * Mouse is in a non-button grab, so ensure
+ * the button grab is inside the grab tree.
+ */
+
+ if (TkPositionInTree(winPtr, grabWinPtr)
+ == TK_GRAB_IN_TREE) {
+ restrictWinPtr = winPtr;
+ } else {
+ restrictWinPtr = grabWinPtr;
+ }
+ TkpSetCapture(restrictWinPtr);
+ }
+ }
+
+ } else {
+ type = ButtonRelease;
+
+ /*
+ * ButtonRelease - Release the mouse capture and clear the
+ * restrict window when the last button is released and we
+ * aren't in a global grab.
+ */
+
+ if ((lastState & ALL_BUTTONS) == mask) {
+ if (!grabWinPtr) {
+ TkpSetCapture(NULL);
+ }
+ }
+
+ /*
+ * If we are releasing a restrict window, then we need
+ * to send the button event followed by mouse motion from
+ * the restrict window to the current mouse position.
+ */
+
+ if (restrictWinPtr) {
+ InitializeEvent(&event, restrictWinPtr, type, x, y,
+ lastState, b);
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ lastState &= ~mask;
+ lastWinPtr = restrictWinPtr;
+ restrictWinPtr = NULL;
+
+ GenerateEnterLeave(winPtr, x, y, lastState);
+ lastPos = pos;
+ continue;
+ }
+ }
+
+ /*
+ * If a restrict window is set, make sure the pointer event
+ * is reported relative to that window. Otherwise, if a
+ * global grab is in effect then events outside of windows
+ * managed by Tk should be reported to the grab window.
+ */
+
+ if (restrictWinPtr) {
+ targetWinPtr = restrictWinPtr;
+ } else if (grabWinPtr && !winPtr) {
+ targetWinPtr = grabWinPtr;
+ } else {
+ targetWinPtr = winPtr;
+ }
+
+ /*
+ * If we still have a target window, send the event.
+ */
+
+ if (winPtr != NULL) {
+ InitializeEvent(&event, targetWinPtr, type, x, y,
+ lastState, b);
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ }
+
+ /*
+ * Update the state for the next iteration.
+ */
+
+ lastState = (type == ButtonPress)
+ ? (lastState | mask) : (lastState & ~mask);
+ lastPos = pos;
+ }
+ }
+
+ /*
+ * Make sure the cursor window is up to date.
+ */
+
+ if (restrictWinPtr) {
+ targetWinPtr = restrictWinPtr;
+ } else if (grabWinPtr) {
+ targetWinPtr = (TkPositionInTree(winPtr, grabWinPtr)
+ == TK_GRAB_IN_TREE) ? winPtr : grabWinPtr;
+ } else {
+ targetWinPtr = winPtr;
+ }
+ UpdateCursor(targetWinPtr);
+
+ /*
+ * If no other events caused the position to be updated,
+ * generate a motion event.
+ */
+
+ if (lastPos.x != pos.x || lastPos.y != pos.y) {
+ if (restrictWinPtr) {
+ targetWinPtr = restrictWinPtr;
+ } else if (grabWinPtr && !winPtr) {
+ targetWinPtr = grabWinPtr;
+ }
+
+ if (targetWinPtr != NULL) {
+ InitializeEvent(&event, targetWinPtr, MotionNotify, x, y,
+ lastState, NotifyNormal);
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ }
+ lastPos = pos;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XGrabPointer --
+ *
+ * Capture the mouse so event are reported outside of toplevels.
+ * Note that this is a very limited implementation that only
+ * supports GrabModeAsync and owner_events True.
+ *
+ * Results:
+ * Always returns GrabSuccess.
+ *
+ * Side effects:
+ * Turns on mouse capture, sets the global grab pointer, and
+ * clears any window restrictions.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+XGrabPointer(display, grab_window, owner_events, event_mask, pointer_mode,
+ keyboard_mode, confine_to, cursor, time)
+ Display* display;
+ Window grab_window;
+ Bool owner_events;
+ unsigned int event_mask;
+ int pointer_mode;
+ int keyboard_mode;
+ Window confine_to;
+ Cursor cursor;
+ Time time;
+{
+ display->request++;
+ grabWinPtr = (TkWindow *) Tk_IdToWindow(display, grab_window);
+ restrictWinPtr = NULL;
+ TkpSetCapture(grabWinPtr);
+ if (TkPositionInTree(lastWinPtr, grabWinPtr) != TK_GRAB_IN_TREE) {
+ UpdateCursor(grabWinPtr);
+ }
+ return GrabSuccess;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XUngrabPointer --
+ *
+ * Release the current grab.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Releases the mouse capture.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XUngrabPointer(display, time)
+ Display* display;
+ Time time;
+{
+ display->request++;
+ grabWinPtr = NULL;
+ restrictWinPtr = NULL;
+ TkpSetCapture(NULL);
+ UpdateCursor(lastWinPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPointerDeadWindow --
+ *
+ * Clean up pointer module state when a window is destroyed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May release the current capture window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkPointerDeadWindow(winPtr)
+ TkWindow *winPtr;
+{
+ if (winPtr == lastWinPtr) {
+ lastWinPtr = NULL;
+ }
+ if (winPtr == grabWinPtr) {
+ grabWinPtr = NULL;
+ }
+ if (winPtr == restrictWinPtr) {
+ restrictWinPtr = NULL;
+ }
+ if (!(restrictWinPtr || grabWinPtr)) {
+ TkpSetCapture(NULL);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateCursor --
+ *
+ * Set the windows global cursor to the cursor associated with
+ * the given Tk window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes the mouse cursor.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateCursor(winPtr)
+ TkWindow *winPtr;
+{
+ Cursor cursor = None;
+
+ /*
+ * A window inherits its cursor from its parent if it doesn't
+ * have one of its own. Top level windows inherit the default
+ * cursor.
+ */
+
+ cursorWinPtr = winPtr;
+ while (winPtr != NULL) {
+ if (winPtr->atts.cursor != None) {
+ cursor = winPtr->atts.cursor;
+ break;
+ } else if (winPtr->flags & TK_TOP_LEVEL) {
+ break;
+ }
+ winPtr = winPtr->parentPtr;
+ }
+ TkpSetCursor((TkpCursor) cursor);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XDefineCursor --
+ *
+ * This function is called to update the cursor on a window.
+ * Since the mouse might be in the specified window, we need to
+ * check the specified window against the current mouse position
+ * and grab state.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May update the cursor.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XDefineCursor(display, w, cursor)
+ Display* display;
+ Window w;
+ Cursor cursor;
+{
+ TkWindow *winPtr = (TkWindow *)Tk_IdToWindow(display, w);
+
+ if (cursorWinPtr == winPtr) {
+ UpdateCursor(winPtr);
+ }
+ display->request++;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGenerateActivateEvents --
+ *
+ * This function is called by the Mac and Windows window manager
+ * routines when a toplevel window is activated or deactivated.
+ * Activate/Deactivate events will be sent to every subwindow of
+ * the toplevel followed by a FocusIn/FocusOut message.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates X events.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkGenerateActivateEvents(winPtr, active)
+ TkWindow *winPtr; /* Toplevel to activate. */
+ int active; /* Non-zero if the window is being
+ * activated, else 0.*/
+{
+ XEvent event;
+
+ /*
+ * Generate Activate and Deactivate events. This event
+ * is sent to every subwindow in a toplevel window.
+ */
+
+ event.xany.serial = winPtr->display->request++;
+ event.xany.send_event = False;
+ event.xany.display = winPtr->display;
+ event.xany.window = winPtr->window;
+
+ event.xany.type = active ? ActivateNotify : DeactivateNotify;
+ TkQueueEventForAllChildren(winPtr, &event);
+
+}
diff --git a/generic/tkPort.h b/generic/tkPort.h
new file mode 100644
index 0000000..7051aa0
--- /dev/null
+++ b/generic/tkPort.h
@@ -0,0 +1,36 @@
+/*
+ * tkPort.h --
+ *
+ * This header file handles porting issues that occur because of
+ * differences between systems. It reads in platform specific
+ * portability files.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkPort.h 1.7 96/02/11 16:42:10
+ */
+
+#ifndef _TKPORT
+#define _TKPORT
+
+#ifndef _TK
+#include "tk.h"
+#endif
+#ifndef _TCL
+#include "tcl.h"
+#endif
+
+#if defined(__WIN32__) || defined(_WIN32)
+# include "tkWinPort.h"
+#else
+# if defined(MAC_TCL)
+# include "tkMacPort.h"
+# else
+# include "../unix/tkUnixPort.h"
+# endif
+#endif
+
+#endif /* _TKPORT */
diff --git a/generic/tkRectOval.c b/generic/tkRectOval.c
new file mode 100644
index 0000000..d1ba71c
--- /dev/null
+++ b/generic/tkRectOval.c
@@ -0,0 +1,1030 @@
+/*
+ * tkRectOval.c --
+ *
+ * This file implements rectangle and oval items for canvas
+ * widgets.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkRectOval.c 1.40 96/05/03 10:52:21
+ */
+
+#include <stdio.h>
+#include "tk.h"
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * The structure below defines the record for each rectangle/oval item.
+ */
+
+typedef struct RectOvalItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ double bbox[4]; /* Coordinates of bounding box for rectangle
+ * or oval (x1, y1, x2, y2). Item includes
+ * x1 and x2 but not y1 and y2. */
+ int width; /* Width of outline. */
+ XColor *outlineColor; /* Color for outline. */
+ XColor *fillColor; /* Color for filling rectangle/oval. */
+ Pixmap fillStipple; /* Stipple bitmap for filling item. */
+ GC outlineGC; /* Graphics context for outline. */
+ GC fillGC; /* Graphics context for filling item. */
+} RectOvalItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(RectOvalItem, fillColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-outline", (char *) NULL, (char *) NULL,
+ "black", Tk_Offset(RectOvalItem, outlineColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(RectOvalItem, fillStipple), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
+ "1", Tk_Offset(RectOvalItem, width), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static void ComputeRectOvalBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ RectOvalItem *rectOvalPtr));
+static int ConfigureRectOval _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv, int flags));
+static int CreateRectOval _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int argc, char **argv));
+static void DeleteRectOval _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayRectOval _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static int OvalToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *areaPtr));
+static double OvalToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *pointPtr));
+static int RectOvalCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv));
+static int RectOvalToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+static int RectToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *areaPtr));
+static double RectToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *pointPtr));
+static void ScaleRectOval _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void TranslateRectOval _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+
+/*
+ * The structures below defines the rectangle and oval item types
+ * by means of procedures that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkRectangleType = {
+ "rectangle", /* name */
+ sizeof(RectOvalItem), /* itemSize */
+ CreateRectOval, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureRectOval, /* configureProc */
+ RectOvalCoords, /* coordProc */
+ DeleteRectOval, /* deleteProc */
+ DisplayRectOval, /* displayProc */
+ 0, /* alwaysRedraw */
+ RectToPoint, /* pointProc */
+ RectToArea, /* areaProc */
+ RectOvalToPostscript, /* postscriptProc */
+ ScaleRectOval, /* scaleProc */
+ TranslateRectOval, /* translateProc */
+ (Tk_ItemIndexProc *) NULL, /* indexProc */
+ (Tk_ItemCursorProc *) NULL, /* icursorProc */
+ (Tk_ItemSelectionProc *) NULL, /* selectionProc */
+ (Tk_ItemInsertProc *) NULL, /* insertProc */
+ (Tk_ItemDCharsProc *) NULL, /* dTextProc */
+ (Tk_ItemType *) NULL /* nextPtr */
+};
+
+Tk_ItemType tkOvalType = {
+ "oval", /* name */
+ sizeof(RectOvalItem), /* itemSize */
+ CreateRectOval, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureRectOval, /* configureProc */
+ RectOvalCoords, /* coordProc */
+ DeleteRectOval, /* deleteProc */
+ DisplayRectOval, /* displayProc */
+ 0, /* alwaysRedraw */
+ OvalToPoint, /* pointProc */
+ OvalToArea, /* areaProc */
+ RectOvalToPostscript, /* postscriptProc */
+ ScaleRectOval, /* scaleProc */
+ TranslateRectOval, /* translateProc */
+ (Tk_ItemIndexProc *) NULL, /* indexProc */
+ (Tk_ItemCursorProc *) NULL, /* cursorProc */
+ (Tk_ItemSelectionProc *) NULL, /* selectionProc */
+ (Tk_ItemInsertProc *) NULL, /* insertProc */
+ (Tk_ItemDCharsProc *) NULL, /* dTextProc */
+ (Tk_ItemType *) NULL /* nextPtr */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateRectOval --
+ *
+ * This procedure is invoked to create a new rectangle
+ * or oval item in a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in
+ * creating the item, then an error message is left in
+ * interp->result; in this case itemPtr is left uninitialized,
+ * so it can be safely freed by the caller.
+ *
+ * Side effects:
+ * A new rectangle or oval item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateRectOval(interp, canvas, itemPtr, argc, argv)
+ Tcl_Interp *interp; /* For error reporting. */
+ Tk_Canvas canvas; /* Canvas to hold new item. */
+ Tk_Item *itemPtr; /* Record to hold new item; header
+ * has been initialized by caller. */
+ int argc; /* Number of arguments in argv. */
+ char **argv; /* Arguments describing rectangle. */
+{
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
+ itemPtr->typePtr->name, " x1 y1 x2 y2 ?options?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Carry out initialization that is needed in order to clean
+ * up after errors during the the remainder of this procedure.
+ */
+
+ rectOvalPtr->width = 1;
+ rectOvalPtr->outlineColor = NULL;
+ rectOvalPtr->fillColor = NULL;
+ rectOvalPtr->fillStipple = None;
+ rectOvalPtr->outlineGC = None;
+ rectOvalPtr->fillGC = None;
+
+ /*
+ * Process the arguments to fill in the item record.
+ */
+
+ if ((Tk_CanvasGetCoord(interp, canvas, argv[0],
+ &rectOvalPtr->bbox[0]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[1],
+ &rectOvalPtr->bbox[1]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[2],
+ &rectOvalPtr->bbox[2]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[3],
+ &rectOvalPtr->bbox[3]) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+
+ if (ConfigureRectOval(interp, canvas, itemPtr, argc-4, argv+4, 0)
+ != TCL_OK) {
+ DeleteRectOval(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * RectOvalCoords --
+ *
+ * This procedure is invoked to process the "coords" widget
+ * command on rectangles and ovals. See the user documentation
+ * for details on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets interp->result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+RectOvalCoords(interp, canvas, itemPtr, argc, argv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item whose coordinates are to be
+ * read or modified. */
+ int argc; /* Number of coordinates supplied in
+ * argv. */
+ char **argv; /* Array of coordinates: x1, y1,
+ * x2, y2, ... */
+{
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+ char c0[TCL_DOUBLE_SPACE], c1[TCL_DOUBLE_SPACE];
+ char c2[TCL_DOUBLE_SPACE], c3[TCL_DOUBLE_SPACE];
+
+ if (argc == 0) {
+ Tcl_PrintDouble(interp, rectOvalPtr->bbox[0], c0);
+ Tcl_PrintDouble(interp, rectOvalPtr->bbox[1], c1);
+ Tcl_PrintDouble(interp, rectOvalPtr->bbox[2], c2);
+ Tcl_PrintDouble(interp, rectOvalPtr->bbox[3], c3);
+ Tcl_AppendResult(interp, c0, " ", c1, " ", c2, " ", c3,
+ (char *) NULL);
+ } else if (argc == 4) {
+ if ((Tk_CanvasGetCoord(interp, canvas, argv[0],
+ &rectOvalPtr->bbox[0]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[1],
+ &rectOvalPtr->bbox[1]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[2],
+ &rectOvalPtr->bbox[2]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[3],
+ &rectOvalPtr->bbox[3]) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComputeRectOvalBbox(canvas, rectOvalPtr);
+ } else {
+ sprintf(interp->result,
+ "wrong # coordinates: expected 0 or 4, got %d",
+ argc);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureRectOval --
+ *
+ * This procedure is invoked to configure various aspects
+ * of a rectangle or oval item, such as its border and
+ * background colors.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then
+ * an error message is left in interp->result.
+ *
+ * Side effects:
+ * Configuration information, such as colors and stipple
+ * patterns, may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureRectOval(interp, canvas, itemPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Rectangle item to reconfigure. */
+ int argc; /* Number of elements in argv. */
+ char **argv; /* Arguments describing things to configure. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+ XGCValues gcValues;
+ GC newGC;
+ unsigned long mask;
+ Tk_Window tkwin;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv,
+ (char *) rectOvalPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as
+ * graphics contexts.
+ */
+
+ if (rectOvalPtr->width < 1) {
+ rectOvalPtr->width = 1;
+ }
+ if (rectOvalPtr->outlineColor == NULL) {
+ newGC = None;
+ } else {
+ gcValues.foreground = rectOvalPtr->outlineColor->pixel;
+ gcValues.cap_style = CapProjecting;
+ gcValues.line_width = rectOvalPtr->width;
+ mask = GCForeground|GCCapStyle|GCLineWidth;
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ }
+ if (rectOvalPtr->outlineGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), rectOvalPtr->outlineGC);
+ }
+ rectOvalPtr->outlineGC = newGC;
+
+ if (rectOvalPtr->fillColor == NULL) {
+ newGC = None;
+ } else {
+ gcValues.foreground = rectOvalPtr->fillColor->pixel;
+ if (rectOvalPtr->fillStipple != None) {
+ gcValues.stipple = rectOvalPtr->fillStipple;
+ gcValues.fill_style = FillStippled;
+ mask = GCForeground|GCStipple|GCFillStyle;
+ } else {
+ mask = GCForeground;
+ }
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ }
+ if (rectOvalPtr->fillGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), rectOvalPtr->fillGC);
+ }
+ rectOvalPtr->fillGC = newGC;
+ ComputeRectOvalBbox(canvas, rectOvalPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteRectOval --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a rectangle or oval item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteRectOval(canvas, itemPtr, display)
+ Tk_Canvas canvas; /* Info about overall widget. */
+ Tk_Item *itemPtr; /* Item that is being deleted. */
+ Display *display; /* Display containing window for
+ * canvas. */
+{
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+
+ if (rectOvalPtr->outlineColor != NULL) {
+ Tk_FreeColor(rectOvalPtr->outlineColor);
+ }
+ if (rectOvalPtr->fillColor != NULL) {
+ Tk_FreeColor(rectOvalPtr->fillColor);
+ }
+ if (rectOvalPtr->fillStipple != None) {
+ Tk_FreeBitmap(display, rectOvalPtr->fillStipple);
+ }
+ if (rectOvalPtr->outlineGC != None) {
+ Tk_FreeGC(display, rectOvalPtr->outlineGC);
+ }
+ if (rectOvalPtr->fillGC != None) {
+ Tk_FreeGC(display, rectOvalPtr->fillGC);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeRectOvalBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of a rectangle
+ * or oval.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ComputeRectOvalBbox(canvas, rectOvalPtr)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ RectOvalItem *rectOvalPtr; /* Item whose bbox is to be
+ * recomputed. */
+{
+ int bloat, tmp;
+ double dtmp;
+
+ /*
+ * Make sure that the first coordinates are the lowest ones.
+ */
+
+ if (rectOvalPtr->bbox[1] > rectOvalPtr->bbox[3]) {
+ double tmp;
+ tmp = rectOvalPtr->bbox[3];
+ rectOvalPtr->bbox[3] = rectOvalPtr->bbox[1];
+ rectOvalPtr->bbox[1] = tmp;
+ }
+ if (rectOvalPtr->bbox[0] > rectOvalPtr->bbox[2]) {
+ double tmp;
+ tmp = rectOvalPtr->bbox[2];
+ rectOvalPtr->bbox[2] = rectOvalPtr->bbox[0];
+ rectOvalPtr->bbox[0] = tmp;
+ }
+
+ if (rectOvalPtr->outlineColor == NULL) {
+ bloat = 0;
+ } else {
+ bloat = (rectOvalPtr->width+1)/2;
+ }
+
+ /*
+ * Special note: the rectangle is always drawn at least 1x1 in
+ * size, so round up the upper coordinates to be at least 1 unit
+ * greater than the lower ones.
+ */
+
+ tmp = (int) ((rectOvalPtr->bbox[0] >= 0) ? rectOvalPtr->bbox[0] + .5
+ : rectOvalPtr->bbox[0] - .5);
+ rectOvalPtr->header.x1 = tmp - bloat;
+ tmp = (int) ((rectOvalPtr->bbox[1] >= 0) ? rectOvalPtr->bbox[1] + .5
+ : rectOvalPtr->bbox[1] - .5);
+ rectOvalPtr->header.y1 = tmp - bloat;
+ dtmp = rectOvalPtr->bbox[2];
+ if (dtmp < (rectOvalPtr->bbox[0] + 1)) {
+ dtmp = rectOvalPtr->bbox[0] + 1;
+ }
+ tmp = (int) ((dtmp >= 0) ? dtmp + .5 : dtmp - .5);
+ rectOvalPtr->header.x2 = tmp + bloat;
+ dtmp = rectOvalPtr->bbox[3];
+ if (dtmp < (rectOvalPtr->bbox[1] + 1)) {
+ dtmp = rectOvalPtr->bbox[1] + 1;
+ }
+ tmp = (int) ((dtmp >= 0) ? dtmp + .5 : dtmp - .5);
+ rectOvalPtr->header.y2 = tmp + bloat;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayRectOval --
+ *
+ * This procedure is invoked to draw a rectangle or oval
+ * item in a given drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * information in canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayRectOval(canvas, itemPtr, display, drawable, x, y, width, height)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ Tk_Item *itemPtr; /* Item to be displayed. */
+ Display *display; /* Display on which to draw item. */
+ Drawable drawable; /* Pixmap or window in which to draw
+ * item. */
+ int x, y, width, height; /* Describes region of canvas that
+ * must be redisplayed (not used). */
+{
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+ short x1, y1, x2, y2;
+
+ /*
+ * Compute the screen coordinates of the bounding box for the item.
+ * Make sure that the bbox is at least one pixel large, since some
+ * X servers will die if it isn't.
+ */
+
+ Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[0], rectOvalPtr->bbox[1],
+ &x1, &y1);
+ Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[2], rectOvalPtr->bbox[3],
+ &x2, &y2);
+ if (x2 <= x1) {
+ x2 = x1+1;
+ }
+ if (y2 <= y1) {
+ y2 = y1+1;
+ }
+
+ /*
+ * Display filled part first (if wanted), then outline. If we're
+ * stippling, then modify the stipple offset in the GC. Be sure to
+ * reset the offset when done, since the GC is supposed to be
+ * read-only.
+ */
+
+ if (rectOvalPtr->fillGC != None) {
+ if (rectOvalPtr->fillStipple != None) {
+ Tk_CanvasSetStippleOrigin(canvas, rectOvalPtr->fillGC);
+ }
+ if (rectOvalPtr->header.typePtr == &tkRectangleType) {
+ XFillRectangle(display, drawable, rectOvalPtr->fillGC,
+ x1, y1, (unsigned int) (x2-x1), (unsigned int) (y2-y1));
+ } else {
+ XFillArc(display, drawable, rectOvalPtr->fillGC,
+ x1, y1, (unsigned) (x2-x1), (unsigned) (y2-y1),
+ 0, 360*64);
+ }
+ if (rectOvalPtr->fillStipple != None) {
+ XSetTSOrigin(display, rectOvalPtr->fillGC, 0, 0);
+ }
+ }
+ if (rectOvalPtr->outlineGC != None) {
+ if (rectOvalPtr->header.typePtr == &tkRectangleType) {
+ XDrawRectangle(display, drawable, rectOvalPtr->outlineGC,
+ x1, y1, (unsigned) (x2-x1), (unsigned) (y2-y1));
+ } else {
+ XDrawArc(display, drawable, rectOvalPtr->outlineGC,
+ x1, y1, (unsigned) (x2-x1), (unsigned) (y2-y1), 0, 360*64);
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * RectToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * rectangle, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are coordPtr[0] and coordPtr[1] is inside the rectangle. If the
+ * point isn't inside the rectangle then the return value is the
+ * distance from the point to the rectangle. If itemPtr is filled,
+ * then anywhere in the interior is considered "inside"; if
+ * itemPtr isn't filled, then "inside" means only the area
+ * occupied by the outline.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static double
+RectToPoint(canvas, itemPtr, pointPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *pointPtr; /* Pointer to x and y coordinates. */
+{
+ RectOvalItem *rectPtr = (RectOvalItem *) itemPtr;
+ double xDiff, yDiff, x1, y1, x2, y2, inc, tmp;
+
+ /*
+ * Generate a new larger rectangle that includes the border
+ * width, if there is one.
+ */
+
+ x1 = rectPtr->bbox[0];
+ y1 = rectPtr->bbox[1];
+ x2 = rectPtr->bbox[2];
+ y2 = rectPtr->bbox[3];
+ if (rectPtr->outlineGC != None) {
+ inc = rectPtr->width/2.0;
+ x1 -= inc;
+ y1 -= inc;
+ x2 += inc;
+ y2 += inc;
+ }
+
+ /*
+ * If the point is inside the rectangle, handle specially:
+ * distance is 0 if rectangle is filled, otherwise compute
+ * distance to nearest edge of rectangle and subtract width
+ * of edge.
+ */
+
+ if ((pointPtr[0] >= x1) && (pointPtr[0] < x2)
+ && (pointPtr[1] >= y1) && (pointPtr[1] < y2)) {
+ if ((rectPtr->fillGC != None) || (rectPtr->outlineGC == None)) {
+ return 0.0;
+ }
+ xDiff = pointPtr[0] - x1;
+ tmp = x2 - pointPtr[0];
+ if (tmp < xDiff) {
+ xDiff = tmp;
+ }
+ yDiff = pointPtr[1] - y1;
+ tmp = y2 - pointPtr[1];
+ if (tmp < yDiff) {
+ yDiff = tmp;
+ }
+ if (yDiff < xDiff) {
+ xDiff = yDiff;
+ }
+ xDiff -= rectPtr->width;
+ if (xDiff < 0.0) {
+ return 0.0;
+ }
+ return xDiff;
+ }
+
+ /*
+ * Point is outside rectangle.
+ */
+
+ if (pointPtr[0] < x1) {
+ xDiff = x1 - pointPtr[0];
+ } else if (pointPtr[0] > x2) {
+ xDiff = pointPtr[0] - x2;
+ } else {
+ xDiff = 0;
+ }
+
+ if (pointPtr[1] < y1) {
+ yDiff = y1 - pointPtr[1];
+ } else if (pointPtr[1] > y2) {
+ yDiff = pointPtr[1] - y2;
+ } else {
+ yDiff = 0;
+ }
+
+ return hypot(xDiff, yDiff);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * OvalToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * oval, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are coordPtr[0] and coordPtr[1] is inside the oval. If the
+ * point isn't inside the oval then the return value is the
+ * distance from the point to the oval. If itemPtr is filled,
+ * then anywhere in the interior is considered "inside"; if
+ * itemPtr isn't filled, then "inside" means only the area
+ * occupied by the outline.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static double
+OvalToPoint(canvas, itemPtr, pointPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *pointPtr; /* Pointer to x and y coordinates. */
+{
+ RectOvalItem *ovalPtr = (RectOvalItem *) itemPtr;
+ double width;
+ int filled;
+
+ width = ovalPtr->width;
+ filled = ovalPtr->fillGC != None;
+ if (ovalPtr->outlineGC == None) {
+ width = 0.0;
+ filled = 1;
+ }
+ return TkOvalToPoint(ovalPtr->bbox, width, filled, pointPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * RectToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given rectangle.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area
+ * given by rectPtr, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+RectToArea(canvas, itemPtr, areaPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against rectangle. */
+ double *areaPtr; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) describing rectangular
+ * area. */
+{
+ RectOvalItem *rectPtr = (RectOvalItem *) itemPtr;
+ double halfWidth;
+
+ halfWidth = rectPtr->width/2.0;
+ if (rectPtr->outlineGC == None) {
+ halfWidth = 0.0;
+ }
+
+ if ((areaPtr[2] <= (rectPtr->bbox[0] - halfWidth))
+ || (areaPtr[0] >= (rectPtr->bbox[2] + halfWidth))
+ || (areaPtr[3] <= (rectPtr->bbox[1] - halfWidth))
+ || (areaPtr[1] >= (rectPtr->bbox[3] + halfWidth))) {
+ return -1;
+ }
+ if ((rectPtr->fillGC == None) && (rectPtr->outlineGC != None)
+ && (areaPtr[0] >= (rectPtr->bbox[0] + halfWidth))
+ && (areaPtr[1] >= (rectPtr->bbox[1] + halfWidth))
+ && (areaPtr[2] <= (rectPtr->bbox[2] - halfWidth))
+ && (areaPtr[3] <= (rectPtr->bbox[3] - halfWidth))) {
+ return -1;
+ }
+ if ((areaPtr[0] <= (rectPtr->bbox[0] - halfWidth))
+ && (areaPtr[1] <= (rectPtr->bbox[1] - halfWidth))
+ && (areaPtr[2] >= (rectPtr->bbox[2] + halfWidth))
+ && (areaPtr[3] >= (rectPtr->bbox[3] + halfWidth))) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * OvalToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area
+ * given by rectPtr, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+OvalToArea(canvas, itemPtr, areaPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against oval. */
+ double *areaPtr; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) describing rectangular
+ * area. */
+{
+ RectOvalItem *ovalPtr = (RectOvalItem *) itemPtr;
+ double oval[4], halfWidth;
+ int result;
+
+ /*
+ * Expand the oval to include the width of the outline, if any.
+ */
+
+ halfWidth = ovalPtr->width/2.0;
+ if (ovalPtr->outlineGC == None) {
+ halfWidth = 0.0;
+ }
+ oval[0] = ovalPtr->bbox[0] - halfWidth;
+ oval[1] = ovalPtr->bbox[1] - halfWidth;
+ oval[2] = ovalPtr->bbox[2] + halfWidth;
+ oval[3] = ovalPtr->bbox[3] + halfWidth;
+
+ result = TkOvalToArea(oval, areaPtr);
+
+ /*
+ * If the rectangle appears to overlap the oval and the oval
+ * isn't filled, do one more check to see if perhaps all four
+ * of the rectangle's corners are totally inside the oval's
+ * unfilled center, in which case we should return "outside".
+ */
+
+ if ((result == 0) && (ovalPtr->outlineGC != None)
+ && (ovalPtr->fillGC == None)) {
+ double centerX, centerY, width, height;
+ double xDelta1, yDelta1, xDelta2, yDelta2;
+
+ centerX = (ovalPtr->bbox[0] + ovalPtr->bbox[2])/2.0;
+ centerY = (ovalPtr->bbox[1] + ovalPtr->bbox[3])/2.0;
+ width = (ovalPtr->bbox[2] - ovalPtr->bbox[0])/2.0 - halfWidth;
+ height = (ovalPtr->bbox[3] - ovalPtr->bbox[1])/2.0 - halfWidth;
+ xDelta1 = (areaPtr[0] - centerX)/width;
+ xDelta1 *= xDelta1;
+ yDelta1 = (areaPtr[1] - centerY)/height;
+ yDelta1 *= yDelta1;
+ xDelta2 = (areaPtr[2] - centerX)/width;
+ xDelta2 *= xDelta2;
+ yDelta2 = (areaPtr[3] - centerY)/height;
+ yDelta2 *= yDelta2;
+ if (((xDelta1 + yDelta1) < 1.0)
+ && ((xDelta1 + yDelta2) < 1.0)
+ && ((xDelta2 + yDelta1) < 1.0)
+ && ((xDelta2 + yDelta2) < 1.0)) {
+ return -1;
+ }
+ }
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleRectOval --
+ *
+ * This procedure is invoked to rescale a rectangle or oval
+ * item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The rectangle or oval referred to by itemPtr is rescaled
+ * so that the following transformation is applied to all
+ * point coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleRectOval(canvas, itemPtr, originX, originY, scaleX, scaleY)
+ Tk_Canvas canvas; /* Canvas containing rectangle. */
+ Tk_Item *itemPtr; /* Rectangle to be scaled. */
+ double originX, originY; /* Origin about which to scale rect. */
+ double scaleX; /* Amount to scale in X direction. */
+ double scaleY; /* Amount to scale in Y direction. */
+{
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+
+ rectOvalPtr->bbox[0] = originX + scaleX*(rectOvalPtr->bbox[0] - originX);
+ rectOvalPtr->bbox[1] = originY + scaleY*(rectOvalPtr->bbox[1] - originY);
+ rectOvalPtr->bbox[2] = originX + scaleX*(rectOvalPtr->bbox[2] - originX);
+ rectOvalPtr->bbox[3] = originY + scaleY*(rectOvalPtr->bbox[3] - originY);
+ ComputeRectOvalBbox(canvas, rectOvalPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateRectOval --
+ *
+ * This procedure is called to move a rectangle or oval by a
+ * given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the rectangle or oval is offset by
+ * (xDelta, yDelta), and the bounding box is updated in the
+ * generic part of the item structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateRectOval(canvas, itemPtr, deltaX, deltaY)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item that is being moved. */
+ double deltaX, deltaY; /* Amount by which item is to be
+ * moved. */
+{
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+
+ rectOvalPtr->bbox[0] += deltaX;
+ rectOvalPtr->bbox[1] += deltaY;
+ rectOvalPtr->bbox[2] += deltaX;
+ rectOvalPtr->bbox[3] += deltaY;
+ ComputeRectOvalBbox(canvas, rectOvalPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * RectOvalToPostscript --
+ *
+ * This procedure is called to generate Postscript for
+ * rectangle and oval items.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error
+ * occurs in generating Postscript then an error message is
+ * left in interp->result, replacing whatever used to be there.
+ * If no error occurs, then Postscript for the rectangle is
+ * appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+RectOvalToPostscript(interp, canvas, itemPtr, prepass)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ Tk_Item *itemPtr; /* Item for which Postscript is
+ * wanted. */
+ int prepass; /* 1 means this is a prepass to
+ * collect font information; 0 means
+ * final Postscript is being created. */
+{
+ char pathCmd[500], string[100];
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+ double y1, y2;
+
+ y1 = Tk_CanvasPsY(canvas, rectOvalPtr->bbox[1]);
+ y2 = Tk_CanvasPsY(canvas, rectOvalPtr->bbox[3]);
+
+ /*
+ * Generate a string that creates a path for the rectangle or oval.
+ * This is the only part of the procedure's code that is type-
+ * specific.
+ */
+
+
+ if (rectOvalPtr->header.typePtr == &tkRectangleType) {
+ sprintf(pathCmd, "%.15g %.15g moveto %.15g 0 rlineto 0 %.15g rlineto %.15g 0 rlineto closepath\n",
+ rectOvalPtr->bbox[0], y1,
+ rectOvalPtr->bbox[2]-rectOvalPtr->bbox[0], y2-y1,
+ rectOvalPtr->bbox[0]-rectOvalPtr->bbox[2]);
+ } else {
+ sprintf(pathCmd, "matrix currentmatrix\n%.15g %.15g translate %.15g %.15g scale 1 0 moveto 0 0 1 0 360 arc\nsetmatrix\n",
+ (rectOvalPtr->bbox[0] + rectOvalPtr->bbox[2])/2, (y1 + y2)/2,
+ (rectOvalPtr->bbox[2] - rectOvalPtr->bbox[0])/2, (y1 - y2)/2);
+ }
+
+ /*
+ * First draw the filled area of the rectangle.
+ */
+
+ if (rectOvalPtr->fillColor != NULL) {
+ Tcl_AppendResult(interp, pathCmd, (char *) NULL);
+ if (Tk_CanvasPsColor(interp, canvas, rectOvalPtr->fillColor)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (rectOvalPtr->fillStipple != None) {
+ Tcl_AppendResult(interp, "clip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas, rectOvalPtr->fillStipple)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (rectOvalPtr->outlineColor != NULL) {
+ Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
+ }
+ } else {
+ Tcl_AppendResult(interp, "fill\n", (char *) NULL);
+ }
+ }
+
+ /*
+ * Now draw the outline, if there is one.
+ */
+
+ if (rectOvalPtr->outlineColor != NULL) {
+ Tcl_AppendResult(interp, pathCmd, (char *) NULL);
+ sprintf(string, "%d setlinewidth", rectOvalPtr->width);
+ Tcl_AppendResult(interp, string,
+ " 0 setlinejoin 2 setlinecap\n", (char *) NULL);
+ if (Tk_CanvasPsColor(interp, canvas, rectOvalPtr->outlineColor)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_AppendResult(interp, "stroke\n", (char *) NULL);
+ }
+ return TCL_OK;
+}
diff --git a/generic/tkScale.c b/generic/tkScale.c
new file mode 100644
index 0000000..6c78150
--- /dev/null
+++ b/generic/tkScale.c
@@ -0,0 +1,1143 @@
+/*
+ * tkScale.c --
+ *
+ * This module implements a scale widgets for the Tk toolkit.
+ * A scale displays a slider that can be adjusted to change a
+ * value; it also displays numeric labels and a textual label,
+ * if desired.
+ *
+ * The modifications to use floating-point values are based on
+ * an implementation by Paul Mackerras. The -variable option
+ * is due to Henning Schulzrinne. All of these are used with
+ * permission.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkScale.c 1.88 97/07/31 09:11:57
+ */
+
+#include "tkPort.h"
+#include "default.h"
+#include "tkInt.h"
+#include "tclMath.h"
+#include "tkScale.h"
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_SCALE_ACTIVE_BG_COLOR, Tk_Offset(TkScale, activeBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_SCALE_ACTIVE_BG_MONO, Tk_Offset(TkScale, activeBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_SCALE_BG_COLOR, Tk_Offset(TkScale, bgBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_SCALE_BG_MONO, Tk_Offset(TkScale, bgBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_DOUBLE, "-bigincrement", "bigIncrement", "BigIncrement",
+ DEF_SCALE_BIG_INCREMENT, Tk_Offset(TkScale, bigIncrement), 0},
+ {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_SCALE_BORDER_WIDTH, Tk_Offset(TkScale, borderWidth), 0},
+ {TK_CONFIG_STRING, "-command", "command", "Command",
+ DEF_SCALE_COMMAND, Tk_Offset(TkScale, command), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_SCALE_CURSOR, Tk_Offset(TkScale, cursor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_INT, "-digits", "digits", "Digits",
+ DEF_SCALE_DIGITS, Tk_Offset(TkScale, digits), 0},
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_FONT, "-font", "font", "Font",
+ DEF_SCALE_FONT, Tk_Offset(TkScale, tkfont),
+ 0},
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_SCALE_FG_COLOR, Tk_Offset(TkScale, textColorPtr),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_SCALE_FG_MONO, Tk_Offset(TkScale, textColorPtr),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_DOUBLE, "-from", "from", "From",
+ DEF_SCALE_FROM, Tk_Offset(TkScale, fromValue), 0},
+ {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_SCALE_HIGHLIGHT_BG,
+ Tk_Offset(TkScale, highlightBgColorPtr), 0},
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_SCALE_HIGHLIGHT, Tk_Offset(TkScale, highlightColorPtr), 0},
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_SCALE_HIGHLIGHT_WIDTH, Tk_Offset(TkScale, highlightWidth), 0},
+ {TK_CONFIG_STRING, "-label", "label", "Label",
+ DEF_SCALE_LABEL, Tk_Offset(TkScale, label), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-length", "length", "Length",
+ DEF_SCALE_LENGTH, Tk_Offset(TkScale, length), 0},
+ {TK_CONFIG_UID, "-orient", "orient", "Orient",
+ DEF_SCALE_ORIENT, Tk_Offset(TkScale, orientUid), 0},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_SCALE_RELIEF, Tk_Offset(TkScale, relief), 0},
+ {TK_CONFIG_INT, "-repeatdelay", "repeatDelay", "RepeatDelay",
+ DEF_SCALE_REPEAT_DELAY, Tk_Offset(TkScale, repeatDelay), 0},
+ {TK_CONFIG_INT, "-repeatinterval", "repeatInterval", "RepeatInterval",
+ DEF_SCALE_REPEAT_INTERVAL, Tk_Offset(TkScale, repeatInterval), 0},
+ {TK_CONFIG_DOUBLE, "-resolution", "resolution", "Resolution",
+ DEF_SCALE_RESOLUTION, Tk_Offset(TkScale, resolution), 0},
+ {TK_CONFIG_BOOLEAN, "-showvalue", "showValue", "ShowValue",
+ DEF_SCALE_SHOW_VALUE, Tk_Offset(TkScale, showValue), 0},
+ {TK_CONFIG_PIXELS, "-sliderlength", "sliderLength", "SliderLength",
+ DEF_SCALE_SLIDER_LENGTH, Tk_Offset(TkScale, sliderLength), 0},
+ {TK_CONFIG_RELIEF, "-sliderrelief", "sliderRelief", "SliderRelief",
+ DEF_SCALE_SLIDER_RELIEF, Tk_Offset(TkScale, sliderRelief),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_UID, "-state", "state", "State",
+ DEF_SCALE_STATE, Tk_Offset(TkScale, state), 0},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_SCALE_TAKE_FOCUS, Tk_Offset(TkScale, takeFocus),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_DOUBLE, "-tickinterval", "tickInterval", "TickInterval",
+ DEF_SCALE_TICK_INTERVAL, Tk_Offset(TkScale, tickInterval), 0},
+ {TK_CONFIG_DOUBLE, "-to", "to", "To",
+ DEF_SCALE_TO, Tk_Offset(TkScale, toValue), 0},
+ {TK_CONFIG_COLOR, "-troughcolor", "troughColor", "Background",
+ DEF_SCALE_TROUGH_COLOR, Tk_Offset(TkScale, troughColorPtr),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR, "-troughcolor", "troughColor", "Background",
+ DEF_SCALE_TROUGH_MONO, Tk_Offset(TkScale, troughColorPtr),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_STRING, "-variable", "variable", "Variable",
+ DEF_SCALE_VARIABLE, Tk_Offset(TkScale, varName), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-width", "width", "Width",
+ DEF_SCALE_WIDTH, Tk_Offset(TkScale, width), 0},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void ComputeFormat _ANSI_ARGS_((TkScale *scalePtr));
+static void ComputeScaleGeometry _ANSI_ARGS_((TkScale *scalePtr));
+static int ConfigureScale _ANSI_ARGS_((Tcl_Interp *interp,
+ TkScale *scalePtr, int argc, char **argv,
+ int flags));
+static void DestroyScale _ANSI_ARGS_((char *memPtr));
+static void ScaleCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void ScaleEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static char * ScaleVarProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, char *name1, char *name2,
+ int flags));
+static int ScaleWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void ScaleWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+
+/*
+ * The structure below defines scale class behavior by means of procedures
+ * that can be invoked from generic window code.
+ */
+
+static TkClassProcs scaleClass = {
+ NULL, /* createProc. */
+ ScaleWorldChanged, /* geometryProc. */
+ NULL /* modalProc. */
+};
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ScaleCmd --
+ *
+ * This procedure is invoked to process the "scale" Tcl
+ * command. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_ScaleCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ register TkScale *scalePtr;
+ Tk_Window new;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " pathName ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+ scalePtr = TkpCreateScale(new);
+
+ /*
+ * Initialize fields that won't be initialized by ConfigureScale,
+ * or which ConfigureScale expects to have reasonable values
+ * (e.g. resource pointers).
+ */
+
+ scalePtr->tkwin = new;
+ scalePtr->display = Tk_Display(new);
+ scalePtr->interp = interp;
+ scalePtr->widgetCmd = Tcl_CreateCommand(interp,
+ Tk_PathName(scalePtr->tkwin), ScaleWidgetCmd,
+ (ClientData) scalePtr, ScaleCmdDeletedProc);
+ scalePtr->orientUid = NULL;
+ scalePtr->vertical = 0;
+ scalePtr->width = 0;
+ scalePtr->length = 0;
+ scalePtr->value = 0;
+ scalePtr->varName = NULL;
+ scalePtr->fromValue = 0;
+ scalePtr->toValue = 0;
+ scalePtr->tickInterval = 0;
+ scalePtr->resolution = 1;
+ scalePtr->bigIncrement = 0.0;
+ scalePtr->command = NULL;
+ scalePtr->repeatDelay = 0;
+ scalePtr->repeatInterval = 0;
+ scalePtr->label = NULL;
+ scalePtr->labelLength = 0;
+ scalePtr->state = tkNormalUid;
+ scalePtr->borderWidth = 0;
+ scalePtr->bgBorder = NULL;
+ scalePtr->activeBorder = NULL;
+ scalePtr->sliderRelief = TK_RELIEF_RAISED;
+ scalePtr->troughColorPtr = NULL;
+ scalePtr->troughGC = None;
+ scalePtr->copyGC = None;
+ scalePtr->tkfont = NULL;
+ scalePtr->textColorPtr = NULL;
+ scalePtr->textGC = None;
+ scalePtr->relief = TK_RELIEF_FLAT;
+ scalePtr->highlightWidth = 0;
+ scalePtr->highlightBgColorPtr = NULL;
+ scalePtr->highlightColorPtr = NULL;
+ scalePtr->inset = 0;
+ scalePtr->sliderLength = 0;
+ scalePtr->showValue = 0;
+ scalePtr->horizLabelY = 0;
+ scalePtr->horizValueY = 0;
+ scalePtr->horizTroughY = 0;
+ scalePtr->horizTickY = 0;
+ scalePtr->vertTickRightX = 0;
+ scalePtr->vertValueRightX = 0;
+ scalePtr->vertTroughX = 0;
+ scalePtr->vertLabelX = 0;
+ scalePtr->cursor = None;
+ scalePtr->takeFocus = NULL;
+ scalePtr->flags = NEVER_SET;
+
+ Tk_SetClass(scalePtr->tkwin, "Scale");
+ TkSetClassProcs(scalePtr->tkwin, &scaleClass, (ClientData) scalePtr);
+ Tk_CreateEventHandler(scalePtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ ScaleEventProc, (ClientData) scalePtr);
+ if (ConfigureScale(interp, scalePtr, argc-2, argv+2, 0) != TCL_OK) {
+ goto error;
+ }
+
+ interp->result = Tk_PathName(scalePtr->tkwin);
+ return TCL_OK;
+
+ error:
+ Tk_DestroyWindow(scalePtr->tkwin);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleWidgetCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to a widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ScaleWidgetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about scale
+ * widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ register TkScale *scalePtr = (TkScale *) clientData;
+ int result = TCL_OK;
+ size_t length;
+ int c;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_Preserve((ClientData) scalePtr);
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
+ && (length >= 2)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " cget option\"",
+ (char *) NULL);
+ goto error;
+ }
+ result = Tk_ConfigureValue(interp, scalePtr->tkwin, configSpecs,
+ (char *) scalePtr, argv[2], 0);
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
+ && (length >= 3)) {
+ if (argc == 2) {
+ result = Tk_ConfigureInfo(interp, scalePtr->tkwin, configSpecs,
+ (char *) scalePtr, (char *) NULL, 0);
+ } else if (argc == 3) {
+ result = Tk_ConfigureInfo(interp, scalePtr->tkwin, configSpecs,
+ (char *) scalePtr, argv[2], 0);
+ } else {
+ result = ConfigureScale(interp, scalePtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ } else if ((c == 'c') && (strncmp(argv[1], "coords", length) == 0)
+ && (length >= 3)) {
+ int x, y ;
+ double value;
+
+ if ((argc != 2) && (argc != 3)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " coords ?value?\"", (char *) NULL);
+ goto error;
+ }
+ if (argc == 3) {
+ if (Tcl_GetDouble(interp, argv[2], &value) != TCL_OK) {
+ goto error;
+ }
+ } else {
+ value = scalePtr->value;
+ }
+ if (scalePtr->vertical) {
+ x = scalePtr->vertTroughX + scalePtr->width/2
+ + scalePtr->borderWidth;
+ y = TkpValueToPixel(scalePtr, value);
+ } else {
+ x = TkpValueToPixel(scalePtr, value);
+ y = scalePtr->horizTroughY + scalePtr->width/2
+ + scalePtr->borderWidth;
+ }
+ sprintf(interp->result, "%d %d", x, y);
+ } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
+ double value;
+ int x, y;
+
+ if ((argc != 2) && (argc != 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " get ?x y?\"", (char *) NULL);
+ goto error;
+ }
+ if (argc == 2) {
+ value = scalePtr->value;
+ } else {
+ if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
+ goto error;
+ }
+ value = TkpPixelToValue(scalePtr, x, y);
+ }
+ sprintf(interp->result, scalePtr->format, value);
+ } else if ((c == 'i') && (strncmp(argv[1], "identify", length) == 0)) {
+ int x, y, thing;
+
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " identify x y\"", (char *) NULL);
+ goto error;
+ }
+ if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
+ goto error;
+ }
+ thing = TkpScaleElement(scalePtr, x,y);
+ switch (thing) {
+ case TROUGH1: interp->result = "trough1"; break;
+ case SLIDER: interp->result = "slider"; break;
+ case TROUGH2: interp->result = "trough2"; break;
+ }
+ } else if ((c == 's') && (strncmp(argv[1], "set", length) == 0)) {
+ double value;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " set value\"", (char *) NULL);
+ goto error;
+ }
+ if (Tcl_GetDouble(interp, argv[2], &value) != TCL_OK) {
+ goto error;
+ }
+ if (scalePtr->state != tkDisabledUid) {
+ TkpSetScaleValue(scalePtr, value, 1, 1);
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be cget, configure, coords, get, identify, or set",
+ (char *) NULL);
+ goto error;
+ }
+ Tcl_Release((ClientData) scalePtr);
+ return result;
+
+ error:
+ Tcl_Release((ClientData) scalePtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyScale --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a button at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the scale is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyScale(memPtr)
+ char *memPtr; /* Info about scale widget. */
+{
+ register TkScale *scalePtr = (TkScale *) memPtr;
+
+ /*
+ * Free up all the stuff that requires special handling, then
+ * let Tk_FreeOptions handle all the standard option-related
+ * stuff.
+ */
+
+ if (scalePtr->varName != NULL) {
+ Tcl_UntraceVar(scalePtr->interp, scalePtr->varName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ScaleVarProc, (ClientData) scalePtr);
+ }
+ if (scalePtr->troughGC != None) {
+ Tk_FreeGC(scalePtr->display, scalePtr->troughGC);
+ }
+ if (scalePtr->copyGC != None) {
+ Tk_FreeGC(scalePtr->display, scalePtr->copyGC);
+ }
+ if (scalePtr->textGC != None) {
+ Tk_FreeGC(scalePtr->display, scalePtr->textGC);
+ }
+ Tk_FreeOptions(configSpecs, (char *) scalePtr, scalePtr->display, 0);
+ TkpDestroyScale(scalePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureScale --
+ *
+ * This procedure is called to process an argv/argc list, plus
+ * the Tk option database, in order to configure (or
+ * reconfigure) a scale widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then interp->result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width,
+ * etc. get set for scalePtr; old resources get freed,
+ * if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureScale(interp, scalePtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register TkScale *scalePtr; /* Information about widget; may or may
+ * not already have values for some fields. */
+ int argc; /* Number of valid entries in argv. */
+ char **argv; /* Arguments. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ size_t length;
+
+ /*
+ * Eliminate any existing trace on a variable monitored by the scale.
+ */
+
+ if (scalePtr->varName != NULL) {
+ Tcl_UntraceVar(interp, scalePtr->varName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ScaleVarProc, (ClientData) scalePtr);
+ }
+
+ if (Tk_ConfigureWidget(interp, scalePtr->tkwin, configSpecs,
+ argc, argv, (char *) scalePtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the scale is tied to the value of a variable, then set up
+ * a trace on the variable's value and set the scale's value from
+ * the value of the variable, if it exists.
+ */
+
+ if (scalePtr->varName != NULL) {
+ char *stringValue, *end;
+ double value;
+
+ stringValue = Tcl_GetVar(interp, scalePtr->varName, TCL_GLOBAL_ONLY);
+ if (stringValue != NULL) {
+ value = strtod(stringValue, &end);
+ if ((end != stringValue) && (*end == 0)) {
+ scalePtr->value = TkRoundToResolution(scalePtr, value);
+ }
+ }
+ Tcl_TraceVar(interp, scalePtr->varName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ScaleVarProc, (ClientData) scalePtr);
+ }
+
+ /*
+ * Several options need special processing, such as parsing the
+ * orientation and creating GCs.
+ */
+
+ length = strlen(scalePtr->orientUid);
+ if (strncmp(scalePtr->orientUid, "vertical", length) == 0) {
+ scalePtr->vertical = 1;
+ } else if (strncmp(scalePtr->orientUid, "horizontal", length) == 0) {
+ scalePtr->vertical = 0;
+ } else {
+ Tcl_AppendResult(interp, "bad orientation \"", scalePtr->orientUid,
+ "\": must be vertical or horizontal", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ scalePtr->fromValue = TkRoundToResolution(scalePtr, scalePtr->fromValue);
+ scalePtr->toValue = TkRoundToResolution(scalePtr, scalePtr->toValue);
+ scalePtr->tickInterval = TkRoundToResolution(scalePtr,
+ scalePtr->tickInterval);
+
+ /*
+ * Make sure that the tick interval has the right sign so that
+ * addition moves from fromValue to toValue.
+ */
+
+ if ((scalePtr->tickInterval < 0)
+ ^ ((scalePtr->toValue - scalePtr->fromValue) < 0)) {
+ scalePtr->tickInterval = -scalePtr->tickInterval;
+ }
+
+ /*
+ * Set the scale value to itself; all this does is to make sure
+ * that the scale's value is within the new acceptable range for
+ * the scale and reflect the value in the associated variable,
+ * if any.
+ */
+
+ ComputeFormat(scalePtr);
+ TkpSetScaleValue(scalePtr, scalePtr->value, 1, 1);
+
+ if (scalePtr->label != NULL) {
+ scalePtr->labelLength = strlen(scalePtr->label);
+ } else {
+ scalePtr->labelLength = 0;
+ }
+
+ if ((scalePtr->state != tkNormalUid)
+ && (scalePtr->state != tkDisabledUid)
+ && (scalePtr->state != tkActiveUid)) {
+ Tcl_AppendResult(interp, "bad state value \"", scalePtr->state,
+ "\": must be normal, active, or disabled", (char *) NULL);
+ scalePtr->state = tkNormalUid;
+ return TCL_ERROR;
+ }
+
+ Tk_SetBackgroundFromBorder(scalePtr->tkwin, scalePtr->bgBorder);
+
+ if (scalePtr->highlightWidth < 0) {
+ scalePtr->highlightWidth = 0;
+ }
+ scalePtr->inset = scalePtr->highlightWidth + scalePtr->borderWidth;
+
+ ScaleWorldChanged((ClientData) scalePtr);
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ScaleWorldChanged --
+ *
+ * This procedure is called when the world has changed in some
+ * way and the widget needs to recompute all its graphics contexts
+ * and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Scale will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+ScaleWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ XGCValues gcValues;
+ GC gc;
+ TkScale *scalePtr;
+
+ scalePtr = (TkScale *) instanceData;
+
+ gcValues.foreground = scalePtr->troughColorPtr->pixel;
+ gc = Tk_GetGC(scalePtr->tkwin, GCForeground, &gcValues);
+ if (scalePtr->troughGC != None) {
+ Tk_FreeGC(scalePtr->display, scalePtr->troughGC);
+ }
+ scalePtr->troughGC = gc;
+
+ gcValues.font = Tk_FontId(scalePtr->tkfont);
+ gcValues.foreground = scalePtr->textColorPtr->pixel;
+ gc = Tk_GetGC(scalePtr->tkwin, GCForeground | GCFont, &gcValues);
+ if (scalePtr->textGC != None) {
+ Tk_FreeGC(scalePtr->display, scalePtr->textGC);
+ }
+ scalePtr->textGC = gc;
+
+ if (scalePtr->copyGC == None) {
+ gcValues.graphics_exposures = False;
+ scalePtr->copyGC = Tk_GetGC(scalePtr->tkwin, GCGraphicsExposures,
+ &gcValues);
+ }
+ scalePtr->inset = scalePtr->highlightWidth + scalePtr->borderWidth;
+
+ /*
+ * Recompute display-related information, and let the geometry
+ * manager know how much space is needed now.
+ */
+
+ ComputeScaleGeometry(scalePtr);
+
+ TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComputeFormat --
+ *
+ * This procedure is invoked to recompute the "format" field
+ * of a scale's widget record, which determines how the value
+ * of the scale is converted to a string.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The format field of scalePtr is modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ComputeFormat(scalePtr)
+ TkScale *scalePtr; /* Information about scale widget. */
+{
+ double maxValue, x;
+ int mostSigDigit, numDigits, leastSigDigit, afterDecimal;
+ int eDigits, fDigits;
+
+ /*
+ * Compute the displacement from the decimal of the most significant
+ * digit required for any number in the scale's range.
+ */
+
+ maxValue = fabs(scalePtr->fromValue);
+ x = fabs(scalePtr->toValue);
+ if (x > maxValue) {
+ maxValue = x;
+ }
+ if (maxValue == 0) {
+ maxValue = 1;
+ }
+ mostSigDigit = (int) floor(log10(maxValue));
+
+ /*
+ * If the number of significant digits wasn't specified explicitly,
+ * compute it. It's the difference between the most significant
+ * digit needed to represent any number on the scale and the
+ * most significant digit of the smallest difference between
+ * numbers on the scale. In other words, display enough digits so
+ * that at least one digit will be different between any two adjacent
+ * positions of the scale.
+ */
+
+ numDigits = scalePtr->digits;
+ if (numDigits <= 0) {
+ if (scalePtr->resolution > 0) {
+ /*
+ * A resolution was specified for the scale, so just use it.
+ */
+
+ leastSigDigit = (int) floor(log10(scalePtr->resolution));
+ } else {
+ /*
+ * No resolution was specified, so compute the difference
+ * in value between adjacent pixels and use it for the least
+ * significant digit.
+ */
+
+ x = fabs(scalePtr->fromValue - scalePtr->toValue);
+ if (scalePtr->length > 0) {
+ x /= scalePtr->length;
+ }
+ if (x > 0){
+ leastSigDigit = (int) floor(log10(x));
+ } else {
+ leastSigDigit = 0;
+ }
+ }
+ numDigits = mostSigDigit - leastSigDigit + 1;
+ if (numDigits < 1) {
+ numDigits = 1;
+ }
+ }
+
+ /*
+ * Compute the number of characters required using "e" format and
+ * "f" format, and then choose whichever one takes fewer characters.
+ */
+
+ eDigits = numDigits + 4;
+ if (numDigits > 1) {
+ eDigits++; /* Decimal point. */
+ }
+ afterDecimal = numDigits - mostSigDigit - 1;
+ if (afterDecimal < 0) {
+ afterDecimal = 0;
+ }
+ fDigits = (mostSigDigit >= 0) ? mostSigDigit + afterDecimal : afterDecimal;
+ if (afterDecimal > 0) {
+ fDigits++; /* Decimal point. */
+ }
+ if (mostSigDigit < 0) {
+ fDigits++; /* Zero to left of decimal point. */
+ }
+ if (fDigits <= eDigits) {
+ sprintf(scalePtr->format, "%%.%df", afterDecimal);
+ } else {
+ sprintf(scalePtr->format, "%%.%de", numDigits-1);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComputeScaleGeometry --
+ *
+ * This procedure is called to compute various geometrical
+ * information for a scale, such as where various things get
+ * displayed. It's called when the window is reconfigured.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Display-related numbers get changed in *scalePtr. The
+ * geometry manager gets told about the window's preferred size.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ComputeScaleGeometry(scalePtr)
+ register TkScale *scalePtr; /* Information about widget. */
+{
+ char valueString[PRINT_CHARS];
+ int tmp, valuePixels, x, y, extraSpace;
+ Tk_FontMetrics fm;
+
+ /*
+ * Horizontal scales are simpler than vertical ones because
+ * all sizes are the same (the height of a line of text);
+ * handle them first and then quit.
+ */
+
+ Tk_GetFontMetrics(scalePtr->tkfont, &fm);
+ if (!scalePtr->vertical) {
+ y = scalePtr->inset;
+ extraSpace = 0;
+ if (scalePtr->labelLength != 0) {
+ scalePtr->horizLabelY = y + SPACING;
+ y += fm.linespace + SPACING;
+ extraSpace = SPACING;
+ }
+ if (scalePtr->showValue) {
+ scalePtr->horizValueY = y + SPACING;
+ y += fm.linespace + SPACING;
+ extraSpace = SPACING;
+ } else {
+ scalePtr->horizValueY = y;
+ }
+ y += extraSpace;
+ scalePtr->horizTroughY = y;
+ y += scalePtr->width + 2*scalePtr->borderWidth;
+ if (scalePtr->tickInterval != 0) {
+ scalePtr->horizTickY = y + SPACING;
+ y += fm.linespace + 2*SPACING;
+ }
+ Tk_GeometryRequest(scalePtr->tkwin,
+ scalePtr->length + 2*scalePtr->inset, y + scalePtr->inset);
+ Tk_SetInternalBorder(scalePtr->tkwin, scalePtr->inset);
+ return;
+ }
+
+ /*
+ * Vertical scale: compute the amount of space needed to display
+ * the scales value by formatting strings for the two end points;
+ * use whichever length is longer.
+ */
+
+ sprintf(valueString, scalePtr->format, scalePtr->fromValue);
+ valuePixels = Tk_TextWidth(scalePtr->tkfont, valueString, -1);
+
+ sprintf(valueString, scalePtr->format, scalePtr->toValue);
+ tmp = Tk_TextWidth(scalePtr->tkfont, valueString, -1);
+ if (valuePixels < tmp) {
+ valuePixels = tmp;
+ }
+
+ /*
+ * Assign x-locations to the elements of the scale, working from
+ * left to right.
+ */
+
+ x = scalePtr->inset;
+ if ((scalePtr->tickInterval != 0) && (scalePtr->showValue)) {
+ scalePtr->vertTickRightX = x + SPACING + valuePixels;
+ scalePtr->vertValueRightX = scalePtr->vertTickRightX + valuePixels
+ + fm.ascent/2;
+ x = scalePtr->vertValueRightX + SPACING;
+ } else if (scalePtr->tickInterval != 0) {
+ scalePtr->vertTickRightX = x + SPACING + valuePixels;
+ scalePtr->vertValueRightX = scalePtr->vertTickRightX;
+ x = scalePtr->vertTickRightX + SPACING;
+ } else if (scalePtr->showValue) {
+ scalePtr->vertTickRightX = x;
+ scalePtr->vertValueRightX = x + SPACING + valuePixels;
+ x = scalePtr->vertValueRightX + SPACING;
+ } else {
+ scalePtr->vertTickRightX = x;
+ scalePtr->vertValueRightX = x;
+ }
+ scalePtr->vertTroughX = x;
+ x += 2*scalePtr->borderWidth + scalePtr->width;
+ if (scalePtr->labelLength == 0) {
+ scalePtr->vertLabelX = 0;
+ } else {
+ scalePtr->vertLabelX = x + fm.ascent/2;
+ x = scalePtr->vertLabelX + fm.ascent/2
+ + Tk_TextWidth(scalePtr->tkfont, scalePtr->label,
+ scalePtr->labelLength);
+ }
+ Tk_GeometryRequest(scalePtr->tkwin, x + scalePtr->inset,
+ scalePtr->length + 2*scalePtr->inset);
+ Tk_SetInternalBorder(scalePtr->tkwin, scalePtr->inset);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on scales.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TkScale *scalePtr = (TkScale *) clientData;
+
+ if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
+ TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);
+ } else if (eventPtr->type == DestroyNotify) {
+ if (scalePtr->tkwin != NULL) {
+ scalePtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(scalePtr->interp, scalePtr->widgetCmd);
+ }
+ if (scalePtr->flags & REDRAW_ALL) {
+ Tcl_CancelIdleCall(TkpDisplayScale, (ClientData) scalePtr);
+ }
+ Tcl_EventuallyFree((ClientData) scalePtr, DestroyScale);
+ } else if (eventPtr->type == ConfigureNotify) {
+ ComputeScaleGeometry(scalePtr);
+ TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ scalePtr->flags |= GOT_FOCUS;
+ if (scalePtr->highlightWidth > 0) {
+ TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ scalePtr->flags &= ~GOT_FOCUS;
+ if (scalePtr->highlightWidth > 0) {
+ TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ScaleCmdDeletedProc --
+ *
+ * This procedure is invoked when a widget command is deleted. If
+ * the widget isn't already in the process of being destroyed,
+ * this command destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ScaleCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ TkScale *scalePtr = (TkScale *) clientData;
+ Tk_Window tkwin = scalePtr->tkwin;
+
+ /*
+ * This procedure could be invoked either because the window was
+ * destroyed and the command was then deleted (in which case tkwin
+ * is NULL) or because the command was deleted, and then this procedure
+ * destroys the widget.
+ */
+
+ if (tkwin != NULL) {
+ scalePtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkEventuallyRedrawScale --
+ *
+ * Arrange for part or all of a scale widget to redrawn at
+ * the next convenient time in the future.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If "what" is REDRAW_SLIDER then just the slider and the
+ * value readout will be redrawn; if "what" is REDRAW_ALL
+ * then the entire widget will be redrawn.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkEventuallyRedrawScale(scalePtr, what)
+ register TkScale *scalePtr; /* Information about widget. */
+ int what; /* What to redraw: REDRAW_SLIDER
+ * or REDRAW_ALL. */
+{
+ if ((what == 0) || (scalePtr->tkwin == NULL)
+ || !Tk_IsMapped(scalePtr->tkwin)) {
+ return;
+ }
+ if ((scalePtr->flags & REDRAW_ALL) == 0) {
+ Tcl_DoWhenIdle(TkpDisplayScale, (ClientData) scalePtr);
+ }
+ scalePtr->flags |= what;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkRoundToResolution --
+ *
+ * Round a given floating-point value to the nearest multiple
+ * of the scale's resolution.
+ *
+ * Results:
+ * The return value is the rounded result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+double
+TkRoundToResolution(scalePtr, value)
+ TkScale *scalePtr; /* Information about scale widget. */
+ double value; /* Value to round. */
+{
+ double rem, new;
+
+ if (scalePtr->resolution <= 0) {
+ return value;
+ }
+ new = scalePtr->resolution * floor(value/scalePtr->resolution);
+ rem = value - new;
+ if (rem < 0) {
+ if (rem <= -scalePtr->resolution/2) {
+ new -= scalePtr->resolution;
+ }
+ } else {
+ if (rem >= scalePtr->resolution/2) {
+ new += scalePtr->resolution;
+ }
+ }
+ return new;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ScaleVarProc --
+ *
+ * This procedure is invoked by Tcl whenever someone modifies a
+ * variable associated with a scale widget.
+ *
+ * Results:
+ * NULL is always returned.
+ *
+ * Side effects:
+ * The value displayed in the scale will change to match the
+ * variable's new value. If the variable has a bogus value then
+ * it is reset to the value of the scale.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+ScaleVarProc(clientData, interp, name1, name2, flags)
+ ClientData clientData; /* Information about button. */
+ Tcl_Interp *interp; /* Interpreter containing variable. */
+ char *name1; /* Name of variable. */
+ char *name2; /* Second part of variable name. */
+ int flags; /* Information about what happened. */
+{
+ register TkScale *scalePtr = (TkScale *) clientData;
+ char *stringValue, *end, *result;
+ double value;
+
+ /*
+ * If the variable is unset, then immediately recreate it unless
+ * the whole interpreter is going away.
+ */
+
+ if (flags & TCL_TRACE_UNSETS) {
+ if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+ Tcl_TraceVar(interp, scalePtr->varName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ScaleVarProc, clientData);
+ scalePtr->flags |= NEVER_SET;
+ TkpSetScaleValue(scalePtr, scalePtr->value, 1, 0);
+ }
+ return (char *) NULL;
+ }
+
+ /*
+ * If we came here because we updated the variable (in TkpSetScaleValue),
+ * then ignore the trace. Otherwise update the scale with the value
+ * of the variable.
+ */
+
+ if (scalePtr->flags & SETTING_VAR) {
+ return (char *) NULL;
+ }
+ result = NULL;
+ stringValue = Tcl_GetVar(interp, scalePtr->varName, TCL_GLOBAL_ONLY);
+ if (stringValue != NULL) {
+ value = strtod(stringValue, &end);
+ if ((end == stringValue) || (*end != 0)) {
+ result = "can't assign non-numeric value to scale variable";
+ } else {
+ scalePtr->value = TkRoundToResolution(scalePtr, value);
+ }
+
+ /*
+ * This code is a bit tricky because it sets the scale's value before
+ * calling TkpSetScaleValue. This way, TkpSetScaleValue won't bother
+ * to set the variable again or to invoke the -command. However, it
+ * also won't redisplay the scale, so we have to ask for that
+ * explicitly.
+ */
+
+ TkpSetScaleValue(scalePtr, scalePtr->value, 1, 0);
+ TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER);
+ }
+
+ return result;
+}
diff --git a/generic/tkScale.h b/generic/tkScale.h
new file mode 100644
index 0000000..dba6f68
--- /dev/null
+++ b/generic/tkScale.h
@@ -0,0 +1,225 @@
+/*
+ * tkScale.h --
+ *
+ * Declarations of types and functions used to implement
+ * the scale widget.
+ *
+ * Copyright (c) 1996 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkScale.h 1.5 96/07/08 12:56:56
+ */
+
+#ifndef _TKSCALE
+#define _TKSCALE
+
+#ifndef _TK
+#include "tk.h"
+#endif
+
+/*
+ * A data structure of the following type is kept for each scale
+ * widget managed by this file:
+ */
+
+typedef struct TkScale {
+ Tk_Window tkwin; /* Window that embodies the scale. NULL
+ * means that the window has been destroyed
+ * but the data structures haven't yet been
+ * cleaned up.*/
+ Display *display; /* Display containing widget. Used, among
+ * other things, so that resources can be
+ * freed even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with scale. */
+ Tcl_Command widgetCmd; /* Token for scale's widget command. */
+ Tk_Uid orientUid; /* Orientation for window ("vertical" or
+ * "horizontal"). */
+ int vertical; /* Non-zero means vertical orientation,
+ * zero means horizontal. */
+ int width; /* Desired narrow dimension of scale,
+ * in pixels. */
+ int length; /* Desired long dimension of scale,
+ * in pixels. */
+ double value; /* Current value of scale. */
+ char *varName; /* Name of variable (malloc'ed) or NULL.
+ * If non-NULL, scale's value tracks
+ * the contents of this variable and
+ * vice versa. */
+ double fromValue; /* Value corresponding to left or top of
+ * scale. */
+ double toValue; /* Value corresponding to right or bottom
+ * of scale. */
+ double tickInterval; /* Distance between tick marks; 0 means
+ * don't display any tick marks. */
+ double resolution; /* If > 0, all values are rounded to an
+ * even multiple of this value. */
+ int digits; /* Number of significant digits to print
+ * in values. 0 means we get to choose the
+ * number based on resolution and/or the
+ * range of the scale. */
+ char format[10]; /* Sprintf conversion specifier computed from
+ * digits and other information. */
+ double bigIncrement; /* Amount to use for large increments to
+ * scale value. (0 means we pick a value). */
+ char *command; /* Command prefix to use when invoking Tcl
+ * commands because the scale value changed.
+ * NULL means don't invoke commands.
+ * Malloc'ed. */
+ int repeatDelay; /* How long to wait before auto-repeating
+ * on scrolling actions (in ms). */
+ int repeatInterval; /* Interval between autorepeats (in ms). */
+ char *label; /* Label to display above or to right of
+ * scale; NULL means don't display a
+ * label. Malloc'ed. */
+ int labelLength; /* Number of non-NULL chars. in label. */
+ Tk_Uid state; /* Normal or disabled. Value cannot be
+ * changed when scale is disabled. */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ int borderWidth; /* Width of 3-D border around window. */
+ Tk_3DBorder bgBorder; /* Used for drawing slider and other
+ * background areas. */
+ Tk_3DBorder activeBorder; /* For drawing the slider when active. */
+ int sliderRelief; /* Is slider to be drawn raised, sunken, etc. */
+ XColor *troughColorPtr; /* Color for drawing trough. */
+ GC troughGC; /* For drawing trough. */
+ GC copyGC; /* Used for copying from pixmap onto screen. */
+ Tk_Font tkfont; /* Information about text font, or NULL. */
+ XColor *textColorPtr; /* Color for drawing text. */
+ GC textGC; /* GC for drawing text in normal mode. */
+ int relief; /* Indicates whether window as a whole is
+ * raised, sunken, or flat. */
+ int highlightWidth; /* Width in pixels of highlight to draw
+ * around widget when it has the focus.
+ * <= 0 means don't draw a highlight. */
+ XColor *highlightBgColorPtr;
+ /* Color for drawing traversal highlight
+ * area when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ int inset; /* Total width of all borders, including
+ * traversal highlight and 3-D border.
+ * Indicates how much interior stuff must
+ * be offset from outside edges to leave
+ * room for borders. */
+ int sliderLength; /* Length of slider, measured in pixels along
+ * long dimension of scale. */
+ int showValue; /* Non-zero means to display the scale value
+ * below or to the left of the slider; zero
+ * means don't display the value. */
+
+ /*
+ * Layout information for horizontal scales, assuming that window
+ * gets the size it requested:
+ */
+
+ int horizLabelY; /* Y-coord at which to draw label. */
+ int horizValueY; /* Y-coord at which to draw value text. */
+ int horizTroughY; /* Y-coord of top of slider trough. */
+ int horizTickY; /* Y-coord at which to draw tick text. */
+ /*
+ * Layout information for vertical scales, assuming that window
+ * gets the size it requested:
+ */
+
+ int vertTickRightX; /* X-location of right side of tick-marks. */
+ int vertValueRightX; /* X-location of right side of value string. */
+ int vertTroughX; /* X-location of scale's slider trough. */
+ int vertLabelX; /* X-location of origin of label. */
+
+ /*
+ * Miscellaneous information:
+ */
+
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ char *takeFocus; /* Value of -takefocus option; not used in
+ * the C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+ int flags; /* Various flags; see below for
+ * definitions. */
+} TkScale;
+
+/*
+ * Flag bits for scales:
+ *
+ * REDRAW_SLIDER - 1 means slider (and numerical readout) need
+ * to be redrawn.
+ * REDRAW_OTHER - 1 means other stuff besides slider and value
+ * need to be redrawn.
+ * REDRAW_ALL - 1 means the entire widget needs to be redrawn.
+ * ACTIVE - 1 means the widget is active (the mouse is
+ * in its window).
+ * INVOKE_COMMAND - 1 means the scale's command needs to be
+ * invoked during the next redisplay (the
+ * value of the scale has changed since the
+ * last time the command was invoked).
+ * SETTING_VAR - 1 means that the associated variable is
+ * being set by us, so there's no need for
+ * ScaleVarProc to do anything.
+ * NEVER_SET - 1 means that the scale's value has never
+ * been set before (so must invoke -command and
+ * set associated variable even if the value
+ * doesn't appear to have changed).
+ * GOT_FOCUS - 1 means that the focus is currently in
+ * this widget.
+ */
+
+#define REDRAW_SLIDER 1
+#define REDRAW_OTHER 2
+#define REDRAW_ALL 3
+#define ACTIVE 4
+#define INVOKE_COMMAND 0x10
+#define SETTING_VAR 0x20
+#define NEVER_SET 0x40
+#define GOT_FOCUS 0x80
+
+/*
+ * Symbolic values for the active parts of a slider. These are
+ * the values that may be returned by the ScaleElement procedure.
+ */
+
+#define OTHER 0
+#define TROUGH1 1
+#define SLIDER 2
+#define TROUGH2 3
+
+/*
+ * Space to leave between scale area and text, and between text and
+ * edge of window.
+ */
+
+#define SPACING 2
+
+/*
+ * How many characters of space to provide when formatting the
+ * scale's value:
+ */
+
+#define PRINT_CHARS 150
+
+/*
+ * Declaration of procedures used in the implementation of the scrollbar
+ * widget.
+ */
+
+EXTERN void TkEventuallyRedrawScale _ANSI_ARGS_((TkScale *scalePtr,
+ int what));
+EXTERN double TkRoundToResolution _ANSI_ARGS_((TkScale *scalePtr,
+ double value));
+EXTERN TkScale * TkpCreateScale _ANSI_ARGS_((Tk_Window tkwin));
+EXTERN void TkpDestroyScale _ANSI_ARGS_((TkScale *scalePtr));
+EXTERN void TkpDisplayScale _ANSI_ARGS_((ClientData clientData));
+EXTERN double TkpPixelToValue _ANSI_ARGS_((TkScale *scalePtr,
+ int x, int y));
+EXTERN int TkpScaleElement _ANSI_ARGS_((TkScale *scalePtr,
+ int x, int y));
+EXTERN void TkpSetScaleValue _ANSI_ARGS_((TkScale *scalePtr,
+ double value, int setVar, int invokeCommand));
+EXTERN int TkpValueToPixel _ANSI_ARGS_((TkScale *scalePtr,
+ double value));
+
+#endif /* _TKSCALE */
diff --git a/generic/tkScrollbar.c b/generic/tkScrollbar.c
new file mode 100644
index 0000000..3025a78
--- /dev/null
+++ b/generic/tkScrollbar.c
@@ -0,0 +1,691 @@
+/*
+ * tkScrollbar.c --
+ *
+ * This module implements a scrollbar widgets for the Tk
+ * toolkit. A scrollbar displays a slider and two arrows;
+ * mouse clicks on features within the scrollbar cause
+ * scrolling commands to be invoked.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkScrollbar.c 1.94 97/07/31 09:12:44
+ */
+
+#include "tkPort.h"
+#include "tkScrollbar.h"
+#include "default.h"
+
+/*
+ * Information used for argv parsing.
+ */
+
+Tk_ConfigSpec tkpScrollbarConfigSpecs[] = {
+ {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_SCROLLBAR_ACTIVE_BG_COLOR, Tk_Offset(TkScrollbar, activeBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_SCROLLBAR_ACTIVE_BG_MONO, Tk_Offset(TkScrollbar, activeBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_RELIEF, "-activerelief", "activeRelief", "Relief",
+ DEF_SCROLLBAR_ACTIVE_RELIEF, Tk_Offset(TkScrollbar, activeRelief), 0},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_SCROLLBAR_BG_COLOR, Tk_Offset(TkScrollbar, bgBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_SCROLLBAR_BG_MONO, Tk_Offset(TkScrollbar, bgBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_SCROLLBAR_BORDER_WIDTH, Tk_Offset(TkScrollbar, borderWidth), 0},
+ {TK_CONFIG_STRING, "-command", "command", "Command",
+ DEF_SCROLLBAR_COMMAND, Tk_Offset(TkScrollbar, command),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_SCROLLBAR_CURSOR, Tk_Offset(TkScrollbar, cursor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-elementborderwidth", "elementBorderWidth",
+ "BorderWidth", DEF_SCROLLBAR_EL_BORDER_WIDTH,
+ Tk_Offset(TkScrollbar, elementBorderWidth), 0},
+ {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_SCROLLBAR_HIGHLIGHT_BG,
+ Tk_Offset(TkScrollbar, highlightBgColorPtr), 0},
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_SCROLLBAR_HIGHLIGHT,
+ Tk_Offset(TkScrollbar, highlightColorPtr), 0},
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_SCROLLBAR_HIGHLIGHT_WIDTH, Tk_Offset(TkScrollbar, highlightWidth), 0},
+ {TK_CONFIG_BOOLEAN, "-jump", "jump", "Jump",
+ DEF_SCROLLBAR_JUMP, Tk_Offset(TkScrollbar, jump), 0},
+ {TK_CONFIG_UID, "-orient", "orient", "Orient",
+ DEF_SCROLLBAR_ORIENT, Tk_Offset(TkScrollbar, orientUid), 0},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_SCROLLBAR_RELIEF, Tk_Offset(TkScrollbar, relief), 0},
+ {TK_CONFIG_INT, "-repeatdelay", "repeatDelay", "RepeatDelay",
+ DEF_SCROLLBAR_REPEAT_DELAY, Tk_Offset(TkScrollbar, repeatDelay), 0},
+ {TK_CONFIG_INT, "-repeatinterval", "repeatInterval", "RepeatInterval",
+ DEF_SCROLLBAR_REPEAT_INTERVAL, Tk_Offset(TkScrollbar, repeatInterval), 0},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_SCROLLBAR_TAKE_FOCUS, Tk_Offset(TkScrollbar, takeFocus),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-troughcolor", "troughColor", "Background",
+ DEF_SCROLLBAR_TROUGH_COLOR, Tk_Offset(TkScrollbar, troughColorPtr),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR, "-troughcolor", "troughColor", "Background",
+ DEF_SCROLLBAR_TROUGH_MONO, Tk_Offset(TkScrollbar, troughColorPtr),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_PIXELS, "-width", "width", "Width",
+ DEF_SCROLLBAR_WIDTH, Tk_Offset(TkScrollbar, width), 0},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int ConfigureScrollbar _ANSI_ARGS_((Tcl_Interp *interp,
+ TkScrollbar *scrollPtr, int argc, char **argv,
+ int flags));
+static void ScrollbarCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static int ScrollbarWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *, int argc, char **argv));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ScrollbarCmd --
+ *
+ * This procedure is invoked to process the "scrollbar" Tcl
+ * command. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_ScrollbarCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ register TkScrollbar *scrollPtr;
+ Tk_Window new;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " pathName ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+
+ Tk_SetClass(new, "Scrollbar");
+ scrollPtr = TkpCreateScrollbar(new);
+
+ TkSetClassProcs(new, &tkpScrollbarProcs, (ClientData) scrollPtr);
+
+ /*
+ * Initialize fields that won't be initialized by ConfigureScrollbar,
+ * or which ConfigureScrollbar expects to have reasonable values
+ * (e.g. resource pointers).
+ */
+
+ scrollPtr->tkwin = new;
+ scrollPtr->display = Tk_Display(new);
+ scrollPtr->interp = interp;
+ scrollPtr->widgetCmd = Tcl_CreateCommand(interp,
+ Tk_PathName(scrollPtr->tkwin), ScrollbarWidgetCmd,
+ (ClientData) scrollPtr, ScrollbarCmdDeletedProc);
+ scrollPtr->orientUid = NULL;
+ scrollPtr->vertical = 0;
+ scrollPtr->width = 0;
+ scrollPtr->command = NULL;
+ scrollPtr->commandSize = 0;
+ scrollPtr->repeatDelay = 0;
+ scrollPtr->repeatInterval = 0;
+ scrollPtr->borderWidth = 0;
+ scrollPtr->bgBorder = NULL;
+ scrollPtr->activeBorder = NULL;
+ scrollPtr->troughColorPtr = NULL;
+ scrollPtr->relief = TK_RELIEF_FLAT;
+ scrollPtr->highlightWidth = 0;
+ scrollPtr->highlightBgColorPtr = NULL;
+ scrollPtr->highlightColorPtr = NULL;
+ scrollPtr->inset = 0;
+ scrollPtr->elementBorderWidth = -1;
+ scrollPtr->arrowLength = 0;
+ scrollPtr->sliderFirst = 0;
+ scrollPtr->sliderLast = 0;
+ scrollPtr->activeField = 0;
+ scrollPtr->activeRelief = TK_RELIEF_RAISED;
+ scrollPtr->totalUnits = 0;
+ scrollPtr->windowUnits = 0;
+ scrollPtr->firstUnit = 0;
+ scrollPtr->lastUnit = 0;
+ scrollPtr->firstFraction = 0.0;
+ scrollPtr->lastFraction = 0.0;
+ scrollPtr->cursor = None;
+ scrollPtr->takeFocus = NULL;
+ scrollPtr->flags = 0;
+
+ if (ConfigureScrollbar(interp, scrollPtr, argc-2, argv+2, 0) != TCL_OK) {
+ Tk_DestroyWindow(scrollPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ interp->result = Tk_PathName(scrollPtr->tkwin);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScrollbarWidgetCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to a widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ScrollbarWidgetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about scrollbar
+ * widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ register TkScrollbar *scrollPtr = (TkScrollbar *) clientData;
+ int result = TCL_OK;
+ size_t length;
+ int c;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_Preserve((ClientData) scrollPtr);
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'a') && (strncmp(argv[1], "activate", length) == 0)) {
+ int oldActiveField;
+ if (argc == 2) {
+ switch (scrollPtr->activeField) {
+ case TOP_ARROW: interp->result = "arrow1"; break;
+ case SLIDER: interp->result = "slider"; break;
+ case BOTTOM_ARROW: interp->result = "arrow2"; break;
+ }
+ goto done;
+ }
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " activate element\"", (char *) NULL);
+ goto error;
+ }
+ c = argv[2][0];
+ length = strlen(argv[2]);
+ oldActiveField = scrollPtr->activeField;
+ if ((c == 'a') && (strcmp(argv[2], "arrow1") == 0)) {
+ scrollPtr->activeField = TOP_ARROW;
+ } else if ((c == 'a') && (strcmp(argv[2], "arrow2") == 0)) {
+ scrollPtr->activeField = BOTTOM_ARROW;
+ } else if ((c == 's') && (strncmp(argv[2], "slider", length) == 0)) {
+ scrollPtr->activeField = SLIDER;
+ } else {
+ scrollPtr->activeField = OUTSIDE;
+ }
+ if (oldActiveField != scrollPtr->activeField) {
+ TkScrollbarEventuallyRedraw(scrollPtr);
+ }
+ } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
+ && (length >= 2)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " cget option\"",
+ (char *) NULL);
+ goto error;
+ }
+ result = Tk_ConfigureValue(interp, scrollPtr->tkwin,
+ tkpScrollbarConfigSpecs, (char *) scrollPtr, argv[2], 0);
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
+ && (length >= 2)) {
+ if (argc == 2) {
+ result = Tk_ConfigureInfo(interp, scrollPtr->tkwin,
+ tkpScrollbarConfigSpecs, (char *) scrollPtr,
+ (char *) NULL, 0);
+ } else if (argc == 3) {
+ result = Tk_ConfigureInfo(interp, scrollPtr->tkwin,
+ tkpScrollbarConfigSpecs, (char *) scrollPtr, argv[2], 0);
+ } else {
+ result = ConfigureScrollbar(interp, scrollPtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ } else if ((c == 'd') && (strncmp(argv[1], "delta", length) == 0)) {
+ int xDelta, yDelta, pixels, length;
+ double fraction;
+
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " delta xDelta yDelta\"", (char *) NULL);
+ goto error;
+ }
+ if ((Tcl_GetInt(interp, argv[2], &xDelta) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[3], &yDelta) != TCL_OK)) {
+ goto error;
+ }
+ if (scrollPtr->vertical) {
+ pixels = yDelta;
+ length = Tk_Height(scrollPtr->tkwin) - 1
+ - 2*(scrollPtr->arrowLength + scrollPtr->inset);
+ } else {
+ pixels = xDelta;
+ length = Tk_Width(scrollPtr->tkwin) - 1
+ - 2*(scrollPtr->arrowLength + scrollPtr->inset);
+ }
+ if (length == 0) {
+ fraction = 0.0;
+ } else {
+ fraction = ((double) pixels / (double) length);
+ }
+ sprintf(interp->result, "%g", fraction);
+ } else if ((c == 'f') && (strncmp(argv[1], "fraction", length) == 0)) {
+ int x, y, pos, length;
+ double fraction;
+
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " fraction x y\"", (char *) NULL);
+ goto error;
+ }
+ if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
+ goto error;
+ }
+ if (scrollPtr->vertical) {
+ pos = y - (scrollPtr->arrowLength + scrollPtr->inset);
+ length = Tk_Height(scrollPtr->tkwin) - 1
+ - 2*(scrollPtr->arrowLength + scrollPtr->inset);
+ } else {
+ pos = x - (scrollPtr->arrowLength + scrollPtr->inset);
+ length = Tk_Width(scrollPtr->tkwin) - 1
+ - 2*(scrollPtr->arrowLength + scrollPtr->inset);
+ }
+ if (length == 0) {
+ fraction = 0.0;
+ } else {
+ fraction = ((double) pos / (double) length);
+ }
+ if (fraction < 0) {
+ fraction = 0;
+ } else if (fraction > 1.0) {
+ fraction = 1.0;
+ }
+ sprintf(interp->result, "%g", fraction);
+ } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " get\"", (char *) NULL);
+ goto error;
+ }
+ if (scrollPtr->flags & NEW_STYLE_COMMANDS) {
+ char first[TCL_DOUBLE_SPACE], last[TCL_DOUBLE_SPACE];
+
+ Tcl_PrintDouble(interp, scrollPtr->firstFraction, first);
+ Tcl_PrintDouble(interp, scrollPtr->lastFraction, last);
+ Tcl_AppendResult(interp, first, " ", last, (char *) NULL);
+ } else {
+ sprintf(interp->result, "%d %d %d %d", scrollPtr->totalUnits,
+ scrollPtr->windowUnits, scrollPtr->firstUnit,
+ scrollPtr->lastUnit);
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "identify", length) == 0)) {
+ int x, y, thing;
+
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " identify x y\"", (char *) NULL);
+ goto error;
+ }
+ if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
+ goto error;
+ }
+ thing = TkpScrollbarPosition(scrollPtr, x,y);
+ switch (thing) {
+ case TOP_ARROW: interp->result = "arrow1"; break;
+ case TOP_GAP: interp->result = "trough1"; break;
+ case SLIDER: interp->result = "slider"; break;
+ case BOTTOM_GAP: interp->result = "trough2"; break;
+ case BOTTOM_ARROW: interp->result = "arrow2"; break;
+ }
+ } else if ((c == 's') && (strncmp(argv[1], "set", length) == 0)) {
+ int totalUnits, windowUnits, firstUnit, lastUnit;
+
+ if (argc == 4) {
+ double first, last;
+
+ if (Tcl_GetDouble(interp, argv[2], &first) != TCL_OK) {
+ goto error;
+ }
+ if (Tcl_GetDouble(interp, argv[3], &last) != TCL_OK) {
+ goto error;
+ }
+ if (first < 0) {
+ scrollPtr->firstFraction = 0;
+ } else if (first > 1.0) {
+ scrollPtr->firstFraction = 1.0;
+ } else {
+ scrollPtr->firstFraction = first;
+ }
+ if (last < scrollPtr->firstFraction) {
+ scrollPtr->lastFraction = scrollPtr->firstFraction;
+ } else if (last > 1.0) {
+ scrollPtr->lastFraction = 1.0;
+ } else {
+ scrollPtr->lastFraction = last;
+ }
+ scrollPtr->flags |= NEW_STYLE_COMMANDS;
+ } else if (argc == 6) {
+ if (Tcl_GetInt(interp, argv[2], &totalUnits) != TCL_OK) {
+ goto error;
+ }
+ if (totalUnits < 0) {
+ totalUnits = 0;
+ }
+ if (Tcl_GetInt(interp, argv[3], &windowUnits) != TCL_OK) {
+ goto error;
+ }
+ if (windowUnits < 0) {
+ windowUnits = 0;
+ }
+ if (Tcl_GetInt(interp, argv[4], &firstUnit) != TCL_OK) {
+ goto error;
+ }
+ if (Tcl_GetInt(interp, argv[5], &lastUnit) != TCL_OK) {
+ goto error;
+ }
+ if (totalUnits > 0) {
+ if (lastUnit < firstUnit) {
+ lastUnit = firstUnit;
+ }
+ } else {
+ firstUnit = lastUnit = 0;
+ }
+ scrollPtr->totalUnits = totalUnits;
+ scrollPtr->windowUnits = windowUnits;
+ scrollPtr->firstUnit = firstUnit;
+ scrollPtr->lastUnit = lastUnit;
+ if (scrollPtr->totalUnits == 0) {
+ scrollPtr->firstFraction = 0.0;
+ scrollPtr->lastFraction = 1.0;
+ } else {
+ scrollPtr->firstFraction = ((double) firstUnit)/totalUnits;
+ scrollPtr->lastFraction = ((double) (lastUnit+1))/totalUnits;
+ }
+ scrollPtr->flags &= ~NEW_STYLE_COMMANDS;
+ } else {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " set firstFraction lastFraction\" or \"",
+ argv[0],
+ " set totalUnits windowUnits firstUnit lastUnit\"",
+ (char *) NULL);
+ goto error;
+ }
+ TkpComputeScrollbarGeometry(scrollPtr);
+ TkScrollbarEventuallyRedraw(scrollPtr);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be activate, cget, configure, delta, fraction, ",
+ "get, identify, or set", (char *) NULL);
+ goto error;
+ }
+ done:
+ Tcl_Release((ClientData) scrollPtr);
+ return result;
+
+ error:
+ Tcl_Release((ClientData) scrollPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureScrollbar --
+ *
+ * This procedure is called to process an argv/argc list, plus
+ * the Tk option database, in order to configure (or
+ * reconfigure) a scrollbar widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then interp->result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width,
+ * etc. get set for scrollPtr; old resources get freed,
+ * if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureScrollbar(interp, scrollPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register TkScrollbar *scrollPtr; /* Information about widget; may or
+ * may not already have values for
+ * some fields. */
+ int argc; /* Number of valid entries in argv. */
+ char **argv; /* Arguments. */
+ int flags; /* Flags to pass to
+ * Tk_ConfigureWidget. */
+{
+ size_t length;
+
+ if (Tk_ConfigureWidget(interp, scrollPtr->tkwin, tkpScrollbarConfigSpecs,
+ argc, argv, (char *) scrollPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few options need special processing, such as parsing the
+ * orientation or setting the background from a 3-D border.
+ */
+
+ length = strlen(scrollPtr->orientUid);
+ if (strncmp(scrollPtr->orientUid, "vertical", length) == 0) {
+ scrollPtr->vertical = 1;
+ } else if (strncmp(scrollPtr->orientUid, "horizontal", length) == 0) {
+ scrollPtr->vertical = 0;
+ } else {
+ Tcl_AppendResult(interp, "bad orientation \"", scrollPtr->orientUid,
+ "\": must be vertical or horizontal", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (scrollPtr->command != NULL) {
+ scrollPtr->commandSize = strlen(scrollPtr->command);
+ } else {
+ scrollPtr->commandSize = 0;
+ }
+
+ /*
+ * Configure platform specific options.
+ */
+
+ TkpConfigureScrollbar(scrollPtr);
+
+ /*
+ * Register the desired geometry for the window (leave enough space
+ * for the two arrows plus a minimum-size slider, plus border around
+ * the whole window, if any). Then arrange for the window to be
+ * redisplayed.
+ */
+
+ TkpComputeScrollbarGeometry(scrollPtr);
+ TkScrollbarEventuallyRedraw(scrollPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkScrollbarEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on scrollbars.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkScrollbarEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TkScrollbar *scrollPtr = (TkScrollbar *) clientData;
+
+ if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
+ TkScrollbarEventuallyRedraw(scrollPtr);
+ } else if (eventPtr->type == DestroyNotify) {
+ TkpDestroyScrollbar(scrollPtr);
+ if (scrollPtr->tkwin != NULL) {
+ scrollPtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(scrollPtr->interp,
+ scrollPtr->widgetCmd);
+ }
+ if (scrollPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(TkpDisplayScrollbar, (ClientData) scrollPtr);
+ }
+ /*
+ * Free up all the stuff that requires special handling, then
+ * let Tk_FreeOptions handle all the standard option-related
+ * stuff.
+ */
+
+ Tk_FreeOptions(tkpScrollbarConfigSpecs, (char *) scrollPtr,
+ scrollPtr->display, 0);
+ Tcl_EventuallyFree((ClientData) scrollPtr, TCL_DYNAMIC);
+ } else if (eventPtr->type == ConfigureNotify) {
+ TkpComputeScrollbarGeometry(scrollPtr);
+ TkScrollbarEventuallyRedraw(scrollPtr);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ scrollPtr->flags |= GOT_FOCUS;
+ if (scrollPtr->highlightWidth > 0) {
+ TkScrollbarEventuallyRedraw(scrollPtr);
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ scrollPtr->flags &= ~GOT_FOCUS;
+ if (scrollPtr->highlightWidth > 0) {
+ TkScrollbarEventuallyRedraw(scrollPtr);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ScrollbarCmdDeletedProc --
+ *
+ * This procedure is invoked when a widget command is deleted. If
+ * the widget isn't already in the process of being destroyed,
+ * this command destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ScrollbarCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ TkScrollbar *scrollPtr = (TkScrollbar *) clientData;
+ Tk_Window tkwin = scrollPtr->tkwin;
+
+ /*
+ * This procedure could be invoked either because the window was
+ * destroyed and the command was then deleted (in which case tkwin
+ * is NULL) or because the command was deleted, and then this procedure
+ * destroys the widget.
+ */
+
+ if (tkwin != NULL) {
+ scrollPtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkScrollbarEventuallyRedraw --
+ *
+ * Arrange for one or more of the fields of a scrollbar
+ * to be redrawn.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkScrollbarEventuallyRedraw(scrollPtr)
+ register TkScrollbar *scrollPtr; /* Information about widget. */
+{
+ if ((scrollPtr->tkwin == NULL) || (!Tk_IsMapped(scrollPtr->tkwin))) {
+ return;
+ }
+ if ((scrollPtr->flags & REDRAW_PENDING) == 0) {
+ Tcl_DoWhenIdle(TkpDisplayScrollbar, (ClientData) scrollPtr);
+ scrollPtr->flags |= REDRAW_PENDING;
+ }
+}
diff --git a/generic/tkScrollbar.h b/generic/tkScrollbar.h
new file mode 100644
index 0000000..48296a2
--- /dev/null
+++ b/generic/tkScrollbar.h
@@ -0,0 +1,200 @@
+/*
+ * tkScrollbar.h --
+ *
+ * Declarations of types and functions used to implement
+ * the scrollbar widget.
+ *
+ * Copyright (c) 1996 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkScrollbar.h 1.8 96/11/05 11:34:58
+ */
+
+#ifndef _TKSCROLLBAR
+#define _TKSCROLLBAR
+
+#ifndef _TKINT
+#include "tkInt.h"
+#endif
+
+/*
+ * A data structure of the following type is kept for each scrollbar
+ * widget.
+ */
+
+typedef struct TkScrollbar {
+ Tk_Window tkwin; /* Window that embodies the scrollbar. NULL
+ * means that the window has been destroyed
+ * but the data structures haven't yet been
+ * cleaned up.*/
+ Display *display; /* Display containing widget. Used, among
+ * other things, so that resources can be
+ * freed even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with scrollbar. */
+ Tcl_Command widgetCmd; /* Token for scrollbar's widget command. */
+ Tk_Uid orientUid; /* Orientation for window ("vertical" or
+ * "horizontal"). */
+ int vertical; /* Non-zero means vertical orientation
+ * requested, zero means horizontal. */
+ int width; /* Desired narrow dimension of scrollbar,
+ * in pixels. */
+ char *command; /* Command prefix to use when invoking
+ * scrolling commands. NULL means don't
+ * invoke commands. Malloc'ed. */
+ int commandSize; /* Number of non-NULL bytes in command. */
+ int repeatDelay; /* How long to wait before auto-repeating
+ * on scrolling actions (in ms). */
+ int repeatInterval; /* Interval between autorepeats (in ms). */
+ int jump; /* Value of -jump option. */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ int borderWidth; /* Width of 3-D borders. */
+ Tk_3DBorder bgBorder; /* Used for drawing background (all flat
+ * surfaces except for trough). */
+ Tk_3DBorder activeBorder; /* For drawing backgrounds when active (i.e.
+ * when mouse is positioned over element). */
+ XColor *troughColorPtr; /* Color for drawing trough. */
+ int relief; /* Indicates whether window as a whole is
+ * raised, sunken, or flat. */
+ int highlightWidth; /* Width in pixels of highlight to draw
+ * around widget when it has the focus.
+ * <= 0 means don't draw a highlight. */
+ XColor *highlightBgColorPtr;
+ /* Color for drawing traversal highlight
+ * area when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ int inset; /* Total width of all borders, including
+ * traversal highlight and 3-D border.
+ * Indicates how much interior stuff must
+ * be offset from outside edges to leave
+ * room for borders. */
+ int elementBorderWidth; /* Width of border to draw around elements
+ * inside scrollbar (arrows and slider).
+ * -1 means use borderWidth. */
+ int arrowLength; /* Length of arrows along long dimension of
+ * scrollbar, including space for a small gap
+ * between the arrow and the slider.
+ * Recomputed on window size changes. */
+ int sliderFirst; /* Pixel coordinate of top or left edge
+ * of slider area, including border. */
+ int sliderLast; /* Coordinate of pixel just after bottom
+ * or right edge of slider area, including
+ * border. */
+ int activeField; /* Names field to be displayed in active
+ * colors, such as TOP_ARROW, or 0 for
+ * no field. */
+ int activeRelief; /* Value of -activeRelief option: relief
+ * to use for active element. */
+
+ /*
+ * Information describing the application related to the scrollbar.
+ * This information is provided by the application by invoking the
+ * "set" widget command. This information can now be provided in
+ * two ways: the "old" form (totalUnits, windowUnits, firstUnit,
+ * and lastUnit), or the "new" form (firstFraction and lastFraction).
+ * FirstFraction and lastFraction will always be valid, but
+ * the old-style information is only valid if the NEW_STYLE_COMMANDS
+ * flag is 0.
+ */
+
+ int totalUnits; /* Total dimension of application, in
+ * units. Valid only if the NEW_STYLE_COMMANDS
+ * flag isn't set. */
+ int windowUnits; /* Maximum number of units that can be
+ * displayed in the window at once. Valid
+ * only if the NEW_STYLE_COMMANDS flag isn't
+ * set. */
+ int firstUnit; /* Number of last unit visible in
+ * application's window. Valid only if the
+ * NEW_STYLE_COMMANDS flag isn't set. */
+ int lastUnit; /* Index of last unit visible in window.
+ * Valid only if the NEW_STYLE_COMMANDS
+ * flag isn't set. */
+ double firstFraction; /* Position of first visible thing in window,
+ * specified as a fraction between 0 and
+ * 1.0. */
+ double lastFraction; /* Position of last visible thing in window,
+ * specified as a fraction between 0 and
+ * 1.0. */
+
+ /*
+ * Miscellaneous information:
+ */
+
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ char *takeFocus; /* Value of -takefocus option; not used in
+ * the C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+ int flags; /* Various flags; see below for
+ * definitions. */
+} TkScrollbar;
+
+/*
+ * Legal values for "activeField" field of Scrollbar structures. These
+ * are also the return values from the ScrollbarPosition procedure.
+ */
+
+#define OUTSIDE 0
+#define TOP_ARROW 1
+#define TOP_GAP 2
+#define SLIDER 3
+#define BOTTOM_GAP 4
+#define BOTTOM_ARROW 5
+
+/*
+ * Flag bits for scrollbars:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler
+ * has already been queued to redraw
+ * this window.
+ * NEW_STYLE_COMMANDS: Non-zero means the new style of commands
+ * should be used to communicate with the
+ * widget: ".t yview scroll 2 lines", instead
+ * of ".t yview 40", for example.
+ * GOT_FOCUS: Non-zero means this window has the input
+ * focus.
+ */
+
+#define REDRAW_PENDING 1
+#define NEW_STYLE_COMMANDS 2
+#define GOT_FOCUS 4
+
+/*
+ * Declaration of scrollbar class procedures structure.
+ */
+
+extern TkClassProcs tkpScrollbarProcs;
+
+/*
+ * Declaration of scrollbar configuration options.
+ */
+
+extern Tk_ConfigSpec tkpScrollbarConfigSpecs[];
+
+/*
+ * Declaration of procedures used in the implementation of the scrollbar
+ * widget.
+ */
+
+EXTERN void TkScrollbarEventProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+EXTERN void TkScrollbarEventuallyRedraw _ANSI_ARGS_((
+ TkScrollbar *scrollPtr));
+EXTERN void TkpComputeScrollbarGeometry _ANSI_ARGS_((
+ TkScrollbar *scrollPtr));
+EXTERN TkScrollbar * TkpCreateScrollbar _ANSI_ARGS_((Tk_Window tkwin));
+EXTERN void TkpDestroyScrollbar _ANSI_ARGS_((
+ TkScrollbar *scrollPtr));
+EXTERN void TkpDisplayScrollbar _ANSI_ARGS_((
+ ClientData clientData));
+EXTERN void TkpConfigureScrollbar _ANSI_ARGS_((
+ TkScrollbar *scrollPtr));
+EXTERN int TkpScrollbarPosition _ANSI_ARGS_((
+ TkScrollbar *scrollPtr, int x, int y));
+
+#endif /* _TKSCROLLBAR */
diff --git a/generic/tkSelect.c b/generic/tkSelect.c
new file mode 100644
index 0000000..7263e30
--- /dev/null
+++ b/generic/tkSelect.c
@@ -0,0 +1,1341 @@
+/*
+ * tkSelect.c --
+ *
+ * This file manages the selection for the Tk toolkit,
+ * translating between the standard X ICCCM conventions
+ * and Tcl commands.
+ *
+ * Copyright (c) 1990-1993 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkSelect.c 1.57 96/05/03 10:52:40
+ */
+
+#include "tkInt.h"
+#include "tkSelect.h"
+
+/*
+ * When a selection handler is set up by invoking "selection handle",
+ * one of the following data structures is set up to hold information
+ * about the command to invoke and its interpreter.
+ */
+
+typedef struct {
+ Tcl_Interp *interp; /* Interpreter in which to invoke command. */
+ int cmdLength; /* # of non-NULL bytes in command. */
+ char command[4]; /* Command to invoke. Actual space is
+ * allocated as large as necessary. This
+ * must be the last entry in the structure. */
+} CommandInfo;
+
+/*
+ * When selection ownership is claimed with the "selection own" Tcl command,
+ * one of the following structures is created to record the Tcl command
+ * to be executed when the selection is lost again.
+ */
+
+typedef struct LostCommand {
+ Tcl_Interp *interp; /* Interpreter in which to invoke command. */
+ char command[4]; /* Command to invoke. Actual space is
+ * allocated as large as necessary. This
+ * must be the last entry in the structure. */
+} LostCommand;
+
+/*
+ * Shared variables:
+ */
+
+TkSelInProgress *pendingPtr = NULL;
+ /* Topmost search in progress, or
+ * NULL if none. */
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static int HandleTclCommand _ANSI_ARGS_((ClientData clientData,
+ int offset, char *buffer, int maxBytes));
+static void LostSelection _ANSI_ARGS_((ClientData clientData));
+static int SelGetProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, char *portion));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateSelHandler --
+ *
+ * This procedure is called to register a procedure
+ * as the handler for selection requests of a particular
+ * target type on a particular window for a particular
+ * selection.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * In the future, whenever the selection is in tkwin's
+ * window and someone requests the selection in the
+ * form given by target, proc will be invoked to provide
+ * part or all of the selection in the given form. If
+ * there was already a handler declared for the given
+ * window, target and selection type, then it is replaced.
+ * Proc should have the following form:
+ *
+ * int
+ * proc(clientData, offset, buffer, maxBytes)
+ * ClientData clientData;
+ * int offset;
+ * char *buffer;
+ * int maxBytes;
+ * {
+ * }
+ *
+ * The clientData argument to proc will be the same as
+ * the clientData argument to this procedure. The offset
+ * argument indicates which portion of the selection to
+ * return: skip the first offset bytes. Buffer is a
+ * pointer to an area in which to place the converted
+ * selection, and maxBytes gives the number of bytes
+ * available at buffer. Proc should place the selection
+ * in buffer as a string, and return a count of the number
+ * of bytes of selection actually placed in buffer (not
+ * including the terminating NULL character). If the
+ * return value equals maxBytes, this is a sign that there
+ * is probably still more selection information available.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CreateSelHandler(tkwin, selection, target, proc, clientData, format)
+ Tk_Window tkwin; /* Token for window. */
+ Atom selection; /* Selection to be handled. */
+ Atom target; /* The kind of selection conversions
+ * that can be handled by proc,
+ * e.g. TARGETS or STRING. */
+ Tk_SelectionProc *proc; /* Procedure to invoke to convert
+ * selection to type "target". */
+ ClientData clientData; /* Value to pass to proc. */
+ Atom format; /* Format in which the selection
+ * information should be returned to
+ * the requestor. XA_STRING is best by
+ * far, but anything listed in the ICCCM
+ * will be tolerated (blech). */
+{
+ register TkSelHandler *selPtr;
+ TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if (winPtr->dispPtr->multipleAtom == None) {
+ TkSelInit(tkwin);
+ }
+
+ /*
+ * See if there's already a handler for this target and selection on
+ * this window. If so, re-use it. If not, create a new one.
+ */
+
+ for (selPtr = winPtr->selHandlerList; ; selPtr = selPtr->nextPtr) {
+ if (selPtr == NULL) {
+ selPtr = (TkSelHandler *) ckalloc(sizeof(TkSelHandler));
+ selPtr->nextPtr = winPtr->selHandlerList;
+ winPtr->selHandlerList = selPtr;
+ break;
+ }
+ if ((selPtr->selection == selection) && (selPtr->target == target)) {
+
+ /*
+ * Special case: when replacing handler created by
+ * "selection handle", free up memory. Should there be a
+ * callback to allow other clients to do this too?
+ */
+
+ if (selPtr->proc == HandleTclCommand) {
+ ckfree((char *) selPtr->clientData);
+ }
+ break;
+ }
+ }
+ selPtr->selection = selection;
+ selPtr->target = target;
+ selPtr->format = format;
+ selPtr->proc = proc;
+ selPtr->clientData = clientData;
+ if (format == XA_STRING) {
+ selPtr->size = 8;
+ } else {
+ selPtr->size = 32;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DeleteSelHandler --
+ *
+ * Remove the selection handler for a given window, target, and
+ * selection, if it exists.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The selection handler for tkwin and target is removed. If there
+ * is no such handler then nothing happens.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_DeleteSelHandler(tkwin, selection, target)
+ Tk_Window tkwin; /* Token for window. */
+ Atom selection; /* The selection whose handler
+ * is to be removed. */
+ Atom target; /* The target whose selection
+ * handler is to be removed. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ register TkSelHandler *selPtr, *prevPtr;
+ register TkSelInProgress *ipPtr;
+
+ /*
+ * Find the selection handler to be deleted, or return if it doesn't
+ * exist.
+ */
+
+ for (selPtr = winPtr->selHandlerList, prevPtr = NULL; ;
+ prevPtr = selPtr, selPtr = selPtr->nextPtr) {
+ if (selPtr == NULL) {
+ return;
+ }
+ if ((selPtr->selection == selection) && (selPtr->target == target)) {
+ break;
+ }
+ }
+
+ /*
+ * If ConvertSelection is processing this handler, tell it that the
+ * handler is dead.
+ */
+
+ for (ipPtr = pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
+ if (ipPtr->selPtr == selPtr) {
+ ipPtr->selPtr = NULL;
+ }
+ }
+
+ /*
+ * Free resources associated with the handler.
+ */
+
+ if (prevPtr == NULL) {
+ winPtr->selHandlerList = selPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = selPtr->nextPtr;
+ }
+ if (selPtr->proc == HandleTclCommand) {
+ ckfree((char *) selPtr->clientData);
+ }
+ ckfree((char *) selPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_OwnSelection --
+ *
+ * Arrange for tkwin to become the owner of a selection.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * From now on, requests for the selection will be directed
+ * to procedures associated with tkwin (they must have been
+ * declared with calls to Tk_CreateSelHandler). When the
+ * selection is lost by this window, proc will be invoked
+ * (see the manual entry for details). This procedure may
+ * invoke callbacks, including Tcl scripts, so any calling
+ * function should be reentrant at the point where
+ * Tk_OwnSelection is invoked.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_OwnSelection(tkwin, selection, proc, clientData)
+ Tk_Window tkwin; /* Window to become new selection
+ * owner. */
+ Atom selection; /* Selection that window should own. */
+ Tk_LostSelProc *proc; /* Procedure to call when selection
+ * is taken away from tkwin. */
+ ClientData clientData; /* Arbitrary one-word argument to
+ * pass to proc. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkSelectionInfo *infoPtr;
+ Tk_LostSelProc *clearProc = NULL;
+ ClientData clearData = NULL; /* Initialization needed only to
+ * prevent compiler warning. */
+
+
+ if (dispPtr->multipleAtom == None) {
+ TkSelInit(tkwin);
+ }
+ Tk_MakeWindowExist(tkwin);
+
+ /*
+ * This code is somewhat tricky. First, we find the specified selection
+ * on the selection list. If the previous owner is in this process, and
+ * is a different window, then we need to invoke the clearProc. However,
+ * it's dangerous to call the clearProc right now, because it could
+ * invoke a Tcl script that wrecks the current state (e.g. it could
+ * delete the window). To be safe, defer the call until the end of the
+ * procedure when we no longer care about the state.
+ */
+
+ for (infoPtr = dispPtr->selectionInfoPtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->selection == selection) {
+ break;
+ }
+ }
+ if (infoPtr == NULL) {
+ infoPtr = (TkSelectionInfo*) ckalloc(sizeof(TkSelectionInfo));
+ infoPtr->selection = selection;
+ infoPtr->nextPtr = dispPtr->selectionInfoPtr;
+ dispPtr->selectionInfoPtr = infoPtr;
+ } else if (infoPtr->clearProc != NULL) {
+ if (infoPtr->owner != tkwin) {
+ clearProc = infoPtr->clearProc;
+ clearData = infoPtr->clearData;
+ } else if (infoPtr->clearProc == LostSelection) {
+ /*
+ * If the selection handler is one created by "selection own",
+ * be sure to free the record for it; otherwise there will be
+ * a memory leak.
+ */
+
+ ckfree((char *) infoPtr->clearData);
+ }
+ }
+
+ infoPtr->owner = tkwin;
+ infoPtr->serial = NextRequest(winPtr->display);
+ infoPtr->clearProc = proc;
+ infoPtr->clearData = clientData;
+
+ /*
+ * Note that we are using CurrentTime, even though ICCCM recommends against
+ * this practice (the problem is that we don't necessarily have a valid
+ * time to use). We will not be able to retrieve a useful timestamp for
+ * the TIMESTAMP target later.
+ */
+
+ infoPtr->time = CurrentTime;
+
+ /*
+ * Note that we are not checking to see if the selection claim succeeded.
+ * If the ownership does not change, then the clearProc may never be
+ * invoked, and we will return incorrect information when queried for the
+ * current selection owner.
+ */
+
+ XSetSelectionOwner(winPtr->display, infoPtr->selection, winPtr->window,
+ infoPtr->time);
+
+ /*
+ * Now that we are done, we can invoke clearProc without running into
+ * reentrancy problems.
+ */
+
+ if (clearProc != NULL) {
+ (*clearProc)(clearData);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ClearSelection --
+ *
+ * Eliminate the specified selection on tkwin's display, if there is one.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The specified selection is cleared, so that future requests to retrieve
+ * it will fail until some application owns it again. This procedure
+ * invokes callbacks, possibly including Tcl scripts, so any calling
+ * function should be reentrant at the point Tk_ClearSelection is invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_ClearSelection(tkwin, selection)
+ Tk_Window tkwin; /* Window that selects a display. */
+ Atom selection; /* Selection to be cancelled. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkSelectionInfo *infoPtr;
+ TkSelectionInfo *prevPtr;
+ TkSelectionInfo *nextPtr;
+ Tk_LostSelProc *clearProc = NULL;
+ ClientData clearData = NULL; /* Initialization needed only to
+ * prevent compiler warning. */
+
+ if (dispPtr->multipleAtom == None) {
+ TkSelInit(tkwin);
+ }
+
+ for (infoPtr = dispPtr->selectionInfoPtr, prevPtr = NULL;
+ infoPtr != NULL; infoPtr = nextPtr) {
+ nextPtr = infoPtr->nextPtr;
+ if (infoPtr->selection == selection) {
+ if (prevPtr == NULL) {
+ dispPtr->selectionInfoPtr = nextPtr;
+ } else {
+ prevPtr->nextPtr = nextPtr;
+ }
+ break;
+ }
+ prevPtr = infoPtr;
+ }
+
+ if (infoPtr != NULL) {
+ clearProc = infoPtr->clearProc;
+ clearData = infoPtr->clearData;
+ ckfree((char *) infoPtr);
+ }
+ XSetSelectionOwner(winPtr->display, selection, None, CurrentTime);
+
+ if (clearProc != NULL) {
+ (*clearProc)(clearData);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetSelection --
+ *
+ * Retrieve the value of a selection and pass it off (in
+ * pieces, possibly) to a given procedure.
+ *
+ * Results:
+ * The return value is a standard Tcl return value.
+ * If an error occurs (such as no selection exists)
+ * then an error message is left in interp->result.
+ *
+ * Side effects:
+ * The standard X11 protocols are used to retrieve the
+ * selection. When it arrives, it is passed to proc. If
+ * the selection is very large, it will be passed to proc
+ * in several pieces. Proc should have the following
+ * structure:
+ *
+ * int
+ * proc(clientData, interp, portion)
+ * ClientData clientData;
+ * Tcl_Interp *interp;
+ * char *portion;
+ * {
+ * }
+ *
+ * The interp and clientData arguments to proc will be the
+ * same as the corresponding arguments to Tk_GetSelection.
+ * The portion argument points to a character string
+ * containing part of the selection, and numBytes indicates
+ * the length of the portion, not including the terminating
+ * NULL character. If the selection arrives in several pieces,
+ * the "portion" arguments in separate calls will contain
+ * successive parts of the selection. Proc should normally
+ * return TCL_OK. If it detects an error then it should return
+ * TCL_ERROR and leave an error message in interp->result; the
+ * remainder of the selection retrieval will be aborted.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetSelection(interp, tkwin, selection, target, proc, clientData)
+ Tcl_Interp *interp; /* Interpreter to use for reporting
+ * errors. */
+ Tk_Window tkwin; /* Window on whose behalf to retrieve
+ * the selection (determines display
+ * from which to retrieve). */
+ Atom selection; /* Selection to retrieve. */
+ Atom target; /* Desired form in which selection
+ * is to be returned. */
+ Tk_GetSelProc *proc; /* Procedure to call to process the
+ * selection, once it has been retrieved. */
+ ClientData clientData; /* Arbitrary value to pass to proc. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkSelectionInfo *infoPtr;
+
+ if (dispPtr->multipleAtom == None) {
+ TkSelInit(tkwin);
+ }
+
+ /*
+ * If the selection is owned by a window managed by this
+ * process, then call the retrieval procedure directly,
+ * rather than going through the X server (it's dangerous
+ * to go through the X server in this case because it could
+ * result in deadlock if an INCR-style selection results).
+ */
+
+ for (infoPtr = dispPtr->selectionInfoPtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->selection == selection)
+ break;
+ }
+ if (infoPtr != NULL) {
+ register TkSelHandler *selPtr;
+ int offset, result, count;
+ char buffer[TK_SEL_BYTES_AT_ONCE+1];
+ TkSelInProgress ip;
+
+ for (selPtr = ((TkWindow *) infoPtr->owner)->selHandlerList;
+ selPtr != NULL; selPtr = selPtr->nextPtr) {
+ if ((selPtr->target == target)
+ && (selPtr->selection == selection)) {
+ break;
+ }
+ }
+ if (selPtr == NULL) {
+ Atom type;
+
+ count = TkSelDefaultSelection(infoPtr, target, buffer,
+ TK_SEL_BYTES_AT_ONCE, &type);
+ if (count > TK_SEL_BYTES_AT_ONCE) {
+ panic("selection handler returned too many bytes");
+ }
+ if (count < 0) {
+ goto cantget;
+ }
+ buffer[count] = 0;
+ result = (*proc)(clientData, interp, buffer);
+ } else {
+ offset = 0;
+ result = TCL_OK;
+ ip.selPtr = selPtr;
+ ip.nextPtr = pendingPtr;
+ pendingPtr = &ip;
+ while (1) {
+ count = (selPtr->proc)(selPtr->clientData, offset, buffer,
+ TK_SEL_BYTES_AT_ONCE);
+ if ((count < 0) || (ip.selPtr == NULL)) {
+ pendingPtr = ip.nextPtr;
+ goto cantget;
+ }
+ if (count > TK_SEL_BYTES_AT_ONCE) {
+ panic("selection handler returned too many bytes");
+ }
+ buffer[count] = '\0';
+ result = (*proc)(clientData, interp, buffer);
+ if ((result != TCL_OK) || (count < TK_SEL_BYTES_AT_ONCE)
+ || (ip.selPtr == NULL)) {
+ break;
+ }
+ offset += count;
+ }
+ pendingPtr = ip.nextPtr;
+ }
+ return result;
+ }
+
+ /*
+ * The selection is owned by some other process.
+ */
+
+ return TkSelGetSelection(interp, tkwin, selection, target, proc,
+ clientData);
+
+ cantget:
+ Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection),
+ " selection doesn't exist or form \"", Tk_GetAtomName(tkwin, target),
+ "\" not defined", (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SelectionCmd --
+ *
+ * This procedure is invoked to process the "selection" Tcl
+ * command. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_SelectionCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ char *path = NULL;
+ Atom selection;
+ char *selName = NULL;
+ int c, count;
+ size_t length;
+ char **args;
+
+ if (argc < 2) {
+ sprintf(interp->result,
+ "wrong # args: should be \"%.50s option ?arg arg ...?\"",
+ argv[0]);
+ return TCL_ERROR;
+ }
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'c') && (strncmp(argv[1], "clear", length) == 0)) {
+ for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) {
+ if (args[0][0] != '-') {
+ break;
+ }
+ if (count < 2) {
+ Tcl_AppendResult(interp, "value for \"", *args,
+ "\" missing", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = args[0][1];
+ length = strlen(args[0]);
+ if ((c == 'd') && (strncmp(args[0], "-displayof", length) == 0)) {
+ path = args[1];
+ } else if ((c == 's')
+ && (strncmp(args[0], "-selection", length) == 0)) {
+ selName = args[1];
+ } else {
+ Tcl_AppendResult(interp, "unknown option \"", args[0],
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (count == 1) {
+ path = args[0];
+ } else if (count > 1) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " clear ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (path != NULL) {
+ tkwin = Tk_NameToWindow(interp, path, tkwin);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (selName != NULL) {
+ selection = Tk_InternAtom(tkwin, selName);
+ } else {
+ selection = XA_PRIMARY;
+ }
+
+ Tk_ClearSelection(tkwin, selection);
+ return TCL_OK;
+ } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
+ Atom target;
+ char *targetName = NULL;
+ Tcl_DString selBytes;
+ int result;
+
+ for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) {
+ if (args[0][0] != '-') {
+ break;
+ }
+ if (count < 2) {
+ Tcl_AppendResult(interp, "value for \"", *args,
+ "\" missing", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = args[0][1];
+ length = strlen(args[0]);
+ if ((c == 'd') && (strncmp(args[0], "-displayof", length) == 0)) {
+ path = args[1];
+ } else if ((c == 's')
+ && (strncmp(args[0], "-selection", length) == 0)) {
+ selName = args[1];
+ } else if ((c == 't')
+ && (strncmp(args[0], "-type", length) == 0)) {
+ targetName = args[1];
+ } else {
+ Tcl_AppendResult(interp, "unknown option \"", args[0],
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (path != NULL) {
+ tkwin = Tk_NameToWindow(interp, path, tkwin);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (selName != NULL) {
+ selection = Tk_InternAtom(tkwin, selName);
+ } else {
+ selection = XA_PRIMARY;
+ }
+ if (count > 1) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " get ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ } else if (count == 1) {
+ target = Tk_InternAtom(tkwin, args[0]);
+ } else if (targetName != NULL) {
+ target = Tk_InternAtom(tkwin, targetName);
+ } else {
+ target = XA_STRING;
+ }
+
+ Tcl_DStringInit(&selBytes);
+ result = Tk_GetSelection(interp, tkwin, selection, target, SelGetProc,
+ (ClientData) &selBytes);
+ if (result == TCL_OK) {
+ Tcl_DStringResult(interp, &selBytes);
+ } else {
+ Tcl_DStringFree(&selBytes);
+ }
+ return result;
+ } else if ((c == 'h') && (strncmp(argv[1], "handle", length) == 0)) {
+ Atom target, format;
+ char *targetName = NULL;
+ char *formatName = NULL;
+ register CommandInfo *cmdInfoPtr;
+ int cmdLength;
+
+ for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) {
+ if (args[0][0] != '-') {
+ break;
+ }
+ if (count < 2) {
+ Tcl_AppendResult(interp, "value for \"", *args,
+ "\" missing", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = args[0][1];
+ length = strlen(args[0]);
+ if ((c == 'f') && (strncmp(args[0], "-format", length) == 0)) {
+ formatName = args[1];
+ } else if ((c == 's')
+ && (strncmp(args[0], "-selection", length) == 0)) {
+ selName = args[1];
+ } else if ((c == 't')
+ && (strncmp(args[0], "-type", length) == 0)) {
+ targetName = args[1];
+ } else {
+ Tcl_AppendResult(interp, "unknown option \"", args[0],
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if ((count < 2) || (count > 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " handle ?options? window command\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp, args[0], tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (selName != NULL) {
+ selection = Tk_InternAtom(tkwin, selName);
+ } else {
+ selection = XA_PRIMARY;
+ }
+
+ if (count > 2) {
+ target = Tk_InternAtom(tkwin, args[2]);
+ } else if (targetName != NULL) {
+ target = Tk_InternAtom(tkwin, targetName);
+ } else {
+ target = XA_STRING;
+ }
+ if (count > 3) {
+ format = Tk_InternAtom(tkwin, args[3]);
+ } else if (formatName != NULL) {
+ format = Tk_InternAtom(tkwin, formatName);
+ } else {
+ format = XA_STRING;
+ }
+ cmdLength = strlen(args[1]);
+ if (cmdLength == 0) {
+ Tk_DeleteSelHandler(tkwin, selection, target);
+ } else {
+ cmdInfoPtr = (CommandInfo *) ckalloc((unsigned) (
+ sizeof(CommandInfo) - 3 + cmdLength));
+ cmdInfoPtr->interp = interp;
+ cmdInfoPtr->cmdLength = cmdLength;
+ strcpy(cmdInfoPtr->command, args[1]);
+ Tk_CreateSelHandler(tkwin, selection, target, HandleTclCommand,
+ (ClientData) cmdInfoPtr, format);
+ }
+ return TCL_OK;
+ } else if ((c == 'o') && (strncmp(argv[1], "own", length) == 0)) {
+ register LostCommand *lostPtr;
+ char *script = NULL;
+ int cmdLength;
+
+ for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) {
+ if (args[0][0] != '-') {
+ break;
+ }
+ if (count < 2) {
+ Tcl_AppendResult(interp, "value for \"", *args,
+ "\" missing", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = args[0][1];
+ length = strlen(args[0]);
+ if ((c == 'c') && (strncmp(args[0], "-command", length) == 0)) {
+ script = args[1];
+ } else if ((c == 'd')
+ && (strncmp(args[0], "-displayof", length) == 0)) {
+ path = args[1];
+ } else if ((c == 's')
+ && (strncmp(args[0], "-selection", length) == 0)) {
+ selName = args[1];
+ } else {
+ Tcl_AppendResult(interp, "unknown option \"", args[0],
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if (count > 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " own ?options? ?window?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (selName != NULL) {
+ selection = Tk_InternAtom(tkwin, selName);
+ } else {
+ selection = XA_PRIMARY;
+ }
+ if (count == 0) {
+ TkSelectionInfo *infoPtr;
+ TkWindow *winPtr;
+ if (path != NULL) {
+ tkwin = Tk_NameToWindow(interp, path, tkwin);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ winPtr = (TkWindow *)tkwin;
+ for (infoPtr = winPtr->dispPtr->selectionInfoPtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->selection == selection)
+ break;
+ }
+
+ /*
+ * Ignore the internal clipboard window.
+ */
+
+ if ((infoPtr != NULL)
+ && (infoPtr->owner != winPtr->dispPtr->clipWindow)) {
+ interp->result = Tk_PathName(infoPtr->owner);
+ }
+ return TCL_OK;
+ }
+ tkwin = Tk_NameToWindow(interp, args[0], tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (count == 2) {
+ script = args[1];
+ }
+ if (script == NULL) {
+ Tk_OwnSelection(tkwin, selection, (Tk_LostSelProc *) NULL,
+ (ClientData) NULL);
+ return TCL_OK;
+ }
+ cmdLength = strlen(script);
+ lostPtr = (LostCommand *) ckalloc((unsigned) (sizeof(LostCommand)
+ -3 + cmdLength));
+ lostPtr->interp = interp;
+ strcpy(lostPtr->command, script);
+ Tk_OwnSelection(tkwin, selection, LostSelection, (ClientData) lostPtr);
+ return TCL_OK;
+ } else {
+ sprintf(interp->result,
+ "bad option \"%.50s\": must be clear, get, handle, or own",
+ argv[1]);
+ return TCL_ERROR;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelDeadWindow --
+ *
+ * This procedure is invoked just before a TkWindow is deleted.
+ * It performs selection-related cleanup.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees up memory associated with the selection.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSelDeadWindow(winPtr)
+ register TkWindow *winPtr; /* Window that's being deleted. */
+{
+ register TkSelHandler *selPtr;
+ register TkSelInProgress *ipPtr;
+ TkSelectionInfo *infoPtr, *prevPtr, *nextPtr;
+
+ /*
+ * While deleting all the handlers, be careful to check whether
+ * ConvertSelection or TkSelPropProc are about to process one of the
+ * deleted handlers.
+ */
+
+ while (winPtr->selHandlerList != NULL) {
+ selPtr = winPtr->selHandlerList;
+ winPtr->selHandlerList = selPtr->nextPtr;
+ for (ipPtr = pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
+ if (ipPtr->selPtr == selPtr) {
+ ipPtr->selPtr = NULL;
+ }
+ }
+ if (selPtr->proc == HandleTclCommand) {
+ ckfree((char *) selPtr->clientData);
+ }
+ ckfree((char *) selPtr);
+ }
+
+ /*
+ * Remove selections owned by window being deleted.
+ */
+
+ for (infoPtr = winPtr->dispPtr->selectionInfoPtr, prevPtr = NULL;
+ infoPtr != NULL; infoPtr = nextPtr) {
+ nextPtr = infoPtr->nextPtr;
+ if (infoPtr->owner == (Tk_Window) winPtr) {
+ if (infoPtr->clearProc == LostSelection) {
+ ckfree((char *) infoPtr->clearData);
+ }
+ ckfree((char *) infoPtr);
+ infoPtr = prevPtr;
+ if (prevPtr == NULL) {
+ winPtr->dispPtr->selectionInfoPtr = nextPtr;
+ } else {
+ prevPtr->nextPtr = nextPtr;
+ }
+ }
+ prevPtr = infoPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelInit --
+ *
+ * Initialize selection-related information for a display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Selection-related information is initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSelInit(tkwin)
+ Tk_Window tkwin; /* Window token (used to find
+ * display to initialize). */
+{
+ register TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ /*
+ * Fetch commonly-used atoms.
+ */
+
+ dispPtr->multipleAtom = Tk_InternAtom(tkwin, "MULTIPLE");
+ dispPtr->incrAtom = Tk_InternAtom(tkwin, "INCR");
+ dispPtr->targetsAtom = Tk_InternAtom(tkwin, "TARGETS");
+ dispPtr->timestampAtom = Tk_InternAtom(tkwin, "TIMESTAMP");
+ dispPtr->textAtom = Tk_InternAtom(tkwin, "TEXT");
+ dispPtr->compoundTextAtom = Tk_InternAtom(tkwin, "COMPOUND_TEXT");
+ dispPtr->applicationAtom = Tk_InternAtom(tkwin, "TK_APPLICATION");
+ dispPtr->windowAtom = Tk_InternAtom(tkwin, "TK_WINDOW");
+ dispPtr->clipboardAtom = Tk_InternAtom(tkwin, "CLIPBOARD");
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelClearSelection --
+ *
+ * This procedure is invoked to process a SelectionClear event.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Invokes the clear procedure for the window which lost the
+ * selection.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSelClearSelection(tkwin, eventPtr)
+ Tk_Window tkwin; /* Window for which event was targeted. */
+ register XEvent *eventPtr; /* X SelectionClear event. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkSelectionInfo *infoPtr;
+ TkSelectionInfo *prevPtr;
+
+ /*
+ * Invoke clear procedure for window that just lost the selection. This
+ * code is a bit tricky, because any callbacks due to selection changes
+ * between windows managed by the process have already been made. Thus,
+ * ignore the event unless it refers to the window that's currently the
+ * selection owner and the event was generated after the server saw the
+ * SetSelectionOwner request.
+ */
+
+ for (infoPtr = dispPtr->selectionInfoPtr, prevPtr = NULL;
+ infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->selection == eventPtr->xselectionclear.selection) {
+ break;
+ }
+ prevPtr = infoPtr;
+ }
+
+ if (infoPtr != NULL && (infoPtr->owner == tkwin)
+ && (eventPtr->xselectionclear.serial >= (unsigned) infoPtr->serial)) {
+ if (prevPtr == NULL) {
+ dispPtr->selectionInfoPtr = infoPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = infoPtr->nextPtr;
+ }
+
+ /*
+ * Because of reentrancy problems, calling clearProc must be done
+ * after the infoPtr has been removed from the selectionInfoPtr
+ * list (clearProc could modify the list, e.g. by creating
+ * a new selection).
+ */
+
+ if (infoPtr->clearProc != NULL) {
+ (*infoPtr->clearProc)(infoPtr->clearData);
+ }
+ ckfree((char *) infoPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SelGetProc --
+ *
+ * This procedure is invoked to process pieces of the selection
+ * as they arrive during "selection get" commands.
+ *
+ * Results:
+ * Always returns TCL_OK.
+ *
+ * Side effects:
+ * Bytes get appended to the dynamic string pointed to by the
+ * clientData argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+SelGetProc(clientData, interp, portion)
+ ClientData clientData; /* Dynamic string holding partially
+ * assembled selection. */
+ Tcl_Interp *interp; /* Interpreter used for error
+ * reporting (not used). */
+ char *portion; /* New information to be appended. */
+{
+ Tcl_DStringAppend((Tcl_DString *) clientData, portion, -1);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HandleTclCommand --
+ *
+ * This procedure acts as selection handler for handlers created
+ * by the "selection handle" command. It invokes a Tcl command to
+ * retrieve the selection.
+ *
+ * Results:
+ * The return value is a count of the number of bytes actually
+ * stored at buffer, or -1 if an error occurs while executing
+ * the Tcl command to retrieve the selection.
+ *
+ * Side effects:
+ * None except for things done by the Tcl command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+HandleTclCommand(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Information about command to execute. */
+ int offset; /* Return selection bytes starting at this
+ * offset. */
+ char *buffer; /* Place to store converted selection. */
+ int maxBytes; /* Maximum # of bytes to store at buffer. */
+{
+ CommandInfo *cmdInfoPtr = (CommandInfo *) clientData;
+ int spaceNeeded, length;
+#define MAX_STATIC_SIZE 100
+ char staticSpace[MAX_STATIC_SIZE];
+ char *command;
+ Tcl_Interp *interp;
+ Tcl_DString oldResult;
+
+ /*
+ * We must copy the interpreter pointer from CommandInfo because the
+ * command could delete the handler, freeing the CommandInfo data before we
+ * are done using it. We must also protect the interpreter from being
+ * deleted too soo.
+ */
+
+ interp = cmdInfoPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+
+ /*
+ * First, generate a command by taking the command string
+ * and appending the offset and maximum # of bytes.
+ */
+
+ spaceNeeded = cmdInfoPtr->cmdLength + 30;
+ if (spaceNeeded < MAX_STATIC_SIZE) {
+ command = staticSpace;
+ } else {
+ command = (char *) ckalloc((unsigned) spaceNeeded);
+ }
+ sprintf(command, "%s %d %d", cmdInfoPtr->command, offset, maxBytes);
+
+ /*
+ * Execute the command. Be sure to restore the state of the
+ * interpreter after executing the command.
+ */
+
+ Tcl_DStringInit(&oldResult);
+ Tcl_DStringGetResult(interp, &oldResult);
+ if (TkCopyAndGlobalEval(interp, command) == TCL_OK) {
+ length = strlen(interp->result);
+ if (length > maxBytes) {
+ length = maxBytes;
+ }
+ memcpy((VOID *) buffer, (VOID *) interp->result, (size_t) length);
+ buffer[length] = '\0';
+ } else {
+ length = -1;
+ }
+ Tcl_DStringResult(interp, &oldResult);
+
+ if (command != staticSpace) {
+ ckfree(command);
+ }
+
+ Tcl_Release((ClientData) interp);
+ return length;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelDefaultSelection --
+ *
+ * This procedure is called to generate selection information
+ * for a few standard targets such as TIMESTAMP and TARGETS.
+ * It is invoked only if no handler has been declared by the
+ * application.
+ *
+ * Results:
+ * If "target" is a standard target understood by this procedure,
+ * the selection is converted to that form and stored as a
+ * character string in buffer. The type of the selection (e.g.
+ * STRING or ATOM) is stored in *typePtr, and the return value is
+ * a count of the # of non-NULL bytes at buffer. If the target
+ * wasn't understood, or if there isn't enough space at buffer
+ * to hold the entire selection (no INCR-mode transfers for this
+ * stuff!), then -1 is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkSelDefaultSelection(infoPtr, target, buffer, maxBytes, typePtr)
+ TkSelectionInfo *infoPtr; /* Info about selection being retrieved. */
+ Atom target; /* Desired form of selection. */
+ char *buffer; /* Place to put selection characters. */
+ int maxBytes; /* Maximum # of bytes to store at buffer. */
+ Atom *typePtr; /* Store here the type of the selection,
+ * for use in converting to proper X format. */
+{
+ register TkWindow *winPtr = (TkWindow *) infoPtr->owner;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+
+ if (target == dispPtr->timestampAtom) {
+ if (maxBytes < 20) {
+ return -1;
+ }
+ sprintf(buffer, "0x%x", (unsigned int) infoPtr->time);
+ *typePtr = XA_INTEGER;
+ return strlen(buffer);
+ }
+
+ if (target == dispPtr->targetsAtom) {
+ register TkSelHandler *selPtr;
+ char *atomString;
+ int length, atomLength;
+
+ if (maxBytes < 50) {
+ return -1;
+ }
+ strcpy(buffer, "MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW");
+ length = strlen(buffer);
+ for (selPtr = winPtr->selHandlerList; selPtr != NULL;
+ selPtr = selPtr->nextPtr) {
+ if ((selPtr->selection == infoPtr->selection)
+ && (selPtr->target != dispPtr->applicationAtom)
+ && (selPtr->target != dispPtr->windowAtom)) {
+ atomString = Tk_GetAtomName((Tk_Window) winPtr,
+ selPtr->target);
+ atomLength = strlen(atomString) + 1;
+ if ((length + atomLength) >= maxBytes) {
+ return -1;
+ }
+ sprintf(buffer+length, " %s", atomString);
+ length += atomLength;
+ }
+ }
+ *typePtr = XA_ATOM;
+ return length;
+ }
+
+ if (target == dispPtr->applicationAtom) {
+ int length;
+ char *name = winPtr->mainPtr->winPtr->nameUid;
+
+ length = strlen(name);
+ if (maxBytes <= length) {
+ return -1;
+ }
+ strcpy(buffer, name);
+ *typePtr = XA_STRING;
+ return length;
+ }
+
+ if (target == dispPtr->windowAtom) {
+ int length;
+ char *name = winPtr->pathName;
+
+ length = strlen(name);
+ if (maxBytes <= length) {
+ return -1;
+ }
+ strcpy(buffer, name);
+ *typePtr = XA_STRING;
+ return length;
+ }
+
+ return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * LostSelection --
+ *
+ * This procedure is invoked when a window has lost ownership of
+ * the selection and the ownership was claimed with the command
+ * "selection own".
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A Tcl script is executed; it can do almost anything.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+LostSelection(clientData)
+ ClientData clientData; /* Pointer to CommandInfo structure. */
+{
+ LostCommand *lostPtr = (LostCommand *) clientData;
+ char *oldResultString;
+ Tcl_FreeProc *oldFreeProc;
+ Tcl_Interp *interp;
+
+ interp = lostPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+
+ /*
+ * Execute the command. Save the interpreter's result, if any, and
+ * restore it after executing the command.
+ */
+
+ oldFreeProc = interp->freeProc;
+ if (oldFreeProc != TCL_STATIC) {
+ oldResultString = interp->result;
+ } else {
+ oldResultString = (char *) ckalloc((unsigned)
+ (strlen(interp->result) + 1));
+ strcpy(oldResultString, interp->result);
+ oldFreeProc = TCL_DYNAMIC;
+ }
+ interp->freeProc = TCL_STATIC;
+ if (TkCopyAndGlobalEval(interp, lostPtr->command) != TCL_OK) {
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_FreeResult(interp);
+ interp->result = oldResultString;
+ interp->freeProc = oldFreeProc;
+
+ Tcl_Release((ClientData) interp);
+
+ /*
+ * Free the storage for the command, since we're done with it now.
+ */
+
+ ckfree((char *) lostPtr);
+}
diff --git a/generic/tkSelect.h b/generic/tkSelect.h
new file mode 100644
index 0000000..8595599
--- /dev/null
+++ b/generic/tkSelect.h
@@ -0,0 +1,184 @@
+/*
+ * tkSelect.h --
+ *
+ * Declarations of types shared among the files that implement
+ * selection support.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkSelect.h 1.4 95/11/03 13:22:41
+ */
+
+#ifndef _TKSELECT
+#define _TKSELECT
+
+/*
+ * When a selection is owned by a window on a given display, one of the
+ * following structures is present on a list of current selections in the
+ * display structure. The structure is used to record the current owner of
+ * a selection for use in later retrieval requests. There is a list of
+ * such structures because a display can have multiple different selections
+ * active at the same time.
+ */
+
+typedef struct TkSelectionInfo {
+ Atom selection; /* Selection name, e.g. XA_PRIMARY. */
+ Tk_Window owner; /* Current owner of this selection. */
+ int serial; /* Serial number of last XSelectionSetOwner
+ * request made to server for this
+ * selection (used to filter out redundant
+ * SelectionClear events). */
+ Time time; /* Timestamp used to acquire selection. */
+ Tk_LostSelProc *clearProc; /* Procedure to call when owner loses
+ * selection. */
+ ClientData clearData; /* Info to pass to clearProc. */
+ struct TkSelectionInfo *nextPtr;
+ /* Next in list of current selections on
+ * this display. NULL means end of list */
+} TkSelectionInfo;
+
+/*
+ * One of the following structures exists for each selection handler
+ * created for a window by calling Tk_CreateSelHandler. The handlers
+ * are linked in a list rooted in the TkWindow structure.
+ */
+
+typedef struct TkSelHandler {
+ Atom selection; /* Selection name, e.g. XA_PRIMARY */
+ Atom target; /* Target type for selection
+ * conversion, such as TARGETS or
+ * STRING. */
+ Atom format; /* Format in which selection
+ * info will be returned, such
+ * as STRING or ATOM. */
+ Tk_SelectionProc *proc; /* Procedure to generate selection
+ * in this format. */
+ ClientData clientData; /* Argument to pass to proc. */
+ int size; /* Size of units returned by proc
+ * (8 for STRING, 32 for almost
+ * anything else). */
+ struct TkSelHandler *nextPtr;
+ /* Next selection handler associated
+ * with same window (NULL for end of
+ * list). */
+} TkSelHandler;
+
+/*
+ * When the selection is being retrieved, one of the following
+ * structures is present on a list of pending selection retrievals.
+ * The structure is used to communicate between the background
+ * procedure that requests the selection and the foreground
+ * event handler that processes the events in which the selection
+ * is returned. There is a list of such structures so that there
+ * can be multiple simultaneous selection retrievals (e.g. on
+ * different displays).
+ */
+
+typedef struct TkSelRetrievalInfo {
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ TkWindow *winPtr; /* Window used as requestor for
+ * selection. */
+ Atom selection; /* Selection being requested. */
+ Atom property; /* Property where selection will appear. */
+ Atom target; /* Desired form for selection. */
+ int (*proc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp,
+ char *portion)); /* Procedure to call to handle pieces
+ * of selection. */
+ ClientData clientData; /* Argument for proc. */
+ int result; /* Initially -1. Set to a Tcl
+ * return value once the selection
+ * has been retrieved. */
+ Tcl_TimerToken timeout; /* Token for current timeout procedure. */
+ int idleTime; /* Number of seconds that have gone by
+ * without hearing anything from the
+ * selection owner. */
+ struct TkSelRetrievalInfo *nextPtr;
+ /* Next in list of all pending
+ * selection retrievals. NULL means
+ * end of list. */
+} TkSelRetrievalInfo;
+
+/*
+ * The clipboard contains a list of buffers of various types and formats.
+ * All of the buffers of a given type will be returned in sequence when the
+ * CLIPBOARD selection is retrieved. All buffers of a given type on the
+ * same clipboard must have the same format. The TkClipboardTarget structure
+ * is used to record the information about a chain of buffers of the same
+ * type.
+ */
+
+typedef struct TkClipboardBuffer {
+ char *buffer; /* Null terminated data buffer. */
+ long length; /* Length of string in buffer. */
+ struct TkClipboardBuffer *nextPtr; /* Next in list of buffers. NULL
+ * means end of list . */
+} TkClipboardBuffer;
+
+typedef struct TkClipboardTarget {
+ Atom type; /* Type conversion supported. */
+ Atom format; /* Representation used for data. */
+ TkClipboardBuffer *firstBufferPtr; /* First in list of data buffers. */
+ TkClipboardBuffer *lastBufferPtr; /* Last in list of clipboard buffers.
+ * Used to speed up appends. */
+ struct TkClipboardTarget *nextPtr; /* Next in list of targets on
+ * clipboard. NULL means end of
+ * list. */
+} TkClipboardTarget;
+
+/*
+ * It is possible for a Tk_SelectionProc to delete the handler that it
+ * represents. If this happens, the code that is retrieving the selection
+ * needs to know about it so it doesn't use the now-defunct handler
+ * structure. One structure of the following form is created for each
+ * retrieval in progress, so that the retriever can find out if its
+ * handler is deleted. All of the pending retrievals (if there are more
+ * than one) are linked into a list.
+ */
+
+typedef struct TkSelInProgress {
+ TkSelHandler *selPtr; /* Handler being executed. If this handler
+ * is deleted, the field is set to NULL. */
+ struct TkSelInProgress *nextPtr;
+ /* Next higher nested search. */
+} TkSelInProgress;
+
+/*
+ * Declarations for variables shared among the selection-related files:
+ */
+
+extern TkSelInProgress *pendingPtr;
+ /* Topmost search in progress, or
+ * NULL if none. */
+
+/*
+ * Chunk size for retrieving selection. It's defined both in
+ * words and in bytes; the word size is used to allocate
+ * buffer space that's guaranteed to be word-aligned and that
+ * has an extra character for the terminating NULL.
+ */
+
+#define TK_SEL_BYTES_AT_ONCE 4000
+#define TK_SEL_WORDS_AT_ONCE 1001
+
+/*
+ * Declarations for procedures that are used by the selection-related files
+ * but shouldn't be used anywhere else in Tk (or by Tk clients):
+ */
+
+extern void TkSelClearSelection _ANSI_ARGS_((Tk_Window tkwin,
+ XEvent *eventPtr));
+extern int TkSelDefaultSelection _ANSI_ARGS_((
+ TkSelectionInfo *infoPtr, Atom target,
+ char *buffer, int maxBytes, Atom *typePtr));
+extern int TkSelGetSelection _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Atom selection, Atom target,
+ Tk_GetSelProc *proc, ClientData clientData));
+#ifndef TkSelUpdateClipboard
+extern void TkSelUpdateClipboard _ANSI_ARGS_((TkWindow *winPtr,
+ TkClipboardTarget *targetPtr));
+#endif
+
+#endif /* _TKSELECT */
diff --git a/generic/tkSquare.c b/generic/tkSquare.c
new file mode 100644
index 0000000..eff8181
--- /dev/null
+++ b/generic/tkSquare.c
@@ -0,0 +1,587 @@
+/*
+ * tkSquare.c --
+ *
+ * This module implements "square" widgets. A "square" is
+ * a widget that displays a single square that can be moved
+ * around and resized. This file is intended as an example
+ * of how to build a widget; it isn't included in the
+ * normal wish, but it is included in "tktest".
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkSquare.c 1.19 97/07/31 09:13:13
+ */
+
+#include "tkPort.h"
+#include "tk.h"
+
+/*
+ * A data structure of the following type is kept for each square
+ * widget managed by this file:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the square. NULL
+ * means window has been deleted but
+ * widget record hasn't been cleaned up yet. */
+ Display *display; /* X's token for the window's display. */
+ Tcl_Interp *interp; /* Interpreter associated with widget. */
+ Tcl_Command widgetCmd; /* Token for square's widget command. */
+ int x, y; /* Position of square's upper-left corner
+ * within widget. */
+ int size; /* Width and height of square. */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ int borderWidth; /* Width of 3-D border around whole widget. */
+ Tk_3DBorder bgBorder; /* Used for drawing background. */
+ Tk_3DBorder fgBorder; /* For drawing square. */
+ int relief; /* Indicates whether window as a whole is
+ * raised, sunken, or flat. */
+ GC gc; /* Graphics context for copying from
+ * off-screen pixmap onto screen. */
+ int doubleBuffer; /* Non-zero means double-buffer redisplay
+ * with pixmap; zero means draw straight
+ * onto the display. */
+ int updatePending; /* Non-zero means a call to SquareDisplay
+ * has already been scheduled. */
+} Square;
+
+/*
+ * Information used for argv parsing.
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ "#d9d9d9", Tk_Offset(Square, bgBorder), TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ "white", Tk_Offset(Square, bgBorder), TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ "2", Tk_Offset(Square, borderWidth), 0},
+ {TK_CONFIG_INT, "-dbl", "doubleBuffer", "DoubleBuffer",
+ "1", Tk_Offset(Square, doubleBuffer), 0},
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_BORDER, "-foreground", "foreground", "Foreground",
+ "#b03060", Tk_Offset(Square, fgBorder), TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-foreground", "foreground", "Foreground",
+ "black", Tk_Offset(Square, fgBorder), TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ "raised", Tk_Offset(Square, relief), 0},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+int SquareCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void SquareCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static int SquareConfigure _ANSI_ARGS_((Tcl_Interp *interp,
+ Square *squarePtr, int argc, char **argv,
+ int flags));
+static void SquareDestroy _ANSI_ARGS_((char *memPtr));
+static void SquareDisplay _ANSI_ARGS_((ClientData clientData));
+static void KeepInWindow _ANSI_ARGS_((Square *squarePtr));
+static void SquareEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int SquareWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *, int argc, char **argv));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SquareCmd --
+ *
+ * This procedure is invoked to process the "square" Tcl
+ * command. It creates a new "square" widget.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * A new widget is created and configured.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+SquareCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window main = (Tk_Window) clientData;
+ Square *squarePtr;
+ Tk_Window tkwin;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " pathName ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_CreateWindowFromPath(interp, main, argv[1], (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_SetClass(tkwin, "Square");
+
+ /*
+ * Allocate and initialize the widget record.
+ */
+
+ squarePtr = (Square *) ckalloc(sizeof(Square));
+ squarePtr->tkwin = tkwin;
+ squarePtr->display = Tk_Display(tkwin);
+ squarePtr->interp = interp;
+ squarePtr->widgetCmd = Tcl_CreateCommand(interp,
+ Tk_PathName(squarePtr->tkwin), SquareWidgetCmd,
+ (ClientData) squarePtr, SquareCmdDeletedProc);
+ squarePtr->x = 0;
+ squarePtr->y = 0;
+ squarePtr->size = 20;
+ squarePtr->borderWidth = 0;
+ squarePtr->bgBorder = NULL;
+ squarePtr->fgBorder = NULL;
+ squarePtr->relief = TK_RELIEF_FLAT;
+ squarePtr->gc = None;
+ squarePtr->doubleBuffer = 1;
+ squarePtr->updatePending = 0;
+
+ Tk_CreateEventHandler(squarePtr->tkwin, ExposureMask|StructureNotifyMask,
+ SquareEventProc, (ClientData) squarePtr);
+ if (SquareConfigure(interp, squarePtr, argc-2, argv+2, 0) != TCL_OK) {
+ Tk_DestroyWindow(squarePtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ interp->result = Tk_PathName(squarePtr->tkwin);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SquareWidgetCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to a widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+SquareWidgetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about square widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Square *squarePtr = (Square *) clientData;
+ int result = TCL_OK;
+ size_t length;
+ char c;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_Preserve((ClientData) squarePtr);
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
+ && (length >= 2)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " cget option\"",
+ (char *) NULL);
+ goto error;
+ }
+ result = Tk_ConfigureValue(interp, squarePtr->tkwin, configSpecs,
+ (char *) squarePtr, argv[2], 0);
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
+ && (length >= 2)) {
+ if (argc == 2) {
+ result = Tk_ConfigureInfo(interp, squarePtr->tkwin, configSpecs,
+ (char *) squarePtr, (char *) NULL, 0);
+ } else if (argc == 3) {
+ result = Tk_ConfigureInfo(interp, squarePtr->tkwin, configSpecs,
+ (char *) squarePtr, argv[2], 0);
+ } else {
+ result = SquareConfigure(interp, squarePtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ } else if ((c == 'p') && (strncmp(argv[1], "position", length) == 0)) {
+ if ((argc != 2) && (argc != 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " position ?x y?\"", (char *) NULL);
+ goto error;
+ }
+ if (argc == 4) {
+ if ((Tk_GetPixels(interp, squarePtr->tkwin, argv[2],
+ &squarePtr->x) != TCL_OK) || (Tk_GetPixels(interp,
+ squarePtr->tkwin, argv[3], &squarePtr->y) != TCL_OK)) {
+ goto error;
+ }
+ KeepInWindow(squarePtr);
+ }
+ sprintf(interp->result, "%d %d", squarePtr->x, squarePtr->y);
+ } else if ((c == 's') && (strncmp(argv[1], "size", length) == 0)) {
+ if ((argc != 2) && (argc != 3)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " size ?amount?\"", (char *) NULL);
+ goto error;
+ }
+ if (argc == 3) {
+ int i;
+
+ if (Tk_GetPixels(interp, squarePtr->tkwin, argv[2], &i) != TCL_OK) {
+ goto error;
+ }
+ if ((i <= 0) || (i > 100)) {
+ Tcl_AppendResult(interp, "bad size \"", argv[2],
+ "\"", (char *) NULL);
+ goto error;
+ }
+ squarePtr->size = i;
+ KeepInWindow(squarePtr);
+ }
+ sprintf(interp->result, "%d", squarePtr->size);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be cget, configure, position, or size",
+ (char *) NULL);
+ goto error;
+ }
+ if (!squarePtr->updatePending) {
+ Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
+ squarePtr->updatePending = 1;
+ }
+ Tcl_Release((ClientData) squarePtr);
+ return result;
+
+ error:
+ Tcl_Release((ClientData) squarePtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SquareConfigure --
+ *
+ * This procedure is called to process an argv/argc list in
+ * conjunction with the Tk option database to configure (or
+ * reconfigure) a square widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then interp->result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width,
+ * etc. get set for squarePtr; old resources get freed,
+ * if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SquareConfigure(interp, squarePtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Square *squarePtr; /* Information about widget. */
+ int argc; /* Number of valid entries in argv. */
+ char **argv; /* Arguments. */
+ int flags; /* Flags to pass to
+ * Tk_ConfigureWidget. */
+{
+ if (Tk_ConfigureWidget(interp, squarePtr->tkwin, configSpecs,
+ argc, argv, (char *) squarePtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Set the background for the window and create a graphics context
+ * for use during redisplay.
+ */
+
+ Tk_SetWindowBackground(squarePtr->tkwin,
+ Tk_3DBorderColor(squarePtr->bgBorder)->pixel);
+ if ((squarePtr->gc == None) && (squarePtr->doubleBuffer)) {
+ XGCValues gcValues;
+ gcValues.function = GXcopy;
+ gcValues.graphics_exposures = False;
+ squarePtr->gc = Tk_GetGC(squarePtr->tkwin,
+ GCFunction|GCGraphicsExposures, &gcValues);
+ }
+
+ /*
+ * Register the desired geometry for the window. Then arrange for
+ * the window to be redisplayed.
+ */
+
+ Tk_GeometryRequest(squarePtr->tkwin, 200, 150);
+ Tk_SetInternalBorder(squarePtr->tkwin, squarePtr->borderWidth);
+ if (!squarePtr->updatePending) {
+ Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
+ squarePtr->updatePending = 1;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SquareEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on squares.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+SquareEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ Square *squarePtr = (Square *) clientData;
+
+ if (eventPtr->type == Expose) {
+ if (!squarePtr->updatePending) {
+ Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
+ squarePtr->updatePending = 1;
+ }
+ } else if (eventPtr->type == ConfigureNotify) {
+ KeepInWindow(squarePtr);
+ if (!squarePtr->updatePending) {
+ Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
+ squarePtr->updatePending = 1;
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ if (squarePtr->tkwin != NULL) {
+ squarePtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(squarePtr->interp,
+ squarePtr->widgetCmd);
+ }
+ if (squarePtr->updatePending) {
+ Tcl_CancelIdleCall(SquareDisplay, (ClientData) squarePtr);
+ }
+ Tcl_EventuallyFree((ClientData) squarePtr, SquareDestroy);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SquareCmdDeletedProc --
+ *
+ * This procedure is invoked when a widget command is deleted. If
+ * the widget isn't already in the process of being destroyed,
+ * this command destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SquareCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ Square *squarePtr = (Square *) clientData;
+ Tk_Window tkwin = squarePtr->tkwin;
+
+ /*
+ * This procedure could be invoked either because the window was
+ * destroyed and the command was then deleted (in which case tkwin
+ * is NULL) or because the command was deleted, and then this procedure
+ * destroys the widget.
+ */
+
+ if (tkwin != NULL) {
+ squarePtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SquareDisplay --
+ *
+ * This procedure redraws the contents of a square window.
+ * It is invoked as a do-when-idle handler, so it only runs
+ * when there's nothing else for the application to do.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+SquareDisplay(clientData)
+ ClientData clientData; /* Information about window. */
+{
+ Square *squarePtr = (Square *) clientData;
+ Tk_Window tkwin = squarePtr->tkwin;
+ Pixmap pm = None;
+ Drawable d;
+
+ squarePtr->updatePending = 0;
+ if (!Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ /*
+ * Create a pixmap for double-buffering, if necessary.
+ */
+
+ if (squarePtr->doubleBuffer) {
+ pm = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin),
+ DefaultDepthOfScreen(Tk_Screen(tkwin)));
+ d = pm;
+ } else {
+ d = Tk_WindowId(tkwin);
+ }
+
+ /*
+ * Redraw the widget's background and border.
+ */
+
+ Tk_Fill3DRectangle(tkwin, d, squarePtr->bgBorder, 0, 0, Tk_Width(tkwin),
+ Tk_Height(tkwin), squarePtr->borderWidth, squarePtr->relief);
+
+ /*
+ * Display the square.
+ */
+
+ Tk_Fill3DRectangle(tkwin, d, squarePtr->fgBorder, squarePtr->x,
+ squarePtr->y, squarePtr->size, squarePtr->size,
+ squarePtr->borderWidth, TK_RELIEF_RAISED);
+
+ /*
+ * If double-buffered, copy to the screen and release the pixmap.
+ */
+
+ if (squarePtr->doubleBuffer) {
+ XCopyArea(Tk_Display(tkwin), pm, Tk_WindowId(tkwin), squarePtr->gc,
+ 0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin),
+ 0, 0);
+ Tk_FreePixmap(Tk_Display(tkwin), pm);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SquareDestroy --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a square at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the square is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SquareDestroy(memPtr)
+ char *memPtr; /* Info about square widget. */
+{
+ Square *squarePtr = (Square *) memPtr;
+
+ Tk_FreeOptions(configSpecs, (char *) squarePtr, squarePtr->display, 0);
+ if (squarePtr->gc != None) {
+ Tk_FreeGC(squarePtr->display, squarePtr->gc);
+ }
+ ckfree((char *) squarePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * KeepInWindow --
+ *
+ * Adjust the position of the square if necessary to keep it in
+ * the widget's window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The x and y position of the square are adjusted if necessary
+ * to keep the square in the window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+KeepInWindow(squarePtr)
+ register Square *squarePtr; /* Pointer to widget record. */
+{
+ int i, bd;
+ bd = 0;
+ if (squarePtr->relief != TK_RELIEF_FLAT) {
+ bd = squarePtr->borderWidth;
+ }
+ i = (Tk_Width(squarePtr->tkwin) - bd) - (squarePtr->x + squarePtr->size);
+ if (i < 0) {
+ squarePtr->x += i;
+ }
+ i = (Tk_Height(squarePtr->tkwin) - bd) - (squarePtr->y + squarePtr->size);
+ if (i < 0) {
+ squarePtr->y += i;
+ }
+ if (squarePtr->x < bd) {
+ squarePtr->x = bd;
+ }
+ if (squarePtr->y < bd) {
+ squarePtr->y = bd;
+ }
+}
diff --git a/generic/tkTest.c b/generic/tkTest.c
new file mode 100644
index 0000000..dab43d0
--- /dev/null
+++ b/generic/tkTest.c
@@ -0,0 +1,1134 @@
+/*
+ * tkTest.c --
+ *
+ * This file contains C command procedures for a bunch of additional
+ * Tcl commands that are used for testing out Tcl's C interfaces.
+ * These commands are not normally included in Tcl applications;
+ * they're only used for testing.
+ *
+ * Copyright (c) 1993-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkTest.c 1.50 97/11/06 16:56:32
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+#ifdef __WIN32__
+#include "tkWinInt.h"
+#endif
+
+#ifdef MAC_TCL
+#include "tkScrollbar.h"
+#endif
+
+#ifdef __UNIX__
+#include "tkUnixInt.h"
+#endif
+
+/*
+ * The following data structure represents the master for a test
+ * image:
+ */
+
+typedef struct TImageMaster {
+ Tk_ImageMaster master; /* Tk's token for image master. */
+ Tcl_Interp *interp; /* Interpreter for application. */
+ int width, height; /* Dimensions of image. */
+ char *imageName; /* Name of image (malloc-ed). */
+ char *varName; /* Name of variable in which to log
+ * events for image (malloc-ed). */
+} TImageMaster;
+
+/*
+ * The following data structure represents a particular use of a
+ * particular test image.
+ */
+
+typedef struct TImageInstance {
+ TImageMaster *masterPtr; /* Pointer to master for image. */
+ XColor *fg; /* Foreground color for drawing in image. */
+ GC gc; /* Graphics context for drawing in image. */
+} TImageInstance;
+
+/*
+ * The type record for test images:
+ */
+
+static int ImageCreate _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, int argc, char **argv,
+ Tk_ImageType *typePtr, Tk_ImageMaster master,
+ ClientData *clientDataPtr));
+static ClientData ImageGet _ANSI_ARGS_((Tk_Window tkwin,
+ ClientData clientData));
+static void ImageDisplay _ANSI_ARGS_((ClientData clientData,
+ Display *display, Drawable drawable,
+ int imageX, int imageY, int width,
+ int height, int drawableX,
+ int drawableY));
+static void ImageFree _ANSI_ARGS_((ClientData clientData,
+ Display *display));
+static void ImageDelete _ANSI_ARGS_((ClientData clientData));
+
+static Tk_ImageType imageType = {
+ "test", /* name */
+ ImageCreate, /* createProc */
+ ImageGet, /* getProc */
+ ImageDisplay, /* displayProc */
+ ImageFree, /* freeProc */
+ ImageDelete, /* deleteProc */
+ (Tk_ImageType *) NULL /* nextPtr */
+};
+
+/*
+ * One of the following structures describes each of the interpreters
+ * created by the "testnewapp" command. This information is used by
+ * the "testdeleteinterps" command to destroy all of those interpreters.
+ */
+
+typedef struct NewApp {
+ Tcl_Interp *interp; /* Token for interpreter. */
+ struct NewApp *nextPtr; /* Next in list of new interpreters. */
+} NewApp;
+
+static NewApp *newAppPtr = NULL;
+ /* First in list of all new interpreters. */
+
+/*
+ * Declaration for the square widget's class command procedure:
+ */
+
+extern int SquareCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char *argv[]));
+
+typedef struct CBinding {
+ Tcl_Interp *interp;
+ char *command;
+ char *delete;
+} CBinding;
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int CBindingEvalProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, XEvent *eventPtr,
+ Tk_Window tkwin, KeySym keySym));
+static void CBindingFreeProc _ANSI_ARGS_((ClientData clientData));
+int Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+static int ImageCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
+static int TestcbindCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
+#ifdef __WIN32__
+static int TestclipboardCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
+#endif
+static int TestdeleteappsCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
+static int TestmakeexistCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
+static int TestmenubarCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
+#if defined(__WIN32__) || defined(MAC_TCL)
+static int TestmetricsCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
+#endif
+static int TestsendCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
+static int TestpropCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
+#if !(defined(__WIN32__) || defined(MAC_TCL))
+static int TestwrapperCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
+#endif
+
+/*
+ * External (platform specific) initialization routine:
+ */
+
+EXTERN int TkplatformtestInit _ANSI_ARGS_((
+ Tcl_Interp *interp));
+#ifndef MAC_TCL
+#define TkplatformtestInit(x) TCL_OK
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tktest_Init --
+ *
+ * This procedure performs intialization for the Tk test
+ * suite exensions.
+ *
+ * Results:
+ * Returns a standard Tcl completion code, and leaves an error
+ * message in interp->result if an error occurs.
+ *
+ * Side effects:
+ * Creates several test commands.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tktest_Init(interp)
+ Tcl_Interp *interp; /* Interpreter for application. */
+{
+ static int initialized = 0;
+
+ /*
+ * Create additional commands for testing Tk.
+ */
+
+ if (Tcl_PkgProvide(interp, "Tktest", TK_VERSION) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ Tcl_CreateCommand(interp, "square", SquareCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+#ifdef __WIN32__
+ Tcl_CreateCommand(interp, "testclipboard", TestclipboardCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+#endif
+ Tcl_CreateCommand(interp, "testcbind", TestcbindCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testdeleteapps", TestdeleteappsCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testembed", TkpTestembedCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testmakeexist", TestmakeexistCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testmenubar", TestmenubarCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+#if defined(__WIN32__) || defined(MAC_TCL)
+ Tcl_CreateCommand(interp, "testmetrics", TestmetricsCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+#endif
+ Tcl_CreateCommand(interp, "testprop", TestpropCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testsend", TestsendCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+#if !(defined(__WIN32__) || defined(MAC_TCL))
+ Tcl_CreateCommand(interp, "testwrapper", TestwrapperCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+#endif
+
+/*
+ * Create test image type.
+ */
+
+ if (!initialized) {
+ initialized = 1;
+ Tk_CreateImageType(&imageType);
+ }
+
+ /*
+ * And finally add any platform specific test commands.
+ */
+
+ return TkplatformtestInit(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestclipboardCmd --
+ *
+ * This procedure implements the testclipboard command. It provides
+ * a way to determine the actual contents of the Windows clipboard.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef __WIN32__
+static int
+TestclipboardCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ TkWindow *winPtr = (TkWindow *) clientData;
+ HGLOBAL handle;
+ char *data;
+
+ if (OpenClipboard(NULL)) {
+ handle = GetClipboardData(CF_TEXT);
+ if (handle != NULL) {
+ data = GlobalLock(handle);
+ Tcl_AppendResult(interp, data, (char *) NULL);
+ GlobalUnlock(handle);
+ }
+ CloseClipboard();
+ }
+ return TCL_OK;
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestcbindCmd --
+ *
+ * This procedure implements the "testcbinding" command. It provides
+ * a set of functions for testing C bindings in tkBind.c.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Depends on option; see below.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestcbindCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ TkWindow *winPtr;
+ Tk_Window tkwin;
+ ClientData object;
+ CBinding *cbindPtr;
+
+
+ if (argc < 4 || argc > 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " bindtag pattern command ?deletecommand?", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ tkwin = (Tk_Window) clientData;
+
+ if (argv[1][0] == '.') {
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ object = (ClientData) winPtr->pathName;
+ } else {
+ winPtr = (TkWindow *) clientData;
+ object = (ClientData) Tk_GetUid(argv[1]);
+ }
+
+ if (argv[3][0] == '\0') {
+ return Tk_DeleteBinding(interp, winPtr->mainPtr->bindingTable,
+ object, argv[2]);
+ }
+
+ cbindPtr = (CBinding *) ckalloc(sizeof(CBinding));
+ cbindPtr->interp = interp;
+ cbindPtr->command =
+ strcpy((char *) ckalloc(strlen(argv[3]) + 1), argv[3]);
+ if (argc == 4) {
+ cbindPtr->delete = NULL;
+ } else {
+ cbindPtr->delete =
+ strcpy((char *) ckalloc(strlen(argv[4]) + 1), argv[4]);
+ }
+
+ if (TkCreateBindingProcedure(interp, winPtr->mainPtr->bindingTable,
+ object, argv[2], CBindingEvalProc, CBindingFreeProc,
+ (ClientData) cbindPtr) == 0) {
+ ckfree((char *) cbindPtr->command);
+ if (cbindPtr->delete != NULL) {
+ ckfree((char *) cbindPtr->delete);
+ }
+ ckfree((char *) cbindPtr);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+static int
+CBindingEvalProc(clientData, interp, eventPtr, tkwin, keySym)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ XEvent *eventPtr;
+ Tk_Window tkwin;
+ KeySym keySym;
+{
+ CBinding *cbindPtr;
+
+ cbindPtr = (CBinding *) clientData;
+
+ return Tcl_GlobalEval(interp, cbindPtr->command);
+}
+
+static void
+CBindingFreeProc(clientData)
+ ClientData clientData;
+{
+ CBinding *cbindPtr = (CBinding *) clientData;
+
+ if (cbindPtr->delete != NULL) {
+ Tcl_GlobalEval(cbindPtr->interp, cbindPtr->delete);
+ ckfree((char *) cbindPtr->delete);
+ }
+ ckfree((char *) cbindPtr->command);
+ ckfree((char *) cbindPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestdeleteappsCmd --
+ *
+ * This procedure implements the "testdeleteapps" command. It cleans
+ * up all the interpreters left behind by the "testnewapp" command.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * All the intepreters created by previous calls to "testnewapp"
+ * get deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestdeleteappsCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ NewApp *nextPtr;
+
+ while (newAppPtr != NULL) {
+ nextPtr = newAppPtr->nextPtr;
+ Tcl_DeleteInterp(newAppPtr->interp);
+ ckfree((char *) newAppPtr);
+ newAppPtr = nextPtr;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageCreate --
+ *
+ * This procedure is called by the Tk image code to create "test"
+ * images.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The data structure for a new image is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ImageCreate(interp, name, argc, argv, typePtr, master, clientDataPtr)
+ Tcl_Interp *interp; /* Interpreter for application containing
+ * image. */
+ char *name; /* Name to use for image. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings for options (doesn't
+ * include image name or type). */
+ Tk_ImageType *typePtr; /* Pointer to our type record (not used). */
+ Tk_ImageMaster master; /* Token for image, to be used by us in
+ * later callbacks. */
+ ClientData *clientDataPtr; /* Store manager's token for image here;
+ * it will be returned in later callbacks. */
+{
+ TImageMaster *timPtr;
+ char *varName;
+ int i;
+
+ varName = "log";
+ for (i = 0; i < argc; i += 2) {
+ if (strcmp(argv[i], "-variable") != 0) {
+ Tcl_AppendResult(interp, "bad option name \"", argv[i],
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ((i+1) == argc) {
+ Tcl_AppendResult(interp, "no value given for \"", argv[i],
+ "\" option", (char *) NULL);
+ return TCL_ERROR;
+ }
+ varName = argv[i+1];
+ }
+ timPtr = (TImageMaster *) ckalloc(sizeof(TImageMaster));
+ timPtr->master = master;
+ timPtr->interp = interp;
+ timPtr->width = 30;
+ timPtr->height = 15;
+ timPtr->imageName = (char *) ckalloc((unsigned) (strlen(name) + 1));
+ strcpy(timPtr->imageName, name);
+ timPtr->varName = (char *) ckalloc((unsigned) (strlen(varName) + 1));
+ strcpy(timPtr->varName, varName);
+ Tcl_CreateCommand(interp, name, ImageCmd, (ClientData) timPtr,
+ (Tcl_CmdDeleteProc *) NULL);
+ *clientDataPtr = (ClientData) timPtr;
+ Tk_ImageChanged(master, 0, 0, 30, 15, 30, 15);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageCmd --
+ *
+ * This procedure implements the commands corresponding to individual
+ * images.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Forces windows to be created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ImageCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ TImageMaster *timPtr = (TImageMaster *) clientData;
+ int x, y, width, height;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], "option ?arg arg ...?", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (strcmp(argv[1], "changed") == 0) {
+ if (argc != 8) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " changed x y width height imageWidth imageHeight",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[4], &width) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[5], &height) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[6], &timPtr->width) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[7], &timPtr->height) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ Tk_ImageChanged(timPtr->master, x, y, width, height, timPtr->width,
+ timPtr->height);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be changed", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageGet --
+ *
+ * This procedure is called by Tk to set things up for using a
+ * test image in a particular widget.
+ *
+ * Results:
+ * The return value is a token for the image instance, which is
+ * used in future callbacks to ImageDisplay and ImageFree.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ClientData
+ImageGet(tkwin, clientData)
+ Tk_Window tkwin; /* Token for window in which image will
+ * be used. */
+ ClientData clientData; /* Pointer to TImageMaster for image. */
+{
+ TImageMaster *timPtr = (TImageMaster *) clientData;
+ TImageInstance *instPtr;
+ char buffer[100];
+ XGCValues gcValues;
+
+ sprintf(buffer, "%s get", timPtr->imageName);
+ Tcl_SetVar(timPtr->interp, timPtr->varName, buffer,
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+
+ instPtr = (TImageInstance *) ckalloc(sizeof(TImageInstance));
+ instPtr->masterPtr = timPtr;
+ instPtr->fg = Tk_GetColor(timPtr->interp, tkwin, "#ff0000");
+ gcValues.foreground = instPtr->fg->pixel;
+ instPtr->gc = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ return (ClientData) instPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageDisplay --
+ *
+ * This procedure is invoked to redisplay part or all of an
+ * image in a given drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image gets partially redrawn, as an "X" that shows the
+ * exact redraw area.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImageDisplay(clientData, display, drawable, imageX, imageY, width, height,
+ drawableX, drawableY)
+ ClientData clientData; /* Pointer to TImageInstance for image. */
+ Display *display; /* Display to use for drawing. */
+ Drawable drawable; /* Where to redraw image. */
+ int imageX, imageY; /* Origin of area to redraw, relative to
+ * origin of image. */
+ int width, height; /* Dimensions of area to redraw. */
+ int drawableX, drawableY; /* Coordinates in drawable corresponding to
+ * imageX and imageY. */
+{
+ TImageInstance *instPtr = (TImageInstance *) clientData;
+ char buffer[200];
+
+ sprintf(buffer, "%s display %d %d %d %d %d %d",
+ instPtr->masterPtr->imageName, imageX, imageY, width, height,
+ drawableX, drawableY);
+ Tcl_SetVar(instPtr->masterPtr->interp, instPtr->masterPtr->varName, buffer,
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+ if (width > (instPtr->masterPtr->width - imageX)) {
+ width = instPtr->masterPtr->width - imageX;
+ }
+ if (height > (instPtr->masterPtr->height - imageY)) {
+ height = instPtr->masterPtr->height - imageY;
+ }
+ XDrawRectangle(display, drawable, instPtr->gc, drawableX, drawableY,
+ (unsigned) (width-1), (unsigned) (height-1));
+ XDrawLine(display, drawable, instPtr->gc, drawableX, drawableY,
+ (int) (drawableX + width - 1), (int) (drawableY + height - 1));
+ XDrawLine(display, drawable, instPtr->gc, drawableX,
+ (int) (drawableY + height - 1),
+ (int) (drawableX + width - 1), drawableY);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageFree --
+ *
+ * This procedure is called when an instance of an image is
+ * no longer used.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information related to the instance is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImageFree(clientData, display)
+ ClientData clientData; /* Pointer to TImageInstance for instance. */
+ Display *display; /* Display where image was to be drawn. */
+{
+ TImageInstance *instPtr = (TImageInstance *) clientData;
+ char buffer[200];
+
+ sprintf(buffer, "%s free", instPtr->masterPtr->imageName);
+ Tcl_SetVar(instPtr->masterPtr->interp, instPtr->masterPtr->varName, buffer,
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+ Tk_FreeColor(instPtr->fg);
+ Tk_FreeGC(display, instPtr->gc);
+ ckfree((char *) instPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageDelete --
+ *
+ * This procedure is called to clean up a test image when
+ * an application goes away.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information about the image is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImageDelete(clientData)
+ ClientData clientData; /* Pointer to TImageMaster for image. When
+ * this procedure is called, no more
+ * instances exist. */
+{
+ TImageMaster *timPtr = (TImageMaster *) clientData;
+ char buffer[100];
+
+ sprintf(buffer, "%s delete", timPtr->imageName);
+ Tcl_SetVar(timPtr->interp, timPtr->varName, buffer,
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+
+ Tcl_DeleteCommand(timPtr->interp, timPtr->imageName);
+ ckfree(timPtr->imageName);
+ ckfree(timPtr->varName);
+ ckfree((char *) timPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestmakeexistCmd --
+ *
+ * This procedure implements the "testmakeexist" command. It calls
+ * Tk_MakeWindowExist on each of its arguments to force the windows
+ * to be created.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Forces windows to be created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestmakeexistCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window main = (Tk_Window) clientData;
+ int i;
+ Tk_Window tkwin;
+
+ for (i = 1; i < argc; i++) {
+ tkwin = Tk_NameToWindow(interp, argv[i], main);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_MakeWindowExist(tkwin);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestmenubarCmd --
+ *
+ * This procedure implements the "testmenubar" command. It is used
+ * to test the Unix facilities for creating space above a toplevel
+ * window for a menubar.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Changes menubar related stuff.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestmenubarCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+#ifdef __UNIX__
+ Tk_Window main = (Tk_Window) clientData;
+ Tk_Window tkwin, menubar;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0],
+ " option ?arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (strcmp(argv[1], "window") == 0) {
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0],
+ "window toplevel menubar\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp, argv[2], main);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (argv[3][0] == 0) {
+ TkUnixSetMenubar(tkwin, NULL);
+ } else {
+ menubar = Tk_NameToWindow(interp, argv[3], main);
+ if (menubar == NULL) {
+ return TCL_ERROR;
+ }
+ TkUnixSetMenubar(tkwin, menubar);
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be window", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+#else
+ interp->result = "testmenubar is supported only under Unix";
+ return TCL_ERROR;
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestmetricsCmd --
+ *
+ * This procedure implements the testmetrics command. It provides
+ * a way to determine the size of various widget components.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef __WIN32__
+static int
+TestmetricsCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ char buf[200];
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0],
+ " option ?arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (strcmp(argv[1], "cyvscroll") == 0) {
+ sprintf(buf, "%d", GetSystemMetrics(SM_CYVSCROLL));
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ } else if (strcmp(argv[1], "cxhscroll") == 0) {
+ sprintf(buf, "%d", GetSystemMetrics(SM_CXHSCROLL));
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be cxhscroll or cyvscroll", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+#endif
+#ifdef MAC_TCL
+static int
+TestmetricsCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ TkWindow *winPtr;
+ char buf[200];
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0],
+ " option window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (strcmp(argv[1], "cyvscroll") == 0) {
+ sprintf(buf, "%d", ((TkScrollbar *) winPtr->instanceData)->width);
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ } else if (strcmp(argv[1], "cxhscroll") == 0) {
+ sprintf(buf, "%d", ((TkScrollbar *) winPtr->instanceData)->width);
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be cxhscroll or cyvscroll", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestpropCmd --
+ *
+ * This procedure implements the "testprop" command. It fetches
+ * and prints the value of a property on a window.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestpropCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window main = (Tk_Window) clientData;
+ int result, actualFormat;
+ unsigned long bytesAfter, length, value;
+ Atom actualType, propName;
+ char *property, *p, *end;
+ Window w;
+ char buffer[30];
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0],
+ " window property\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ w = strtoul(argv[1], &end, 0);
+ propName = Tk_InternAtom(main, argv[2]);
+ property = NULL;
+ result = XGetWindowProperty(Tk_Display(main),
+ w, propName, 0, 100000, False, AnyPropertyType,
+ &actualType, &actualFormat, &length,
+ &bytesAfter, (unsigned char **) &property);
+ if ((result == Success) && (actualType != None)) {
+ if ((actualFormat == 8) && (actualType == XA_STRING)) {
+ for (p = property; ((unsigned long)(p-property)) < length; p++) {
+ if (*p == 0) {
+ *p = '\n';
+ }
+ }
+ Tcl_SetResult(interp, property, TCL_VOLATILE);
+ } else {
+ for (p = property; length > 0; length--) {
+ if (actualFormat == 32) {
+ value = *((long *) p);
+ p += sizeof(long);
+ } else if (actualFormat == 16) {
+ value = 0xffff & (*((short *) p));
+ p += sizeof(short);
+ } else {
+ value = 0xff & *p;
+ p += 1;
+ }
+ sprintf(buffer, "0x%lx", value);
+ Tcl_AppendElement(interp, buffer);
+ }
+ }
+ }
+ if (property != NULL) {
+ XFree(property);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestsendCmd --
+ *
+ * This procedure implements the "testsend" command. It provides
+ * a set of functions for testing the "send" command and support
+ * procedure in tkSend.c.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Depends on option; see below.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestsendCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ TkWindow *winPtr = (TkWindow *) clientData;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0],
+ " option ?arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+#if !(defined(__WIN32__) || defined(MAC_TCL))
+ if (strcmp(argv[1], "bogus") == 0) {
+ XChangeProperty(winPtr->dispPtr->display,
+ RootWindow(winPtr->dispPtr->display, 0),
+ winPtr->dispPtr->registryProperty, XA_INTEGER, 32,
+ PropModeReplace,
+ (unsigned char *) "This is bogus information", 6);
+ } else if (strcmp(argv[1], "prop") == 0) {
+ int result, actualFormat;
+ unsigned long length, bytesAfter;
+ Atom actualType, propName;
+ char *property, *p, *end;
+ Window w;
+
+ if ((argc != 4) && (argc != 5)) {
+ Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0],
+ " prop window name ?value ?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (strcmp(argv[2], "root") == 0) {
+ w = RootWindow(winPtr->dispPtr->display, 0);
+ } else if (strcmp(argv[2], "comm") == 0) {
+ w = Tk_WindowId(winPtr->dispPtr->commTkwin);
+ } else {
+ w = strtoul(argv[2], &end, 0);
+ }
+ propName = Tk_InternAtom((Tk_Window) winPtr, argv[3]);
+ if (argc == 4) {
+ property = NULL;
+ result = XGetWindowProperty(winPtr->dispPtr->display,
+ w, propName, 0, 100000, False, XA_STRING,
+ &actualType, &actualFormat, &length,
+ &bytesAfter, (unsigned char **) &property);
+ if ((result == Success) && (actualType != None)
+ && (actualFormat == 8) && (actualType == XA_STRING)) {
+ for (p = property; (p-property) < length; p++) {
+ if (*p == 0) {
+ *p = '\n';
+ }
+ }
+ Tcl_SetResult(interp, property, TCL_VOLATILE);
+ }
+ if (property != NULL) {
+ XFree(property);
+ }
+ } else {
+ if (argv[4][0] == 0) {
+ XDeleteProperty(winPtr->dispPtr->display, w, propName);
+ } else {
+ for (p = argv[4]; *p != 0; p++) {
+ if (*p == '\n') {
+ *p = 0;
+ }
+ }
+ XChangeProperty(winPtr->dispPtr->display,
+ w, propName, XA_STRING, 8, PropModeReplace,
+ (unsigned char *) argv[4], p-argv[4]);
+ }
+ }
+ } else if (strcmp(argv[1], "serial") == 0) {
+ sprintf(interp->result, "%d", tkSendSerial+1);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be bogus, prop, or serial", (char *) NULL);
+ return TCL_ERROR;
+ }
+#endif
+ return TCL_OK;
+}
+
+#if !(defined(__WIN32__) || defined(MAC_TCL))
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestwrapperCmd --
+ *
+ * This procedure implements the "testwrapper" command. It
+ * provides a way from Tcl to determine the extra window Tk adds
+ * in between the toplevel window and the window decorations.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestwrapperCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ TkWindow *winPtr, *wrapperPtr;
+ Tk_Window tkwin;
+
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0],
+ " window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ tkwin = (Tk_Window) clientData;
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ wrapperPtr = TkpGetWrapperWindow(winPtr);
+ if (wrapperPtr != NULL) {
+ TkpPrintWindowId(interp->result, Tk_WindowId(wrapperPtr));
+ }
+ return TCL_OK;
+}
+#endif
diff --git a/generic/tkText.c b/generic/tkText.c
new file mode 100644
index 0000000..643aea0
--- /dev/null
+++ b/generic/tkText.c
@@ -0,0 +1,2264 @@
+/*
+ * tkText.c --
+ *
+ * This module provides a big chunk of the implementation of
+ * multi-line editable text widgets for Tk. Among other things,
+ * it provides the Tcl command interfaces to text widgets and
+ * the display code. The B-tree representation of text is
+ * implemented elsewhere.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkText.c 1.104 97/10/13 15:18:24
+ */
+
+#include "default.h"
+#include "tkPort.h"
+#include "tkInt.h"
+
+#ifdef MAC_TCL
+#define Style TkStyle
+#define DInfo TkDInfo
+#endif
+
+#include "tkText.h"
+
+/*
+ * Information used to parse text configuration options:
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_TEXT_BG_COLOR, Tk_Offset(TkText, border), TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_TEXT_BG_MONO, Tk_Offset(TkText, border), TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_TEXT_BORDER_WIDTH, Tk_Offset(TkText, borderWidth), 0},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_TEXT_CURSOR, Tk_Offset(TkText, cursor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BOOLEAN, "-exportselection", "exportSelection",
+ "ExportSelection", DEF_TEXT_EXPORT_SELECTION,
+ Tk_Offset(TkText, exportSelection), 0},
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_FONT, "-font", "font", "Font",
+ DEF_TEXT_FONT, Tk_Offset(TkText, tkfont), 0},
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_TEXT_FG, Tk_Offset(TkText, fgColor), 0},
+ {TK_CONFIG_PIXELS, "-height", "height", "Height",
+ DEF_TEXT_HEIGHT, Tk_Offset(TkText, height), 0},
+ {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_TEXT_HIGHLIGHT_BG,
+ Tk_Offset(TkText, highlightBgColorPtr), 0},
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_TEXT_HIGHLIGHT, Tk_Offset(TkText, highlightColorPtr), 0},
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_TEXT_HIGHLIGHT_WIDTH, Tk_Offset(TkText, highlightWidth), 0},
+ {TK_CONFIG_BORDER, "-insertbackground", "insertBackground", "Foreground",
+ DEF_TEXT_INSERT_BG, Tk_Offset(TkText, insertBorder), 0},
+ {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
+ DEF_TEXT_INSERT_BD_COLOR, Tk_Offset(TkText, insertBorderWidth),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
+ DEF_TEXT_INSERT_BD_MONO, Tk_Offset(TkText, insertBorderWidth),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_INT, "-insertofftime", "insertOffTime", "OffTime",
+ DEF_TEXT_INSERT_OFF_TIME, Tk_Offset(TkText, insertOffTime), 0},
+ {TK_CONFIG_INT, "-insertontime", "insertOnTime", "OnTime",
+ DEF_TEXT_INSERT_ON_TIME, Tk_Offset(TkText, insertOnTime), 0},
+ {TK_CONFIG_PIXELS, "-insertwidth", "insertWidth", "InsertWidth",
+ DEF_TEXT_INSERT_WIDTH, Tk_Offset(TkText, insertWidth), 0},
+ {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
+ DEF_TEXT_PADX, Tk_Offset(TkText, padX), 0},
+ {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
+ DEF_TEXT_PADY, Tk_Offset(TkText, padY), 0},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_TEXT_RELIEF, Tk_Offset(TkText, relief), 0},
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_TEXT_SELECT_COLOR, Tk_Offset(TkText, selBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_TEXT_SELECT_MONO, Tk_Offset(TkText, selBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_STRING, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
+ DEF_TEXT_SELECT_BD_COLOR, Tk_Offset(TkText, selBdString),
+ TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
+ DEF_TEXT_SELECT_BD_MONO, Tk_Offset(TkText, selBdString),
+ TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_TEXT_SELECT_FG_COLOR, Tk_Offset(TkText, selFgColorPtr),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_TEXT_SELECT_FG_MONO, Tk_Offset(TkText, selFgColorPtr),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_BOOLEAN, "-setgrid", "setGrid", "SetGrid",
+ DEF_TEXT_SET_GRID, Tk_Offset(TkText, setGrid), 0},
+ {TK_CONFIG_PIXELS, "-spacing1", "spacing1", "Spacing",
+ DEF_TEXT_SPACING1, Tk_Offset(TkText, spacing1),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_PIXELS, "-spacing2", "spacing2", "Spacing",
+ DEF_TEXT_SPACING2, Tk_Offset(TkText, spacing2),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_PIXELS, "-spacing3", "spacing3", "Spacing",
+ DEF_TEXT_SPACING3, Tk_Offset(TkText, spacing3),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_UID, "-state", "state", "State",
+ DEF_TEXT_STATE, Tk_Offset(TkText, state), 0},
+ {TK_CONFIG_STRING, "-tabs", "tabs", "Tabs",
+ DEF_TEXT_TABS, Tk_Offset(TkText, tabOptionString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_TEXT_TAKE_FOCUS, Tk_Offset(TkText, takeFocus),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_INT, "-width", "width", "Width",
+ DEF_TEXT_WIDTH, Tk_Offset(TkText, width), 0},
+ {TK_CONFIG_UID, "-wrap", "wrap", "Wrap",
+ DEF_TEXT_WRAP, Tk_Offset(TkText, wrapMode), 0},
+ {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ DEF_TEXT_XSCROLL_COMMAND, Tk_Offset(TkText, xScrollCmd),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
+ DEF_TEXT_YSCROLL_COMMAND, Tk_Offset(TkText, yScrollCmd),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Tk_Uid's used to represent text states:
+ */
+
+Tk_Uid tkTextCharUid = NULL;
+Tk_Uid tkTextDisabledUid = NULL;
+Tk_Uid tkTextNoneUid = NULL;
+Tk_Uid tkTextNormalUid = NULL;
+Tk_Uid tkTextWordUid = NULL;
+
+/*
+ * Boolean variable indicating whether or not special debugging code
+ * should be executed.
+ */
+
+int tkTextDebug = 0;
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int ConfigureText _ANSI_ARGS_((Tcl_Interp *interp,
+ TkText *textPtr, int argc, char **argv, int flags));
+static int DeleteChars _ANSI_ARGS_((TkText *textPtr,
+ char *index1String, char *index2String));
+static void DestroyText _ANSI_ARGS_((char *memPtr));
+static void InsertChars _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *indexPtr, char *string));
+static void TextBlinkProc _ANSI_ARGS_((ClientData clientData));
+static void TextCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void TextEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int TextFetchSelection _ANSI_ARGS_((ClientData clientData,
+ int offset, char *buffer, int maxBytes));
+static int TextSearchCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, char **argv));
+static int TextWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void TextWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+static int TextDumpCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, char **argv));
+static void DumpLine _ANSI_ARGS_((Tcl_Interp *interp,
+ TkText *textPtr, int what, TkTextLine *linePtr,
+ int start, int end, int lineno, char *command));
+static int DumpSegment _ANSI_ARGS_((Tcl_Interp *interp, char *key,
+ char *value, char * command, int lineno, int offset,
+ int what));
+
+/*
+ * The structure below defines text class behavior by means of procedures
+ * that can be invoked from generic window code.
+ */
+
+static TkClassProcs textClass = {
+ NULL, /* createProc. */
+ TextWorldChanged, /* geometryProc. */
+ NULL /* modalProc. */
+};
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_TextCmd --
+ *
+ * This procedure is invoked to process the "text" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_TextCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ Tk_Window new;
+ register TkText *textPtr;
+ TkTextIndex startIndex;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " pathName ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Perform once-only initialization:
+ */
+
+ if (tkTextNormalUid == NULL) {
+ tkTextCharUid = Tk_GetUid("char");
+ tkTextDisabledUid = Tk_GetUid("disabled");
+ tkTextNoneUid = Tk_GetUid("none");
+ tkTextNormalUid = Tk_GetUid("normal");
+ tkTextWordUid = Tk_GetUid("word");
+ }
+
+ /*
+ * Create the window.
+ */
+
+ new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+
+ textPtr = (TkText *) ckalloc(sizeof(TkText));
+ textPtr->tkwin = new;
+ textPtr->display = Tk_Display(new);
+ textPtr->interp = interp;
+ textPtr->widgetCmd = Tcl_CreateCommand(interp,
+ Tk_PathName(textPtr->tkwin), TextWidgetCmd,
+ (ClientData) textPtr, TextCmdDeletedProc);
+ textPtr->tree = TkBTreeCreate(textPtr);
+ Tcl_InitHashTable(&textPtr->tagTable, TCL_STRING_KEYS);
+ textPtr->numTags = 0;
+ Tcl_InitHashTable(&textPtr->markTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&textPtr->windowTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&textPtr->imageTable, TCL_STRING_KEYS);
+ textPtr->state = tkTextNormalUid;
+ textPtr->border = NULL;
+ textPtr->borderWidth = 0;
+ textPtr->padX = 0;
+ textPtr->padY = 0;
+ textPtr->relief = TK_RELIEF_FLAT;
+ textPtr->highlightWidth = 0;
+ textPtr->highlightBgColorPtr = NULL;
+ textPtr->highlightColorPtr = NULL;
+ textPtr->cursor = None;
+ textPtr->fgColor = NULL;
+ textPtr->tkfont = NULL;
+ textPtr->charWidth = 1;
+ textPtr->spacing1 = 0;
+ textPtr->spacing2 = 0;
+ textPtr->spacing3 = 0;
+ textPtr->tabOptionString = NULL;
+ textPtr->tabArrayPtr = NULL;
+ textPtr->wrapMode = tkTextCharUid;
+ textPtr->width = 0;
+ textPtr->height = 0;
+ textPtr->setGrid = 0;
+ textPtr->prevWidth = Tk_Width(new);
+ textPtr->prevHeight = Tk_Height(new);
+ TkTextCreateDInfo(textPtr);
+ TkTextMakeIndex(textPtr->tree, 0, 0, &startIndex);
+ TkTextSetYView(textPtr, &startIndex, 0);
+ textPtr->selTagPtr = NULL;
+ textPtr->selBorder = NULL;
+ textPtr->selBdString = NULL;
+ textPtr->selFgColorPtr = NULL;
+ textPtr->exportSelection = 1;
+ textPtr->abortSelections = 0;
+ textPtr->insertMarkPtr = NULL;
+ textPtr->insertBorder = NULL;
+ textPtr->insertWidth = 0;
+ textPtr->insertBorderWidth = 0;
+ textPtr->insertOnTime = 0;
+ textPtr->insertOffTime = 0;
+ textPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
+ textPtr->bindingTable = NULL;
+ textPtr->currentMarkPtr = NULL;
+ textPtr->pickEvent.type = LeaveNotify;
+ textPtr->pickEvent.xcrossing.x = 0;
+ textPtr->pickEvent.xcrossing.y = 0;
+ textPtr->numCurTags = 0;
+ textPtr->curTagArrayPtr = NULL;
+ textPtr->takeFocus = NULL;
+ textPtr->xScrollCmd = NULL;
+ textPtr->yScrollCmd = NULL;
+ textPtr->flags = 0;
+
+ /*
+ * Create the "sel" tag and the "current" and "insert" marks.
+ */
+
+ textPtr->selTagPtr = TkTextCreateTag(textPtr, "sel");
+ textPtr->selTagPtr->reliefString = (char *) ckalloc(7);
+ strcpy(textPtr->selTagPtr->reliefString, DEF_TEXT_SELECT_RELIEF);
+ textPtr->selTagPtr->relief = TK_RELIEF_RAISED;
+ textPtr->currentMarkPtr = TkTextSetMark(textPtr, "current", &startIndex);
+ textPtr->insertMarkPtr = TkTextSetMark(textPtr, "insert", &startIndex);
+
+ Tk_SetClass(textPtr->tkwin, "Text");
+ TkSetClassProcs(textPtr->tkwin, &textClass, (ClientData) textPtr);
+ Tk_CreateEventHandler(textPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ TextEventProc, (ClientData) textPtr);
+ Tk_CreateEventHandler(textPtr->tkwin, KeyPressMask|KeyReleaseMask
+ |ButtonPressMask|ButtonReleaseMask|EnterWindowMask
+ |LeaveWindowMask|PointerMotionMask|VirtualEventMask,
+ TkTextBindProc, (ClientData) textPtr);
+ Tk_CreateSelHandler(textPtr->tkwin, XA_PRIMARY, XA_STRING,
+ TextFetchSelection, (ClientData) textPtr, XA_STRING);
+ if (ConfigureText(interp, textPtr, argc-2, argv+2, 0) != TCL_OK) {
+ Tk_DestroyWindow(textPtr->tkwin);
+ return TCL_ERROR;
+ }
+ interp->result = Tk_PathName(textPtr->tkwin);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextWidgetCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to a text widget. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TextWidgetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about text widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ register TkText *textPtr = (TkText *) clientData;
+ int result = TCL_OK;
+ size_t length;
+ int c;
+ TkTextIndex index1, index2;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_Preserve((ClientData) textPtr);
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0)) {
+ int x, y, width, height;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " bbox index\"", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (TkTextCharBbox(textPtr, &index1, &x, &y, &width, &height) == 0) {
+ sprintf(interp->result, "%d %d %d %d", x, y, width, height);
+ }
+ } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
+ && (length >= 2)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " cget option\"",
+ (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ result = Tk_ConfigureValue(interp, textPtr->tkwin, configSpecs,
+ (char *) textPtr, argv[2], 0);
+ } else if ((c == 'c') && (strncmp(argv[1], "compare", length) == 0)
+ && (length >= 3)) {
+ int relation, value;
+ char *p;
+
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " compare index1 op index2\"", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if ((TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK)
+ || (TkTextGetIndex(interp, textPtr, argv[4], &index2)
+ != TCL_OK)) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ relation = TkTextIndexCmp(&index1, &index2);
+ p = argv[3];
+ if (p[0] == '<') {
+ value = (relation < 0);
+ if ((p[1] == '=') && (p[2] == 0)) {
+ value = (relation <= 0);
+ } else if (p[1] != 0) {
+ compareError:
+ Tcl_AppendResult(interp, "bad comparison operator \"",
+ argv[3], "\": must be <, <=, ==, >=, >, or !=",
+ (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else if (p[0] == '>') {
+ value = (relation > 0);
+ if ((p[1] == '=') && (p[2] == 0)) {
+ value = (relation >= 0);
+ } else if (p[1] != 0) {
+ goto compareError;
+ }
+ } else if ((p[0] == '=') && (p[1] == '=') && (p[2] == 0)) {
+ value = (relation == 0);
+ } else if ((p[0] == '!') && (p[1] == '=') && (p[2] == 0)) {
+ value = (relation != 0);
+ } else {
+ goto compareError;
+ }
+ interp->result = (value) ? "1" : "0";
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
+ && (length >= 3)) {
+ if (argc == 2) {
+ result = Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,
+ (char *) textPtr, (char *) NULL, 0);
+ } else if (argc == 3) {
+ result = Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,
+ (char *) textPtr, argv[2], 0);
+ } else {
+ result = ConfigureText(interp, textPtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ } else if ((c == 'd') && (strncmp(argv[1], "debug", length) == 0)
+ && (length >= 3)) {
+ if (argc > 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " debug boolean\"", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (argc == 2) {
+ interp->result = (tkBTreeDebug) ? "1" : "0";
+ } else {
+ if (Tcl_GetBoolean(interp, argv[2], &tkBTreeDebug) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ tkTextDebug = tkBTreeDebug;
+ }
+ } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)
+ && (length >= 3)) {
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " delete index1 ?index2?\"", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (textPtr->state == tkTextNormalUid) {
+ result = DeleteChars(textPtr, argv[2],
+ (argc == 4) ? argv[3] : (char *) NULL);
+ }
+ } else if ((c == 'd') && (strncmp(argv[1], "dlineinfo", length) == 0)
+ && (length >= 2)) {
+ int x, y, width, height, base;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " dlineinfo index\"", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (TkTextDLineInfo(textPtr, &index1, &x, &y, &width, &height, &base)
+ == 0) {
+ sprintf(interp->result, "%d %d %d %d %d", x, y, width,
+ height, base);
+ }
+ } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " get index1 ?index2?\"", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (argc == 3) {
+ index2 = index1;
+ TkTextIndexForwChars(&index2, 1, &index2);
+ } else if (TkTextGetIndex(interp, textPtr, argv[3], &index2)
+ != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (TkTextIndexCmp(&index1, &index2) >= 0) {
+ goto done;
+ }
+ while (1) {
+ int offset, last, savedChar;
+ TkTextSegment *segPtr;
+
+ segPtr = TkTextIndexToSeg(&index1, &offset);
+ last = segPtr->size;
+ if (index1.linePtr == index2.linePtr) {
+ int last2;
+
+ if (index2.charIndex == index1.charIndex) {
+ break;
+ }
+ last2 = index2.charIndex - index1.charIndex + offset;
+ if (last2 < last) {
+ last = last2;
+ }
+ }
+ if (segPtr->typePtr == &tkTextCharType) {
+ savedChar = segPtr->body.chars[last];
+ segPtr->body.chars[last] = 0;
+ Tcl_AppendResult(interp, segPtr->body.chars + offset,
+ (char *) NULL);
+ segPtr->body.chars[last] = savedChar;
+ }
+ TkTextIndexForwChars(&index1, last-offset, &index1);
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
+ && (length >= 3)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " index index\"",
+ (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ TkTextPrintIndex(&index1, interp->result);
+ } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
+ && (length >= 3)) {
+ int i, j, numTags;
+ char **tagNames;
+ TkTextTag **oldTagArrayPtr;
+
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0],
+ " insert index chars ?tagList chars tagList ...?\"",
+ (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (textPtr->state == tkTextNormalUid) {
+ for (j = 3; j < argc; j += 2) {
+ InsertChars(textPtr, &index1, argv[j]);
+ if (argc > (j+1)) {
+ TkTextIndexForwChars(&index1, (int) strlen(argv[j]),
+ &index2);
+ oldTagArrayPtr = TkBTreeGetTags(&index1, &numTags);
+ if (oldTagArrayPtr != NULL) {
+ for (i = 0; i < numTags; i++) {
+ TkBTreeTag(&index1, &index2, oldTagArrayPtr[i], 0);
+ }
+ ckfree((char *) oldTagArrayPtr);
+ }
+ if (Tcl_SplitList(interp, argv[j+1], &numTags, &tagNames)
+ != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ for (i = 0; i < numTags; i++) {
+ TkBTreeTag(&index1, &index2,
+ TkTextCreateTag(textPtr, tagNames[i]), 1);
+ }
+ ckfree((char *) tagNames);
+ index1 = index2;
+ }
+ }
+ }
+ } else if ((c == 'd') && (strncmp(argv[1], "dump", length) == 0)) {
+ result = TextDumpCmd(textPtr, interp, argc, argv);
+ } else if ((c == 'i') && (strncmp(argv[1], "image", length) == 0)) {
+ result = TkTextImageCmd(textPtr, interp, argc, argv);
+ } else if ((c == 'm') && (strncmp(argv[1], "mark", length) == 0)) {
+ result = TkTextMarkCmd(textPtr, interp, argc, argv);
+ } else if ((c == 's') && (strcmp(argv[1], "scan") == 0) && (length >= 2)) {
+ result = TkTextScanCmd(textPtr, interp, argc, argv);
+ } else if ((c == 's') && (strcmp(argv[1], "search") == 0)
+ && (length >= 3)) {
+ result = TextSearchCmd(textPtr, interp, argc, argv);
+ } else if ((c == 's') && (strcmp(argv[1], "see") == 0) && (length >= 3)) {
+ result = TkTextSeeCmd(textPtr, interp, argc, argv);
+ } else if ((c == 't') && (strcmp(argv[1], "tag") == 0)) {
+ result = TkTextTagCmd(textPtr, interp, argc, argv);
+ } else if ((c == 'w') && (strncmp(argv[1], "window", length) == 0)) {
+ result = TkTextWindowCmd(textPtr, interp, argc, argv);
+ } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) {
+ result = TkTextXviewCmd(textPtr, interp, argc, argv);
+ } else if ((c == 'y') && (strncmp(argv[1], "yview", length) == 0)
+ && (length >= 2)) {
+ result = TkTextYviewCmd(textPtr, interp, argc, argv);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be bbox, cget, compare, configure, debug, delete, ",
+ "dlineinfo, get, image, index, insert, mark, scan, search, see, ",
+ "tag, window, xview, or yview",
+ (char *) NULL);
+ result = TCL_ERROR;
+ }
+
+ done:
+ Tcl_Release((ClientData) textPtr);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyText --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a text at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the text is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyText(memPtr)
+ char *memPtr; /* Info about text widget. */
+{
+ register TkText *textPtr = (TkText *) memPtr;
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+ TkTextTag *tagPtr;
+
+ /*
+ * Free up all the stuff that requires special handling, then
+ * let Tk_FreeOptions handle all the standard option-related
+ * stuff. Special note: free up display-related information
+ * before deleting the B-tree, since display-related stuff
+ * may refer to stuff in the B-tree.
+ */
+
+ TkTextFreeDInfo(textPtr);
+ TkBTreeDestroy(textPtr->tree);
+ for (hPtr = Tcl_FirstHashEntry(&textPtr->tagTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ tagPtr = (TkTextTag *) Tcl_GetHashValue(hPtr);
+ TkTextFreeTag(textPtr, tagPtr);
+ }
+ Tcl_DeleteHashTable(&textPtr->tagTable);
+ for (hPtr = Tcl_FirstHashEntry(&textPtr->markTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ ckfree((char *) Tcl_GetHashValue(hPtr));
+ }
+ Tcl_DeleteHashTable(&textPtr->markTable);
+ if (textPtr->tabArrayPtr != NULL) {
+ ckfree((char *) textPtr->tabArrayPtr);
+ }
+ if (textPtr->insertBlinkHandler != NULL) {
+ Tcl_DeleteTimerHandler(textPtr->insertBlinkHandler);
+ }
+ if (textPtr->bindingTable != NULL) {
+ Tk_DeleteBindingTable(textPtr->bindingTable);
+ }
+
+ /*
+ * NOTE: do NOT free up selBorder, selBdString, or selFgColorPtr:
+ * they are duplicates of information in the "sel" tag, which was
+ * freed up as part of deleting the tags above.
+ */
+
+ textPtr->selBorder = NULL;
+ textPtr->selBdString = NULL;
+ textPtr->selFgColorPtr = NULL;
+ Tk_FreeOptions(configSpecs, (char *) textPtr, textPtr->display, 0);
+ ckfree((char *) textPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureText --
+ *
+ * This procedure is called to process an argv/argc list, plus
+ * the Tk option database, in order to configure (or
+ * reconfigure) a text widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then interp->result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as text string, colors, font,
+ * etc. get set for textPtr; old resources get freed, if there
+ * were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureText(interp, textPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register TkText *textPtr; /* Information about widget; may or may
+ * not already have values for some fields. */
+ int argc; /* Number of valid entries in argv. */
+ char **argv; /* Arguments. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ int oldExport = textPtr->exportSelection;
+
+ if (Tk_ConfigureWidget(interp, textPtr->tkwin, configSpecs,
+ argc, argv, (char *) textPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few other options also need special processing, such as parsing
+ * the geometry and setting the background from a 3-D border.
+ */
+
+ if ((textPtr->state != tkTextNormalUid)
+ && (textPtr->state != tkTextDisabledUid)) {
+ Tcl_AppendResult(interp, "bad state value \"", textPtr->state,
+ "\": must be normal or disabled", (char *) NULL);
+ textPtr->state = tkTextNormalUid;
+ return TCL_ERROR;
+ }
+
+ if ((textPtr->wrapMode != tkTextCharUid)
+ && (textPtr->wrapMode != tkTextNoneUid)
+ && (textPtr->wrapMode != tkTextWordUid)) {
+ Tcl_AppendResult(interp, "bad wrap mode \"", textPtr->wrapMode,
+ "\": must be char, none, or word", (char *) NULL);
+ textPtr->wrapMode = tkTextCharUid;
+ return TCL_ERROR;
+ }
+
+ Tk_SetBackgroundFromBorder(textPtr->tkwin, textPtr->border);
+
+ /*
+ * Don't allow negative spacings.
+ */
+
+ if (textPtr->spacing1 < 0) {
+ textPtr->spacing1 = 0;
+ }
+ if (textPtr->spacing2 < 0) {
+ textPtr->spacing2 = 0;
+ }
+ if (textPtr->spacing3 < 0) {
+ textPtr->spacing3 = 0;
+ }
+
+ /*
+ * Parse tab stops.
+ */
+
+ if (textPtr->tabArrayPtr != NULL) {
+ ckfree((char *) textPtr->tabArrayPtr);
+ textPtr->tabArrayPtr = NULL;
+ }
+ if (textPtr->tabOptionString != NULL) {
+ textPtr->tabArrayPtr = TkTextGetTabs(interp, textPtr->tkwin,
+ textPtr->tabOptionString);
+ if (textPtr->tabArrayPtr == NULL) {
+ Tcl_AddErrorInfo(interp,"\n (while processing -tabs option)");
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Make sure that configuration options are properly mirrored
+ * between the widget record and the "sel" tags. NOTE: we don't
+ * have to free up information during the mirroring; old
+ * information was freed when it was replaced in the widget
+ * record.
+ */
+
+ textPtr->selTagPtr->border = textPtr->selBorder;
+ if (textPtr->selTagPtr->bdString != textPtr->selBdString) {
+ textPtr->selTagPtr->bdString = textPtr->selBdString;
+ if (textPtr->selBdString != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin, textPtr->selBdString,
+ &textPtr->selTagPtr->borderWidth) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (textPtr->selTagPtr->borderWidth < 0) {
+ textPtr->selTagPtr->borderWidth = 0;
+ }
+ }
+ }
+ textPtr->selTagPtr->fgColor = textPtr->selFgColorPtr;
+ textPtr->selTagPtr->affectsDisplay = 0;
+ if ((textPtr->selTagPtr->border != NULL)
+ || (textPtr->selTagPtr->bdString != NULL)
+ || (textPtr->selTagPtr->reliefString != NULL)
+ || (textPtr->selTagPtr->bgStipple != None)
+ || (textPtr->selTagPtr->fgColor != NULL)
+ || (textPtr->selTagPtr->tkfont != None)
+ || (textPtr->selTagPtr->fgStipple != None)
+ || (textPtr->selTagPtr->justifyString != NULL)
+ || (textPtr->selTagPtr->lMargin1String != NULL)
+ || (textPtr->selTagPtr->lMargin2String != NULL)
+ || (textPtr->selTagPtr->offsetString != NULL)
+ || (textPtr->selTagPtr->overstrikeString != NULL)
+ || (textPtr->selTagPtr->rMarginString != NULL)
+ || (textPtr->selTagPtr->spacing1String != NULL)
+ || (textPtr->selTagPtr->spacing2String != NULL)
+ || (textPtr->selTagPtr->spacing3String != NULL)
+ || (textPtr->selTagPtr->tabString != NULL)
+ || (textPtr->selTagPtr->underlineString != NULL)
+ || (textPtr->selTagPtr->wrapMode != NULL)) {
+ textPtr->selTagPtr->affectsDisplay = 1;
+ }
+ TkTextRedrawTag(textPtr, (TkTextIndex *) NULL, (TkTextIndex *) NULL,
+ textPtr->selTagPtr, 1);
+
+ /*
+ * Claim the selection if we've suddenly started exporting it and there
+ * are tagged characters.
+ */
+
+ if (textPtr->exportSelection && (!oldExport)) {
+ TkTextSearch search;
+ TkTextIndex first, last;
+
+ TkTextMakeIndex(textPtr->tree, 0, 0, &first);
+ TkTextMakeIndex(textPtr->tree,
+ TkBTreeNumLines(textPtr->tree), 0, &last);
+ TkBTreeStartSearch(&first, &last, textPtr->selTagPtr, &search);
+ if (TkBTreeCharTagged(&first, textPtr->selTagPtr)
+ || TkBTreeNextTag(&search)) {
+ Tk_OwnSelection(textPtr->tkwin, XA_PRIMARY, TkTextLostSelection,
+ (ClientData) textPtr);
+ textPtr->flags |= GOT_SELECTION;
+ }
+ }
+
+ /*
+ * Register the desired geometry for the window, and arrange for
+ * the window to be redisplayed.
+ */
+
+ if (textPtr->width <= 0) {
+ textPtr->width = 1;
+ }
+ if (textPtr->height <= 0) {
+ textPtr->height = 1;
+ }
+ TextWorldChanged((ClientData) textPtr);
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TextWorldChanged --
+ *
+ * This procedure is called when the world has changed in some
+ * way and the widget needs to recompute all its graphics contexts
+ * and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Configures all tags in the Text with a empty argc/argv, for
+ * the side effect of causing all the items to recompute their
+ * geometry and to be redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+TextWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ TkText *textPtr;
+ Tk_FontMetrics fm;
+
+ textPtr = (TkText *) instanceData;
+
+ textPtr->charWidth = Tk_TextWidth(textPtr->tkfont, "0", 1);
+ if (textPtr->charWidth <= 0) {
+ textPtr->charWidth = 1;
+ }
+ Tk_GetFontMetrics(textPtr->tkfont, &fm);
+ Tk_GeometryRequest(textPtr->tkwin,
+ textPtr->width * textPtr->charWidth + 2*textPtr->borderWidth
+ + 2*textPtr->padX + 2*textPtr->highlightWidth,
+ textPtr->height * (fm.linespace + textPtr->spacing1
+ + textPtr->spacing3) + 2*textPtr->borderWidth
+ + 2*textPtr->padY + 2*textPtr->highlightWidth);
+ Tk_SetInternalBorder(textPtr->tkwin,
+ textPtr->borderWidth + textPtr->highlightWidth);
+ if (textPtr->setGrid) {
+ Tk_SetGrid(textPtr->tkwin, textPtr->width, textPtr->height,
+ textPtr->charWidth, fm.linespace);
+ } else {
+ Tk_UnsetGrid(textPtr->tkwin);
+ }
+
+ TkTextRelayoutWindow(textPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher on
+ * structure changes to a text. For texts with 3D
+ * borders, this procedure is also invoked for exposures.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TextEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ register XEvent *eventPtr; /* Information about event. */
+{
+ register TkText *textPtr = (TkText *) clientData;
+ TkTextIndex index, index2;
+
+ if (eventPtr->type == Expose) {
+ TkTextRedrawRegion(textPtr, eventPtr->xexpose.x,
+ eventPtr->xexpose.y, eventPtr->xexpose.width,
+ eventPtr->xexpose.height);
+ } else if (eventPtr->type == ConfigureNotify) {
+ if ((textPtr->prevWidth != Tk_Width(textPtr->tkwin))
+ || (textPtr->prevHeight != Tk_Height(textPtr->tkwin))) {
+ TkTextRelayoutWindow(textPtr);
+ textPtr->prevWidth = Tk_Width(textPtr->tkwin);
+ textPtr->prevHeight = Tk_Height(textPtr->tkwin);
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ if (textPtr->tkwin != NULL) {
+ if (textPtr->setGrid) {
+ Tk_UnsetGrid(textPtr->tkwin);
+ }
+ textPtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(textPtr->interp,
+ textPtr->widgetCmd);
+ }
+ Tcl_EventuallyFree((ClientData) textPtr, DestroyText);
+ } else if ((eventPtr->type == FocusIn) || (eventPtr->type == FocusOut)) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ Tcl_DeleteTimerHandler(textPtr->insertBlinkHandler);
+ if (eventPtr->type == FocusIn) {
+ textPtr->flags |= GOT_FOCUS | INSERT_ON;
+ if (textPtr->insertOffTime != 0) {
+ textPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ textPtr->insertOnTime, TextBlinkProc,
+ (ClientData) textPtr);
+ }
+ } else {
+ textPtr->flags &= ~(GOT_FOCUS | INSERT_ON);
+ textPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
+ }
+#ifndef ALWAYS_SHOW_SELECTION
+ TkTextRedrawTag(textPtr, NULL, NULL, textPtr->selTagPtr, 1);
+#endif
+ TkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index);
+ TkTextIndexForwChars(&index, 1, &index2);
+ TkTextChanged(textPtr, &index, &index2);
+ if (textPtr->highlightWidth > 0) {
+ TkTextRedrawRegion(textPtr, 0, 0, textPtr->highlightWidth,
+ textPtr->highlightWidth);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextCmdDeletedProc --
+ *
+ * This procedure is invoked when a widget command is deleted. If
+ * the widget isn't already in the process of being destroyed,
+ * this command destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TextCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ TkText *textPtr = (TkText *) clientData;
+ Tk_Window tkwin = textPtr->tkwin;
+
+ /*
+ * This procedure could be invoked either because the window was
+ * destroyed and the command was then deleted (in which case tkwin
+ * is NULL) or because the command was deleted, and then this procedure
+ * destroys the widget.
+ */
+
+ if (tkwin != NULL) {
+ if (textPtr->setGrid) {
+ Tk_UnsetGrid(textPtr->tkwin);
+ }
+ textPtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InsertChars --
+ *
+ * This procedure implements most of the functionality of the
+ * "insert" widget command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The characters in "string" get added to the text just before
+ * the character indicated by "indexPtr".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InsertChars(textPtr, indexPtr, string)
+ TkText *textPtr; /* Overall information about text widget. */
+ TkTextIndex *indexPtr; /* Where to insert new characters. May be
+ * modified and/or invalidated. */
+ char *string; /* Null-terminated string containing new
+ * information to add to text. */
+{
+ int lineIndex, resetView, offset;
+ TkTextIndex newTop;
+
+ /*
+ * Don't allow insertions on the last (dummy) line of the text.
+ */
+
+ lineIndex = TkBTreeLineIndex(indexPtr->linePtr);
+ if (lineIndex == TkBTreeNumLines(textPtr->tree)) {
+ lineIndex--;
+ TkTextMakeIndex(textPtr->tree, lineIndex, 1000000, indexPtr);
+ }
+
+ /*
+ * Notify the display module that lines are about to change, then do
+ * the insertion. If the insertion occurs on the top line of the
+ * widget (textPtr->topIndex), then we have to recompute topIndex
+ * after the insertion, since the insertion could invalidate it.
+ */
+
+ resetView = offset = 0;
+ if (indexPtr->linePtr == textPtr->topIndex.linePtr) {
+ resetView = 1;
+ offset = textPtr->topIndex.charIndex;
+ if (offset > indexPtr->charIndex) {
+ offset += strlen(string);
+ }
+ }
+ TkTextChanged(textPtr, indexPtr, indexPtr);
+ TkBTreeInsertChars(indexPtr, string);
+ if (resetView) {
+ TkTextMakeIndex(textPtr->tree, lineIndex, 0, &newTop);
+ TkTextIndexForwChars(&newTop, offset, &newTop);
+ TkTextSetYView(textPtr, &newTop, 0);
+ }
+
+ /*
+ * Invalidate any selection retrievals in progress.
+ */
+
+ textPtr->abortSelections = 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteChars --
+ *
+ * This procedure implements most of the functionality of the
+ * "delete" widget command.
+ *
+ * Results:
+ * Returns a standard Tcl result, and leaves an error message
+ * in textPtr->interp if there is an error.
+ *
+ * Side effects:
+ * Characters get deleted from the text.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DeleteChars(textPtr, index1String, index2String)
+ TkText *textPtr; /* Overall information about text widget. */
+ char *index1String; /* String describing location of first
+ * character to delete. */
+ char *index2String; /* String describing location of last
+ * character to delete. NULL means just
+ * delete the one character given by
+ * index1String. */
+{
+ int line1, line2, line, charIndex, resetView;
+ TkTextIndex index1, index2;
+
+ /*
+ * Parse the starting and stopping indices.
+ */
+
+ if (TkTextGetIndex(textPtr->interp, textPtr, index1String, &index1)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index2String != NULL) {
+ if (TkTextGetIndex(textPtr->interp, textPtr, index2String, &index2)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ index2 = index1;
+ TkTextIndexForwChars(&index2, 1, &index2);
+ }
+
+ /*
+ * Make sure there's really something to delete.
+ */
+
+ if (TkTextIndexCmp(&index1, &index2) >= 0) {
+ return TCL_OK;
+ }
+
+ /*
+ * The code below is ugly, but it's needed to make sure there
+ * is always a dummy empty line at the end of the text. If the
+ * final newline of the file (just before the dummy line) is being
+ * deleted, then back up index to just before the newline. If
+ * there is a newline just before the first character being deleted,
+ * then back up the first index too, so that an even number of lines
+ * gets deleted. Furthermore, remove any tags that are present on
+ * the newline that isn't going to be deleted after all (this simulates
+ * deleting the newline and then adding a "clean" one back again).
+ */
+
+ line1 = TkBTreeLineIndex(index1.linePtr);
+ line2 = TkBTreeLineIndex(index2.linePtr);
+ if (line2 == TkBTreeNumLines(textPtr->tree)) {
+ TkTextTag **arrayPtr;
+ int arraySize, i;
+ TkTextIndex oldIndex2;
+
+ oldIndex2 = index2;
+ TkTextIndexBackChars(&oldIndex2, 1, &index2);
+ line2--;
+ if ((index1.charIndex == 0) && (line1 != 0)) {
+ TkTextIndexBackChars(&index1, 1, &index1);
+ line1--;
+ }
+ arrayPtr = TkBTreeGetTags(&index2, &arraySize);
+ if (arrayPtr != NULL) {
+ for (i = 0; i < arraySize; i++) {
+ TkBTreeTag(&index2, &oldIndex2, arrayPtr[i], 0);
+ }
+ ckfree((char *) arrayPtr);
+ }
+ }
+
+ /*
+ * Tell the display what's about to happen so it can discard
+ * obsolete display information, then do the deletion. Also,
+ * if the deletion involves the top line on the screen, then
+ * we have to reset the view (the deletion will invalidate
+ * textPtr->topIndex). Compute what the new first character
+ * will be, then do the deletion, then reset the view.
+ */
+
+ TkTextChanged(textPtr, &index1, &index2);
+ resetView = line = charIndex = 0;
+ if (TkTextIndexCmp(&index2, &textPtr->topIndex) >= 0) {
+ if (TkTextIndexCmp(&index1, &textPtr->topIndex) <= 0) {
+ /*
+ * Deletion range straddles topIndex: use the beginning
+ * of the range as the new topIndex.
+ */
+
+ resetView = 1;
+ line = line1;
+ charIndex = index1.charIndex;
+ } else if (index1.linePtr == textPtr->topIndex.linePtr) {
+ /*
+ * Deletion range starts on top line but after topIndex.
+ * Use the current topIndex as the new one.
+ */
+
+ resetView = 1;
+ line = line1;
+ charIndex = textPtr->topIndex.charIndex;
+ }
+ } else if (index2.linePtr == textPtr->topIndex.linePtr) {
+ /*
+ * Deletion range ends on top line but before topIndex.
+ * Figure out what will be the new character index for
+ * the character currently pointed to by topIndex.
+ */
+
+ resetView = 1;
+ line = line2;
+ charIndex = textPtr->topIndex.charIndex;
+ if (index1.linePtr != index2.linePtr) {
+ charIndex -= index2.charIndex;
+ } else {
+ charIndex -= (index2.charIndex - index1.charIndex);
+ }
+ }
+ TkBTreeDeleteChars(&index1, &index2);
+ if (resetView) {
+ TkTextMakeIndex(textPtr->tree, line, charIndex, &index1);
+ TkTextSetYView(textPtr, &index1, 0);
+ }
+
+ /*
+ * Invalidate any selection retrievals in progress.
+ */
+
+ textPtr->abortSelections = 1;
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextFetchSelection --
+ *
+ * This procedure is called back by Tk when the selection is
+ * requested by someone. It returns part or all of the selection
+ * in a buffer provided by the caller.
+ *
+ * Results:
+ * The return value is the number of non-NULL bytes stored
+ * at buffer. Buffer is filled (or partially filled) with a
+ * NULL-terminated string containing part or all of the selection,
+ * as given by offset and maxBytes.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TextFetchSelection(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Information about text widget. */
+ int offset; /* Offset within selection of first
+ * character to be returned. */
+ char *buffer; /* Location in which to place
+ * selection. */
+ int maxBytes; /* Maximum number of bytes to place
+ * at buffer, not including terminating
+ * NULL character. */
+{
+ register TkText *textPtr = (TkText *) clientData;
+ TkTextIndex eof;
+ int count, chunkSize, offsetInSeg;
+ TkTextSearch search;
+ TkTextSegment *segPtr;
+
+ if (!textPtr->exportSelection) {
+ return -1;
+ }
+
+ /*
+ * Find the beginning of the next range of selected text. Note: if
+ * the selection is being retrieved in multiple pieces (offset != 0)
+ * and some modification has been made to the text that affects the
+ * selection then reject the selection request (make 'em start over
+ * again).
+ */
+
+ if (offset == 0) {
+ TkTextMakeIndex(textPtr->tree, 0, 0, &textPtr->selIndex);
+ textPtr->abortSelections = 0;
+ } else if (textPtr->abortSelections) {
+ return 0;
+ }
+ TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &eof);
+ TkBTreeStartSearch(&textPtr->selIndex, &eof, textPtr->selTagPtr, &search);
+ if (!TkBTreeCharTagged(&textPtr->selIndex, textPtr->selTagPtr)) {
+ if (!TkBTreeNextTag(&search)) {
+ if (offset == 0) {
+ return -1;
+ } else {
+ return 0;
+ }
+ }
+ textPtr->selIndex = search.curIndex;
+ }
+
+ /*
+ * Each iteration through the outer loop below scans one selected range.
+ * Each iteration through the inner loop scans one segment in the
+ * selected range.
+ */
+
+ count = 0;
+ while (1) {
+ /*
+ * Find the end of the current range of selected text.
+ */
+
+ if (!TkBTreeNextTag(&search)) {
+ panic("TextFetchSelection couldn't find end of range");
+ }
+
+ /*
+ * Copy information from character segments into the buffer
+ * until either we run out of space in the buffer or we get
+ * to the end of this range of text.
+ */
+
+ while (1) {
+ if (maxBytes == 0) {
+ goto done;
+ }
+ segPtr = TkTextIndexToSeg(&textPtr->selIndex, &offsetInSeg);
+ chunkSize = segPtr->size - offsetInSeg;
+ if (chunkSize > maxBytes) {
+ chunkSize = maxBytes;
+ }
+ if (textPtr->selIndex.linePtr == search.curIndex.linePtr) {
+ int leftInRange;
+
+ leftInRange = search.curIndex.charIndex
+ - textPtr->selIndex.charIndex;
+ if (leftInRange < chunkSize) {
+ chunkSize = leftInRange;
+ if (chunkSize <= 0) {
+ break;
+ }
+ }
+ }
+ if (segPtr->typePtr == &tkTextCharType) {
+ memcpy((VOID *) buffer, (VOID *) (segPtr->body.chars
+ + offsetInSeg), (size_t) chunkSize);
+ buffer += chunkSize;
+ maxBytes -= chunkSize;
+ count += chunkSize;
+ }
+ TkTextIndexForwChars(&textPtr->selIndex, chunkSize,
+ &textPtr->selIndex);
+ }
+
+ /*
+ * Find the beginning of the next range of selected text.
+ */
+
+ if (!TkBTreeNextTag(&search)) {
+ break;
+ }
+ textPtr->selIndex = search.curIndex;
+ }
+
+ done:
+ *buffer = 0;
+ return count;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextLostSelection --
+ *
+ * This procedure is called back by Tk when the selection is
+ * grabbed away from a text widget. On Windows and Mac systems, we
+ * want to remember the selection for the next time the focus
+ * enters the window. On Unix, just remove the "sel" tag from
+ * everything in the widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The "sel" tag is cleared from the window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextLostSelection(clientData)
+ ClientData clientData; /* Information about text widget. */
+{
+ register TkText *textPtr = (TkText *) clientData;
+#ifdef ALWAYS_SHOW_SELECTION
+ TkTextIndex start, end;
+
+ if (!textPtr->exportSelection) {
+ return;
+ }
+
+ /*
+ * On Windows and Mac systems, we want to remember the selection
+ * for the next time the focus enters the window. On Unix,
+ * just remove the "sel" tag from everything in the widget.
+ */
+
+ TkTextMakeIndex(textPtr->tree, 0, 0, &start);
+ TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &end);
+ TkTextRedrawTag(textPtr, &start, &end, textPtr->selTagPtr, 1);
+ TkBTreeTag(&start, &end, textPtr->selTagPtr, 0);
+#endif
+ textPtr->flags &= ~GOT_SELECTION;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextBlinkProc --
+ *
+ * This procedure is called as a timer handler to blink the
+ * insertion cursor off and on.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor gets turned on or off, redisplay gets invoked,
+ * and this procedure reschedules itself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TextBlinkProc(clientData)
+ ClientData clientData; /* Pointer to record describing text. */
+{
+ register TkText *textPtr = (TkText *) clientData;
+ TkTextIndex index;
+ int x, y, w, h;
+
+ if (!(textPtr->flags & GOT_FOCUS) || (textPtr->insertOffTime == 0)) {
+ return;
+ }
+ if (textPtr->flags & INSERT_ON) {
+ textPtr->flags &= ~INSERT_ON;
+ textPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ textPtr->insertOffTime, TextBlinkProc, (ClientData) textPtr);
+ } else {
+ textPtr->flags |= INSERT_ON;
+ textPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ textPtr->insertOnTime, TextBlinkProc, (ClientData) textPtr);
+ }
+ TkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index);
+ TkTextCharBbox(textPtr, &index, &x, &y, &w, &h);
+ TkTextRedrawRegion(textPtr, x - textPtr->insertWidth / 2, y,
+ textPtr->insertWidth, h);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextSearchCmd --
+ *
+ * This procedure is invoked to process the "search" widget command
+ * for text widgets. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TextSearchCmd(textPtr, interp, argc, argv)
+ TkText *textPtr; /* Information about text widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ int backwards, exact, c, i, argsLeft, noCase, leftToScan;
+ size_t length;
+ int numLines, startingLine, startingChar, lineNum, firstChar, lastChar;
+ int code, matchLength, matchChar, passes, stopLine, searchWholeText;
+ int patLength;
+ char *arg, *pattern, *varName, *p, *startOfLine;
+ char buffer[20];
+ TkTextIndex index, stopIndex;
+ Tcl_DString line, patDString;
+ TkTextSegment *segPtr;
+ TkTextLine *linePtr;
+ Tcl_RegExp regexp = NULL; /* Initialization needed only to
+ * prevent compiler warning. */
+
+ /*
+ * Parse switches and other arguments.
+ */
+
+ exact = 1;
+ backwards = 0;
+ noCase = 0;
+ varName = NULL;
+ for (i = 2; i < argc; i++) {
+ arg = argv[i];
+ if (arg[0] != '-') {
+ break;
+ }
+ length = strlen(arg);
+ if (length < 2) {
+ badSwitch:
+ Tcl_AppendResult(interp, "bad switch \"", arg,
+ "\": must be -forward, -backward, -exact, -regexp, ",
+ "-nocase, -count, or --", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = arg[1];
+ if ((c == 'b') && (strncmp(argv[i], "-backwards", length) == 0)) {
+ backwards = 1;
+ } else if ((c == 'c') && (strncmp(argv[i], "-count", length) == 0)) {
+ if (i >= (argc-1)) {
+ interp->result = "no value given for \"-count\" option";
+ return TCL_ERROR;
+ }
+ i++;
+ varName = argv[i];
+ } else if ((c == 'e') && (strncmp(argv[i], "-exact", length) == 0)) {
+ exact = 1;
+ } else if ((c == 'f') && (strncmp(argv[i], "-forwards", length) == 0)) {
+ backwards = 0;
+ } else if ((c == 'n') && (strncmp(argv[i], "-nocase", length) == 0)) {
+ noCase = 1;
+ } else if ((c == 'r') && (strncmp(argv[i], "-regexp", length) == 0)) {
+ exact = 0;
+ } else if ((c == '-') && (strncmp(argv[i], "--", length) == 0)) {
+ i++;
+ break;
+ } else {
+ goto badSwitch;
+ }
+ }
+ argsLeft = argc - (i+2);
+ if ((argsLeft != 0) && (argsLeft != 1)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " search ?switches? pattern index ?stopIndex?",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ pattern = argv[i];
+
+ /*
+ * Convert the pattern to lower-case if we're supposed to ignore case.
+ */
+
+ if (noCase) {
+ Tcl_DStringInit(&patDString);
+ Tcl_DStringAppend(&patDString, pattern, -1);
+ pattern = Tcl_DStringValue(&patDString);
+ for (p = pattern; *p != 0; p++) {
+ if (isupper(UCHAR(*p))) {
+ *p = tolower(UCHAR(*p));
+ }
+ }
+ }
+
+ if (TkTextGetIndex(interp, textPtr, argv[i+1], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ numLines = TkBTreeNumLines(textPtr->tree);
+ startingLine = TkBTreeLineIndex(index.linePtr);
+ startingChar = index.charIndex;
+ if (startingLine >= numLines) {
+ if (backwards) {
+ startingLine = TkBTreeNumLines(textPtr->tree) - 1;
+ startingChar = TkBTreeCharsInLine(TkBTreeFindLine(textPtr->tree,
+ startingLine));
+ } else {
+ startingLine = 0;
+ startingChar = 0;
+ }
+ }
+ if (argsLeft == 1) {
+ if (TkTextGetIndex(interp, textPtr, argv[i+2], &stopIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ stopLine = TkBTreeLineIndex(stopIndex.linePtr);
+ if (!backwards && (stopLine == numLines)) {
+ stopLine = numLines-1;
+ }
+ searchWholeText = 0;
+ } else {
+ stopLine = 0;
+ searchWholeText = 1;
+ }
+
+ /*
+ * Scan through all of the lines of the text circularly, starting
+ * at the given index.
+ */
+
+ matchLength = patLength = 0; /* Only needed to prevent compiler
+ * warnings. */
+ if (exact) {
+ patLength = strlen(pattern);
+ } else {
+ regexp = Tcl_RegExpCompile(interp, pattern);
+ if (regexp == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ lineNum = startingLine;
+ code = TCL_OK;
+ Tcl_DStringInit(&line);
+ for (passes = 0; passes < 2; ) {
+ if (lineNum >= numLines) {
+ /*
+ * Don't search the dummy last line of the text.
+ */
+
+ goto nextLine;
+ }
+
+ /*
+ * Extract the text from the line. If we're doing regular
+ * expression matching, drop the newline from the line, so
+ * that "$" can be used to match the end of the line.
+ */
+
+ linePtr = TkBTreeFindLine(textPtr->tree, lineNum);
+ for (segPtr = linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ if (segPtr->typePtr != &tkTextCharType) {
+ continue;
+ }
+ Tcl_DStringAppend(&line, segPtr->body.chars, segPtr->size);
+ }
+ if (!exact) {
+ Tcl_DStringSetLength(&line, Tcl_DStringLength(&line)-1);
+ }
+ startOfLine = Tcl_DStringValue(&line);
+
+ /*
+ * If we're ignoring case, convert the line to lower case.
+ */
+
+ if (noCase) {
+ for (p = Tcl_DStringValue(&line); *p != 0; p++) {
+ if (isupper(UCHAR(*p))) {
+ *p = tolower(UCHAR(*p));
+ }
+ }
+ }
+
+ /*
+ * Check for matches within the current line. If so, and if we're
+ * searching backwards, repeat the search to find the last match
+ * in the line.
+ */
+
+ matchChar = -1;
+ firstChar = 0;
+ lastChar = INT_MAX;
+ if (lineNum == startingLine) {
+ int indexInDString;
+
+ /*
+ * The starting line is tricky: the first time we see it
+ * we check one part of the line, and the second pass through
+ * we check the other part of the line. We have to be very
+ * careful here because there could be embedded windows or
+ * other things that are not in the extracted line. Rescan
+ * the original line to compute the index in it of the first
+ * character.
+ */
+
+ indexInDString = startingChar;
+ for (segPtr = linePtr->segPtr, leftToScan = startingChar;
+ leftToScan > 0; segPtr = segPtr->nextPtr) {
+ if (segPtr->typePtr != &tkTextCharType) {
+ indexInDString -= segPtr->size;
+ }
+ leftToScan -= segPtr->size;
+ }
+
+ passes++;
+ if ((passes == 1) ^ backwards) {
+ /*
+ * Only use the last part of the line.
+ */
+
+ firstChar = indexInDString;
+ if (firstChar >= Tcl_DStringLength(&line)) {
+ goto nextLine;
+ }
+ } else {
+ /*
+ * Use only the first part of the line.
+ */
+
+ lastChar = indexInDString;
+ }
+ }
+ do {
+ int thisLength;
+ if (exact) {
+ p = strstr(startOfLine + firstChar, pattern);
+ if (p == NULL) {
+ break;
+ }
+ i = p - startOfLine;
+ thisLength = patLength;
+ } else {
+ char *start, *end;
+ int match;
+
+ match = Tcl_RegExpExec(interp, regexp,
+ startOfLine + firstChar, startOfLine);
+ if (match < 0) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ if (!match) {
+ break;
+ }
+ Tcl_RegExpRange(regexp, 0, &start, &end);
+ i = start - startOfLine;
+ thisLength = end - start;
+ }
+ if (i >= lastChar) {
+ break;
+ }
+ matchChar = i;
+ matchLength = thisLength;
+ firstChar = matchChar+1;
+ } while (backwards);
+
+ /*
+ * If we found a match then we're done. Make sure that
+ * the match occurred before the stopping index, if one was
+ * specified.
+ */
+
+ if (matchChar >= 0) {
+ /*
+ * The index information returned by the regular expression
+ * parser only considers textual information: it doesn't
+ * account for embedded windows or any other non-textual info.
+ * Scan through the line's segments again to adjust both
+ * matchChar and matchCount.
+ */
+
+ for (segPtr = linePtr->segPtr, leftToScan = matchChar;
+ leftToScan >= 0; segPtr = segPtr->nextPtr) {
+ if (segPtr->typePtr != &tkTextCharType) {
+ matchChar += segPtr->size;
+ continue;
+ }
+ leftToScan -= segPtr->size;
+ }
+ for (leftToScan += matchLength; leftToScan > 0;
+ segPtr = segPtr->nextPtr) {
+ if (segPtr->typePtr != &tkTextCharType) {
+ matchLength += segPtr->size;
+ continue;
+ }
+ leftToScan -= segPtr->size;
+ }
+ TkTextMakeIndex(textPtr->tree, lineNum, matchChar, &index);
+ if (!searchWholeText) {
+ if (!backwards && (TkTextIndexCmp(&index, &stopIndex) >= 0)) {
+ goto done;
+ }
+ if (backwards && (TkTextIndexCmp(&index, &stopIndex) < 0)) {
+ goto done;
+ }
+ }
+ if (varName != NULL) {
+ sprintf(buffer, "%d", matchLength);
+ if (Tcl_SetVar(interp, varName, buffer, TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+ TkTextPrintIndex(&index, interp->result);
+ goto done;
+ }
+
+ /*
+ * Go to the next (or previous) line;
+ */
+
+ nextLine:
+ if (backwards) {
+ lineNum--;
+ if (!searchWholeText) {
+ if (lineNum < stopLine) {
+ break;
+ }
+ } else if (lineNum < 0) {
+ lineNum = numLines-1;
+ }
+ } else {
+ lineNum++;
+ if (!searchWholeText) {
+ if (lineNum > stopLine) {
+ break;
+ }
+ } else if (lineNum >= numLines) {
+ lineNum = 0;
+ }
+ }
+ Tcl_DStringSetLength(&line, 0);
+ }
+ done:
+ Tcl_DStringFree(&line);
+ if (noCase) {
+ Tcl_DStringFree(&patDString);
+ }
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextGetTabs --
+ *
+ * Parses a string description of a set of tab stops.
+ *
+ * Results:
+ * The return value is a pointer to a malloc'ed structure holding
+ * parsed information about the tab stops. If an error occurred
+ * then the return value is NULL and an error message is left in
+ * interp->result.
+ *
+ * Side effects:
+ * Memory is allocated for the structure that is returned. It is
+ * up to the caller to free this structure when it is no longer
+ * needed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkTextTabArray *
+TkTextGetTabs(interp, tkwin, string)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Window tkwin; /* Window in which the tabs will be
+ * used. */
+ char *string; /* Description of the tab stops. See
+ * the text manual entry for details. */
+{
+ int argc, i, count, c;
+ char **argv;
+ TkTextTabArray *tabArrayPtr;
+ TkTextTab *tabPtr;
+
+ if (Tcl_SplitList(interp, string, &argc, &argv) != TCL_OK) {
+ return NULL;
+ }
+
+ /*
+ * First find out how many entries we need to allocate in the
+ * tab array.
+ */
+
+ count = 0;
+ for (i = 0; i < argc; i++) {
+ c = argv[i][0];
+ if ((c != 'l') && (c != 'r') && (c != 'c') && (c != 'n')) {
+ count++;
+ }
+ }
+
+ /*
+ * Parse the elements of the list one at a time to fill in the
+ * array.
+ */
+
+ tabArrayPtr = (TkTextTabArray *) ckalloc((unsigned)
+ (sizeof(TkTextTabArray) + (count-1)*sizeof(TkTextTab)));
+ tabArrayPtr->numTabs = 0;
+ for (i = 0, tabPtr = &tabArrayPtr->tabs[0]; i < argc; i++, tabPtr++) {
+ if (Tk_GetPixels(interp, tkwin, argv[i], &tabPtr->location)
+ != TCL_OK) {
+ goto error;
+ }
+ tabArrayPtr->numTabs++;
+
+ /*
+ * See if there is an explicit alignment in the next list
+ * element. Otherwise just use "left".
+ */
+
+ tabPtr->alignment = LEFT;
+ if ((i+1) == argc) {
+ continue;
+ }
+ c = UCHAR(argv[i+1][0]);
+ if (!isalpha(c)) {
+ continue;
+ }
+ i += 1;
+ if ((c == 'l') && (strncmp(argv[i], "left",
+ strlen(argv[i])) == 0)) {
+ tabPtr->alignment = LEFT;
+ } else if ((c == 'r') && (strncmp(argv[i], "right",
+ strlen(argv[i])) == 0)) {
+ tabPtr->alignment = RIGHT;
+ } else if ((c == 'c') && (strncmp(argv[i], "center",
+ strlen(argv[i])) == 0)) {
+ tabPtr->alignment = CENTER;
+ } else if ((c == 'n') && (strncmp(argv[i],
+ "numeric", strlen(argv[i])) == 0)) {
+ tabPtr->alignment = NUMERIC;
+ } else {
+ Tcl_AppendResult(interp, "bad tab alignment \"",
+ argv[i], "\": must be left, right, center, or numeric",
+ (char *) NULL);
+ goto error;
+ }
+ }
+ ckfree((char *) argv);
+ return tabArrayPtr;
+
+ error:
+ ckfree((char *) tabArrayPtr);
+ ckfree((char *) argv);
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextDumpCmd --
+ *
+ * Return information about the text, tags, marks, and embedded windows
+ * and images in a text widget. See the man page for the description
+ * of the text dump operation for all the details.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Memory is allocated for the result, if needed (standard Tcl result
+ * side effects).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TextDumpCmd(textPtr, interp, argc, argv)
+ register TkText *textPtr; /* Information about text widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. Someone else has already
+ * parsed this command enough to know that
+ * argv[1] is "dump". */
+{
+ TkTextIndex index1, index2;
+ int arg;
+ int lineno; /* Current line number */
+ int what = 0; /* bitfield to select segment types */
+ int atEnd; /* True if dumping up to logical end */
+ TkTextLine *linePtr;
+ char *command = NULL; /* Script callback to apply to segments */
+#define TK_DUMP_TEXT 0x1
+#define TK_DUMP_MARK 0x2
+#define TK_DUMP_TAG 0x4
+#define TK_DUMP_WIN 0x8
+#define TK_DUMP_IMG 0x10
+#define TK_DUMP_ALL (TK_DUMP_TEXT|TK_DUMP_MARK|TK_DUMP_TAG| \
+ TK_DUMP_WIN|TK_DUMP_IMG)
+
+ for (arg=2 ; argv[arg] != (char *) NULL ; arg++) {
+ size_t len;
+ if (argv[arg][0] != '-') {
+ break;
+ }
+ len = strlen(argv[arg]);
+ if (strncmp("-all", argv[arg], len) == 0) {
+ what = TK_DUMP_ALL;
+ } else if (strncmp("-text", argv[arg], len) == 0) {
+ what |= TK_DUMP_TEXT;
+ } else if (strncmp("-tag", argv[arg], len) == 0) {
+ what |= TK_DUMP_TAG;
+ } else if (strncmp("-mark", argv[arg], len) == 0) {
+ what |= TK_DUMP_MARK;
+ } else if (strncmp("-image", argv[arg], len) == 0) {
+ what |= TK_DUMP_IMG;
+ } else if (strncmp("-window", argv[arg], len) == 0) {
+ what |= TK_DUMP_WIN;
+ } else if (strncmp("-command", argv[arg], len) == 0) {
+ arg++;
+ if (arg >= argc) {
+ Tcl_AppendResult(interp, "Usage: ", argv[0], " dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?", NULL);
+ return TCL_ERROR;
+ }
+ command = argv[arg];
+ } else {
+ Tcl_AppendResult(interp, "Usage: ", argv[0], " dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?", NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (arg >= argc) {
+ Tcl_AppendResult(interp, "Usage: ", argv[0], " dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?", NULL);
+ return TCL_ERROR;
+ }
+ if (what == 0) {
+ what = TK_DUMP_ALL;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[arg], &index1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ lineno = TkBTreeLineIndex(index1.linePtr) + 1;
+ arg++;
+ atEnd = 0;
+ if (argc == arg) {
+ TkTextIndexForwChars(&index1, 1, &index2);
+ } else {
+ if (TkTextGetIndex(interp, textPtr, argv[arg], &index2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (strncmp(argv[arg], "end", strlen(argv[arg])) == 0) {
+ atEnd = 1;
+ }
+ }
+ if (TkTextIndexCmp(&index1, &index2) >= 0) {
+ return TCL_OK;
+ }
+ if (index1.linePtr == index2.linePtr) {
+ DumpLine(interp, textPtr, what, index1.linePtr,
+ index1.charIndex, index2.charIndex, lineno, command);
+ } else {
+ DumpLine(interp, textPtr, what, index1.linePtr,
+ index1.charIndex, 32000000, lineno, command);
+ linePtr = index1.linePtr;
+ while ((linePtr = TkBTreeNextLine(linePtr)) != (TkTextLine *)NULL) {
+ lineno++;
+ if (linePtr == index2.linePtr) {
+ break;
+ }
+ DumpLine(interp, textPtr, what, linePtr, 0, 32000000,
+ lineno, command);
+ }
+ DumpLine(interp, textPtr, what, index2.linePtr, 0,
+ index2.charIndex, lineno, command);
+ }
+ /*
+ * Special case to get the leftovers hiding at the end mark.
+ */
+ if (atEnd) {
+ DumpLine(interp, textPtr, what & ~TK_DUMP_TEXT, index2.linePtr,
+ 0, 1, lineno, command);
+
+ }
+ return TCL_OK;
+}
+
+/*
+ * DumpLine
+ * Return information about a given text line from character
+ * position "start" up to, but not including, "end".
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None, but see DumpSegment.
+ */
+static void
+DumpLine(interp, textPtr, what, linePtr, start, end, lineno, command)
+ Tcl_Interp *interp;
+ TkText *textPtr;
+ int what; /* bit flags to select segment types */
+ TkTextLine *linePtr; /* The current line */
+ int start, end; /* Character range to dump */
+ int lineno; /* Line number for indices dump */
+ char *command; /* Script to apply to the segment */
+{
+ int offset;
+ TkTextSegment *segPtr;
+ /*
+ * Must loop through line looking at its segments.
+ * character
+ * toggleOn, toggleOff
+ * mark
+ * image
+ * window
+ */
+ for (offset = 0, segPtr = linePtr->segPtr ;
+ (offset < end) && (segPtr != (TkTextSegment *)NULL) ;
+ offset += segPtr->size, segPtr = segPtr->nextPtr) {
+ if ((what & TK_DUMP_TEXT) && (segPtr->typePtr == &tkTextCharType) &&
+ (offset + segPtr->size > start)) {
+ char savedChar; /* Last char used in the seg */
+ int last = segPtr->size; /* Index of savedChar */
+ int first = 0; /* Index of first char in seg */
+ if (offset + segPtr->size > end) {
+ last = end - offset;
+ }
+ if (start > offset) {
+ first = start - offset;
+ }
+ savedChar = segPtr->body.chars[last];
+ segPtr->body.chars[last] = '\0';
+ DumpSegment(interp, "text", segPtr->body.chars + first,
+ command, lineno, offset + first, what);
+ segPtr->body.chars[last] = savedChar;
+ } else if ((offset >= start)) {
+ if ((what & TK_DUMP_MARK) && (segPtr->typePtr->name[0] == 'm')) {
+ TkTextMark *markPtr = (TkTextMark *)&segPtr->body;
+ char *name = Tcl_GetHashKey(&textPtr->markTable, markPtr->hPtr);
+ DumpSegment(interp, "mark", name,
+ command, lineno, offset, what);
+ } else if ((what & TK_DUMP_TAG) &&
+ (segPtr->typePtr == &tkTextToggleOnType)) {
+ DumpSegment(interp, "tagon",
+ segPtr->body.toggle.tagPtr->name,
+ command, lineno, offset, what);
+ } else if ((what & TK_DUMP_TAG) &&
+ (segPtr->typePtr == &tkTextToggleOffType)) {
+ DumpSegment(interp, "tagoff",
+ segPtr->body.toggle.tagPtr->name,
+ command, lineno, offset, what);
+ } else if ((what & TK_DUMP_IMG) &&
+ (segPtr->typePtr->name[0] == 'i')) {
+ TkTextEmbImage *eiPtr = (TkTextEmbImage *)&segPtr->body;
+ char *name = (eiPtr->name == NULL) ? "" : eiPtr->name;
+ DumpSegment(interp, "image", name,
+ command, lineno, offset, what);
+ } else if ((what & TK_DUMP_WIN) &&
+ (segPtr->typePtr->name[0] == 'w')) {
+ TkTextEmbWindow *ewPtr = (TkTextEmbWindow *)&segPtr->body;
+ char *pathname;
+ if (ewPtr->tkwin == (Tk_Window) NULL) {
+ pathname = "";
+ } else {
+ pathname = Tk_PathName(ewPtr->tkwin);
+ }
+ DumpSegment(interp, "window", pathname,
+ command, lineno, offset, what);
+ }
+ }
+ }
+}
+
+/*
+ * DumpSegment
+ * Either append information about the current segment to the result,
+ * or make a script callback with that information as arguments.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Either evals the callback or appends elements to the result string.
+ */
+static int
+DumpSegment(interp, key, value, command, lineno, offset, what)
+ Tcl_Interp *interp;
+ char *key; /* Segment type key */
+ char *value; /* Segment value */
+ char *command; /* Script callback */
+ int lineno; /* Line number for indices dump */
+ int offset; /* Character position */
+ int what; /* Look for TK_DUMP_INDEX bit */
+{
+ char buffer[30];
+ sprintf(buffer, "%d.%d", lineno, offset);
+ if (command == (char *) NULL) {
+ Tcl_AppendElement(interp, key);
+ Tcl_AppendElement(interp, value);
+ Tcl_AppendElement(interp, buffer);
+ return TCL_OK;
+ } else {
+ char *argv[4];
+ char *list;
+ int result;
+ argv[0] = key;
+ argv[1] = value;
+ argv[2] = buffer;
+ argv[3] = (char *) NULL;
+ list = Tcl_Merge(3, argv);
+ result = Tcl_VarEval(interp, command, " ", list, (char *) NULL);
+ ckfree(list);
+ return result;
+ }
+}
+
diff --git a/generic/tkText.h b/generic/tkText.h
new file mode 100644
index 0000000..a7999d2
--- /dev/null
+++ b/generic/tkText.h
@@ -0,0 +1,848 @@
+/*
+ * tkText.h --
+ *
+ * Declarations shared among the files that implement text
+ * widgets.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkText.h 1.46 96/11/25 11:26:12
+ */
+
+#ifndef _TKTEXT
+#define _TKTEXT
+
+#ifndef _TK
+#include "tk.h"
+#endif
+
+/*
+ * Opaque types for structures whose guts are only needed by a single
+ * file:
+ */
+
+typedef struct TkTextBTree *TkTextBTree;
+
+/*
+ * The data structure below defines a single line of text (from newline
+ * to newline, not necessarily what appears on one line of the screen).
+ */
+
+typedef struct TkTextLine {
+ struct Node *parentPtr; /* Pointer to parent node containing
+ * line. */
+ struct TkTextLine *nextPtr; /* Next in linked list of lines with
+ * same parent node in B-tree. NULL
+ * means end of list. */
+ struct TkTextSegment *segPtr; /* First in ordered list of segments
+ * that make up the line. */
+} TkTextLine;
+
+/*
+ * -----------------------------------------------------------------------
+ * Segments: each line is divided into one or more segments, where each
+ * segment is one of several things, such as a group of characters, a
+ * tag toggle, a mark, or an embedded widget. Each segment starts with
+ * a standard header followed by a body that varies from type to type.
+ * -----------------------------------------------------------------------
+ */
+
+/*
+ * The data structure below defines the body of a segment that represents
+ * a tag toggle. There is one of these structures at both the beginning
+ * and end of each tagged range.
+ */
+
+typedef struct TkTextToggle {
+ struct TkTextTag *tagPtr; /* Tag that starts or ends here. */
+ int inNodeCounts; /* 1 means this toggle has been
+ * accounted for in node toggle
+ * counts; 0 means it hasn't, yet. */
+} TkTextToggle;
+
+/*
+ * The data structure below defines line segments that represent
+ * marks. There is one of these for each mark in the text.
+ */
+
+typedef struct TkTextMark {
+ struct TkText *textPtr; /* Overall information about text
+ * widget. */
+ TkTextLine *linePtr; /* Line structure that contains the
+ * segment. */
+ Tcl_HashEntry *hPtr; /* Pointer to hash table entry for mark
+ * (in textPtr->markTable). */
+} TkTextMark;
+
+/*
+ * A structure of the following type holds information for each window
+ * embedded in a text widget. This information is only used by the
+ * file tkTextWind.c
+ */
+
+typedef struct TkTextEmbWindow {
+ struct TkText *textPtr; /* Information about the overall text
+ * widget. */
+ TkTextLine *linePtr; /* Line structure that contains this
+ * window. */
+ Tk_Window tkwin; /* Window for this segment. NULL
+ * means that the window hasn't
+ * been created yet. */
+ char *create; /* Script to create window on-demand.
+ * NULL means no such script.
+ * Malloc-ed. */
+ int align; /* How to align window in vertical
+ * space. See definitions in
+ * tkTextWind.c. */
+ int padX, padY; /* Padding to leave around each side
+ * of window, in pixels. */
+ int stretch; /* Should window stretch to fill
+ * vertical space of line (except for
+ * pady)? 0 or 1. */
+ int chunkCount; /* Number of display chunks that
+ * refer to this window. */
+ int displayed; /* Non-zero means that the window
+ * has been displayed on the screen
+ * recently. */
+} TkTextEmbWindow;
+
+/*
+ * A structure of the following type holds information for each image
+ * embedded in a text widget. This information is only used by the
+ * file tkTextImage.c
+ */
+
+typedef struct TkTextEmbImage {
+ struct TkText *textPtr; /* Information about the overall text
+ * widget. */
+ TkTextLine *linePtr; /* Line structure that contains this
+ * image. */
+ char *imageString; /* Name of the image for this segment */
+ char *imageName; /* Name used by text widget to identify
+ * this image. May be unique-ified */
+ char *name; /* Name used in the hash table.
+ * used by "image names" to identify
+ * this instance of the image */
+ Tk_Image image; /* Image for this segment. NULL
+ * means that the image hasn't
+ * been created yet. */
+ int align; /* How to align image in vertical
+ * space. See definitions in
+ * tkTextImage.c. */
+ int padX, padY; /* Padding to leave around each side
+ * of image, in pixels. */
+ int chunkCount; /* Number of display chunks that
+ * refer to this image. */
+} TkTextEmbImage;
+
+/*
+ * The data structure below defines line segments.
+ */
+
+typedef struct TkTextSegment {
+ struct Tk_SegType *typePtr; /* Pointer to record describing
+ * segment's type. */
+ struct TkTextSegment *nextPtr; /* Next in list of segments for this
+ * line, or NULL for end of list. */
+ int size; /* Size of this segment (# of bytes
+ * of index space it occupies). */
+ union {
+ char chars[4]; /* Characters that make up character
+ * info. Actual length varies to
+ * hold as many characters as needed.*/
+ TkTextToggle toggle; /* Information about tag toggle. */
+ TkTextMark mark; /* Information about mark. */
+ TkTextEmbWindow ew; /* Information about embedded
+ * window. */
+ TkTextEmbImage ei; /* Information about embedded
+ * image. */
+ } body;
+} TkTextSegment;
+
+/*
+ * Data structures of the type defined below are used during the
+ * execution of Tcl commands to keep track of various interesting
+ * places in a text. An index is only valid up until the next
+ * modification to the character structure of the b-tree so they
+ * can't be retained across Tcl commands. However, mods to marks
+ * or tags don't invalidate indices.
+ */
+
+typedef struct TkTextIndex {
+ TkTextBTree tree; /* Tree containing desired position. */
+ TkTextLine *linePtr; /* Pointer to line containing position
+ * of interest. */
+ int charIndex; /* Index within line of desired
+ * character (0 means first one). */
+} TkTextIndex;
+
+/*
+ * Types for procedure pointers stored in TkTextDispChunk strutures:
+ */
+
+typedef struct TkTextDispChunk TkTextDispChunk;
+
+typedef void Tk_ChunkDisplayProc _ANSI_ARGS_((
+ TkTextDispChunk *chunkPtr, int x, int y,
+ int height, int baseline, Display *display,
+ Drawable dst, int screenY));
+typedef void Tk_ChunkUndisplayProc _ANSI_ARGS_((
+ struct TkText *textPtr,
+ TkTextDispChunk *chunkPtr));
+typedef int Tk_ChunkMeasureProc _ANSI_ARGS_((
+ TkTextDispChunk *chunkPtr, int x));
+typedef void Tk_ChunkBboxProc _ANSI_ARGS_((
+ TkTextDispChunk *chunkPtr, int index, int y,
+ int lineHeight, int baseline, int *xPtr,
+ int *yPtr, int *widthPtr, int *heightPtr));
+
+/*
+ * The structure below represents a chunk of stuff that is displayed
+ * together on the screen. This structure is allocated and freed by
+ * generic display code but most of its fields are filled in by
+ * segment-type-specific code.
+ */
+
+struct TkTextDispChunk {
+ /*
+ * The fields below are set by the type-independent code before
+ * calling the segment-type-specific layoutProc. They should not
+ * be modified by segment-type-specific code.
+ */
+
+ int x; /* X position of chunk, in pixels.
+ * This position is measured from the
+ * left edge of the logical line,
+ * not from the left edge of the
+ * window (i.e. it doesn't change
+ * under horizontal scrolling). */
+ struct TkTextDispChunk *nextPtr; /* Next chunk in the display line
+ * or NULL for the end of the list. */
+ struct TextStyle *stylePtr; /* Display information, known only
+ * to tkTextDisp.c. */
+
+ /*
+ * The fields below are set by the layoutProc that creates the
+ * chunk.
+ */
+
+ Tk_ChunkDisplayProc *displayProc; /* Procedure to invoke to draw this
+ * chunk on the display or an
+ * off-screen pixmap. */
+ Tk_ChunkUndisplayProc *undisplayProc;
+ /* Procedure to invoke when segment
+ * ceases to be displayed on screen
+ * anymore. */
+ Tk_ChunkMeasureProc *measureProc; /* Procedure to find character under
+ * a given x-location. */
+ Tk_ChunkBboxProc *bboxProc; /* Procedure to find bounding box
+ * of character in chunk. */
+ int numChars; /* Number of characters that will be
+ * displayed in the chunk. */
+ int minAscent; /* Minimum space above the baseline
+ * needed by this chunk. */
+ int minDescent; /* Minimum space below the baseline
+ * needed by this chunk. */
+ int minHeight; /* Minimum total line height needed
+ * by this chunk. */
+ int width; /* Width of this chunk, in pixels.
+ * Initially set by chunk-specific
+ * code, but may be increased to
+ * include tab or extra space at end
+ * of line. */
+ int breakIndex; /* Index within chunk of last
+ * acceptable position for a line
+ * (break just before this character).
+ * <= 0 means don't break during or
+ * immediately after this chunk. */
+ ClientData clientData; /* Additional information for use
+ * of displayProc and undisplayProc. */
+};
+
+/*
+ * One data structure of the following type is used for each tag in a
+ * text widget. These structures are kept in textPtr->tagTable and
+ * referred to in other structures.
+ */
+
+typedef struct TkTextTag {
+ char *name; /* Name of this tag. This field is actually
+ * a pointer to the key from the entry in
+ * textPtr->tagTable, so it needn't be freed
+ * explicitly. */
+ int priority; /* Priority of this tag within widget. 0
+ * means lowest priority. Exactly one tag
+ * has each integer value between 0 and
+ * numTags-1. */
+ struct Node *tagRootPtr; /* Pointer into the B-Tree at the lowest
+ * node that completely dominates the ranges
+ * of text occupied by the tag. At this
+ * node there is no information about the
+ * tag. One or more children of the node
+ * do contain information about the tag. */
+ int toggleCount; /* Total number of tag toggles */
+
+ /*
+ * Information for displaying text with this tag. The information
+ * belows acts as an override on information specified by lower-priority
+ * tags. If no value is specified, then the next-lower-priority tag
+ * on the text determins the value. The text widget itself provides
+ * defaults if no tag specifies an override.
+ */
+
+ Tk_3DBorder border; /* Used for drawing background. NULL means
+ * no value specified here. */
+ char *bdString; /* -borderwidth option string (malloc-ed).
+ * NULL means option not specified. */
+ int borderWidth; /* Width of 3-D border for background. */
+ char *reliefString; /* -relief option string (malloc-ed).
+ * NULL means option not specified. */
+ int relief; /* 3-D relief for background. */
+ Pixmap bgStipple; /* Stipple bitmap for background. None
+ * means no value specified here. */
+ XColor *fgColor; /* Foreground color for text. NULL means
+ * no value specified here. */
+ Tk_Font tkfont; /* Font for displaying text. NULL means
+ * no value specified here. */
+ Pixmap fgStipple; /* Stipple bitmap for text and other
+ * foreground stuff. None means no value
+ * specified here.*/
+ char *justifyString; /* -justify option string (malloc-ed).
+ * NULL means option not specified. */
+ Tk_Justify justify; /* How to justify text: TK_JUSTIFY_LEFT,
+ * TK_JUSTIFY_RIGHT, or TK_JUSTIFY_CENTER.
+ * Only valid if justifyString is non-NULL. */
+ char *lMargin1String; /* -lmargin1 option string (malloc-ed).
+ * NULL means option not specified. */
+ int lMargin1; /* Left margin for first display line of
+ * each text line, in pixels. Only valid
+ * if lMargin1String is non-NULL. */
+ char *lMargin2String; /* -lmargin2 option string (malloc-ed).
+ * NULL means option not specified. */
+ int lMargin2; /* Left margin for second and later display
+ * lines of each text line, in pixels. Only
+ * valid if lMargin2String is non-NULL. */
+ char *offsetString; /* -offset option string (malloc-ed).
+ * NULL means option not specified. */
+ int offset; /* Vertical offset of text's baseline from
+ * baseline of line. Used for superscripts
+ * and subscripts. Only valid if
+ * offsetString is non-NULL. */
+ char *overstrikeString; /* -overstrike option string (malloc-ed).
+ * NULL means option not specified. */
+ int overstrike; /* Non-zero means draw horizontal line through
+ * middle of text. Only valid if
+ * overstrikeString is non-NULL. */
+ char *rMarginString; /* -rmargin option string (malloc-ed).
+ * NULL means option not specified. */
+ int rMargin; /* Right margin for text, in pixels. Only
+ * valid if rMarginString is non-NULL. */
+ char *spacing1String; /* -spacing1 option string (malloc-ed).
+ * NULL means option not specified. */
+ int spacing1; /* Extra spacing above first display
+ * line for text line. Only valid if
+ * spacing1String is non-NULL. */
+ char *spacing2String; /* -spacing2 option string (malloc-ed).
+ * NULL means option not specified. */
+ int spacing2; /* Extra spacing between display
+ * lines for the same text line. Only valid
+ * if spacing2String is non-NULL. */
+ char *spacing3String; /* -spacing2 option string (malloc-ed).
+ * NULL means option not specified. */
+ int spacing3; /* Extra spacing below last display
+ * line for text line. Only valid if
+ * spacing3String is non-NULL. */
+ char *tabString; /* -tabs option string (malloc-ed).
+ * NULL means option not specified. */
+ struct TkTextTabArray *tabArrayPtr;
+ /* Info about tabs for tag (malloc-ed)
+ * or NULL. Corresponds to tabString. */
+ char *underlineString; /* -underline option string (malloc-ed).
+ * NULL means option not specified. */
+ int underline; /* Non-zero means draw underline underneath
+ * text. Only valid if underlineString is
+ * non-NULL. */
+ Tk_Uid wrapMode; /* How to handle wrap-around for this tag.
+ * Must be tkTextCharUid, tkTextNoneUid,
+ * tkTextWordUid, or NULL to use wrapMode
+ * for whole widget. */
+ int affectsDisplay; /* Non-zero means that this tag affects the
+ * way information is displayed on the screen
+ * (so need to redisplay if tag changes). */
+} TkTextTag;
+
+#define TK_TAG_AFFECTS_DISPLAY 0x1
+#define TK_TAG_UNDERLINE 0x2
+#define TK_TAG_JUSTIFY 0x4
+#define TK_TAG_OFFSET 0x10
+
+/*
+ * The data structure below is used for searching a B-tree for transitions
+ * on a single tag (or for all tag transitions). No code outside of
+ * tkTextBTree.c should ever modify any of the fields in these structures,
+ * but it's OK to use them for read-only information.
+ */
+
+typedef struct TkTextSearch {
+ TkTextIndex curIndex; /* Position of last tag transition
+ * returned by TkBTreeNextTag, or
+ * index of start of segment
+ * containing starting position for
+ * search if TkBTreeNextTag hasn't
+ * been called yet, or same as
+ * stopIndex if search is over. */
+ TkTextSegment *segPtr; /* Actual tag segment returned by last
+ * call to TkBTreeNextTag, or NULL if
+ * TkBTreeNextTag hasn't returned
+ * anything yet. */
+ TkTextSegment *nextPtr; /* Where to resume search in next
+ * call to TkBTreeNextTag. */
+ TkTextSegment *lastPtr; /* Stop search before just before
+ * considering this segment. */
+ TkTextTag *tagPtr; /* Tag to search for (or tag found, if
+ * allTags is non-zero). */
+ int linesLeft; /* Lines left to search (including
+ * curIndex and stopIndex). When
+ * this becomes <= 0 the search is
+ * over. */
+ int allTags; /* Non-zero means ignore tag check:
+ * search for transitions on all
+ * tags. */
+} TkTextSearch;
+
+/*
+ * The following data structure describes a single tab stop.
+ */
+
+typedef enum {LEFT, RIGHT, CENTER, NUMERIC} TkTextTabAlign;
+
+typedef struct TkTextTab {
+ int location; /* Offset in pixels of this tab stop
+ * from the left margin (lmargin2) of
+ * the text. */
+ TkTextTabAlign alignment; /* Where the tab stop appears relative
+ * to the text. */
+} TkTextTab;
+
+typedef struct TkTextTabArray {
+ int numTabs; /* Number of tab stops. */
+ TkTextTab tabs[1]; /* Array of tabs. The actual size
+ * will be numTabs. THIS FIELD MUST
+ * BE THE LAST IN THE STRUCTURE. */
+} TkTextTabArray;
+
+/*
+ * A data structure of the following type is kept for each text widget that
+ * currently exists for this process:
+ */
+
+typedef struct TkText {
+ Tk_Window tkwin; /* Window that embodies the text. NULL
+ * means that the window has been destroyed
+ * but the data structures haven't yet been
+ * cleaned up.*/
+ Display *display; /* Display for widget. Needed, among other
+ * things, to allow resources to be freed
+ * even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with widget. Used
+ * to delete widget command. */
+ Tcl_Command widgetCmd; /* Token for text's widget command. */
+ TkTextBTree tree; /* B-tree representation of text and tags for
+ * widget. */
+ Tcl_HashTable tagTable; /* Hash table that maps from tag names to
+ * pointers to TkTextTag structures. */
+ int numTags; /* Number of tags currently defined for
+ * widget; needed to keep track of
+ * priorities. */
+ Tcl_HashTable markTable; /* Hash table that maps from mark names to
+ * pointers to mark segments. */
+ Tcl_HashTable windowTable; /* Hash table that maps from window names
+ * to pointers to window segments. If a
+ * window segment doesn't yet have an
+ * associated window, there is no entry for
+ * it here. */
+ Tcl_HashTable imageTable; /* Hash table that maps from image names
+ * to pointers to image segments. If an
+ * image segment doesn't yet have an
+ * associated image, there is no entry for
+ * it here. */
+ Tk_Uid state; /* Normal or disabled. Text is read-only
+ * when disabled. */
+
+ /*
+ * Default information for displaying (may be overridden by tags
+ * applied to ranges of characters).
+ */
+
+ Tk_3DBorder border; /* Structure used to draw 3-D border and
+ * default background. */
+ int borderWidth; /* Width of 3-D border to draw around entire
+ * widget. */
+ int padX, padY; /* Padding between text and window border. */
+ int relief; /* 3-d effect for border around entire
+ * widget: TK_RELIEF_RAISED etc. */
+ int highlightWidth; /* Width in pixels of highlight to draw
+ * around widget when it has the focus.
+ * <= 0 means don't draw a highlight. */
+ XColor *highlightBgColorPtr;
+ /* Color for drawing traversal highlight
+ * area when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ XColor *fgColor; /* Default foreground color for text. */
+ Tk_Font tkfont; /* Default font for displaying text. */
+ int charWidth; /* Width of average character in default
+ * font. */
+ int spacing1; /* Default extra spacing above first display
+ * line for each text line. */
+ int spacing2; /* Default extra spacing between display lines
+ * for the same text line. */
+ int spacing3; /* Default extra spacing below last display
+ * line for each text line. */
+ char *tabOptionString; /* Value of -tabs option string (malloc'ed). */
+ TkTextTabArray *tabArrayPtr;
+ /* Information about tab stops (malloc'ed).
+ * NULL means perform default tabbing
+ * behavior. */
+
+ /*
+ * Additional information used for displaying:
+ */
+
+ Tk_Uid wrapMode; /* How to handle wrap-around. Must be
+ * tkTextCharUid, tkTextNoneUid, or
+ * tkTextWordUid. */
+ int width, height; /* Desired dimensions for window, measured
+ * in characters. */
+ int setGrid; /* Non-zero means pass gridding information
+ * to window manager. */
+ int prevWidth, prevHeight; /* Last known dimensions of window; used to
+ * detect changes in size. */
+ TkTextIndex topIndex; /* Identifies first character in top display
+ * line of window. */
+ struct TextDInfo *dInfoPtr; /* Information maintained by tkTextDisp.c. */
+
+ /*
+ * Information related to selection.
+ */
+
+ TkTextTag *selTagPtr; /* Pointer to "sel" tag. Used to tell when
+ * a new selection has been made. */
+ Tk_3DBorder selBorder; /* Border and background for selected
+ * characters. This is a copy of information
+ * in *cursorTagPtr, so it shouldn't be
+ * explicitly freed. */
+ char *selBdString; /* Value of -selectborderwidth option, or NULL
+ * if not specified (malloc'ed). */
+ XColor *selFgColorPtr; /* Foreground color for selected text.
+ * This is a copy of information in
+ * *cursorTagPtr, so it shouldn't be
+ * explicitly freed. */
+ int exportSelection; /* Non-zero means tie "sel" tag to X
+ * selection. */
+ TkTextIndex selIndex; /* Used during multi-pass selection retrievals.
+ * This index identifies the next character
+ * to be returned from the selection. */
+ int abortSelections; /* Set to 1 whenever the text is modified
+ * in a way that interferes with selection
+ * retrieval: used to abort incremental
+ * selection retrievals. */
+ int selOffset; /* Offset in selection corresponding to
+ * selLine and selCh. -1 means neither
+ * this information nor selIndex is of any
+ * use. */
+
+ /*
+ * Information related to insertion cursor:
+ */
+
+ TkTextSegment *insertMarkPtr;
+ /* Points to segment for "insert" mark. */
+ Tk_3DBorder insertBorder; /* Used to draw vertical bar for insertion
+ * cursor. */
+ int insertWidth; /* Total width of insert cursor. */
+ int insertBorderWidth; /* Width of 3-D border around insert cursor. */
+ int insertOnTime; /* Number of milliseconds cursor should spend
+ * in "on" state for each blink. */
+ int insertOffTime; /* Number of milliseconds cursor should spend
+ * in "off" state for each blink. */
+ Tcl_TimerToken insertBlinkHandler;
+ /* Timer handler used to blink cursor on and
+ * off. */
+
+ /*
+ * Information used for event bindings associated with tags:
+ */
+
+ Tk_BindingTable bindingTable;
+ /* Table of all bindings currently defined
+ * for this widget. NULL means that no
+ * bindings exist, so the table hasn't been
+ * created. Each "object" used for this
+ * table is the address of a tag. */
+ TkTextSegment *currentMarkPtr;
+ /* Pointer to segment for "current" mark,
+ * or NULL if none. */
+ XEvent pickEvent; /* The event from which the current character
+ * was chosen. Must be saved so that we
+ * can repick after modifications to the
+ * text. */
+ int numCurTags; /* Number of tags associated with character
+ * at current mark. */
+ TkTextTag **curTagArrayPtr; /* Pointer to array of tags for current
+ * mark, or NULL if none. */
+
+ /*
+ * Miscellaneous additional information:
+ */
+
+ char *takeFocus; /* Value of -takeFocus option; not used in
+ * the C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+ char *xScrollCmd; /* Prefix of command to issue to update
+ * horizontal scrollbar when view changes. */
+ char *yScrollCmd; /* Prefix of command to issue to update
+ * vertical scrollbar when view changes. */
+ int flags; /* Miscellaneous flags; see below for
+ * definitions. */
+} TkText;
+
+/*
+ * Flag values for TkText records:
+ *
+ * GOT_SELECTION: Non-zero means we've already claimed the
+ * selection.
+ * INSERT_ON: Non-zero means insertion cursor should be
+ * displayed on screen.
+ * GOT_FOCUS: Non-zero means this window has the input
+ * focus.
+ * BUTTON_DOWN: 1 means that a mouse button is currently
+ * down; this is used to implement grabs
+ * for the duration of button presses.
+ * UPDATE_SCROLLBARS: Non-zero means scrollbar(s) should be updated
+ * during next redisplay operation.
+ */
+
+#define GOT_SELECTION 1
+#define INSERT_ON 2
+#define GOT_FOCUS 4
+#define BUTTON_DOWN 8
+#define UPDATE_SCROLLBARS 0x10
+#define NEED_REPICK 0x20
+
+/*
+ * Records of the following type define segment types in terms of
+ * a collection of procedures that may be called to manipulate
+ * segments of that type.
+ */
+
+typedef TkTextSegment * Tk_SegSplitProc _ANSI_ARGS_((
+ struct TkTextSegment *segPtr, int index));
+typedef int Tk_SegDeleteProc _ANSI_ARGS_((
+ struct TkTextSegment *segPtr,
+ TkTextLine *linePtr, int treeGone));
+typedef TkTextSegment * Tk_SegCleanupProc _ANSI_ARGS_((
+ struct TkTextSegment *segPtr, TkTextLine *linePtr));
+typedef void Tk_SegLineChangeProc _ANSI_ARGS_((
+ struct TkTextSegment *segPtr, TkTextLine *linePtr));
+typedef int Tk_SegLayoutProc _ANSI_ARGS_((struct TkText *textPtr,
+ struct TkTextIndex *indexPtr, TkTextSegment *segPtr,
+ int offset, int maxX, int maxChars,
+ int noCharsYet, Tk_Uid wrapMode,
+ struct TkTextDispChunk *chunkPtr));
+typedef void Tk_SegCheckProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+
+typedef struct Tk_SegType {
+ char *name; /* Name of this kind of segment. */
+ int leftGravity; /* If a segment has zero size (e.g. a
+ * mark or tag toggle), does it
+ * attach to character to its left
+ * or right? 1 means left, 0 means
+ * right. */
+ Tk_SegSplitProc *splitProc; /* Procedure to split large segment
+ * into two smaller ones. */
+ Tk_SegDeleteProc *deleteProc; /* Procedure to call to delete
+ * segment. */
+ Tk_SegCleanupProc *cleanupProc; /* After any change to a line, this
+ * procedure is invoked for all
+ * segments left in the line to
+ * perform any cleanup they wish
+ * (e.g. joining neighboring
+ * segments). */
+ Tk_SegLineChangeProc *lineChangeProc;
+ /* Invoked when a segment is about
+ * to be moved from its current line
+ * to an earlier line because of
+ * a deletion. The linePtr is that
+ * for the segment's old line.
+ * CleanupProc will be invoked after
+ * the deletion is finished. */
+ Tk_SegLayoutProc *layoutProc; /* Returns size information when
+ * figuring out what to display in
+ * window. */
+ Tk_SegCheckProc *checkProc; /* Called during consistency checks
+ * to check internal consistency of
+ * segment. */
+} Tk_SegType;
+
+/*
+ * The constant below is used to specify a line when what is really
+ * wanted is the entire text. For now, just use a very big number.
+ */
+
+#define TK_END_OF_TEXT 1000000
+
+/*
+ * The following definition specifies the maximum number of characters
+ * needed in a string to hold a position specifier.
+ */
+
+#define TK_POS_CHARS 30
+
+/*
+ * Declarations for variables shared among the text-related files:
+ */
+
+extern int tkBTreeDebug;
+extern int tkTextDebug;
+extern Tk_SegType tkTextCharType;
+extern Tk_Uid tkTextCharUid;
+extern Tk_Uid tkTextDisabledUid;
+extern Tk_SegType tkTextLeftMarkType;
+extern Tk_Uid tkTextNoneUid;
+extern Tk_Uid tkTextNormalUid;
+extern Tk_SegType tkTextRightMarkType;
+extern Tk_SegType tkTextToggleOnType;
+extern Tk_SegType tkTextToggleOffType;
+extern Tk_Uid tkTextWordUid;
+
+/*
+ * Declarations for procedures that are used by the text-related files
+ * but shouldn't be used anywhere else in Tk (or by Tk clients):
+ */
+
+extern int TkBTreeCharTagged _ANSI_ARGS_((TkTextIndex *indexPtr,
+ TkTextTag *tagPtr));
+extern void TkBTreeCheck _ANSI_ARGS_((TkTextBTree tree));
+extern int TkBTreeCharsInLine _ANSI_ARGS_((TkTextLine *linePtr));
+extern TkTextBTree TkBTreeCreate _ANSI_ARGS_((TkText *textPtr));
+extern void TkBTreeDestroy _ANSI_ARGS_((TkTextBTree tree));
+extern void TkBTreeDeleteChars _ANSI_ARGS_((TkTextIndex *index1Ptr,
+ TkTextIndex *index2Ptr));
+extern TkTextLine * TkBTreeFindLine _ANSI_ARGS_((TkTextBTree tree,
+ int line));
+extern TkTextTag ** TkBTreeGetTags _ANSI_ARGS_((TkTextIndex *indexPtr,
+ int *numTagsPtr));
+extern void TkBTreeInsertChars _ANSI_ARGS_((TkTextIndex *indexPtr,
+ char *string));
+extern int TkBTreeLineIndex _ANSI_ARGS_((TkTextLine *linePtr));
+extern void TkBTreeLinkSegment _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextIndex *indexPtr));
+extern TkTextLine * TkBTreeNextLine _ANSI_ARGS_((TkTextLine *linePtr));
+extern int TkBTreeNextTag _ANSI_ARGS_((TkTextSearch *searchPtr));
+extern int TkBTreeNumLines _ANSI_ARGS_((TkTextBTree tree));
+extern TkTextLine * TkBTreePreviousLine _ANSI_ARGS_((TkTextLine *linePtr));
+extern int TkBTreePrevTag _ANSI_ARGS_((TkTextSearch *searchPtr));
+extern void TkBTreeStartSearch _ANSI_ARGS_((TkTextIndex *index1Ptr,
+ TkTextIndex *index2Ptr, TkTextTag *tagPtr,
+ TkTextSearch *searchPtr));
+extern void TkBTreeStartSearchBack _ANSI_ARGS_((TkTextIndex *index1Ptr,
+ TkTextIndex *index2Ptr, TkTextTag *tagPtr,
+ TkTextSearch *searchPtr));
+extern void TkBTreeTag _ANSI_ARGS_((TkTextIndex *index1Ptr,
+ TkTextIndex *index2Ptr, TkTextTag *tagPtr,
+ int add));
+extern void TkBTreeUnlinkSegment _ANSI_ARGS_((TkTextBTree tree,
+ TkTextSegment *segPtr, TkTextLine *linePtr));
+extern void TkTextBindProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+extern void TkTextChanged _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *index1Ptr, TkTextIndex *index2Ptr));
+extern int TkTextCharBbox _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *indexPtr, int *xPtr, int *yPtr,
+ int *widthPtr, int *heightPtr));
+extern int TkTextCharLayoutProc _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *indexPtr, TkTextSegment *segPtr,
+ int offset, int maxX, int maxChars, int noBreakYet,
+ Tk_Uid wrapMode, TkTextDispChunk *chunkPtr));
+extern void TkTextCreateDInfo _ANSI_ARGS_((TkText *textPtr));
+extern int TkTextDLineInfo _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *indexPtr, int *xPtr, int *yPtr,
+ int *widthPtr, int *heightPtr, int *basePtr));
+extern TkTextTag * TkTextCreateTag _ANSI_ARGS_((TkText *textPtr,
+ char *tagName));
+extern void TkTextFreeDInfo _ANSI_ARGS_((TkText *textPtr));
+extern void TkTextFreeTag _ANSI_ARGS_((TkText *textPtr,
+ TkTextTag *tagPtr));
+extern int TkTextGetIndex _ANSI_ARGS_((Tcl_Interp *interp,
+ TkText *textPtr, char *string,
+ TkTextIndex *indexPtr));
+extern TkTextTabArray * TkTextGetTabs _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, char *string));
+extern void TkTextIndexBackChars _ANSI_ARGS_((TkTextIndex *srcPtr,
+ int count, TkTextIndex *dstPtr));
+extern int TkTextIndexCmp _ANSI_ARGS_((TkTextIndex *index1Ptr,
+ TkTextIndex *index2Ptr));
+extern void TkTextIndexForwChars _ANSI_ARGS_((TkTextIndex *srcPtr,
+ int count, TkTextIndex *dstPtr));
+extern TkTextSegment * TkTextIndexToSeg _ANSI_ARGS_((TkTextIndex *indexPtr,
+ int *offsetPtr));
+extern void TkTextInsertDisplayProc _ANSI_ARGS_((
+ TkTextDispChunk *chunkPtr, int x, int y, int height,
+ int baseline, Display *display, Drawable dst,
+ int screenY));
+extern void TkTextLostSelection _ANSI_ARGS_((
+ ClientData clientData));
+extern TkTextIndex * TkTextMakeIndex _ANSI_ARGS_((TkTextBTree tree,
+ int lineIndex, int charIndex,
+ TkTextIndex *indexPtr));
+extern int TkTextMarkCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, char **argv));
+extern int TkTextMarkNameToIndex _ANSI_ARGS_((TkText *textPtr,
+ char *name, TkTextIndex *indexPtr));
+extern void TkTextMarkSegToIndex _ANSI_ARGS_((TkText *textPtr,
+ TkTextSegment *markPtr, TkTextIndex *indexPtr));
+extern void TkTextEventuallyRepick _ANSI_ARGS_((TkText *textPtr));
+extern void TkTextPickCurrent _ANSI_ARGS_((TkText *textPtr,
+ XEvent *eventPtr));
+extern void TkTextPixelIndex _ANSI_ARGS_((TkText *textPtr,
+ int x, int y, TkTextIndex *indexPtr));
+extern void TkTextPrintIndex _ANSI_ARGS_((TkTextIndex *indexPtr,
+ char *string));
+extern void TkTextRedrawRegion _ANSI_ARGS_((TkText *textPtr,
+ int x, int y, int width, int height));
+extern void TkTextRedrawTag _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *index1Ptr, TkTextIndex *index2Ptr,
+ TkTextTag *tagPtr, int withTag));
+extern void TkTextRelayoutWindow _ANSI_ARGS_((TkText *textPtr));
+extern int TkTextScanCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, char **argv));
+extern int TkTextSeeCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, char **argv));
+extern int TkTextSegToOffset _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+extern TkTextSegment * TkTextSetMark _ANSI_ARGS_((TkText *textPtr, char *name,
+ TkTextIndex *indexPtr));
+extern void TkTextSetYView _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *indexPtr, int pickPlace));
+extern int TkTextTagCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, char **argv));
+extern int TkTextImageCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, char **argv));
+extern int TkTextImageIndex _ANSI_ARGS_((TkText *textPtr,
+ char *name, TkTextIndex *indexPtr));
+extern int TkTextWindowCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, char **argv));
+extern int TkTextWindowIndex _ANSI_ARGS_((TkText *textPtr,
+ char *name, TkTextIndex *indexPtr));
+extern int TkTextXviewCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, char **argv));
+extern int TkTextYviewCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, char **argv));
+
+#endif /* _TKTEXT */
diff --git a/generic/tkTextBTree.c b/generic/tkTextBTree.c
new file mode 100644
index 0000000..2fd7deb
--- /dev/null
+++ b/generic/tkTextBTree.c
@@ -0,0 +1,3594 @@
+/*
+ * tkTextBTree.c --
+ *
+ * This file contains code that manages the B-tree representation
+ * of text for Tk's text widget and implements character and
+ * toggle segment types.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkTextBTree.c 1.37 97/04/25 16:52:00
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkText.h"
+
+/*
+ * The data structure below keeps summary information about one tag as part
+ * of the tag information in a node.
+ */
+
+typedef struct Summary {
+ TkTextTag *tagPtr; /* Handle for tag. */
+ int toggleCount; /* Number of transitions into or
+ * out of this tag that occur in
+ * the subtree rooted at this node. */
+ struct Summary *nextPtr; /* Next in list of all tags for same
+ * node, or NULL if at end of list. */
+} Summary;
+
+/*
+ * The data structure below defines a node in the B-tree.
+ */
+
+typedef struct Node {
+ struct Node *parentPtr; /* Pointer to parent node, or NULL if
+ * this is the root. */
+ struct Node *nextPtr; /* Next in list of siblings with the
+ * same parent node, or NULL for end
+ * of list. */
+ Summary *summaryPtr; /* First in malloc-ed list of info
+ * about tags in this subtree (NULL if
+ * no tag info in the subtree). */
+ int level; /* Level of this node in the B-tree.
+ * 0 refers to the bottom of the tree
+ * (children are lines, not nodes). */
+ union { /* First in linked list of children. */
+ struct Node *nodePtr; /* Used if level > 0. */
+ TkTextLine *linePtr; /* Used if level == 0. */
+ } children;
+ int numChildren; /* Number of children of this node. */
+ int numLines; /* Total number of lines (leaves) in
+ * the subtree rooted here. */
+} Node;
+
+/*
+ * Upper and lower bounds on how many children a node may have:
+ * rebalance when either of these limits is exceeded. MAX_CHILDREN
+ * should be twice MIN_CHILDREN and MIN_CHILDREN must be >= 2.
+ */
+
+#define MAX_CHILDREN 12
+#define MIN_CHILDREN 6
+
+/*
+ * The data structure below defines an entire B-tree.
+ */
+
+typedef struct BTree {
+ Node *rootPtr; /* Pointer to root of B-tree. */
+ TkText *textPtr; /* Used to find tagTable in consistency
+ * checking code */
+} BTree;
+
+/*
+ * The structure below is used to pass information between
+ * TkBTreeGetTags and IncCount:
+ */
+
+typedef struct TagInfo {
+ int numTags; /* Number of tags for which there
+ * is currently information in
+ * tags and counts. */
+ int arraySize; /* Number of entries allocated for
+ * tags and counts. */
+ TkTextTag **tagPtrs; /* Array of tags seen so far.
+ * Malloc-ed. */
+ int *counts; /* Toggle count (so far) for each
+ * entry in tags. Malloc-ed. */
+} TagInfo;
+
+/*
+ * Variable that indicates whether to enable consistency checks for
+ * debugging.
+ */
+
+int tkBTreeDebug = 0;
+
+/*
+ * Macros that determine how much space to allocate for new segments:
+ */
+
+#define CSEG_SIZE(chars) ((unsigned) (Tk_Offset(TkTextSegment, body) \
+ + 1 + (chars)))
+#define TSEG_SIZE ((unsigned) (Tk_Offset(TkTextSegment, body) \
+ + sizeof(TkTextToggle)))
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void ChangeNodeToggleCount _ANSI_ARGS_((Node *nodePtr,
+ TkTextTag *tagPtr, int delta));
+static void CharCheckProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+static int CharDeleteProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr, int treeGone));
+static TkTextSegment * CharCleanupProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+static TkTextSegment * CharSplitProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ int index));
+static void CheckNodeConsistency _ANSI_ARGS_((Node *nodePtr));
+static void CleanupLine _ANSI_ARGS_((TkTextLine *linePtr));
+static void DeleteSummaries _ANSI_ARGS_((Summary *tagPtr));
+static void DestroyNode _ANSI_ARGS_((Node *nodePtr));
+static TkTextSegment * FindTagEnd _ANSI_ARGS_((TkTextBTree tree,
+ TkTextTag *tagPtr, TkTextIndex *indexPtr));
+static void IncCount _ANSI_ARGS_((TkTextTag *tagPtr, int inc,
+ TagInfo *tagInfoPtr));
+static void Rebalance _ANSI_ARGS_((BTree *treePtr, Node *nodePtr));
+static void RecomputeNodeCounts _ANSI_ARGS_((Node *nodePtr));
+static TkTextSegment * SplitSeg _ANSI_ARGS_((TkTextIndex *indexPtr));
+static void ToggleCheckProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+static TkTextSegment * ToggleCleanupProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+static int ToggleDeleteProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr, int treeGone));
+static void ToggleLineChangeProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+static TkTextSegment * FindTagStart _ANSI_ARGS_((TkTextBTree tree,
+ TkTextTag *tagPtr, TkTextIndex *indexPtr));
+
+/*
+ * Type record for character segments:
+ */
+
+Tk_SegType tkTextCharType = {
+ "character", /* name */
+ 0, /* leftGravity */
+ CharSplitProc, /* splitProc */
+ CharDeleteProc, /* deleteProc */
+ CharCleanupProc, /* cleanupProc */
+ (Tk_SegLineChangeProc *) NULL, /* lineChangeProc */
+ TkTextCharLayoutProc, /* layoutProc */
+ CharCheckProc /* checkProc */
+};
+
+/*
+ * Type record for segments marking the beginning of a tagged
+ * range:
+ */
+
+Tk_SegType tkTextToggleOnType = {
+ "toggleOn", /* name */
+ 0, /* leftGravity */
+ (Tk_SegSplitProc *) NULL, /* splitProc */
+ ToggleDeleteProc, /* deleteProc */
+ ToggleCleanupProc, /* cleanupProc */
+ ToggleLineChangeProc, /* lineChangeProc */
+ (Tk_SegLayoutProc *) NULL, /* layoutProc */
+ ToggleCheckProc /* checkProc */
+};
+
+/*
+ * Type record for segments marking the end of a tagged
+ * range:
+ */
+
+Tk_SegType tkTextToggleOffType = {
+ "toggleOff", /* name */
+ 1, /* leftGravity */
+ (Tk_SegSplitProc *) NULL, /* splitProc */
+ ToggleDeleteProc, /* deleteProc */
+ ToggleCleanupProc, /* cleanupProc */
+ ToggleLineChangeProc, /* lineChangeProc */
+ (Tk_SegLayoutProc *) NULL, /* layoutProc */
+ ToggleCheckProc /* checkProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeCreate --
+ *
+ * This procedure is called to create a new text B-tree.
+ *
+ * Results:
+ * The return value is a pointer to a new B-tree containing
+ * one line with nothing but a newline character.
+ *
+ * Side effects:
+ * Memory is allocated and initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkTextBTree
+TkBTreeCreate(textPtr)
+ TkText *textPtr;
+{
+ register BTree *treePtr;
+ register Node *rootPtr;
+ register TkTextLine *linePtr, *linePtr2;
+ register TkTextSegment *segPtr;
+
+ /*
+ * The tree will initially have two empty lines. The second line
+ * isn't actually part of the tree's contents, but its presence
+ * makes several operations easier. The tree will have one node,
+ * which is also the root of the tree.
+ */
+
+ rootPtr = (Node *) ckalloc(sizeof(Node));
+ linePtr = (TkTextLine *) ckalloc(sizeof(TkTextLine));
+ linePtr2 = (TkTextLine *) ckalloc(sizeof(TkTextLine));
+ rootPtr->parentPtr = NULL;
+ rootPtr->nextPtr = NULL;
+ rootPtr->summaryPtr = NULL;
+ rootPtr->level = 0;
+ rootPtr->children.linePtr = linePtr;
+ rootPtr->numChildren = 2;
+ rootPtr->numLines = 2;
+
+ linePtr->parentPtr = rootPtr;
+ linePtr->nextPtr = linePtr2;
+ segPtr = (TkTextSegment *) ckalloc(CSEG_SIZE(1));
+ linePtr->segPtr = segPtr;
+ segPtr->typePtr = &tkTextCharType;
+ segPtr->nextPtr = NULL;
+ segPtr->size = 1;
+ segPtr->body.chars[0] = '\n';
+ segPtr->body.chars[1] = 0;
+
+ linePtr2->parentPtr = rootPtr;
+ linePtr2->nextPtr = NULL;
+ segPtr = (TkTextSegment *) ckalloc(CSEG_SIZE(1));
+ linePtr2->segPtr = segPtr;
+ segPtr->typePtr = &tkTextCharType;
+ segPtr->nextPtr = NULL;
+ segPtr->size = 1;
+ segPtr->body.chars[0] = '\n';
+ segPtr->body.chars[1] = 0;
+
+ treePtr = (BTree *) ckalloc(sizeof(BTree));
+ treePtr->rootPtr = rootPtr;
+ treePtr->textPtr = textPtr;
+
+ return (TkTextBTree) treePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeDestroy --
+ *
+ * Delete a B-tree, recycling all of the storage it contains.
+ *
+ * Results:
+ * The tree given by treePtr is deleted. TreePtr should never
+ * again be used.
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBTreeDestroy(tree)
+ TkTextBTree tree; /* Pointer to tree to delete. */
+{
+ BTree *treePtr = (BTree *) tree;
+
+ DestroyNode(treePtr->rootPtr);
+ ckfree((char *) treePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyNode --
+ *
+ * This is a recursive utility procedure used during the deletion
+ * of a B-tree.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All the storage for nodePtr and its descendants is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyNode(nodePtr)
+ register Node *nodePtr;
+{
+ if (nodePtr->level == 0) {
+ TkTextLine *linePtr;
+ TkTextSegment *segPtr;
+
+ while (nodePtr->children.linePtr != NULL) {
+ linePtr = nodePtr->children.linePtr;
+ nodePtr->children.linePtr = linePtr->nextPtr;
+ while (linePtr->segPtr != NULL) {
+ segPtr = linePtr->segPtr;
+ linePtr->segPtr = segPtr->nextPtr;
+ (*segPtr->typePtr->deleteProc)(segPtr, linePtr, 1);
+ }
+ ckfree((char *) linePtr);
+ }
+ } else {
+ register Node *childPtr;
+
+ while (nodePtr->children.nodePtr != NULL) {
+ childPtr = nodePtr->children.nodePtr;
+ nodePtr->children.nodePtr = childPtr->nextPtr;
+ DestroyNode(childPtr);
+ }
+ }
+ DeleteSummaries(nodePtr->summaryPtr);
+ ckfree((char *) nodePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteSummaries --
+ *
+ * Free up all of the memory in a list of tag summaries associated
+ * with a node.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Storage is released.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteSummaries(summaryPtr)
+ register Summary *summaryPtr; /* First in list of node's tag
+ * summaries. */
+{
+ register Summary *nextPtr;
+ while (summaryPtr != NULL) {
+ nextPtr = summaryPtr->nextPtr;
+ ckfree((char *) summaryPtr);
+ summaryPtr = nextPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeInsertChars --
+ *
+ * Insert characters at a given position in a B-tree.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Characters are added to the B-tree at the given position.
+ * If the string contains newlines, new lines will be added,
+ * which could cause the structure of the B-tree to change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBTreeInsertChars(indexPtr, string)
+ register TkTextIndex *indexPtr; /* Indicates where to insert text.
+ * When the procedure returns, this
+ * index is no longer valid because
+ * of changes to the segment
+ * structure. */
+ char *string; /* Pointer to bytes to insert (may
+ * contain newlines, must be null-
+ * terminated). */
+{
+ register Node *nodePtr;
+ register TkTextSegment *prevPtr; /* The segment just before the first
+ * new segment (NULL means new segment
+ * is at beginning of line). */
+ TkTextSegment *curPtr; /* Current segment; new characters
+ * are inserted just after this one.
+ * NULL means insert at beginning of
+ * line. */
+ TkTextLine *linePtr; /* Current line (new segments are
+ * added to this line). */
+ register TkTextSegment *segPtr;
+ TkTextLine *newLinePtr;
+ int chunkSize; /* # characters in current chunk. */
+ register char *eol; /* Pointer to character just after last
+ * one in current chunk. */
+ int changeToLineCount; /* Counts change to total number of
+ * lines in file. */
+
+ prevPtr = SplitSeg(indexPtr);
+ linePtr = indexPtr->linePtr;
+ curPtr = prevPtr;
+
+ /*
+ * Chop the string up into lines and create a new segment for
+ * each line, plus a new line for the leftovers from the
+ * previous line.
+ */
+
+ changeToLineCount = 0;
+ while (*string != 0) {
+ for (eol = string; *eol != 0; eol++) {
+ if (*eol == '\n') {
+ eol++;
+ break;
+ }
+ }
+ chunkSize = eol-string;
+ segPtr = (TkTextSegment *) ckalloc(CSEG_SIZE(chunkSize));
+ segPtr->typePtr = &tkTextCharType;
+ if (curPtr == NULL) {
+ segPtr->nextPtr = linePtr->segPtr;
+ linePtr->segPtr = segPtr;
+ } else {
+ segPtr->nextPtr = curPtr->nextPtr;
+ curPtr->nextPtr = segPtr;
+ }
+ segPtr->size = chunkSize;
+ strncpy(segPtr->body.chars, string, (size_t) chunkSize);
+ segPtr->body.chars[chunkSize] = 0;
+
+ if (eol[-1] != '\n') {
+ break;
+ }
+
+ /*
+ * The chunk ended with a newline, so create a new TkTextLine
+ * and move the remainder of the old line to it.
+ */
+
+ newLinePtr = (TkTextLine *) ckalloc(sizeof(TkTextLine));
+ newLinePtr->parentPtr = linePtr->parentPtr;
+ newLinePtr->nextPtr = linePtr->nextPtr;
+ linePtr->nextPtr = newLinePtr;
+ newLinePtr->segPtr = segPtr->nextPtr;
+ segPtr->nextPtr = NULL;
+ linePtr = newLinePtr;
+ curPtr = NULL;
+ changeToLineCount++;
+
+ string = eol;
+ }
+
+ /*
+ * Cleanup the starting line for the insertion, plus the ending
+ * line if it's different.
+ */
+
+ CleanupLine(indexPtr->linePtr);
+ if (linePtr != indexPtr->linePtr) {
+ CleanupLine(linePtr);
+ }
+
+ /*
+ * Increment the line counts in all the parent nodes of the insertion
+ * point, then rebalance the tree if necessary.
+ */
+
+ for (nodePtr = linePtr->parentPtr ; nodePtr != NULL;
+ nodePtr = nodePtr->parentPtr) {
+ nodePtr->numLines += changeToLineCount;
+ }
+ nodePtr = linePtr->parentPtr;
+ nodePtr->numChildren += changeToLineCount;
+ if (nodePtr->numChildren > MAX_CHILDREN) {
+ Rebalance((BTree *) indexPtr->tree, nodePtr);
+ }
+
+ if (tkBTreeDebug) {
+ TkBTreeCheck(indexPtr->tree);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SplitSeg --
+ *
+ * This procedure is called before adding or deleting
+ * segments. It does three things: (a) it finds the segment
+ * containing indexPtr; (b) if there are several such
+ * segments (because some segments have zero length) then
+ * it picks the first segment that does not have left
+ * gravity; (c) if the index refers to the middle of
+ * a segment then it splits the segment so that the
+ * index now refers to the beginning of a segment.
+ *
+ * Results:
+ * The return value is a pointer to the segment just
+ * before the segment corresponding to indexPtr (as
+ * described above). If the segment corresponding to
+ * indexPtr is the first in its line then the return
+ * value is NULL.
+ *
+ * Side effects:
+ * The segment referred to by indexPtr is split unless
+ * indexPtr refers to its first character.
+ *
+ *--------------------------------------------------------------
+ */
+
+static TkTextSegment *
+SplitSeg(indexPtr)
+ TkTextIndex *indexPtr; /* Index identifying position
+ * at which to split a segment. */
+{
+ TkTextSegment *prevPtr, *segPtr;
+ int count;
+
+ for (count = indexPtr->charIndex, prevPtr = NULL,
+ segPtr = indexPtr->linePtr->segPtr; segPtr != NULL;
+ count -= segPtr->size, prevPtr = segPtr, segPtr = segPtr->nextPtr) {
+ if (segPtr->size > count) {
+ if (count == 0) {
+ return prevPtr;
+ }
+ segPtr = (*segPtr->typePtr->splitProc)(segPtr, count);
+ if (prevPtr == NULL) {
+ indexPtr->linePtr->segPtr = segPtr;
+ } else {
+ prevPtr->nextPtr = segPtr;
+ }
+ return segPtr;
+ } else if ((segPtr->size == 0) && (count == 0)
+ && !segPtr->typePtr->leftGravity) {
+ return prevPtr;
+ }
+ }
+ panic("SplitSeg reached end of line!");
+ return NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CleanupLine --
+ *
+ * This procedure is called after modifications have been
+ * made to a line. It scans over all of the segments in
+ * the line, giving each a chance to clean itself up, e.g.
+ * by merging with the following segments, updating internal
+ * information, etc.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on what the segment-specific cleanup procedures do.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CleanupLine(linePtr)
+ TkTextLine *linePtr; /* Line to be cleaned up. */
+{
+ TkTextSegment *segPtr, **prevPtrPtr;
+ int anyChanges;
+
+ /*
+ * Make a pass over all of the segments in the line, giving each
+ * a chance to clean itself up. This could potentially change
+ * the structure of the line, e.g. by merging two segments
+ * together or having two segments cancel themselves; if so,
+ * then repeat the whole process again, since the first structure
+ * change might make other structure changes possible. Repeat
+ * until eventually there are no changes.
+ */
+
+ while (1) {
+ anyChanges = 0;
+ for (prevPtrPtr = &linePtr->segPtr, segPtr = *prevPtrPtr;
+ segPtr != NULL;
+ prevPtrPtr = &(*prevPtrPtr)->nextPtr, segPtr = *prevPtrPtr) {
+ if (segPtr->typePtr->cleanupProc != NULL) {
+ *prevPtrPtr = (*segPtr->typePtr->cleanupProc)(segPtr, linePtr);
+ if (segPtr != *prevPtrPtr) {
+ anyChanges = 1;
+ }
+ }
+ }
+ if (!anyChanges) {
+ break;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeDeleteChars --
+ *
+ * Delete a range of characters from a B-tree. The caller
+ * must make sure that the final newline of the B-tree is
+ * never deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information is deleted from the B-tree. This can cause the
+ * internal structure of the B-tree to change. Note: because
+ * of changes to the B-tree structure, the indices pointed
+ * to by index1Ptr and index2Ptr should not be used after this
+ * procedure returns.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBTreeDeleteChars(index1Ptr, index2Ptr)
+ register TkTextIndex *index1Ptr; /* Indicates first character that is
+ * to be deleted. */
+ register TkTextIndex *index2Ptr; /* Indicates character just after the
+ * last one that is to be deleted. */
+{
+ TkTextSegment *prevPtr; /* The segment just before the start
+ * of the deletion range. */
+ TkTextSegment *lastPtr; /* The segment just after the end
+ * of the deletion range. */
+ TkTextSegment *segPtr, *nextPtr;
+ TkTextLine *curLinePtr;
+ Node *curNodePtr, *nodePtr;
+
+ /*
+ * Tricky point: split at index2Ptr first; otherwise the split
+ * at index2Ptr may invalidate segPtr and/or prevPtr.
+ */
+
+ lastPtr = SplitSeg(index2Ptr);
+ if (lastPtr != NULL) {
+ lastPtr = lastPtr->nextPtr;
+ } else {
+ lastPtr = index2Ptr->linePtr->segPtr;
+ }
+ prevPtr = SplitSeg(index1Ptr);
+ if (prevPtr != NULL) {
+ segPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = lastPtr;
+ } else {
+ segPtr = index1Ptr->linePtr->segPtr;
+ index1Ptr->linePtr->segPtr = lastPtr;
+ }
+
+ /*
+ * Delete all of the segments between prevPtr and lastPtr.
+ */
+
+ curLinePtr = index1Ptr->linePtr;
+ curNodePtr = curLinePtr->parentPtr;
+ while (segPtr != lastPtr) {
+ if (segPtr == NULL) {
+ TkTextLine *nextLinePtr;
+
+ /*
+ * We just ran off the end of a line. First find the
+ * next line, then go back to the old line and delete it
+ * (unless it's the starting line for the range).
+ */
+
+ nextLinePtr = TkBTreeNextLine(curLinePtr);
+ if (curLinePtr != index1Ptr->linePtr) {
+ if (curNodePtr == index1Ptr->linePtr->parentPtr) {
+ index1Ptr->linePtr->nextPtr = curLinePtr->nextPtr;
+ } else {
+ curNodePtr->children.linePtr = curLinePtr->nextPtr;
+ }
+ for (nodePtr = curNodePtr; nodePtr != NULL;
+ nodePtr = nodePtr->parentPtr) {
+ nodePtr->numLines--;
+ }
+ curNodePtr->numChildren--;
+ ckfree((char *) curLinePtr);
+ }
+ curLinePtr = nextLinePtr;
+ segPtr = curLinePtr->segPtr;
+
+ /*
+ * If the node is empty then delete it and its parents,
+ * recursively upwards until a non-empty node is found.
+ */
+
+ while (curNodePtr->numChildren == 0) {
+ Node *parentPtr;
+
+ parentPtr = curNodePtr->parentPtr;
+ if (parentPtr->children.nodePtr == curNodePtr) {
+ parentPtr->children.nodePtr = curNodePtr->nextPtr;
+ } else {
+ Node *prevNodePtr = parentPtr->children.nodePtr;
+ while (prevNodePtr->nextPtr != curNodePtr) {
+ prevNodePtr = prevNodePtr->nextPtr;
+ }
+ prevNodePtr->nextPtr = curNodePtr->nextPtr;
+ }
+ parentPtr->numChildren--;
+ ckfree((char *) curNodePtr);
+ curNodePtr = parentPtr;
+ }
+ curNodePtr = curLinePtr->parentPtr;
+ continue;
+ }
+
+ nextPtr = segPtr->nextPtr;
+ if ((*segPtr->typePtr->deleteProc)(segPtr, curLinePtr, 0) != 0) {
+ /*
+ * This segment refuses to die. Move it to prevPtr and
+ * advance prevPtr if the segment has left gravity.
+ */
+
+ if (prevPtr == NULL) {
+ segPtr->nextPtr = index1Ptr->linePtr->segPtr;
+ index1Ptr->linePtr->segPtr = segPtr;
+ } else {
+ segPtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = segPtr;
+ }
+ if (segPtr->typePtr->leftGravity) {
+ prevPtr = segPtr;
+ }
+ }
+ segPtr = nextPtr;
+ }
+
+ /*
+ * If the beginning and end of the deletion range are in different
+ * lines, join the two lines together and discard the ending line.
+ */
+
+ if (index1Ptr->linePtr != index2Ptr->linePtr) {
+ TkTextLine *prevLinePtr;
+
+ for (segPtr = lastPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ if (segPtr->typePtr->lineChangeProc != NULL) {
+ (*segPtr->typePtr->lineChangeProc)(segPtr, index2Ptr->linePtr);
+ }
+ }
+ curNodePtr = index2Ptr->linePtr->parentPtr;
+ for (nodePtr = curNodePtr; nodePtr != NULL;
+ nodePtr = nodePtr->parentPtr) {
+ nodePtr->numLines--;
+ }
+ curNodePtr->numChildren--;
+ prevLinePtr = curNodePtr->children.linePtr;
+ if (prevLinePtr == index2Ptr->linePtr) {
+ curNodePtr->children.linePtr = index2Ptr->linePtr->nextPtr;
+ } else {
+ while (prevLinePtr->nextPtr != index2Ptr->linePtr) {
+ prevLinePtr = prevLinePtr->nextPtr;
+ }
+ prevLinePtr->nextPtr = index2Ptr->linePtr->nextPtr;
+ }
+ ckfree((char *) index2Ptr->linePtr);
+ Rebalance((BTree *) index2Ptr->tree, curNodePtr);
+ }
+
+ /*
+ * Cleanup the segments in the new line.
+ */
+
+ CleanupLine(index1Ptr->linePtr);
+
+ /*
+ * Lastly, rebalance the first node of the range.
+ */
+
+ Rebalance((BTree *) index1Ptr->tree, index1Ptr->linePtr->parentPtr);
+ if (tkBTreeDebug) {
+ TkBTreeCheck(index1Ptr->tree);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeFindLine --
+ *
+ * Find a particular line in a B-tree based on its line number.
+ *
+ * Results:
+ * The return value is a pointer to the line structure for the
+ * line whose index is "line", or NULL if no such line exists.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkTextLine *
+TkBTreeFindLine(tree, line)
+ TkTextBTree tree; /* B-tree in which to find line. */
+ int line; /* Index of desired line. */
+{
+ BTree *treePtr = (BTree *) tree;
+ register Node *nodePtr;
+ register TkTextLine *linePtr;
+ int linesLeft;
+
+ nodePtr = treePtr->rootPtr;
+ linesLeft = line;
+ if ((line < 0) || (line >= nodePtr->numLines)) {
+ return NULL;
+ }
+
+ /*
+ * Work down through levels of the tree until a node is found at
+ * level 0.
+ */
+
+ while (nodePtr->level != 0) {
+ for (nodePtr = nodePtr->children.nodePtr;
+ nodePtr->numLines <= linesLeft;
+ nodePtr = nodePtr->nextPtr) {
+ if (nodePtr == NULL) {
+ panic("TkBTreeFindLine ran out of nodes");
+ }
+ linesLeft -= nodePtr->numLines;
+ }
+ }
+
+ /*
+ * Work through the lines attached to the level-0 node.
+ */
+
+ for (linePtr = nodePtr->children.linePtr; linesLeft > 0;
+ linePtr = linePtr->nextPtr) {
+ if (linePtr == NULL) {
+ panic("TkBTreeFindLine ran out of lines");
+ }
+ linesLeft -= 1;
+ }
+ return linePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeNextLine --
+ *
+ * Given an existing line in a B-tree, this procedure locates the
+ * next line in the B-tree. This procedure is used for scanning
+ * through the B-tree.
+ *
+ * Results:
+ * The return value is a pointer to the line that immediately
+ * follows linePtr, or NULL if there is no such line.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkTextLine *
+TkBTreeNextLine(linePtr)
+ register TkTextLine *linePtr; /* Pointer to existing line in
+ * B-tree. */
+{
+ register Node *nodePtr;
+
+ if (linePtr->nextPtr != NULL) {
+ return linePtr->nextPtr;
+ }
+
+ /*
+ * This was the last line associated with the particular parent node.
+ * Search up the tree for the next node, then search down from that
+ * node to find the first line.
+ */
+
+ for (nodePtr = linePtr->parentPtr; ; nodePtr = nodePtr->parentPtr) {
+ if (nodePtr->nextPtr != NULL) {
+ nodePtr = nodePtr->nextPtr;
+ break;
+ }
+ if (nodePtr->parentPtr == NULL) {
+ return (TkTextLine *) NULL;
+ }
+ }
+ while (nodePtr->level > 0) {
+ nodePtr = nodePtr->children.nodePtr;
+ }
+ return nodePtr->children.linePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreePreviousLine --
+ *
+ * Given an existing line in a B-tree, this procedure locates the
+ * previous line in the B-tree. This procedure is used for scanning
+ * through the B-tree in the reverse direction.
+ *
+ * Results:
+ * The return value is a pointer to the line that immediately
+ * preceeds linePtr, or NULL if there is no such line.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkTextLine *
+TkBTreePreviousLine(linePtr)
+ register TkTextLine *linePtr; /* Pointer to existing line in
+ * B-tree. */
+{
+ register Node *nodePtr;
+ register Node *node2Ptr;
+ register TkTextLine *prevPtr;
+
+ /*
+ * Find the line under this node just before the starting line.
+ */
+ prevPtr = linePtr->parentPtr->children.linePtr; /* First line at leaf */
+ while (prevPtr != linePtr) {
+ if (prevPtr->nextPtr == linePtr) {
+ return prevPtr;
+ }
+ prevPtr = prevPtr->nextPtr;
+ if (prevPtr == (TkTextLine *) NULL) {
+ panic("TkBTreePreviousLine ran out of lines");
+ }
+ }
+
+ /*
+ * This was the first line associated with the particular parent node.
+ * Search up the tree for the previous node, then search down from that
+ * node to find its last line.
+ */
+ for (nodePtr = linePtr->parentPtr; ; nodePtr = nodePtr->parentPtr) {
+ if (nodePtr == (Node *) NULL || nodePtr->parentPtr == (Node *) NULL) {
+ return (TkTextLine *) NULL;
+ }
+ if (nodePtr != nodePtr->parentPtr->children.nodePtr) {
+ break;
+ }
+ }
+ for (node2Ptr = nodePtr->parentPtr->children.nodePtr; ;
+ node2Ptr = node2Ptr->children.nodePtr) {
+ while (node2Ptr->nextPtr != nodePtr) {
+ node2Ptr = node2Ptr->nextPtr;
+ }
+ if (node2Ptr->level == 0) {
+ break;
+ }
+ nodePtr = (Node *)NULL;
+ }
+ for (prevPtr = node2Ptr->children.linePtr ; ; prevPtr = prevPtr->nextPtr) {
+ if (prevPtr->nextPtr == (TkTextLine *) NULL) {
+ return prevPtr;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeLineIndex --
+ *
+ * Given a pointer to a line in a B-tree, return the numerical
+ * index of that line.
+ *
+ * Results:
+ * The result is the index of linePtr within the tree, where 0
+ * corresponds to the first line in the tree.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkBTreeLineIndex(linePtr)
+ TkTextLine *linePtr; /* Pointer to existing line in
+ * B-tree. */
+{
+ register TkTextLine *linePtr2;
+ register Node *nodePtr, *parentPtr, *nodePtr2;
+ int index;
+
+ /*
+ * First count how many lines precede this one in its level-0
+ * node.
+ */
+
+ nodePtr = linePtr->parentPtr;
+ index = 0;
+ for (linePtr2 = nodePtr->children.linePtr; linePtr2 != linePtr;
+ linePtr2 = linePtr2->nextPtr) {
+ if (linePtr2 == NULL) {
+ panic("TkBTreeLineIndex couldn't find line");
+ }
+ index += 1;
+ }
+
+ /*
+ * Now work up through the levels of the tree one at a time,
+ * counting how many lines are in nodes preceding the current
+ * node.
+ */
+
+ for (parentPtr = nodePtr->parentPtr ; parentPtr != NULL;
+ nodePtr = parentPtr, parentPtr = parentPtr->parentPtr) {
+ for (nodePtr2 = parentPtr->children.nodePtr; nodePtr2 != nodePtr;
+ nodePtr2 = nodePtr2->nextPtr) {
+ if (nodePtr2 == NULL) {
+ panic("TkBTreeLineIndex couldn't find node");
+ }
+ index += nodePtr2->numLines;
+ }
+ }
+ return index;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeLinkSegment --
+ *
+ * This procedure adds a new segment to a B-tree at a given
+ * location.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * SegPtr will be linked into its tree.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+void
+TkBTreeLinkSegment(segPtr, indexPtr)
+ TkTextSegment *segPtr; /* Pointer to new segment to be added to
+ * B-tree. Should be completely initialized
+ * by caller except for nextPtr field. */
+ TkTextIndex *indexPtr; /* Where to add segment: it gets linked
+ * in just before the segment indicated
+ * here. */
+{
+ register TkTextSegment *prevPtr;
+
+ prevPtr = SplitSeg(indexPtr);
+ if (prevPtr == NULL) {
+ segPtr->nextPtr = indexPtr->linePtr->segPtr;
+ indexPtr->linePtr->segPtr = segPtr;
+ } else {
+ segPtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = segPtr;
+ }
+ CleanupLine(indexPtr->linePtr);
+ if (tkBTreeDebug) {
+ TkBTreeCheck(indexPtr->tree);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeUnlinkSegment --
+ *
+ * This procedure unlinks a segment from its line in a B-tree.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * SegPtr will be unlinked from linePtr. The segment itself
+ * isn't modified by this procedure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+void
+TkBTreeUnlinkSegment(tree, segPtr, linePtr)
+ TkTextBTree tree; /* Tree containing segment. */
+ TkTextSegment *segPtr; /* Segment to be unlinked. */
+ TkTextLine *linePtr; /* Line that currently contains
+ * segment. */
+{
+ register TkTextSegment *prevPtr;
+
+ if (linePtr->segPtr == segPtr) {
+ linePtr->segPtr = segPtr->nextPtr;
+ } else {
+ for (prevPtr = linePtr->segPtr; prevPtr->nextPtr != segPtr;
+ prevPtr = prevPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ prevPtr->nextPtr = segPtr->nextPtr;
+ }
+ CleanupLine(linePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeTag --
+ *
+ * Turn a given tag on or off for a given range of characters in
+ * a B-tree of text.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The given tag is added to the given range of characters
+ * in the tree or removed from all those characters, depending
+ * on the "add" argument. The structure of the btree is modified
+ * enough that index1Ptr and index2Ptr are no longer valid after
+ * this procedure returns, and the indexes may be modified by
+ * this procedure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBTreeTag(index1Ptr, index2Ptr, tagPtr, add)
+ register TkTextIndex *index1Ptr; /* Indicates first character in
+ * range. */
+ register TkTextIndex *index2Ptr; /* Indicates character just after the
+ * last one in range. */
+ TkTextTag *tagPtr; /* Tag to add or remove. */
+ int add; /* One means add tag to the given
+ * range of characters; zero means
+ * remove the tag from the range. */
+{
+ TkTextSegment *segPtr, *prevPtr;
+ TkTextSearch search;
+ TkTextLine *cleanupLinePtr;
+ int oldState;
+ int changed;
+
+ /*
+ * See whether the tag is present at the start of the range. If
+ * the state doesn't already match what we want then add a toggle
+ * there.
+ */
+
+ oldState = TkBTreeCharTagged(index1Ptr, tagPtr);
+ if ((add != 0) ^ oldState) {
+ segPtr = (TkTextSegment *) ckalloc(TSEG_SIZE);
+ segPtr->typePtr = (add) ? &tkTextToggleOnType : &tkTextToggleOffType;
+ prevPtr = SplitSeg(index1Ptr);
+ if (prevPtr == NULL) {
+ segPtr->nextPtr = index1Ptr->linePtr->segPtr;
+ index1Ptr->linePtr->segPtr = segPtr;
+ } else {
+ segPtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = segPtr;
+ }
+ segPtr->size = 0;
+ segPtr->body.toggle.tagPtr = tagPtr;
+ segPtr->body.toggle.inNodeCounts = 0;
+ }
+
+ /*
+ * Scan the range of characters and delete any internal tag
+ * transitions. Keep track of what the old state was at the end
+ * of the range, and add a toggle there if it's needed.
+ */
+
+ TkBTreeStartSearch(index1Ptr, index2Ptr, tagPtr, &search);
+ cleanupLinePtr = index1Ptr->linePtr;
+ while (TkBTreeNextTag(&search)) {
+ oldState ^= 1;
+ segPtr = search.segPtr;
+ prevPtr = search.curIndex.linePtr->segPtr;
+ if (prevPtr == segPtr) {
+ search.curIndex.linePtr->segPtr = segPtr->nextPtr;
+ } else {
+ while (prevPtr->nextPtr != segPtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ prevPtr->nextPtr = segPtr->nextPtr;
+ }
+ if (segPtr->body.toggle.inNodeCounts) {
+ ChangeNodeToggleCount(search.curIndex.linePtr->parentPtr,
+ segPtr->body.toggle.tagPtr, -1);
+ segPtr->body.toggle.inNodeCounts = 0;
+ changed = 1;
+ } else {
+ changed = 0;
+ }
+ ckfree((char *) segPtr);
+
+ /*
+ * The code below is a bit tricky. After deleting a toggle
+ * we eventually have to call CleanupLine, in order to allow
+ * character segments to be merged together. To do this, we
+ * remember in cleanupLinePtr a line that needs to be
+ * cleaned up, but we don't clean it up until we've moved
+ * on to a different line. That way the cleanup process
+ * won't goof up segPtr.
+ */
+
+ if (cleanupLinePtr != search.curIndex.linePtr) {
+ CleanupLine(cleanupLinePtr);
+ cleanupLinePtr = search.curIndex.linePtr;
+ }
+ /*
+ * Quick hack. ChangeNodeToggleCount may move the tag's root
+ * location around and leave the search in the void. This resets
+ * the search.
+ */
+ if (changed) {
+ TkBTreeStartSearch(index1Ptr, index2Ptr, tagPtr, &search);
+ }
+ }
+ if ((add != 0) ^ oldState) {
+ segPtr = (TkTextSegment *) ckalloc(TSEG_SIZE);
+ segPtr->typePtr = (add) ? &tkTextToggleOffType : &tkTextToggleOnType;
+ prevPtr = SplitSeg(index2Ptr);
+ if (prevPtr == NULL) {
+ segPtr->nextPtr = index2Ptr->linePtr->segPtr;
+ index2Ptr->linePtr->segPtr = segPtr;
+ } else {
+ segPtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = segPtr;
+ }
+ segPtr->size = 0;
+ segPtr->body.toggle.tagPtr = tagPtr;
+ segPtr->body.toggle.inNodeCounts = 0;
+ }
+
+ /*
+ * Cleanup cleanupLinePtr and the last line of the range, if
+ * these are different.
+ */
+
+ CleanupLine(cleanupLinePtr);
+ if (cleanupLinePtr != index2Ptr->linePtr) {
+ CleanupLine(index2Ptr->linePtr);
+ }
+
+ if (tkBTreeDebug) {
+ TkBTreeCheck(index1Ptr->tree);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChangeNodeToggleCount --
+ *
+ * This procedure increments or decrements the toggle count for
+ * a particular tag in a particular node and all its ancestors
+ * up to the per-tag root node.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The toggle count for tag is adjusted up or down by "delta" in
+ * nodePtr. This routine maintains the tagRootPtr that identifies
+ * the root node for the tag, moving it up or down the tree as needed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ChangeNodeToggleCount(nodePtr, tagPtr, delta)
+ register Node *nodePtr; /* Node whose toggle count for a tag
+ * must be changed. */
+ TkTextTag *tagPtr; /* Information about tag. */
+ int delta; /* Amount to add to current toggle
+ * count for tag (may be negative). */
+{
+ register Summary *summaryPtr, *prevPtr;
+ register Node *node2Ptr;
+ int rootLevel; /* Level of original tag root */
+
+ tagPtr->toggleCount += delta;
+ if (tagPtr->tagRootPtr == (Node *) NULL) {
+ tagPtr->tagRootPtr = nodePtr;
+ return;
+ }
+
+ /*
+ * Note the level of the existing root for the tag so we can detect
+ * if it needs to be moved because of the toggle count change.
+ */
+
+ rootLevel = tagPtr->tagRootPtr->level;
+
+ /*
+ * Iterate over the node and its ancestors up to the tag root, adjusting
+ * summary counts at each node and moving the tag's root upwards if
+ * necessary.
+ */
+
+ for ( ; nodePtr != tagPtr->tagRootPtr; nodePtr = nodePtr->parentPtr) {
+ /*
+ * See if there's already an entry for this tag for this node. If so,
+ * perhaps all we have to do is adjust its count.
+ */
+
+ for (prevPtr = NULL, summaryPtr = nodePtr->summaryPtr;
+ summaryPtr != NULL;
+ prevPtr = summaryPtr, summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr == tagPtr) {
+ break;
+ }
+ }
+ if (summaryPtr != NULL) {
+ summaryPtr->toggleCount += delta;
+ if (summaryPtr->toggleCount > 0 &&
+ summaryPtr->toggleCount < tagPtr->toggleCount) {
+ continue;
+ }
+ if (summaryPtr->toggleCount != 0) {
+ /*
+ * Should never find a node with max toggle count at this
+ * point (there shouldn't have been a summary entry in the
+ * first place).
+ */
+
+ panic("ChangeNodeToggleCount: bad toggle count (%d) max (%d)",
+ summaryPtr->toggleCount, tagPtr->toggleCount);
+ }
+
+ /*
+ * Zero toggle count; must remove this tag from the list.
+ */
+
+ if (prevPtr == NULL) {
+ nodePtr->summaryPtr = summaryPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = summaryPtr->nextPtr;
+ }
+ ckfree((char *) summaryPtr);
+ } else {
+ /*
+ * This tag isn't currently in the summary information list.
+ */
+
+ if (rootLevel == nodePtr->level) {
+
+ /*
+ * The old tag root is at the same level in the tree as this
+ * node, but it isn't at this node. Move the tag root up
+ * a level, in the hopes that it will now cover this node
+ * as well as the old root (if not, we'll move it up again
+ * the next time through the loop). To push it up one level
+ * we copy the original toggle count into the summary
+ * information at the old root and change the root to its
+ * parent node.
+ */
+
+ Node *rootNodePtr = tagPtr->tagRootPtr;
+ summaryPtr = (Summary *) ckalloc(sizeof(Summary));
+ summaryPtr->tagPtr = tagPtr;
+ summaryPtr->toggleCount = tagPtr->toggleCount - delta;
+ summaryPtr->nextPtr = rootNodePtr->summaryPtr;
+ rootNodePtr->summaryPtr = summaryPtr;
+ rootNodePtr = rootNodePtr->parentPtr;
+ rootLevel = rootNodePtr->level;
+ tagPtr->tagRootPtr = rootNodePtr;
+ }
+ summaryPtr = (Summary *) ckalloc(sizeof(Summary));
+ summaryPtr->tagPtr = tagPtr;
+ summaryPtr->toggleCount = delta;
+ summaryPtr->nextPtr = nodePtr->summaryPtr;
+ nodePtr->summaryPtr = summaryPtr;
+ }
+ }
+
+ /*
+ * If we've decremented the toggle count, then it may be necessary
+ * to push the tag root down one or more levels.
+ */
+
+ if (delta >= 0) {
+ return;
+ }
+ if (tagPtr->toggleCount == 0) {
+ tagPtr->tagRootPtr = (Node *) NULL;
+ return;
+ }
+ nodePtr = tagPtr->tagRootPtr;
+ while (nodePtr->level > 0) {
+ /*
+ * See if a single child node accounts for all of the tag's
+ * toggles. If so, push the root down one level.
+ */
+
+ for (node2Ptr = nodePtr->children.nodePtr;
+ node2Ptr != (Node *)NULL ;
+ node2Ptr = node2Ptr->nextPtr) {
+ for (prevPtr = NULL, summaryPtr = node2Ptr->summaryPtr;
+ summaryPtr != NULL;
+ prevPtr = summaryPtr, summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr == tagPtr) {
+ break;
+ }
+ }
+ if (summaryPtr == NULL) {
+ continue;
+ }
+ if (summaryPtr->toggleCount != tagPtr->toggleCount) {
+ /*
+ * No node has all toggles, so the root is still valid.
+ */
+
+ return;
+ }
+
+ /*
+ * This node has all the toggles, so push down the root.
+ */
+
+ if (prevPtr == NULL) {
+ node2Ptr->summaryPtr = summaryPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = summaryPtr->nextPtr;
+ }
+ ckfree((char *) summaryPtr);
+ tagPtr->tagRootPtr = node2Ptr;
+ break;
+ }
+ nodePtr = tagPtr->tagRootPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindTagStart --
+ *
+ * Find the start of the first range of a tag.
+ *
+ * Results:
+ * The return value is a pointer to the first tag toggle segment
+ * for the tag. This can be either a tagon or tagoff segments because
+ * of the way TkBTreeAdd removes a tag.
+ * Sets *indexPtr to be the index of the tag toggle.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkTextSegment *
+FindTagStart(tree, tagPtr, indexPtr)
+ TkTextBTree tree; /* Tree to search within */
+ TkTextTag *tagPtr; /* Tag to search for. */
+ TkTextIndex *indexPtr; /* Return - index information */
+{
+ register Node *nodePtr;
+ register TkTextLine *linePtr;
+ register TkTextSegment *segPtr;
+ register Summary *summaryPtr;
+ int offset;
+
+ nodePtr = tagPtr->tagRootPtr;
+ if (nodePtr == (Node *) NULL) {
+ return NULL;
+ }
+
+ /*
+ * Search from the root of the subtree that contains the tag down
+ * to the level 0 node.
+ */
+
+ while (nodePtr->level > 0) {
+ for (nodePtr = nodePtr->children.nodePtr ; nodePtr != (Node *) NULL;
+ nodePtr = nodePtr->nextPtr) {
+ for (summaryPtr = nodePtr->summaryPtr ; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr == tagPtr) {
+ goto gotNodeWithTag;
+ }
+ }
+ }
+ gotNodeWithTag:
+ continue;
+ }
+
+ /*
+ * Work through the lines attached to the level-0 node.
+ */
+
+ for (linePtr = nodePtr->children.linePtr; linePtr != (TkTextLine *) NULL;
+ linePtr = linePtr->nextPtr) {
+ for (offset = 0, segPtr = linePtr->segPtr ; segPtr != NULL;
+ offset += segPtr->size, segPtr = segPtr->nextPtr) {
+ if (((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType))
+ && (segPtr->body.toggle.tagPtr == tagPtr)) {
+ /*
+ * It is possible that this is a tagoff tag, but that
+ * gets cleaned up later.
+ */
+ indexPtr->tree = tree;
+ indexPtr->linePtr = linePtr;
+ indexPtr->charIndex = offset;
+ return segPtr;
+ }
+ }
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindTagEnd --
+ *
+ * Find the end of the last range of a tag.
+ *
+ * Results:
+ * The return value is a pointer to the last tag toggle segment
+ * for the tag. This can be either a tagon or tagoff segments because
+ * of the way TkBTreeAdd removes a tag.
+ * Sets *indexPtr to be the index of the tag toggle.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkTextSegment *
+FindTagEnd(tree, tagPtr, indexPtr)
+ TkTextBTree tree; /* Tree to search within */
+ TkTextTag *tagPtr; /* Tag to search for. */
+ TkTextIndex *indexPtr; /* Return - index information */
+{
+ register Node *nodePtr, *lastNodePtr;
+ register TkTextLine *linePtr ,*lastLinePtr;
+ register TkTextSegment *segPtr, *lastSegPtr, *last2SegPtr;
+ register Summary *summaryPtr;
+ int lastoffset, lastoffset2, offset;
+
+ nodePtr = tagPtr->tagRootPtr;
+ if (nodePtr == (Node *) NULL) {
+ return NULL;
+ }
+
+ /*
+ * Search from the root of the subtree that contains the tag down
+ * to the level 0 node.
+ */
+
+ while (nodePtr->level > 0) {
+ for (lastNodePtr = NULL, nodePtr = nodePtr->children.nodePtr ;
+ nodePtr != (Node *) NULL; nodePtr = nodePtr->nextPtr) {
+ for (summaryPtr = nodePtr->summaryPtr ; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr == tagPtr) {
+ lastNodePtr = nodePtr;
+ break;
+ }
+ }
+ }
+ nodePtr = lastNodePtr;
+ }
+
+ /*
+ * Work through the lines attached to the level-0 node.
+ */
+ last2SegPtr = NULL;
+ lastoffset2 = 0;
+ lastoffset = 0;
+ for (lastLinePtr = NULL, linePtr = nodePtr->children.linePtr;
+ linePtr != (TkTextLine *) NULL; linePtr = linePtr->nextPtr) {
+ for (offset = 0, lastSegPtr = NULL, segPtr = linePtr->segPtr ;
+ segPtr != NULL;
+ offset += segPtr->size, segPtr = segPtr->nextPtr) {
+ if (((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType))
+ && (segPtr->body.toggle.tagPtr == tagPtr)) {
+ lastSegPtr = segPtr;
+ lastoffset = offset;
+ }
+ }
+ if (lastSegPtr != NULL) {
+ lastLinePtr = linePtr;
+ last2SegPtr = lastSegPtr;
+ lastoffset2 = lastoffset;
+ }
+ }
+ indexPtr->tree = tree;
+ indexPtr->linePtr = lastLinePtr;
+ indexPtr->charIndex = lastoffset2;
+ return last2SegPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeStartSearch --
+ *
+ * This procedure sets up a search for tag transitions involving
+ * a given tag (or all tags) in a given range of the text.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The information at *searchPtr is set up so that subsequent calls
+ * to TkBTreeNextTag or TkBTreePrevTag will return information about the
+ * locations of tag transitions. Note that TkBTreeNextTag or
+ * TkBTreePrevTag must be called to get the first transition.
+ * Note: unlike TkBTreeNextTag and TkBTreePrevTag, this routine does not
+ * guarantee that searchPtr->curIndex is equal to *index1Ptr. It may be
+ * greater than that if *index1Ptr is less than the first tag transition.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBTreeStartSearch(index1Ptr, index2Ptr, tagPtr, searchPtr)
+ TkTextIndex *index1Ptr; /* Search starts here. Tag toggles
+ * at this position will not be
+ * returned. */
+ TkTextIndex *index2Ptr; /* Search stops here. Tag toggles
+ * at this position *will* be
+ * returned. */
+ TkTextTag *tagPtr; /* Tag to search for. NULL means
+ * search for any tag. */
+ register TkTextSearch *searchPtr; /* Where to store information about
+ * search's progress. */
+{
+ int offset;
+ TkTextIndex index0; /* First index of the tag */
+ TkTextSegment *seg0Ptr; /* First segment of the tag */
+
+ /*
+ * Find the segment that contains the first toggle for the tag. This
+ * may become the starting point in the search.
+ */
+
+ seg0Ptr = FindTagStart(index1Ptr->tree, tagPtr, &index0);
+ if (seg0Ptr == (TkTextSegment *) NULL) {
+ /*
+ * Even though there are no toggles, the display code still
+ * uses the search curIndex, so initialize that anyway.
+ */
+
+ searchPtr->linesLeft = 0;
+ searchPtr->curIndex = *index1Ptr;
+ searchPtr->segPtr = NULL;
+ searchPtr->nextPtr = NULL;
+ return;
+ }
+ if (TkTextIndexCmp(index1Ptr, &index0) < 0) {
+ /*
+ * Adjust start of search up to the first range of the tag
+ */
+
+ searchPtr->curIndex = index0;
+ searchPtr->segPtr = NULL;
+ searchPtr->nextPtr = seg0Ptr; /* Will be returned by NextTag */
+ index1Ptr = &index0;
+ } else {
+ searchPtr->curIndex = *index1Ptr;
+ searchPtr->segPtr = NULL;
+ searchPtr->nextPtr = TkTextIndexToSeg(index1Ptr, &offset);
+ searchPtr->curIndex.charIndex -= offset;
+ }
+ searchPtr->lastPtr = TkTextIndexToSeg(index2Ptr, (int *) NULL);
+ searchPtr->tagPtr = tagPtr;
+ searchPtr->linesLeft = TkBTreeLineIndex(index2Ptr->linePtr) + 1
+ - TkBTreeLineIndex(index1Ptr->linePtr);
+ searchPtr->allTags = (tagPtr == NULL);
+ if (searchPtr->linesLeft == 1) {
+ /*
+ * Starting and stopping segments are in the same line; mark the
+ * search as over immediately if the second segment is before the
+ * first. A search does not return a toggle at the very start of
+ * the range, unless the range is artificially moved up to index0.
+ */
+ if (((index1Ptr == &index0) &&
+ (index1Ptr->charIndex > index2Ptr->charIndex)) ||
+ ((index1Ptr != &index0) &&
+ (index1Ptr->charIndex >= index2Ptr->charIndex))) {
+ searchPtr->linesLeft = 0;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeStartSearchBack --
+ *
+ * This procedure sets up a search backwards for tag transitions involving
+ * a given tag (or all tags) in a given range of the text. In the
+ * normal case the first index (*index1Ptr) is beyond the second
+ * index (*index2Ptr).
+ *
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The information at *searchPtr is set up so that subsequent calls
+ * to TkBTreePrevTag will return information about the
+ * locations of tag transitions. Note that TkBTreePrevTag must be called
+ * to get the first transition.
+ * Note: unlike TkBTreeNextTag and TkBTreePrevTag, this routine does not
+ * guarantee that searchPtr->curIndex is equal to *index1Ptr. It may be
+ * less than that if *index1Ptr is greater than the last tag transition.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBTreeStartSearchBack(index1Ptr, index2Ptr, tagPtr, searchPtr)
+ TkTextIndex *index1Ptr; /* Search starts here. Tag toggles
+ * at this position will not be
+ * returned. */
+ TkTextIndex *index2Ptr; /* Search stops here. Tag toggles
+ * at this position *will* be
+ * returned. */
+ TkTextTag *tagPtr; /* Tag to search for. NULL means
+ * search for any tag. */
+ register TkTextSearch *searchPtr; /* Where to store information about
+ * search's progress. */
+{
+ int offset;
+ TkTextIndex index0; /* Last index of the tag */
+ TkTextIndex backOne; /* One character before starting index */
+ TkTextSegment *seg0Ptr; /* Last segment of the tag */
+
+ /*
+ * Find the segment that contains the last toggle for the tag. This
+ * may become the starting point in the search.
+ */
+
+ seg0Ptr = FindTagEnd(index1Ptr->tree, tagPtr, &index0);
+ if (seg0Ptr == (TkTextSegment *) NULL) {
+ /*
+ * Even though there are no toggles, the display code still
+ * uses the search curIndex, so initialize that anyway.
+ */
+
+ searchPtr->linesLeft = 0;
+ searchPtr->curIndex = *index1Ptr;
+ searchPtr->segPtr = NULL;
+ searchPtr->nextPtr = NULL;
+ return;
+ }
+
+ /*
+ * Adjust the start of the search so it doesn't find any tag toggles
+ * that are right at the index specified by the user.
+ */
+
+ if (TkTextIndexCmp(index1Ptr, &index0) > 0) {
+ searchPtr->curIndex = index0;
+ index1Ptr = &index0;
+ } else {
+ TkTextIndexBackChars(index1Ptr, 1, &searchPtr->curIndex);
+ }
+ searchPtr->segPtr = NULL;
+ searchPtr->nextPtr = TkTextIndexToSeg(&searchPtr->curIndex, &offset);
+ searchPtr->curIndex.charIndex -= offset;
+
+ /*
+ * Adjust the end of the search so it does find toggles that are right
+ * at the second index specified by the user.
+ */
+
+ if ((TkBTreeLineIndex(index2Ptr->linePtr) == 0) &&
+ (index2Ptr->charIndex == 0)) {
+ backOne = *index2Ptr;
+ searchPtr->lastPtr = NULL; /* Signals special case for 1.0 */
+ } else {
+ TkTextIndexBackChars(index2Ptr, 1, &backOne);
+ searchPtr->lastPtr = TkTextIndexToSeg(&backOne, (int *) NULL);
+ }
+ searchPtr->tagPtr = tagPtr;
+ searchPtr->linesLeft = TkBTreeLineIndex(index1Ptr->linePtr) + 1
+ - TkBTreeLineIndex(backOne.linePtr);
+ searchPtr->allTags = (tagPtr == NULL);
+ if (searchPtr->linesLeft == 1) {
+ /*
+ * Starting and stopping segments are in the same line; mark the
+ * search as over immediately if the second segment is after the
+ * first.
+ */
+
+ if (index1Ptr->charIndex <= backOne.charIndex) {
+ searchPtr->linesLeft = 0;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeNextTag --
+ *
+ * Once a tag search has begun, successive calls to this procedure
+ * return successive tag toggles. Note: it is NOT SAFE to call this
+ * procedure if characters have been inserted into or deleted from
+ * the B-tree since the call to TkBTreeStartSearch.
+ *
+ * Results:
+ * The return value is 1 if another toggle was found that met the
+ * criteria specified in the call to TkBTreeStartSearch; in this
+ * case searchPtr->curIndex gives the toggle's position and
+ * searchPtr->curTagPtr points to its segment. 0 is returned if
+ * no more matching tag transitions were found; in this case
+ * searchPtr->curIndex is the same as searchPtr->stopIndex.
+ *
+ * Side effects:
+ * Information in *searchPtr is modified to update the state of the
+ * search and indicate where the next tag toggle is located.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkBTreeNextTag(searchPtr)
+ register TkTextSearch *searchPtr; /* Information about search in
+ * progress; must have been set up by
+ * call to TkBTreeStartSearch. */
+{
+ register TkTextSegment *segPtr;
+ register Node *nodePtr;
+ register Summary *summaryPtr;
+
+ if (searchPtr->linesLeft <= 0) {
+ goto searchOver;
+ }
+
+ /*
+ * The outermost loop iterates over lines that may potentially contain
+ * a relevant tag transition, starting from the current segment in
+ * the current line.
+ */
+
+ segPtr = searchPtr->nextPtr;
+ while (1) {
+ /*
+ * Check for more tags on the current line.
+ */
+
+ for ( ; segPtr != NULL; segPtr = segPtr->nextPtr) {
+ if (segPtr == searchPtr->lastPtr) {
+ goto searchOver;
+ }
+ if (((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType))
+ && (searchPtr->allTags
+ || (segPtr->body.toggle.tagPtr == searchPtr->tagPtr))) {
+ searchPtr->segPtr = segPtr;
+ searchPtr->nextPtr = segPtr->nextPtr;
+ searchPtr->tagPtr = segPtr->body.toggle.tagPtr;
+ return 1;
+ }
+ searchPtr->curIndex.charIndex += segPtr->size;
+ }
+
+ /*
+ * See if there are more lines associated with the current parent
+ * node. If so, go back to the top of the loop to search the next
+ * one.
+ */
+
+ nodePtr = searchPtr->curIndex.linePtr->parentPtr;
+ searchPtr->curIndex.linePtr = searchPtr->curIndex.linePtr->nextPtr;
+ searchPtr->linesLeft--;
+ if (searchPtr->linesLeft <= 0) {
+ goto searchOver;
+ }
+ if (searchPtr->curIndex.linePtr != NULL) {
+ segPtr = searchPtr->curIndex.linePtr->segPtr;
+ searchPtr->curIndex.charIndex = 0;
+ continue;
+ }
+ if (nodePtr == searchPtr->tagPtr->tagRootPtr) {
+ goto searchOver;
+ }
+
+ /*
+ * Search across and up through the B-tree's node hierarchy looking
+ * for the next node that has a relevant tag transition somewhere in
+ * its subtree. Be sure to update linesLeft as we skip over large
+ * chunks of lines.
+ */
+
+ while (1) {
+ while (nodePtr->nextPtr == NULL) {
+ if (nodePtr->parentPtr == NULL ||
+ nodePtr->parentPtr == searchPtr->tagPtr->tagRootPtr) {
+ goto searchOver;
+ }
+ nodePtr = nodePtr->parentPtr;
+ }
+ nodePtr = nodePtr->nextPtr;
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if ((searchPtr->allTags) ||
+ (summaryPtr->tagPtr == searchPtr->tagPtr)) {
+ goto gotNodeWithTag;
+ }
+ }
+ searchPtr->linesLeft -= nodePtr->numLines;
+ }
+
+ /*
+ * At this point we've found a subtree that has a relevant tag
+ * transition. Now search down (and across) through that subtree
+ * to find the first level-0 node that has a relevant tag transition.
+ */
+
+ gotNodeWithTag:
+ while (nodePtr->level > 0) {
+ for (nodePtr = nodePtr->children.nodePtr; ;
+ nodePtr = nodePtr->nextPtr) {
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if ((searchPtr->allTags)
+ || (summaryPtr->tagPtr == searchPtr->tagPtr)) {
+ goto nextChild;
+ }
+ }
+ searchPtr->linesLeft -= nodePtr->numLines;
+ if (nodePtr->nextPtr == NULL) {
+ panic("TkBTreeNextTag found incorrect tag summary info.");
+ }
+ }
+ nextChild:
+ continue;
+ }
+
+ /*
+ * Now we're down to a level-0 node that contains a line that contains
+ * a relevant tag transition. Set up line information and go back to
+ * the beginning of the loop to search through lines.
+ */
+
+ searchPtr->curIndex.linePtr = nodePtr->children.linePtr;
+ searchPtr->curIndex.charIndex = 0;
+ segPtr = searchPtr->curIndex.linePtr->segPtr;
+ if (searchPtr->linesLeft <= 0) {
+ goto searchOver;
+ }
+ continue;
+ }
+
+ searchOver:
+ searchPtr->linesLeft = 0;
+ searchPtr->segPtr = NULL;
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreePrevTag --
+ *
+ * Once a tag search has begun, successive calls to this procedure
+ * return successive tag toggles in the reverse direction.
+ * Note: it is NOT SAFE to call this
+ * procedure if characters have been inserted into or deleted from
+ * the B-tree since the call to TkBTreeStartSearch.
+ *
+ * Results:
+ * The return value is 1 if another toggle was found that met the
+ * criteria specified in the call to TkBTreeStartSearch; in this
+ * case searchPtr->curIndex gives the toggle's position and
+ * searchPtr->curTagPtr points to its segment. 0 is returned if
+ * no more matching tag transitions were found; in this case
+ * searchPtr->curIndex is the same as searchPtr->stopIndex.
+ *
+ * Side effects:
+ * Information in *searchPtr is modified to update the state of the
+ * search and indicate where the next tag toggle is located.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkBTreePrevTag(searchPtr)
+ register TkTextSearch *searchPtr; /* Information about search in
+ * progress; must have been set up by
+ * call to TkBTreeStartSearch. */
+{
+ register TkTextSegment *segPtr, *prevPtr;
+ register TkTextLine *linePtr, *prevLinePtr;
+ register Node *nodePtr, *node2Ptr, *prevNodePtr;
+ register Summary *summaryPtr;
+ int charIndex;
+ int pastLast; /* Saw last marker during scan */
+ int linesSkipped;
+
+ if (searchPtr->linesLeft <= 0) {
+ goto searchOver;
+ }
+
+ /*
+ * The outermost loop iterates over lines that may potentially contain
+ * a relevant tag transition, starting from the current segment in
+ * the current line. "nextPtr" is maintained as the last segment in
+ * a line that we can look at.
+ */
+
+ while (1) {
+ /*
+ * Check for the last toggle before the current segment on this line.
+ */
+ charIndex = 0;
+ if (searchPtr->lastPtr == NULL) {
+ /*
+ * Search back to the very beginning, so pastLast is irrelevent.
+ */
+ pastLast = 1;
+ } else {
+ pastLast = 0;
+ }
+ for (prevPtr = NULL, segPtr = searchPtr->curIndex.linePtr->segPtr ;
+ segPtr != NULL && segPtr != searchPtr->nextPtr;
+ segPtr = segPtr->nextPtr) {
+ if (((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType))
+ && (searchPtr->allTags
+ || (segPtr->body.toggle.tagPtr == searchPtr->tagPtr))) {
+ prevPtr = segPtr;
+ searchPtr->curIndex.charIndex = charIndex;
+ }
+ if (segPtr == searchPtr->lastPtr) {
+ prevPtr = NULL; /* Segments earlier than last don't count */
+ pastLast = 1;
+ }
+ charIndex += segPtr->size;
+ }
+ if (prevPtr != NULL) {
+ if (searchPtr->linesLeft == 1 && !pastLast) {
+ /*
+ * We found a segment that is before the stopping index.
+ * Note that it is OK if prevPtr == lastPtr.
+ */
+ goto searchOver;
+ }
+ searchPtr->segPtr = prevPtr;
+ searchPtr->nextPtr = prevPtr;
+ searchPtr->tagPtr = prevPtr->body.toggle.tagPtr;
+ return 1;
+ }
+
+ searchPtr->linesLeft--;
+ if (searchPtr->linesLeft <= 0) {
+ goto searchOver;
+ }
+
+ /*
+ * See if there are more lines associated with the current parent
+ * node. If so, go back to the top of the loop to search the previous
+ * one.
+ */
+
+ nodePtr = searchPtr->curIndex.linePtr->parentPtr;
+ for (prevLinePtr = NULL, linePtr = nodePtr->children.linePtr;
+ linePtr != NULL && linePtr != searchPtr->curIndex.linePtr;
+ prevLinePtr = linePtr, linePtr = linePtr->nextPtr) {
+ /* empty loop body */ ;
+ }
+ if (prevLinePtr != NULL) {
+ searchPtr->curIndex.linePtr = prevLinePtr;
+ searchPtr->nextPtr = NULL;
+ continue;
+ }
+ if (nodePtr == searchPtr->tagPtr->tagRootPtr) {
+ goto searchOver;
+ }
+
+ /*
+ * Search across and up through the B-tree's node hierarchy looking
+ * for the previous node that has a relevant tag transition somewhere in
+ * its subtree. The search and line counting is trickier with/out
+ * back pointers. We'll scan all the nodes under a parent up to
+ * the current node, searching all of them for tag state. The last
+ * one we find, if any, is recorded in prevNodePtr, and any nodes
+ * past prevNodePtr that don't have tag state increment linesSkipped.
+ */
+
+ while (1) {
+ for (prevNodePtr = NULL, linesSkipped = 0,
+ node2Ptr = nodePtr->parentPtr->children.nodePtr ;
+ node2Ptr != nodePtr; node2Ptr = node2Ptr->nextPtr) {
+ for (summaryPtr = node2Ptr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if ((searchPtr->allTags) ||
+ (summaryPtr->tagPtr == searchPtr->tagPtr)) {
+ prevNodePtr = node2Ptr;
+ linesSkipped = 0;
+ goto keepLooking;
+ }
+ }
+ linesSkipped += node2Ptr->numLines;
+
+ keepLooking:
+ continue;
+ }
+ if (prevNodePtr != NULL) {
+ nodePtr = prevNodePtr;
+ searchPtr->linesLeft -= linesSkipped;
+ goto gotNodeWithTag;
+ }
+ nodePtr = nodePtr->parentPtr;
+ if (nodePtr->parentPtr == NULL ||
+ nodePtr == searchPtr->tagPtr->tagRootPtr) {
+ goto searchOver;
+ }
+ }
+
+ /*
+ * At this point we've found a subtree that has a relevant tag
+ * transition. Now search down (and across) through that subtree
+ * to find the last level-0 node that has a relevant tag transition.
+ */
+
+ gotNodeWithTag:
+ while (nodePtr->level > 0) {
+ for (linesSkipped = 0, prevNodePtr = NULL,
+ nodePtr = nodePtr->children.nodePtr; nodePtr != NULL ;
+ nodePtr = nodePtr->nextPtr) {
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if ((searchPtr->allTags)
+ || (summaryPtr->tagPtr == searchPtr->tagPtr)) {
+ prevNodePtr = nodePtr;
+ linesSkipped = 0;
+ goto keepLooking2;
+ }
+ }
+ linesSkipped += nodePtr->numLines;
+
+ keepLooking2:
+ continue;
+ }
+ if (prevNodePtr == NULL) {
+ panic("TkBTreePrevTag found incorrect tag summary info.");
+ }
+ searchPtr->linesLeft -= linesSkipped;
+ nodePtr = prevNodePtr;
+ }
+
+ /*
+ * Now we're down to a level-0 node that contains a line that contains
+ * a relevant tag transition. Set up line information and go back to
+ * the beginning of the loop to search through lines. We start with
+ * the last line below the node.
+ */
+
+ for (prevLinePtr = NULL, linePtr = nodePtr->children.linePtr;
+ linePtr != NULL ;
+ prevLinePtr = linePtr, linePtr = linePtr->nextPtr) {
+ /* empty loop body */ ;
+ }
+ searchPtr->curIndex.linePtr = prevLinePtr;
+ searchPtr->curIndex.charIndex = 0;
+ if (searchPtr->linesLeft <= 0) {
+ goto searchOver;
+ }
+ continue;
+ }
+
+ searchOver:
+ searchPtr->linesLeft = 0;
+ searchPtr->segPtr = NULL;
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeCharTagged --
+ *
+ * Determine whether a particular character has a particular tag.
+ *
+ * Results:
+ * The return value is 1 if the given tag is in effect at the
+ * character given by linePtr and ch, and 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkBTreeCharTagged(indexPtr, tagPtr)
+ TkTextIndex *indexPtr; /* Indicates a character position at
+ * which to check for a tag. */
+ TkTextTag *tagPtr; /* Tag of interest. */
+{
+ register Node *nodePtr;
+ register TkTextLine *siblingLinePtr;
+ register TkTextSegment *segPtr;
+ TkTextSegment *toggleSegPtr;
+ int toggles, index;
+
+ /*
+ * Check for toggles for the tag in indexPtr's line but before
+ * indexPtr. If there is one, its type indicates whether or
+ * not the character is tagged.
+ */
+
+ toggleSegPtr = NULL;
+ for (index = 0, segPtr = indexPtr->linePtr->segPtr;
+ (index + segPtr->size) <= indexPtr->charIndex;
+ index += segPtr->size, segPtr = segPtr->nextPtr) {
+ if (((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType))
+ && (segPtr->body.toggle.tagPtr == tagPtr)) {
+ toggleSegPtr = segPtr;
+ }
+ }
+ if (toggleSegPtr != NULL) {
+ return (toggleSegPtr->typePtr == &tkTextToggleOnType);
+ }
+
+ /*
+ * No toggle in this line. Look for toggles for the tag in lines
+ * that are predecessors of indexPtr->linePtr but under the same
+ * level-0 node.
+ */
+
+ for (siblingLinePtr = indexPtr->linePtr->parentPtr->children.linePtr;
+ siblingLinePtr != indexPtr->linePtr;
+ siblingLinePtr = siblingLinePtr->nextPtr) {
+ for (segPtr = siblingLinePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ if (((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType))
+ && (segPtr->body.toggle.tagPtr == tagPtr)) {
+ toggleSegPtr = segPtr;
+ }
+ }
+ }
+ if (toggleSegPtr != NULL) {
+ return (toggleSegPtr->typePtr == &tkTextToggleOnType);
+ }
+
+ /*
+ * No toggle in this node. Scan upwards through the ancestors of
+ * this node, counting the number of toggles of the given tag in
+ * siblings that precede that node.
+ */
+
+ toggles = 0;
+ for (nodePtr = indexPtr->linePtr->parentPtr; nodePtr->parentPtr != NULL;
+ nodePtr = nodePtr->parentPtr) {
+ register Node *siblingPtr;
+ register Summary *summaryPtr;
+
+ for (siblingPtr = nodePtr->parentPtr->children.nodePtr;
+ siblingPtr != nodePtr; siblingPtr = siblingPtr->nextPtr) {
+ for (summaryPtr = siblingPtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr == tagPtr) {
+ toggles += summaryPtr->toggleCount;
+ }
+ }
+ }
+ if (nodePtr == tagPtr->tagRootPtr) {
+ break;
+ }
+ }
+
+ /*
+ * An odd number of toggles means that the tag is present at the
+ * given point.
+ */
+
+ return toggles & 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeGetTags --
+ *
+ * Return information about all of the tags that are associated
+ * with a particular character in a B-tree of text.
+ *
+ * Results:
+ * The return value is a malloc-ed array containing pointers to
+ * information for each of the tags that is associated with
+ * the character at the position given by linePtr and ch. The
+ * word at *numTagsPtr is filled in with the number of pointers
+ * in the array. It is up to the caller to free the array by
+ * passing it to free. If there are no tags at the given character
+ * then a NULL pointer is returned and *numTagsPtr will be set to 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+TkTextTag **
+TkBTreeGetTags(indexPtr, numTagsPtr)
+ TkTextIndex *indexPtr; /* Indicates a particular position in
+ * the B-tree. */
+ int *numTagsPtr; /* Store number of tags found at this
+ * location. */
+{
+ register Node *nodePtr;
+ register TkTextLine *siblingLinePtr;
+ register TkTextSegment *segPtr;
+ int src, dst, index;
+ TagInfo tagInfo;
+#define NUM_TAG_INFOS 10
+
+ tagInfo.numTags = 0;
+ tagInfo.arraySize = NUM_TAG_INFOS;
+ tagInfo.tagPtrs = (TkTextTag **) ckalloc((unsigned)
+ NUM_TAG_INFOS*sizeof(TkTextTag *));
+ tagInfo.counts = (int *) ckalloc((unsigned)
+ NUM_TAG_INFOS*sizeof(int));
+
+ /*
+ * Record tag toggles within the line of indexPtr but preceding
+ * indexPtr.
+ */
+
+ for (index = 0, segPtr = indexPtr->linePtr->segPtr;
+ (index + segPtr->size) <= indexPtr->charIndex;
+ index += segPtr->size, segPtr = segPtr->nextPtr) {
+ if ((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType)) {
+ IncCount(segPtr->body.toggle.tagPtr, 1, &tagInfo);
+ }
+ }
+
+ /*
+ * Record toggles for tags in lines that are predecessors of
+ * indexPtr->linePtr but under the same level-0 node.
+ */
+
+ for (siblingLinePtr = indexPtr->linePtr->parentPtr->children.linePtr;
+ siblingLinePtr != indexPtr->linePtr;
+ siblingLinePtr = siblingLinePtr->nextPtr) {
+ for (segPtr = siblingLinePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ if ((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType)) {
+ IncCount(segPtr->body.toggle.tagPtr, 1, &tagInfo);
+ }
+ }
+ }
+
+ /*
+ * For each node in the ancestry of this line, record tag toggles
+ * for all siblings that precede that node.
+ */
+
+ for (nodePtr = indexPtr->linePtr->parentPtr; nodePtr->parentPtr != NULL;
+ nodePtr = nodePtr->parentPtr) {
+ register Node *siblingPtr;
+ register Summary *summaryPtr;
+
+ for (siblingPtr = nodePtr->parentPtr->children.nodePtr;
+ siblingPtr != nodePtr; siblingPtr = siblingPtr->nextPtr) {
+ for (summaryPtr = siblingPtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->toggleCount & 1) {
+ IncCount(summaryPtr->tagPtr, summaryPtr->toggleCount,
+ &tagInfo);
+ }
+ }
+ }
+ }
+
+ /*
+ * Go through the tag information and squash out all of the tags
+ * that have even toggle counts (these tags exist before the point
+ * of interest, but not at the desired character itself).
+ */
+
+ for (src = 0, dst = 0; src < tagInfo.numTags; src++) {
+ if (tagInfo.counts[src] & 1) {
+ tagInfo.tagPtrs[dst] = tagInfo.tagPtrs[src];
+ dst++;
+ }
+ }
+ *numTagsPtr = dst;
+ ckfree((char *) tagInfo.counts);
+ if (dst == 0) {
+ ckfree((char *) tagInfo.tagPtrs);
+ return NULL;
+ }
+ return tagInfo.tagPtrs;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IncCount --
+ *
+ * This is a utility procedure used by TkBTreeGetTags. It
+ * increments the count for a particular tag, adding a new
+ * entry for that tag if there wasn't one previously.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The information at *tagInfoPtr may be modified, and the arrays
+ * may be reallocated to make them larger.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+IncCount(tagPtr, inc, tagInfoPtr)
+ TkTextTag *tagPtr; /* Handle for tag. */
+ int inc; /* Amount by which to increment tag count. */
+ TagInfo *tagInfoPtr; /* Holds cumulative information about tags;
+ * increment count here. */
+{
+ register TkTextTag **tagPtrPtr;
+ int count;
+
+ for (tagPtrPtr = tagInfoPtr->tagPtrs, count = tagInfoPtr->numTags;
+ count > 0; tagPtrPtr++, count--) {
+ if (*tagPtrPtr == tagPtr) {
+ tagInfoPtr->counts[tagInfoPtr->numTags-count] += inc;
+ return;
+ }
+ }
+
+ /*
+ * There isn't currently an entry for this tag, so we have to
+ * make a new one. If the arrays are full, then enlarge the
+ * arrays first.
+ */
+
+ if (tagInfoPtr->numTags == tagInfoPtr->arraySize) {
+ TkTextTag **newTags;
+ int *newCounts, newSize;
+
+ newSize = 2*tagInfoPtr->arraySize;
+ newTags = (TkTextTag **) ckalloc((unsigned)
+ (newSize*sizeof(TkTextTag *)));
+ memcpy((VOID *) newTags, (VOID *) tagInfoPtr->tagPtrs,
+ tagInfoPtr->arraySize * sizeof(TkTextTag *));
+ ckfree((char *) tagInfoPtr->tagPtrs);
+ tagInfoPtr->tagPtrs = newTags;
+ newCounts = (int *) ckalloc((unsigned) (newSize*sizeof(int)));
+ memcpy((VOID *) newCounts, (VOID *) tagInfoPtr->counts,
+ tagInfoPtr->arraySize * sizeof(int));
+ ckfree((char *) tagInfoPtr->counts);
+ tagInfoPtr->counts = newCounts;
+ tagInfoPtr->arraySize = newSize;
+ }
+
+ tagInfoPtr->tagPtrs[tagInfoPtr->numTags] = tagPtr;
+ tagInfoPtr->counts[tagInfoPtr->numTags] = inc;
+ tagInfoPtr->numTags++;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeCheck --
+ *
+ * This procedure runs a set of consistency checks over a B-tree
+ * and panics if any inconsistencies are found.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If a structural defect is found, the procedure panics with an
+ * error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBTreeCheck(tree)
+ TkTextBTree tree; /* Tree to check. */
+{
+ BTree *treePtr = (BTree *) tree;
+ register Summary *summaryPtr;
+ register Node *nodePtr;
+ register TkTextLine *linePtr;
+ register TkTextSegment *segPtr;
+ register TkTextTag *tagPtr;
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+ int count;
+
+ /*
+ * Make sure that the tag toggle counts and the tag root pointers are OK.
+ */
+ for (entryPtr = Tcl_FirstHashEntry(&treePtr->textPtr->tagTable, &search);
+ entryPtr != NULL ; entryPtr = Tcl_NextHashEntry(&search)) {
+ tagPtr = (TkTextTag *) Tcl_GetHashValue(entryPtr);
+ nodePtr = tagPtr->tagRootPtr;
+ if (nodePtr == (Node *) NULL) {
+ if (tagPtr->toggleCount != 0) {
+ panic("TkBTreeCheck found \"%s\" with toggles (%d) but no root",
+ tagPtr->name, tagPtr->toggleCount);
+ }
+ continue; /* no ranges for the tag */
+ } else if (tagPtr->toggleCount == 0) {
+ panic("TkBTreeCheck found root for \"%s\" with no toggles",
+ tagPtr->name);
+ } else if (tagPtr->toggleCount & 1) {
+ panic("TkBTreeCheck found odd toggle count for \"%s\" (%d)",
+ tagPtr->name, tagPtr->toggleCount);
+ }
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr == tagPtr) {
+ panic("TkBTreeCheck found root node with summary info");
+ }
+ }
+ count = 0;
+ if (nodePtr->level > 0) {
+ for (nodePtr = nodePtr->children.nodePtr ; nodePtr != NULL ;
+ nodePtr = nodePtr->nextPtr) {
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr == tagPtr) {
+ count += summaryPtr->toggleCount;
+ }
+ }
+ }
+ } else {
+ for (linePtr = nodePtr->children.linePtr ; linePtr != NULL ;
+ linePtr = linePtr->nextPtr) {
+ for (segPtr = linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ if ((segPtr->typePtr == &tkTextToggleOnType ||
+ segPtr->typePtr == &tkTextToggleOffType) &&
+ segPtr->body.toggle.tagPtr == tagPtr) {
+ count++;
+ }
+ }
+ }
+ }
+ if (count != tagPtr->toggleCount) {
+ panic("TkBTreeCheck toggleCount (%d) wrong for \"%s\" should be (%d)",
+ tagPtr->toggleCount, tagPtr->name, count);
+ }
+ }
+
+ /*
+ * Call a recursive procedure to do the main body of checks.
+ */
+
+ nodePtr = treePtr->rootPtr;
+ CheckNodeConsistency(treePtr->rootPtr);
+
+ /*
+ * Make sure that there are at least two lines in the text and
+ * that the last line has no characters except a newline.
+ */
+
+ if (nodePtr->numLines < 2) {
+ panic("TkBTreeCheck: less than 2 lines in tree");
+ }
+ while (nodePtr->level > 0) {
+ nodePtr = nodePtr->children.nodePtr;
+ while (nodePtr->nextPtr != NULL) {
+ nodePtr = nodePtr->nextPtr;
+ }
+ }
+ linePtr = nodePtr->children.linePtr;
+ while (linePtr->nextPtr != NULL) {
+ linePtr = linePtr->nextPtr;
+ }
+ segPtr = linePtr->segPtr;
+ while ((segPtr->typePtr == &tkTextToggleOffType)
+ || (segPtr->typePtr == &tkTextRightMarkType)
+ || (segPtr->typePtr == &tkTextLeftMarkType)) {
+ /*
+ * It's OK to toggle a tag off in the last line, but
+ * not to start a new range. It's also OK to have marks
+ * in the last line.
+ */
+
+ segPtr = segPtr->nextPtr;
+ }
+ if (segPtr->typePtr != &tkTextCharType) {
+ panic("TkBTreeCheck: last line has bogus segment type");
+ }
+ if (segPtr->nextPtr != NULL) {
+ panic("TkBTreeCheck: last line has too many segments");
+ }
+ if (segPtr->size != 1) {
+ panic("TkBTreeCheck: last line has wrong # characters: %d",
+ segPtr->size);
+ }
+ if ((segPtr->body.chars[0] != '\n') || (segPtr->body.chars[1] != 0)) {
+ panic("TkBTreeCheck: last line had bad value: %s",
+ segPtr->body.chars);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CheckNodeConsistency --
+ *
+ * This procedure is called as part of consistency checking for
+ * B-trees: it checks several aspects of a node and also runs
+ * checks recursively on the node's children.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If anything suspicious is found in the tree structure, the
+ * procedure panics.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CheckNodeConsistency(nodePtr)
+ register Node *nodePtr; /* Node whose subtree should be
+ * checked. */
+{
+ register Node *childNodePtr;
+ register Summary *summaryPtr, *summaryPtr2;
+ register TkTextLine *linePtr;
+ register TkTextSegment *segPtr;
+ int numChildren, numLines, toggleCount, minChildren;
+
+ if (nodePtr->parentPtr != NULL) {
+ minChildren = MIN_CHILDREN;
+ } else if (nodePtr->level > 0) {
+ minChildren = 2;
+ } else {
+ minChildren = 1;
+ }
+ if ((nodePtr->numChildren < minChildren)
+ || (nodePtr->numChildren > MAX_CHILDREN)) {
+ panic("CheckNodeConsistency: bad child count (%d)",
+ nodePtr->numChildren);
+ }
+
+ numChildren = 0;
+ numLines = 0;
+ if (nodePtr->level == 0) {
+ for (linePtr = nodePtr->children.linePtr; linePtr != NULL;
+ linePtr = linePtr->nextPtr) {
+ if (linePtr->parentPtr != nodePtr) {
+ panic("CheckNodeConsistency: line doesn't point to parent");
+ }
+ if (linePtr->segPtr == NULL) {
+ panic("CheckNodeConsistency: line has no segments");
+ }
+ for (segPtr = linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ if (segPtr->typePtr->checkProc != NULL) {
+ (*segPtr->typePtr->checkProc)(segPtr, linePtr);
+ }
+ if ((segPtr->size == 0) && (!segPtr->typePtr->leftGravity)
+ && (segPtr->nextPtr != NULL)
+ && (segPtr->nextPtr->size == 0)
+ && (segPtr->nextPtr->typePtr->leftGravity)) {
+ panic("CheckNodeConsistency: wrong segment order for gravity");
+ }
+ if ((segPtr->nextPtr == NULL)
+ && (segPtr->typePtr != &tkTextCharType)) {
+ panic("CheckNodeConsistency: line ended with wrong type");
+ }
+ }
+ numChildren++;
+ numLines++;
+ }
+ } else {
+ for (childNodePtr = nodePtr->children.nodePtr; childNodePtr != NULL;
+ childNodePtr = childNodePtr->nextPtr) {
+ if (childNodePtr->parentPtr != nodePtr) {
+ panic("CheckNodeConsistency: node doesn't point to parent");
+ }
+ if (childNodePtr->level != (nodePtr->level-1)) {
+ panic("CheckNodeConsistency: level mismatch (%d %d)",
+ nodePtr->level, childNodePtr->level);
+ }
+ CheckNodeConsistency(childNodePtr);
+ for (summaryPtr = childNodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ for (summaryPtr2 = nodePtr->summaryPtr; ;
+ summaryPtr2 = summaryPtr2->nextPtr) {
+ if (summaryPtr2 == NULL) {
+ if (summaryPtr->tagPtr->tagRootPtr == nodePtr) {
+ break;
+ }
+ panic("CheckNodeConsistency: node tag \"%s\" not %s",
+ summaryPtr->tagPtr->name,
+ "present in parent summaries");
+ }
+ if (summaryPtr->tagPtr == summaryPtr2->tagPtr) {
+ break;
+ }
+ }
+ }
+ numChildren++;
+ numLines += childNodePtr->numLines;
+ }
+ }
+ if (numChildren != nodePtr->numChildren) {
+ panic("CheckNodeConsistency: mismatch in numChildren (%d %d)",
+ numChildren, nodePtr->numChildren);
+ }
+ if (numLines != nodePtr->numLines) {
+ panic("CheckNodeConsistency: mismatch in numLines (%d %d)",
+ numLines, nodePtr->numLines);
+ }
+
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr->toggleCount == summaryPtr->toggleCount) {
+ panic("CheckNodeConsistency: found unpruned root for \"%s\"",
+ summaryPtr->tagPtr->name);
+ }
+ toggleCount = 0;
+ if (nodePtr->level == 0) {
+ for (linePtr = nodePtr->children.linePtr; linePtr != NULL;
+ linePtr = linePtr->nextPtr) {
+ for (segPtr = linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ if ((segPtr->typePtr != &tkTextToggleOnType)
+ && (segPtr->typePtr != &tkTextToggleOffType)) {
+ continue;
+ }
+ if (segPtr->body.toggle.tagPtr == summaryPtr->tagPtr) {
+ toggleCount ++;
+ }
+ }
+ }
+ } else {
+ for (childNodePtr = nodePtr->children.nodePtr;
+ childNodePtr != NULL;
+ childNodePtr = childNodePtr->nextPtr) {
+ for (summaryPtr2 = childNodePtr->summaryPtr;
+ summaryPtr2 != NULL;
+ summaryPtr2 = summaryPtr2->nextPtr) {
+ if (summaryPtr2->tagPtr == summaryPtr->tagPtr) {
+ toggleCount += summaryPtr2->toggleCount;
+ }
+ }
+ }
+ }
+ if (toggleCount != summaryPtr->toggleCount) {
+ panic("CheckNodeConsistency: mismatch in toggleCount (%d %d)",
+ toggleCount, summaryPtr->toggleCount);
+ }
+ for (summaryPtr2 = summaryPtr->nextPtr; summaryPtr2 != NULL;
+ summaryPtr2 = summaryPtr2->nextPtr) {
+ if (summaryPtr2->tagPtr == summaryPtr->tagPtr) {
+ panic("CheckNodeConsistency: duplicated node tag: %s",
+ summaryPtr->tagPtr->name);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Rebalance --
+ *
+ * This procedure is called when a node of a B-tree appears to be
+ * out of balance (too many children, or too few). It rebalances
+ * that node and all of its ancestors in the tree.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The internal structure of treePtr may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+Rebalance(treePtr, nodePtr)
+ BTree *treePtr; /* Tree that is being rebalanced. */
+ register Node *nodePtr; /* Node that may be out of balance. */
+{
+ /*
+ * Loop over the entire ancestral chain of the node, working up
+ * through the tree one node at a time until the root node has
+ * been processed.
+ */
+
+ for ( ; nodePtr != NULL; nodePtr = nodePtr->parentPtr) {
+ register Node *newPtr, *childPtr;
+ register TkTextLine *linePtr;
+ int i;
+
+ /*
+ * Check to see if the node has too many children. If it does,
+ * then split off all but the first MIN_CHILDREN into a separate
+ * node following the original one. Then repeat until the
+ * node has a decent size.
+ */
+
+ if (nodePtr->numChildren > MAX_CHILDREN) {
+ while (1) {
+ /*
+ * If the node being split is the root node, then make a
+ * new root node above it first.
+ */
+
+ if (nodePtr->parentPtr == NULL) {
+ newPtr = (Node *) ckalloc(sizeof(Node));
+ newPtr->parentPtr = NULL;
+ newPtr->nextPtr = NULL;
+ newPtr->summaryPtr = NULL;
+ newPtr->level = nodePtr->level + 1;
+ newPtr->children.nodePtr = nodePtr;
+ newPtr->numChildren = 1;
+ newPtr->numLines = nodePtr->numLines;
+ RecomputeNodeCounts(newPtr);
+ treePtr->rootPtr = newPtr;
+ }
+ newPtr = (Node *) ckalloc(sizeof(Node));
+ newPtr->parentPtr = nodePtr->parentPtr;
+ newPtr->nextPtr = nodePtr->nextPtr;
+ nodePtr->nextPtr = newPtr;
+ newPtr->summaryPtr = NULL;
+ newPtr->level = nodePtr->level;
+ newPtr->numChildren = nodePtr->numChildren - MIN_CHILDREN;
+ if (nodePtr->level == 0) {
+ for (i = MIN_CHILDREN-1,
+ linePtr = nodePtr->children.linePtr;
+ i > 0; i--, linePtr = linePtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ newPtr->children.linePtr = linePtr->nextPtr;
+ linePtr->nextPtr = NULL;
+ } else {
+ for (i = MIN_CHILDREN-1,
+ childPtr = nodePtr->children.nodePtr;
+ i > 0; i--, childPtr = childPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ newPtr->children.nodePtr = childPtr->nextPtr;
+ childPtr->nextPtr = NULL;
+ }
+ RecomputeNodeCounts(nodePtr);
+ nodePtr->parentPtr->numChildren++;
+ nodePtr = newPtr;
+ if (nodePtr->numChildren <= MAX_CHILDREN) {
+ RecomputeNodeCounts(nodePtr);
+ break;
+ }
+ }
+ }
+
+ while (nodePtr->numChildren < MIN_CHILDREN) {
+ register Node *otherPtr;
+ Node *halfwayNodePtr = NULL; /* Initialization needed only */
+ TkTextLine *halfwayLinePtr = NULL; /* to prevent cc warnings. */
+ int totalChildren, firstChildren, i;
+
+ /*
+ * Too few children for this node. If this is the root then,
+ * it's OK for it to have less than MIN_CHILDREN children
+ * as long as it's got at least two. If it has only one
+ * (and isn't at level 0), then chop the root node out of
+ * the tree and use its child as the new root.
+ */
+
+ if (nodePtr->parentPtr == NULL) {
+ if ((nodePtr->numChildren == 1) && (nodePtr->level > 0)) {
+ treePtr->rootPtr = nodePtr->children.nodePtr;
+ treePtr->rootPtr->parentPtr = NULL;
+ DeleteSummaries(nodePtr->summaryPtr);
+ ckfree((char *) nodePtr);
+ }
+ return;
+ }
+
+ /*
+ * Not the root. Make sure that there are siblings to
+ * balance with.
+ */
+
+ if (nodePtr->parentPtr->numChildren < 2) {
+ Rebalance(treePtr, nodePtr->parentPtr);
+ continue;
+ }
+
+ /*
+ * Find a sibling neighbor to borrow from, and arrange for
+ * nodePtr to be the earlier of the pair.
+ */
+
+ if (nodePtr->nextPtr == NULL) {
+ for (otherPtr = nodePtr->parentPtr->children.nodePtr;
+ otherPtr->nextPtr != nodePtr;
+ otherPtr = otherPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ nodePtr = otherPtr;
+ }
+ otherPtr = nodePtr->nextPtr;
+
+ /*
+ * We're going to either merge the two siblings together
+ * into one node or redivide the children among them to
+ * balance their loads. As preparation, join their two
+ * child lists into a single list and remember the half-way
+ * point in the list.
+ */
+
+ totalChildren = nodePtr->numChildren + otherPtr->numChildren;
+ firstChildren = totalChildren/2;
+ if (nodePtr->children.nodePtr == NULL) {
+ nodePtr->children = otherPtr->children;
+ otherPtr->children.nodePtr = NULL;
+ otherPtr->children.linePtr = NULL;
+ }
+ if (nodePtr->level == 0) {
+ register TkTextLine *linePtr;
+
+ for (linePtr = nodePtr->children.linePtr, i = 1;
+ linePtr->nextPtr != NULL;
+ linePtr = linePtr->nextPtr, i++) {
+ if (i == firstChildren) {
+ halfwayLinePtr = linePtr;
+ }
+ }
+ linePtr->nextPtr = otherPtr->children.linePtr;
+ while (i <= firstChildren) {
+ halfwayLinePtr = linePtr;
+ linePtr = linePtr->nextPtr;
+ i++;
+ }
+ } else {
+ register Node *childPtr;
+
+ for (childPtr = nodePtr->children.nodePtr, i = 1;
+ childPtr->nextPtr != NULL;
+ childPtr = childPtr->nextPtr, i++) {
+ if (i <= firstChildren) {
+ if (i == firstChildren) {
+ halfwayNodePtr = childPtr;
+ }
+ }
+ }
+ childPtr->nextPtr = otherPtr->children.nodePtr;
+ while (i <= firstChildren) {
+ halfwayNodePtr = childPtr;
+ childPtr = childPtr->nextPtr;
+ i++;
+ }
+ }
+
+ /*
+ * If the two siblings can simply be merged together, do it.
+ */
+
+ if (totalChildren <= MAX_CHILDREN) {
+ RecomputeNodeCounts(nodePtr);
+ nodePtr->nextPtr = otherPtr->nextPtr;
+ nodePtr->parentPtr->numChildren--;
+ DeleteSummaries(otherPtr->summaryPtr);
+ ckfree((char *) otherPtr);
+ continue;
+ }
+
+ /*
+ * The siblings can't be merged, so just divide their
+ * children evenly between them.
+ */
+
+ if (nodePtr->level == 0) {
+ otherPtr->children.linePtr = halfwayLinePtr->nextPtr;
+ halfwayLinePtr->nextPtr = NULL;
+ } else {
+ otherPtr->children.nodePtr = halfwayNodePtr->nextPtr;
+ halfwayNodePtr->nextPtr = NULL;
+ }
+ RecomputeNodeCounts(nodePtr);
+ RecomputeNodeCounts(otherPtr);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RecomputeNodeCounts --
+ *
+ * This procedure is called to recompute all the counts in a node
+ * (tags, child information, etc.) by scanning the information in
+ * its descendants. This procedure is called during rebalancing
+ * when a node's child structure has changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The tag counts for nodePtr are modified to reflect its current
+ * child structure, as are its numChildren and numLines fields.
+ * Also, all of the childrens' parentPtr fields are made to point
+ * to nodePtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RecomputeNodeCounts(nodePtr)
+ register Node *nodePtr; /* Node whose tag summary information
+ * must be recomputed. */
+{
+ register Summary *summaryPtr, *summaryPtr2;
+ register Node *childPtr;
+ register TkTextLine *linePtr;
+ register TkTextSegment *segPtr;
+ TkTextTag *tagPtr;
+
+ /*
+ * Zero out all the existing counts for the node, but don't delete
+ * the existing Summary records (most of them will probably be reused).
+ */
+
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ summaryPtr->toggleCount = 0;
+ }
+ nodePtr->numChildren = 0;
+ nodePtr->numLines = 0;
+
+ /*
+ * Scan through the children, adding the childrens' tag counts into
+ * the node's tag counts and adding new Summary structures if
+ * necessary.
+ */
+
+ if (nodePtr->level == 0) {
+ for (linePtr = nodePtr->children.linePtr; linePtr != NULL;
+ linePtr = linePtr->nextPtr) {
+ nodePtr->numChildren++;
+ nodePtr->numLines++;
+ linePtr->parentPtr = nodePtr;
+ for (segPtr = linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ if (((segPtr->typePtr != &tkTextToggleOnType)
+ && (segPtr->typePtr != &tkTextToggleOffType))
+ || !(segPtr->body.toggle.inNodeCounts)) {
+ continue;
+ }
+ tagPtr = segPtr->body.toggle.tagPtr;
+ for (summaryPtr = nodePtr->summaryPtr; ;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr == NULL) {
+ summaryPtr = (Summary *) ckalloc(sizeof(Summary));
+ summaryPtr->tagPtr = tagPtr;
+ summaryPtr->toggleCount = 1;
+ summaryPtr->nextPtr = nodePtr->summaryPtr;
+ nodePtr->summaryPtr = summaryPtr;
+ break;
+ }
+ if (summaryPtr->tagPtr == tagPtr) {
+ summaryPtr->toggleCount++;
+ break;
+ }
+ }
+ }
+ }
+ } else {
+ for (childPtr = nodePtr->children.nodePtr; childPtr != NULL;
+ childPtr = childPtr->nextPtr) {
+ nodePtr->numChildren++;
+ nodePtr->numLines += childPtr->numLines;
+ childPtr->parentPtr = nodePtr;
+ for (summaryPtr2 = childPtr->summaryPtr; summaryPtr2 != NULL;
+ summaryPtr2 = summaryPtr2->nextPtr) {
+ for (summaryPtr = nodePtr->summaryPtr; ;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr == NULL) {
+ summaryPtr = (Summary *) ckalloc(sizeof(Summary));
+ summaryPtr->tagPtr = summaryPtr2->tagPtr;
+ summaryPtr->toggleCount = summaryPtr2->toggleCount;
+ summaryPtr->nextPtr = nodePtr->summaryPtr;
+ nodePtr->summaryPtr = summaryPtr;
+ break;
+ }
+ if (summaryPtr->tagPtr == summaryPtr2->tagPtr) {
+ summaryPtr->toggleCount += summaryPtr2->toggleCount;
+ break;
+ }
+ }
+ }
+ }
+ }
+
+ /*
+ * Scan through the node's tag records again and delete any Summary
+ * records that still have a zero count, or that have all the toggles.
+ * The node with the children that account for all the tags toggles
+ * have no summary information, and they become the tagRootPtr for the tag.
+ */
+
+ summaryPtr2 = NULL;
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL; ) {
+ if (summaryPtr->toggleCount > 0 &&
+ summaryPtr->toggleCount < summaryPtr->tagPtr->toggleCount) {
+ if (nodePtr->level == summaryPtr->tagPtr->tagRootPtr->level) {
+ /*
+ * The tag's root node split and some toggles left.
+ * The tag root must move up a level.
+ */
+ summaryPtr->tagPtr->tagRootPtr = nodePtr->parentPtr;
+ }
+ summaryPtr2 = summaryPtr;
+ summaryPtr = summaryPtr->nextPtr;
+ continue;
+ }
+ if (summaryPtr->toggleCount == summaryPtr->tagPtr->toggleCount) {
+ /*
+ * A node merge has collected all the toggles under one node.
+ * Push the root down to this level.
+ */
+ summaryPtr->tagPtr->tagRootPtr = nodePtr;
+ }
+ if (summaryPtr2 != NULL) {
+ summaryPtr2->nextPtr = summaryPtr->nextPtr;
+ ckfree((char *) summaryPtr);
+ summaryPtr = summaryPtr2->nextPtr;
+ } else {
+ nodePtr->summaryPtr = summaryPtr->nextPtr;
+ ckfree((char *) summaryPtr);
+ summaryPtr = nodePtr->summaryPtr;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeNumLines --
+ *
+ * This procedure returns a count of the number of lines of
+ * text present in a given B-tree.
+ *
+ * Results:
+ * The return value is a count of the number of usable lines
+ * in tree (i.e. it doesn't include the dummy line that is just
+ * used to mark the end of the tree).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkBTreeNumLines(tree)
+ TkTextBTree tree; /* Information about tree. */
+{
+ BTree *treePtr = (BTree *) tree;
+ return treePtr->rootPtr->numLines - 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CharSplitProc --
+ *
+ * This procedure implements splitting for character segments.
+ *
+ * Results:
+ * The return value is a pointer to a chain of two segments
+ * that have the same characters as segPtr except split
+ * among the two segments.
+ *
+ * Side effects:
+ * Storage for segPtr is freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static TkTextSegment *
+CharSplitProc(segPtr, index)
+ TkTextSegment *segPtr; /* Pointer to segment to split. */
+ int index; /* Position within segment at which
+ * to split. */
+{
+ TkTextSegment *newPtr1, *newPtr2;
+
+ newPtr1 = (TkTextSegment *) ckalloc(CSEG_SIZE(index));
+ newPtr2 = (TkTextSegment *) ckalloc(
+ CSEG_SIZE(segPtr->size - index));
+ newPtr1->typePtr = &tkTextCharType;
+ newPtr1->nextPtr = newPtr2;
+ newPtr1->size = index;
+ strncpy(newPtr1->body.chars, segPtr->body.chars, (size_t) index);
+ newPtr1->body.chars[index] = 0;
+ newPtr2->typePtr = &tkTextCharType;
+ newPtr2->nextPtr = segPtr->nextPtr;
+ newPtr2->size = segPtr->size - index;
+ strcpy(newPtr2->body.chars, segPtr->body.chars + index);
+ ckfree((char*) segPtr);
+ return newPtr1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CharCleanupProc --
+ *
+ * This procedure merges adjacent character segments into
+ * a single character segment, if possible.
+ *
+ * Results:
+ * The return value is a pointer to the first segment in
+ * the (new) list of segments that used to start with segPtr.
+ *
+ * Side effects:
+ * Storage for the segments may be allocated and freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static TkTextSegment *
+CharCleanupProc(segPtr, linePtr)
+ TkTextSegment *segPtr; /* Pointer to first of two adjacent
+ * segments to join. */
+ TkTextLine *linePtr; /* Line containing segments (not
+ * used). */
+{
+ TkTextSegment *segPtr2, *newPtr;
+
+ segPtr2 = segPtr->nextPtr;
+ if ((segPtr2 == NULL) || (segPtr2->typePtr != &tkTextCharType)) {
+ return segPtr;
+ }
+ newPtr = (TkTextSegment *) ckalloc(CSEG_SIZE(
+ segPtr->size + segPtr2->size));
+ newPtr->typePtr = &tkTextCharType;
+ newPtr->nextPtr = segPtr2->nextPtr;
+ newPtr->size = segPtr->size + segPtr2->size;
+ strcpy(newPtr->body.chars, segPtr->body.chars);
+ strcpy(newPtr->body.chars + segPtr->size, segPtr2->body.chars);
+ ckfree((char*) segPtr);
+ ckfree((char*) segPtr2);
+ return newPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CharDeleteProc --
+ *
+ * This procedure is invoked to delete a character segment.
+ *
+ * Results:
+ * Always returns 0 to indicate that the segment was deleted.
+ *
+ * Side effects:
+ * Storage for the segment is freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+CharDeleteProc(segPtr, linePtr, treeGone)
+ TkTextSegment *segPtr; /* Segment to delete. */
+ TkTextLine *linePtr; /* Line containing segment. */
+ int treeGone; /* Non-zero means the entire tree is
+ * being deleted, so everything must
+ * get cleaned up. */
+{
+ ckfree((char*) segPtr);
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CharCheckProc --
+ *
+ * This procedure is invoked to perform consistency checks
+ * on character segments.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If the segment isn't inconsistent then the procedure
+ * panics.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+CharCheckProc(segPtr, linePtr)
+ TkTextSegment *segPtr; /* Segment to check. */
+ TkTextLine *linePtr; /* Line containing segment. */
+{
+ /*
+ * Make sure that the segment contains the number of
+ * characters indicated by its header, and that the last
+ * segment in a line ends in a newline. Also make sure
+ * that there aren't ever two character segments adjacent
+ * to each other: they should be merged together.
+ */
+
+ if (segPtr->size <= 0) {
+ panic("CharCheckProc: segment has size <= 0");
+ }
+ if (strlen(segPtr->body.chars) != (size_t) segPtr->size) {
+ panic("CharCheckProc: segment has wrong size");
+ }
+ if (segPtr->nextPtr == NULL) {
+ if (segPtr->body.chars[segPtr->size-1] != '\n') {
+ panic("CharCheckProc: line doesn't end with newline");
+ }
+ } else {
+ if (segPtr->nextPtr->typePtr == &tkTextCharType) {
+ panic("CharCheckProc: adjacent character segments weren't merged");
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ToggleDeleteProc --
+ *
+ * This procedure is invoked to delete toggle segments.
+ *
+ * Results:
+ * Returns 1 to indicate that the segment may not be deleted,
+ * unless the entire B-tree is going away.
+ *
+ * Side effects:
+ * If the tree is going away then the toggle's memory is
+ * freed; otherwise the toggle counts in nodes above the
+ * segment get updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ToggleDeleteProc(segPtr, linePtr, treeGone)
+ TkTextSegment *segPtr; /* Segment to check. */
+ TkTextLine *linePtr; /* Line containing segment. */
+ int treeGone; /* Non-zero means the entire tree is
+ * being deleted, so everything must
+ * get cleaned up. */
+{
+ if (treeGone) {
+ ckfree((char *) segPtr);
+ return 0;
+ }
+
+ /*
+ * This toggle is in the middle of a range of characters that's
+ * being deleted. Refuse to die. We'll be moved to the end of
+ * the deleted range and our cleanup procedure will be called
+ * later. Decrement node toggle counts here, and set a flag
+ * so we'll re-increment them in the cleanup procedure.
+ */
+
+ if (segPtr->body.toggle.inNodeCounts) {
+ ChangeNodeToggleCount(linePtr->parentPtr,
+ segPtr->body.toggle.tagPtr, -1);
+ segPtr->body.toggle.inNodeCounts = 0;
+ }
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ToggleCleanupProc --
+ *
+ * This procedure is called when a toggle is part of a line that's
+ * been modified in some way. It's invoked after the
+ * modifications are complete.
+ *
+ * Results:
+ * The return value is the head segment in a new list
+ * that is to replace the tail of the line that used to
+ * start at segPtr. This allows the procedure to delete
+ * or modify segPtr.
+ *
+ * Side effects:
+ * Toggle counts in the nodes above the new line will be
+ * updated if they're not already. Toggles may be collapsed
+ * if there are duplicate toggles at the same position.
+ *
+ *--------------------------------------------------------------
+ */
+
+static TkTextSegment *
+ToggleCleanupProc(segPtr, linePtr)
+ TkTextSegment *segPtr; /* Segment to check. */
+ TkTextLine *linePtr; /* Line that now contains segment. */
+{
+ TkTextSegment *segPtr2, *prevPtr;
+ int counts;
+
+ /*
+ * If this is a toggle-off segment, look ahead through the next
+ * segments to see if there's a toggle-on segment for the same tag
+ * before any segments with non-zero size. If so then the two
+ * toggles cancel each other; remove them both.
+ */
+
+ if (segPtr->typePtr == &tkTextToggleOffType) {
+ for (prevPtr = segPtr, segPtr2 = prevPtr->nextPtr;
+ (segPtr2 != NULL) && (segPtr2->size == 0);
+ prevPtr = segPtr2, segPtr2 = prevPtr->nextPtr) {
+ if (segPtr2->typePtr != &tkTextToggleOnType) {
+ continue;
+ }
+ if (segPtr2->body.toggle.tagPtr != segPtr->body.toggle.tagPtr) {
+ continue;
+ }
+ counts = segPtr->body.toggle.inNodeCounts
+ + segPtr2->body.toggle.inNodeCounts;
+ if (counts != 0) {
+ ChangeNodeToggleCount(linePtr->parentPtr,
+ segPtr->body.toggle.tagPtr, -counts);
+ }
+ prevPtr->nextPtr = segPtr2->nextPtr;
+ ckfree((char *) segPtr2);
+ segPtr2 = segPtr->nextPtr;
+ ckfree((char *) segPtr);
+ return segPtr2;
+ }
+ }
+
+ if (!segPtr->body.toggle.inNodeCounts) {
+ ChangeNodeToggleCount(linePtr->parentPtr,
+ segPtr->body.toggle.tagPtr, 1);
+ segPtr->body.toggle.inNodeCounts = 1;
+ }
+ return segPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ToggleLineChangeProc --
+ *
+ * This procedure is invoked when a toggle segment is about
+ * to move from one line to another.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Toggle counts are decremented in the nodes above the line.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ToggleLineChangeProc(segPtr, linePtr)
+ TkTextSegment *segPtr; /* Segment to check. */
+ TkTextLine *linePtr; /* Line that used to contain segment. */
+{
+ if (segPtr->body.toggle.inNodeCounts) {
+ ChangeNodeToggleCount(linePtr->parentPtr,
+ segPtr->body.toggle.tagPtr, -1);
+ segPtr->body.toggle.inNodeCounts = 0;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ToggleCheckProc --
+ *
+ * This procedure is invoked to perform consistency checks
+ * on toggle segments.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If a consistency problem is found the procedure panics.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ToggleCheckProc(segPtr, linePtr)
+ TkTextSegment *segPtr; /* Segment to check. */
+ TkTextLine *linePtr; /* Line containing segment. */
+{
+ register Summary *summaryPtr;
+ int needSummary;
+
+ if (segPtr->size != 0) {
+ panic("ToggleCheckProc: segment had non-zero size");
+ }
+ if (!segPtr->body.toggle.inNodeCounts) {
+ panic("ToggleCheckProc: toggle counts not updated in nodes");
+ }
+ needSummary = (segPtr->body.toggle.tagPtr->tagRootPtr != linePtr->parentPtr);
+ for (summaryPtr = linePtr->parentPtr->summaryPtr; ;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr == NULL) {
+ if (needSummary) {
+ panic("ToggleCheckProc: tag not present in node");
+ } else {
+ break;
+ }
+ }
+ if (summaryPtr->tagPtr == segPtr->body.toggle.tagPtr) {
+ if (!needSummary) {
+ panic("ToggleCheckProc: tag present in root node summary");
+ }
+ break;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeCharsInLine --
+ *
+ * This procedure returns a count of the number of characters
+ * in a given line.
+ *
+ * Results:
+ * The return value is the character count for linePtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkBTreeCharsInLine(linePtr)
+ TkTextLine *linePtr; /* Line whose characters should be
+ * counted. */
+{
+ TkTextSegment *segPtr;
+ int count;
+
+ count = 0;
+ for (segPtr = linePtr->segPtr; segPtr != NULL; segPtr = segPtr->nextPtr) {
+ count += segPtr->size;
+ }
+ return count;
+}
diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c
new file mode 100644
index 0000000..8d9c022
--- /dev/null
+++ b/generic/tkTextDisp.c
@@ -0,0 +1,5015 @@
+/*
+ * tkTextDisp.c --
+ *
+ * This module provides facilities to display text widgets. It is
+ * the only place where information is kept about the screen layout
+ * of text widgets.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkTextDisp.c 1.124 97/07/11 18:01:03
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+#include "tkText.h"
+
+/*
+ * The following structure describes how to display a range of characters.
+ * The information is generated by scanning all of the tags associated
+ * with the characters and combining that with default information for
+ * the overall widget. These structures form the hash keys for
+ * dInfoPtr->styleTable.
+ */
+
+typedef struct StyleValues {
+ Tk_3DBorder border; /* Used for drawing background under text.
+ * NULL means use widget background. */
+ int borderWidth; /* Width of 3-D border for background. */
+ int relief; /* 3-D relief for background. */
+ Pixmap bgStipple; /* Stipple bitmap for background. None
+ * means draw solid. */
+ XColor *fgColor; /* Foreground color for text. */
+ Tk_Font tkfont; /* Font for displaying text. */
+ Pixmap fgStipple; /* Stipple bitmap for text and other
+ * foreground stuff. None means draw
+ * solid.*/
+ int justify; /* Justification style for text. */
+ int lMargin1; /* Left margin, in pixels, for first display
+ * line of each text line. */
+ int lMargin2; /* Left margin, in pixels, for second and
+ * later display lines of each text line. */
+ int offset; /* Offset in pixels of baseline, relative to
+ * baseline of line. */
+ int overstrike; /* Non-zero means draw overstrike through
+ * text. */
+ int rMargin; /* Right margin, in pixels. */
+ int spacing1; /* Spacing above first dline in text line. */
+ int spacing2; /* Spacing between lines of dline. */
+ int spacing3; /* Spacing below last dline in text line. */
+ TkTextTabArray *tabArrayPtr;/* Locations and types of tab stops (may
+ * be NULL). */
+ int underline; /* Non-zero means draw underline underneath
+ * text. */
+ Tk_Uid wrapMode; /* How to handle wrap-around for this tag.
+ * One of tkTextCharUid, tkTextNoneUid,
+ * or tkTextWordUid. */
+} StyleValues;
+
+/*
+ * The following structure extends the StyleValues structure above with
+ * graphics contexts used to actually draw the characters. The entries
+ * in dInfoPtr->styleTable point to structures of this type.
+ */
+
+typedef struct TextStyle {
+ int refCount; /* Number of times this structure is
+ * referenced in Chunks. */
+ GC bgGC; /* Graphics context for background. None
+ * means use widget background. */
+ GC fgGC; /* Graphics context for foreground. */
+ StyleValues *sValuePtr; /* Raw information from which GCs were
+ * derived. */
+ Tcl_HashEntry *hPtr; /* Pointer to entry in styleTable. Used
+ * to delete entry. */
+} TextStyle;
+
+/*
+ * The following macro determines whether two styles have the same
+ * background so that, for example, no beveled border should be drawn
+ * between them.
+ */
+
+#define SAME_BACKGROUND(s1, s2) \
+ (((s1)->sValuePtr->border == (s2)->sValuePtr->border) \
+ && ((s1)->sValuePtr->borderWidth == (s2)->sValuePtr->borderWidth) \
+ && ((s1)->sValuePtr->relief == (s2)->sValuePtr->relief) \
+ && ((s1)->sValuePtr->bgStipple == (s2)->sValuePtr->bgStipple))
+
+/*
+ * The following structure describes one line of the display, which may
+ * be either part or all of one line of the text.
+ */
+
+typedef struct DLine {
+ TkTextIndex index; /* Identifies first character in text
+ * that is displayed on this line. */
+ int count; /* Number of characters accounted for by this
+ * display line, including a trailing space
+ * or newline that isn't actually displayed. */
+ int y; /* Y-position at which line is supposed to
+ * be drawn (topmost pixel of rectangular
+ * area occupied by line). */
+ int oldY; /* Y-position at which line currently
+ * appears on display. -1 means line isn't
+ * currently visible on display and must be
+ * redrawn. This is used to move lines by
+ * scrolling rather than re-drawing. */
+ int height; /* Height of line, in pixels. */
+ int baseline; /* Offset of text baseline from y, in
+ * pixels. */
+ int spaceAbove; /* How much extra space was added to the
+ * top of the line because of spacing
+ * options. This is included in height
+ * and baseline. */
+ int spaceBelow; /* How much extra space was added to the
+ * bottom of the line because of spacing
+ * options. This is included in height. */
+ int length; /* Total length of line, in pixels. */
+ TkTextDispChunk *chunkPtr; /* Pointer to first chunk in list of all
+ * of those that are displayed on this
+ * line of the screen. */
+ struct DLine *nextPtr; /* Next in list of all display lines for
+ * this window. The list is sorted in
+ * order from top to bottom. Note: the
+ * next DLine doesn't always correspond
+ * to the next line of text: (a) can have
+ * multiple DLines for one text line, and
+ * (b) can have gaps where DLine's have been
+ * deleted because they're out of date. */
+ int flags; /* Various flag bits: see below for values. */
+} DLine;
+
+/*
+ * Flag bits for DLine structures:
+ *
+ * HAS_3D_BORDER - Non-zero means that at least one of the
+ * chunks in this line has a 3D border, so
+ * it potentially interacts with 3D borders
+ * in neighboring lines (see
+ * DisplayLineBackground).
+ * NEW_LAYOUT - Non-zero means that the line has been
+ * re-layed out since the last time the
+ * display was updated.
+ * TOP_LINE - Non-zero means that this was the top line
+ * in the window the last time that the window
+ * was laid out. This is important because
+ * a line may be displayed differently if its
+ * at the top or bottom than if it's in the
+ * middle (e.g. beveled edges aren't displayed
+ * for middle lines if the adjacent line has
+ * a similar background).
+ * BOTTOM_LINE - Non-zero means that this was the bottom line
+ * in the window the last time that the window
+ * was laid out.
+ */
+
+#define HAS_3D_BORDER 1
+#define NEW_LAYOUT 2
+#define TOP_LINE 4
+#define BOTTOM_LINE 8
+
+/*
+ * Overall display information for a text widget:
+ */
+
+typedef struct TextDInfo {
+ Tcl_HashTable styleTable; /* Hash table that maps from StyleValues
+ * to TextStyles for this widget. */
+ DLine *dLinePtr; /* First in list of all display lines for
+ * this widget, in order from top to bottom. */
+ GC copyGC; /* Graphics context for copying from off-
+ * screen pixmaps onto screen. */
+ GC scrollGC; /* Graphics context for copying from one place
+ * in the window to another (scrolling):
+ * differs from copyGC in that we need to get
+ * GraphicsExpose events. */
+ int x; /* First x-coordinate that may be used for
+ * actually displaying line information.
+ * Leaves space for border, etc. */
+ int y; /* First y-coordinate that may be used for
+ * actually displaying line information.
+ * Leaves space for border, etc. */
+ int maxX; /* First x-coordinate to right of available
+ * space for displaying lines. */
+ int maxY; /* First y-coordinate below available
+ * space for displaying lines. */
+ int topOfEof; /* Top-most pixel (lowest y-value) that has
+ * been drawn in the appropriate fashion for
+ * the portion of the window after the last
+ * line of the text. This field is used to
+ * figure out when to redraw part or all of
+ * the eof field. */
+
+ /*
+ * Information used for scrolling:
+ */
+
+ int newCharOffset; /* Desired x scroll position, measured as the
+ * number of average-size characters off-screen
+ * to the left for a line with no left
+ * margin. */
+ int curPixelOffset; /* Actual x scroll position, measured as the
+ * number of pixels off-screen to the left. */
+ int maxLength; /* Length in pixels of longest line that's
+ * visible in window (length may exceed window
+ * size). If there's no wrapping, this will
+ * be zero. */
+ double xScrollFirst, xScrollLast;
+ /* Most recent values reported to horizontal
+ * scrollbar; used to eliminate unnecessary
+ * reports. */
+ double yScrollFirst, yScrollLast;
+ /* Most recent values reported to vertical
+ * scrollbar; used to eliminate unnecessary
+ * reports. */
+
+ /*
+ * The following information is used to implement scanning:
+ */
+
+ int scanMarkChar; /* Character that was at the left edge of
+ * the window when the scan started. */
+ int scanMarkX; /* X-position of mouse at time scan started. */
+ int scanTotalScroll; /* Total scrolling (in screen lines) that has
+ * occurred since scanMarkY was set. */
+ int scanMarkY; /* Y-position of mouse at time scan started. */
+
+ /*
+ * Miscellaneous information:
+ */
+
+ int dLinesInvalidated; /* This value is set to 1 whenever something
+ * happens that invalidates information in
+ * DLine structures; if a redisplay
+ * is in progress, it will see this and
+ * abort the redisplay. This is needed
+ * because, for example, an embedded window
+ * could change its size when it is first
+ * displayed, invalidating the DLine that
+ * is currently being displayed. If redisplay
+ * continues, it will use freed memory and
+ * could dump core. */
+ int flags; /* Various flag values: see below for
+ * definitions. */
+} TextDInfo;
+
+/*
+ * In TkTextDispChunk structures for character segments, the clientData
+ * field points to one of the following structures:
+ */
+
+typedef struct CharInfo {
+ int numChars; /* Number of characters to display. */
+ char chars[4]; /* Characters to display. Actual size
+ * will be numChars, not 4. THIS MUST BE
+ * THE LAST FIELD IN THE STRUCTURE. */
+} CharInfo;
+
+/*
+ * Flag values for TextDInfo structures:
+ *
+ * DINFO_OUT_OF_DATE: Non-zero means that the DLine structures
+ * for this window are partially or completely
+ * out of date and need to be recomputed.
+ * REDRAW_PENDING: Means that a when-idle handler has been
+ * scheduled to update the display.
+ * REDRAW_BORDERS: Means window border or pad area has
+ * potentially been damaged and must be redrawn.
+ * REPICK_NEEDED: 1 means that the widget has been modified
+ * in a way that could change the current
+ * character (a different character might be
+ * under the mouse cursor now). Need to
+ * recompute the current character before
+ * the next redisplay.
+ */
+
+#define DINFO_OUT_OF_DATE 1
+#define REDRAW_PENDING 2
+#define REDRAW_BORDERS 4
+#define REPICK_NEEDED 8
+
+/*
+ * The following counters keep statistics about redisplay that can be
+ * checked to see how clever this code is at reducing redisplays.
+ */
+
+static int numRedisplays; /* Number of calls to DisplayText. */
+static int linesRedrawn; /* Number of calls to DisplayDLine. */
+static int numCopies; /* Number of calls to XCopyArea to copy part
+ * of the screen. */
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void AdjustForTab _ANSI_ARGS_((TkText *textPtr,
+ TkTextTabArray *tabArrayPtr, int index,
+ TkTextDispChunk *chunkPtr));
+static void CharBboxProc _ANSI_ARGS_((TkTextDispChunk *chunkPtr,
+ int index, int y, int lineHeight, int baseline,
+ int *xPtr, int *yPtr, int *widthPtr,
+ int *heightPtr));
+static void CharDisplayProc _ANSI_ARGS_((TkTextDispChunk *chunkPtr,
+ int x, int y, int height, int baseline,
+ Display *display, Drawable dst, int screenY));
+static int CharMeasureProc _ANSI_ARGS_((TkTextDispChunk *chunkPtr,
+ int x));
+static void CharUndisplayProc _ANSI_ARGS_((TkText *textPtr,
+ TkTextDispChunk *chunkPtr));
+static void DisplayDLine _ANSI_ARGS_((TkText *textPtr,
+ DLine *dlPtr, DLine *prevPtr, Pixmap pixmap));
+static void DisplayLineBackground _ANSI_ARGS_((TkText *textPtr,
+ DLine *dlPtr, DLine *prevPtr, Pixmap pixmap));
+static void DisplayText _ANSI_ARGS_((ClientData clientData));
+static DLine * FindDLine _ANSI_ARGS_((DLine *dlPtr,
+ TkTextIndex *indexPtr));
+static void FreeDLines _ANSI_ARGS_((TkText *textPtr,
+ DLine *firstPtr, DLine *lastPtr, int unlink));
+static void FreeStyle _ANSI_ARGS_((TkText *textPtr,
+ TextStyle *stylePtr));
+static TextStyle * GetStyle _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *indexPtr));
+static void GetXView _ANSI_ARGS_((Tcl_Interp *interp,
+ TkText *textPtr, int report));
+static void GetYView _ANSI_ARGS_((Tcl_Interp *interp,
+ TkText *textPtr, int report));
+static DLine * LayoutDLine _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *indexPtr));
+static int MeasureChars _ANSI_ARGS_((Tk_Font tkfont,
+ CONST char *source, int maxChars, int startX,
+ int maxX, int tabOrigin, int *nextXPtr));
+static void MeasureUp _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *srcPtr, int distance,
+ TkTextIndex *dstPtr));
+static int NextTabStop _ANSI_ARGS_((Tk_Font tkfont, int x,
+ int tabOrigin));
+static void UpdateDisplayInfo _ANSI_ARGS_((TkText *textPtr));
+static void ScrollByLines _ANSI_ARGS_((TkText *textPtr,
+ int offset));
+static int SizeOfTab _ANSI_ARGS_((TkText *textPtr,
+ TkTextTabArray *tabArrayPtr, int index, int x,
+ int maxX));
+static void TextInvalidateRegion _ANSI_ARGS_((TkText *textPtr,
+ TkRegion region));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextCreateDInfo --
+ *
+ * This procedure is called when a new text widget is created.
+ * Its job is to set up display-related information for the widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A TextDInfo data structure is allocated and initialized and attached
+ * to textPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextCreateDInfo(textPtr)
+ TkText *textPtr; /* Overall information for text widget. */
+{
+ register TextDInfo *dInfoPtr;
+ XGCValues gcValues;
+
+ dInfoPtr = (TextDInfo *) ckalloc(sizeof(TextDInfo));
+ Tcl_InitHashTable(&dInfoPtr->styleTable, sizeof(StyleValues)/sizeof(int));
+ dInfoPtr->dLinePtr = NULL;
+ dInfoPtr->copyGC = None;
+ gcValues.graphics_exposures = True;
+ dInfoPtr->scrollGC = Tk_GetGC(textPtr->tkwin, GCGraphicsExposures,
+ &gcValues);
+ dInfoPtr->topOfEof = 0;
+ dInfoPtr->newCharOffset = 0;
+ dInfoPtr->curPixelOffset = 0;
+ dInfoPtr->maxLength = 0;
+ dInfoPtr->xScrollFirst = -1;
+ dInfoPtr->xScrollLast = -1;
+ dInfoPtr->yScrollFirst = -1;
+ dInfoPtr->yScrollLast = -1;
+ dInfoPtr->scanMarkChar = 0;
+ dInfoPtr->scanMarkX = 0;
+ dInfoPtr->scanTotalScroll = 0;
+ dInfoPtr->scanMarkY = 0;
+ dInfoPtr->dLinesInvalidated = 0;
+ dInfoPtr->flags = DINFO_OUT_OF_DATE;
+ textPtr->dInfoPtr = dInfoPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextFreeDInfo --
+ *
+ * This procedure is called to free up all of the private display
+ * information kept by this file for a text widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Lots of resources get freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextFreeDInfo(textPtr)
+ TkText *textPtr; /* Overall information for text widget. */
+{
+ register TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+
+ /*
+ * Be careful to free up styleTable *after* freeing up all the
+ * DLines, so that the hash table is still intact to free up the
+ * style-related information from the lines. Once the lines are
+ * all free then styleTable will be empty.
+ */
+
+ FreeDLines(textPtr, dInfoPtr->dLinePtr, (DLine *) NULL, 1);
+ Tcl_DeleteHashTable(&dInfoPtr->styleTable);
+ if (dInfoPtr->copyGC != None) {
+ Tk_FreeGC(textPtr->display, dInfoPtr->copyGC);
+ }
+ Tk_FreeGC(textPtr->display, dInfoPtr->scrollGC);
+ if (dInfoPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayText, (ClientData) textPtr);
+ }
+ ckfree((char *) dInfoPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetStyle --
+ *
+ * This procedure creates all the information needed to display
+ * text at a particular location.
+ *
+ * Results:
+ * The return value is a pointer to a TextStyle structure that
+ * corresponds to *sValuePtr.
+ *
+ * Side effects:
+ * A new entry may be created in the style table for the widget.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TextStyle *
+GetStyle(textPtr, indexPtr)
+ TkText *textPtr; /* Overall information about text widget. */
+ TkTextIndex *indexPtr; /* The character in the text for which
+ * display information is wanted. */
+{
+ TkTextTag **tagPtrs;
+ register TkTextTag *tagPtr;
+ StyleValues styleValues;
+ TextStyle *stylePtr;
+ Tcl_HashEntry *hPtr;
+ int numTags, new, i;
+ XGCValues gcValues;
+ unsigned long mask;
+
+ /*
+ * The variables below keep track of the highest-priority specification
+ * that has occurred for each of the various fields of the StyleValues.
+ */
+
+ int borderPrio, borderWidthPrio, reliefPrio, bgStipplePrio;
+ int fgPrio, fontPrio, fgStipplePrio;
+ int underlinePrio, justifyPrio, offsetPrio;
+ int lMargin1Prio, lMargin2Prio, rMarginPrio;
+ int spacing1Prio, spacing2Prio, spacing3Prio;
+ int overstrikePrio, tabPrio, wrapPrio;
+
+ /*
+ * Find out what tags are present for the character, then compute
+ * a StyleValues structure corresponding to those tags (scan
+ * through all of the tags, saving information for the highest-
+ * priority tag).
+ */
+
+ tagPtrs = TkBTreeGetTags(indexPtr, &numTags);
+ borderPrio = borderWidthPrio = reliefPrio = bgStipplePrio = -1;
+ fgPrio = fontPrio = fgStipplePrio = -1;
+ underlinePrio = justifyPrio = offsetPrio = -1;
+ lMargin1Prio = lMargin2Prio = rMarginPrio = -1;
+ spacing1Prio = spacing2Prio = spacing3Prio = -1;
+ overstrikePrio = tabPrio = wrapPrio = -1;
+ memset((VOID *) &styleValues, 0, sizeof(StyleValues));
+ styleValues.relief = TK_RELIEF_FLAT;
+ styleValues.fgColor = textPtr->fgColor;
+ styleValues.tkfont = textPtr->tkfont;
+ styleValues.justify = TK_JUSTIFY_LEFT;
+ styleValues.spacing1 = textPtr->spacing1;
+ styleValues.spacing2 = textPtr->spacing2;
+ styleValues.spacing3 = textPtr->spacing3;
+ styleValues.tabArrayPtr = textPtr->tabArrayPtr;
+ styleValues.wrapMode = textPtr->wrapMode;
+ for (i = 0 ; i < numTags; i++) {
+ tagPtr = tagPtrs[i];
+
+ /*
+ * On Windows and Mac, we need to skip the selection tag if
+ * we don't have focus.
+ */
+
+#ifndef ALWAYS_SHOW_SELECTION
+ if ((tagPtr == textPtr->selTagPtr) && !(textPtr->flags & GOT_FOCUS)) {
+ continue;
+ }
+#endif
+
+ if ((tagPtr->border != NULL) && (tagPtr->priority > borderPrio)) {
+ styleValues.border = tagPtr->border;
+ borderPrio = tagPtr->priority;
+ }
+ if ((tagPtr->bdString != NULL)
+ && (tagPtr->priority > borderWidthPrio)) {
+ styleValues.borderWidth = tagPtr->borderWidth;
+ borderWidthPrio = tagPtr->priority;
+ }
+ if ((tagPtr->reliefString != NULL)
+ && (tagPtr->priority > reliefPrio)) {
+ if (styleValues.border == NULL) {
+ styleValues.border = textPtr->border;
+ }
+ styleValues.relief = tagPtr->relief;
+ reliefPrio = tagPtr->priority;
+ }
+ if ((tagPtr->bgStipple != None)
+ && (tagPtr->priority > bgStipplePrio)) {
+ styleValues.bgStipple = tagPtr->bgStipple;
+ bgStipplePrio = tagPtr->priority;
+ }
+ if ((tagPtr->fgColor != None) && (tagPtr->priority > fgPrio)) {
+ styleValues.fgColor = tagPtr->fgColor;
+ fgPrio = tagPtr->priority;
+ }
+ if ((tagPtr->tkfont != None) && (tagPtr->priority > fontPrio)) {
+ styleValues.tkfont = tagPtr->tkfont;
+ fontPrio = tagPtr->priority;
+ }
+ if ((tagPtr->fgStipple != None)
+ && (tagPtr->priority > fgStipplePrio)) {
+ styleValues.fgStipple = tagPtr->fgStipple;
+ fgStipplePrio = tagPtr->priority;
+ }
+ if ((tagPtr->justifyString != NULL)
+ && (tagPtr->priority > justifyPrio)) {
+ styleValues.justify = tagPtr->justify;
+ justifyPrio = tagPtr->priority;
+ }
+ if ((tagPtr->lMargin1String != NULL)
+ && (tagPtr->priority > lMargin1Prio)) {
+ styleValues.lMargin1 = tagPtr->lMargin1;
+ lMargin1Prio = tagPtr->priority;
+ }
+ if ((tagPtr->lMargin2String != NULL)
+ && (tagPtr->priority > lMargin2Prio)) {
+ styleValues.lMargin2 = tagPtr->lMargin2;
+ lMargin2Prio = tagPtr->priority;
+ }
+ if ((tagPtr->offsetString != NULL)
+ && (tagPtr->priority > offsetPrio)) {
+ styleValues.offset = tagPtr->offset;
+ offsetPrio = tagPtr->priority;
+ }
+ if ((tagPtr->overstrikeString != NULL)
+ && (tagPtr->priority > overstrikePrio)) {
+ styleValues.overstrike = tagPtr->overstrike;
+ overstrikePrio = tagPtr->priority;
+ }
+ if ((tagPtr->rMarginString != NULL)
+ && (tagPtr->priority > rMarginPrio)) {
+ styleValues.rMargin = tagPtr->rMargin;
+ rMarginPrio = tagPtr->priority;
+ }
+ if ((tagPtr->spacing1String != NULL)
+ && (tagPtr->priority > spacing1Prio)) {
+ styleValues.spacing1 = tagPtr->spacing1;
+ spacing1Prio = tagPtr->priority;
+ }
+ if ((tagPtr->spacing2String != NULL)
+ && (tagPtr->priority > spacing2Prio)) {
+ styleValues.spacing2 = tagPtr->spacing2;
+ spacing2Prio = tagPtr->priority;
+ }
+ if ((tagPtr->spacing3String != NULL)
+ && (tagPtr->priority > spacing3Prio)) {
+ styleValues.spacing3 = tagPtr->spacing3;
+ spacing3Prio = tagPtr->priority;
+ }
+ if ((tagPtr->tabString != NULL)
+ && (tagPtr->priority > tabPrio)) {
+ styleValues.tabArrayPtr = tagPtr->tabArrayPtr;
+ tabPrio = tagPtr->priority;
+ }
+ if ((tagPtr->underlineString != NULL)
+ && (tagPtr->priority > underlinePrio)) {
+ styleValues.underline = tagPtr->underline;
+ underlinePrio = tagPtr->priority;
+ }
+ if ((tagPtr->wrapMode != NULL)
+ && (tagPtr->priority > wrapPrio)) {
+ styleValues.wrapMode = tagPtr->wrapMode;
+ wrapPrio = tagPtr->priority;
+ }
+ }
+ if (tagPtrs != NULL) {
+ ckfree((char *) tagPtrs);
+ }
+
+ /*
+ * Use an existing style if there's one around that matches.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&textPtr->dInfoPtr->styleTable,
+ (char *) &styleValues, &new);
+ if (!new) {
+ stylePtr = (TextStyle *) Tcl_GetHashValue(hPtr);
+ stylePtr->refCount++;
+ return stylePtr;
+ }
+
+ /*
+ * No existing style matched. Make a new one.
+ */
+
+ stylePtr = (TextStyle *) ckalloc(sizeof(TextStyle));
+ stylePtr->refCount = 1;
+ if (styleValues.border != NULL) {
+ gcValues.foreground = Tk_3DBorderColor(styleValues.border)->pixel;
+ mask = GCForeground;
+ if (styleValues.bgStipple != None) {
+ gcValues.stipple = styleValues.bgStipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ stylePtr->bgGC = Tk_GetGC(textPtr->tkwin, mask, &gcValues);
+ } else {
+ stylePtr->bgGC = None;
+ }
+ mask = GCForeground|GCFont;
+ gcValues.foreground = styleValues.fgColor->pixel;
+ gcValues.font = Tk_FontId(styleValues.tkfont);
+ if (styleValues.fgStipple != None) {
+ gcValues.stipple = styleValues.fgStipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ stylePtr->fgGC = Tk_GetGC(textPtr->tkwin, mask, &gcValues);
+ stylePtr->sValuePtr = (StyleValues *)
+ Tcl_GetHashKey(&textPtr->dInfoPtr->styleTable, hPtr);
+ stylePtr->hPtr = hPtr;
+ Tcl_SetHashValue(hPtr, stylePtr);
+ return stylePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeStyle --
+ *
+ * This procedure is called when a TextStyle structure is no longer
+ * needed. It decrements the reference count and frees up the
+ * space for the style structure if the reference count is 0.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The storage and other resources associated with the style
+ * are freed up if no-one's still using it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeStyle(textPtr, stylePtr)
+ TkText *textPtr; /* Information about overall widget. */
+ register TextStyle *stylePtr; /* Information about style to free. */
+
+{
+ stylePtr->refCount--;
+ if (stylePtr->refCount == 0) {
+ if (stylePtr->bgGC != None) {
+ Tk_FreeGC(textPtr->display, stylePtr->bgGC);
+ }
+ Tk_FreeGC(textPtr->display, stylePtr->fgGC);
+ Tcl_DeleteHashEntry(stylePtr->hPtr);
+ ckfree((char *) stylePtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * LayoutDLine --
+ *
+ * This procedure generates a single DLine structure for a display
+ * line whose leftmost character is given by indexPtr.
+ *
+ * Results:
+ * The return value is a pointer to a DLine structure desribing the
+ * display line. All fields are filled in and correct except for
+ * y and nextPtr.
+ *
+ * Side effects:
+ * Storage is allocated for the new DLine.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DLine *
+LayoutDLine(textPtr, indexPtr)
+ TkText *textPtr; /* Overall information about text widget. */
+ TkTextIndex *indexPtr; /* Beginning of display line. May not
+ * necessarily point to a character segment. */
+{
+ register DLine *dlPtr; /* New display line. */
+ TkTextSegment *segPtr; /* Current segment in text. */
+ TkTextDispChunk *lastChunkPtr; /* Last chunk allocated so far
+ * for line. */
+ TkTextDispChunk *chunkPtr; /* Current chunk. */
+ TkTextIndex curIndex;
+ TkTextDispChunk *breakChunkPtr; /* Chunk containing best word break
+ * point, if any. */
+ TkTextIndex breakIndex; /* Index of first character in
+ * breakChunkPtr. */
+ int breakCharOffset; /* Character within breakChunkPtr just
+ * to right of best break point. */
+ int noCharsYet; /* Non-zero means that no characters
+ * have been placed on the line yet. */
+ int justify; /* How to justify line: taken from
+ * style for first character in line. */
+ int jIndent; /* Additional indentation (beyond
+ * margins) due to justification. */
+ int rMargin; /* Right margin width for line. */
+ Tk_Uid wrapMode; /* Wrap mode to use for this line. */
+ int x = 0, maxX = 0; /* Initializations needed only to
+ * stop compiler warnings. */
+ int wholeLine; /* Non-zero means this display line
+ * runs to the end of the text line. */
+ int tabIndex; /* Index of the current tab stop. */
+ int gotTab; /* Non-zero means the current chunk
+ * contains a tab. */
+ TkTextDispChunk *tabChunkPtr; /* Pointer to the chunk containing
+ * the previous tab stop. */
+ int maxChars; /* Maximum number of characters to
+ * include in this chunk. */
+ TkTextTabArray *tabArrayPtr; /* Tab stops for line; taken from
+ * style for first character on line. */
+ int tabSize; /* Number of pixels consumed by current
+ * tab stop. */
+ TkTextDispChunk *lastCharChunkPtr; /* Pointer to last chunk in display
+ * lines with numChars > 0. Used to
+ * drop 0-sized chunks from the end
+ * of the line. */
+ int offset, ascent, descent, code;
+ StyleValues *sValuePtr;
+
+ /*
+ * Create and initialize a new DLine structure.
+ */
+
+ dlPtr = (DLine *) ckalloc(sizeof(DLine));
+ dlPtr->index = *indexPtr;
+ dlPtr->count = 0;
+ dlPtr->y = 0;
+ dlPtr->oldY = -1;
+ dlPtr->height = 0;
+ dlPtr->baseline = 0;
+ dlPtr->chunkPtr = NULL;
+ dlPtr->nextPtr = NULL;
+ dlPtr->flags = NEW_LAYOUT;
+
+ /*
+ * Each iteration of the loop below creates one TkTextDispChunk for
+ * the new display line. The line will always have at least one
+ * chunk (for the newline character at the end, if there's nothing
+ * else available).
+ */
+
+ curIndex = *indexPtr;
+ lastChunkPtr = NULL;
+ chunkPtr = NULL;
+ noCharsYet = 1;
+ breakChunkPtr = NULL;
+ breakCharOffset = 0;
+ justify = TK_JUSTIFY_LEFT;
+ tabIndex = -1;
+ tabChunkPtr = NULL;
+ tabArrayPtr = NULL;
+ rMargin = 0;
+ wrapMode = tkTextCharUid;
+ tabSize = 0;
+ lastCharChunkPtr = NULL;
+
+ /*
+ * Find the first segment to consider for the line. Can't call
+ * TkTextIndexToSeg for this because it won't return a segment
+ * with zero size (such as the insertion cursor's mark).
+ */
+
+ for (offset = curIndex.charIndex, segPtr = curIndex.linePtr->segPtr;
+ (offset > 0) && (offset >= segPtr->size);
+ offset -= segPtr->size, segPtr = segPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+
+ while (segPtr != NULL) {
+ if (segPtr->typePtr->layoutProc == NULL) {
+ segPtr = segPtr->nextPtr;
+ offset = 0;
+ continue;
+ }
+ if (chunkPtr == NULL) {
+ chunkPtr = (TkTextDispChunk *) ckalloc(sizeof(TkTextDispChunk));
+ chunkPtr->nextPtr = NULL;
+ }
+ chunkPtr->stylePtr = GetStyle(textPtr, &curIndex);
+
+ /*
+ * Save style information such as justification and indentation,
+ * up until the first character is encountered, then retain that
+ * information for the rest of the line.
+ */
+
+ if (noCharsYet) {
+ tabArrayPtr = chunkPtr->stylePtr->sValuePtr->tabArrayPtr;
+ justify = chunkPtr->stylePtr->sValuePtr->justify;
+ rMargin = chunkPtr->stylePtr->sValuePtr->rMargin;
+ wrapMode = chunkPtr->stylePtr->sValuePtr->wrapMode;
+ x = ((curIndex.charIndex == 0)
+ ? chunkPtr->stylePtr->sValuePtr->lMargin1
+ : chunkPtr->stylePtr->sValuePtr->lMargin2);
+ if (wrapMode == tkTextNoneUid) {
+ maxX = INT_MAX;
+ } else {
+ maxX = textPtr->dInfoPtr->maxX - textPtr->dInfoPtr->x
+ - rMargin;
+ if (maxX < x) {
+ maxX = x;
+ }
+ }
+ }
+
+ /*
+ * See if there is a tab in the current chunk; if so, only
+ * layout characters up to (and including) the tab.
+ */
+
+ gotTab = 0;
+ maxChars = segPtr->size - offset;
+ if (justify == TK_JUSTIFY_LEFT) {
+ if (segPtr->typePtr == &tkTextCharType) {
+ char *p;
+
+ for (p = segPtr->body.chars + offset; *p != 0; p++) {
+ if (*p == '\t') {
+ maxChars = (p + 1 - segPtr->body.chars) - offset;
+ gotTab = 1;
+ break;
+ }
+ }
+ }
+ }
+
+ chunkPtr->x = x;
+ code = (*segPtr->typePtr->layoutProc)(textPtr, &curIndex, segPtr,
+ offset, maxX-tabSize, maxChars, noCharsYet, wrapMode,
+ chunkPtr);
+ if (code <= 0) {
+ FreeStyle(textPtr, chunkPtr->stylePtr);
+ if (code < 0) {
+ /*
+ * This segment doesn't wish to display itself (e.g. most
+ * marks).
+ */
+
+ segPtr = segPtr->nextPtr;
+ offset = 0;
+ continue;
+ }
+
+ /*
+ * No characters from this segment fit in the window: this
+ * means we're at the end of the display line.
+ */
+
+ if (chunkPtr != NULL) {
+ ckfree((char *) chunkPtr);
+ }
+ break;
+ }
+ if (chunkPtr->numChars > 0) {
+ noCharsYet = 0;
+ lastCharChunkPtr = chunkPtr;
+ }
+ if (lastChunkPtr == NULL) {
+ dlPtr->chunkPtr = chunkPtr;
+ } else {
+ lastChunkPtr->nextPtr = chunkPtr;
+ }
+ lastChunkPtr = chunkPtr;
+ x += chunkPtr->width;
+ if (chunkPtr->breakIndex > 0) {
+ breakCharOffset = chunkPtr->breakIndex;
+ breakIndex = curIndex;
+ breakChunkPtr = chunkPtr;
+ }
+ if (chunkPtr->numChars != maxChars) {
+ break;
+ }
+
+ /*
+ * If we're at a new tab, adjust the layout for all the chunks
+ * pertaining to the previous tab. Also adjust the amount of
+ * space left in the line to account for space that will be eaten
+ * up by the tab.
+ */
+
+ if (gotTab) {
+ if (tabIndex >= 0) {
+ AdjustForTab(textPtr, tabArrayPtr, tabIndex, tabChunkPtr);
+ x = chunkPtr->x + chunkPtr->width;
+ }
+ tabIndex++;
+ tabChunkPtr = chunkPtr;
+ tabSize = SizeOfTab(textPtr, tabArrayPtr, tabIndex, x, maxX);
+ if (tabSize >= (maxX - x)) {
+ break;
+ }
+ }
+ curIndex.charIndex += chunkPtr->numChars;
+ offset += chunkPtr->numChars;
+ if (offset >= segPtr->size) {
+ offset = 0;
+ segPtr = segPtr->nextPtr;
+ }
+ chunkPtr = NULL;
+ }
+ if (noCharsYet) {
+ panic("LayoutDLine couldn't place any characters on a line");
+ }
+ wholeLine = (segPtr == NULL);
+
+ /*
+ * We're at the end of the display line. Throw away everything
+ * after the most recent word break, if there is one; this may
+ * potentially require the last chunk to be layed out again.
+ */
+
+ if (breakChunkPtr == NULL) {
+ /*
+ * This code makes sure that we don't accidentally display
+ * chunks with no characters at the end of the line (such as
+ * the insertion cursor). These chunks belong on the next
+ * line. So, throw away everything after the last chunk that
+ * has characters in it.
+ */
+
+ breakChunkPtr = lastCharChunkPtr;
+ breakCharOffset = breakChunkPtr->numChars;
+ }
+ if ((breakChunkPtr != NULL) && ((lastChunkPtr != breakChunkPtr)
+ || (breakCharOffset != lastChunkPtr->numChars))) {
+ while (1) {
+ chunkPtr = breakChunkPtr->nextPtr;
+ if (chunkPtr == NULL) {
+ break;
+ }
+ FreeStyle(textPtr, chunkPtr->stylePtr);
+ breakChunkPtr->nextPtr = chunkPtr->nextPtr;
+ (*chunkPtr->undisplayProc)(textPtr, chunkPtr);
+ ckfree((char *) chunkPtr);
+ }
+ if (breakCharOffset != breakChunkPtr->numChars) {
+ (*breakChunkPtr->undisplayProc)(textPtr, breakChunkPtr);
+ segPtr = TkTextIndexToSeg(&breakIndex, &offset);
+ (*segPtr->typePtr->layoutProc)(textPtr, &breakIndex,
+ segPtr, offset, maxX, breakCharOffset, 0,
+ wrapMode, breakChunkPtr);
+ }
+ lastChunkPtr = breakChunkPtr;
+ wholeLine = 0;
+ }
+
+ /*
+ * Make tab adjustments for the last tab stop, if there is one.
+ */
+
+ if ((tabIndex >= 0) && (tabChunkPtr != NULL)) {
+ AdjustForTab(textPtr, tabArrayPtr, tabIndex, tabChunkPtr);
+ }
+
+ /*
+ * Make one more pass over the line to recompute various things
+ * like its height, length, and total number of characters. Also
+ * modify the x-locations of chunks to reflect justification.
+ * If we're not wrapping, I'm not sure what is the best way to
+ * handle left and center justification: should the total length,
+ * for purposes of justification, be (a) the window width, (b)
+ * the length of the longest line in the window, or (c) the length
+ * of the longest line in the text? (c) isn't available, (b) seems
+ * weird, since it can change with vertical scrolling, so (a) is
+ * what is implemented below.
+ */
+
+ if (wrapMode == tkTextNoneUid) {
+ maxX = textPtr->dInfoPtr->maxX - textPtr->dInfoPtr->x - rMargin;
+ }
+ dlPtr->length = lastChunkPtr->x + lastChunkPtr->width;
+ if (justify == TK_JUSTIFY_LEFT) {
+ jIndent = 0;
+ } else if (justify == TK_JUSTIFY_RIGHT) {
+ jIndent = maxX - dlPtr->length;
+ } else {
+ jIndent = (maxX - dlPtr->length)/2;
+ }
+ ascent = descent = 0;
+ for (chunkPtr = dlPtr->chunkPtr; chunkPtr != NULL;
+ chunkPtr = chunkPtr->nextPtr) {
+ chunkPtr->x += jIndent;
+ dlPtr->count += chunkPtr->numChars;
+ if (chunkPtr->minAscent > ascent) {
+ ascent = chunkPtr->minAscent;
+ }
+ if (chunkPtr->minDescent > descent) {
+ descent = chunkPtr->minDescent;
+ }
+ if (chunkPtr->minHeight > dlPtr->height) {
+ dlPtr->height = chunkPtr->minHeight;
+ }
+ sValuePtr = chunkPtr->stylePtr->sValuePtr;
+ if ((sValuePtr->borderWidth > 0)
+ && (sValuePtr->relief != TK_RELIEF_FLAT)) {
+ dlPtr->flags |= HAS_3D_BORDER;
+ }
+ }
+ if (dlPtr->height < (ascent + descent)) {
+ dlPtr->height = ascent + descent;
+ dlPtr->baseline = ascent;
+ } else {
+ dlPtr->baseline = ascent + (dlPtr->height - ascent - descent)/2;
+ }
+ sValuePtr = dlPtr->chunkPtr->stylePtr->sValuePtr;
+ if (dlPtr->index.charIndex == 0) {
+ dlPtr->spaceAbove = sValuePtr->spacing1;
+ } else {
+ dlPtr->spaceAbove = sValuePtr->spacing2 - sValuePtr->spacing2/2;
+ }
+ if (wholeLine) {
+ dlPtr->spaceBelow = sValuePtr->spacing3;
+ } else {
+ dlPtr->spaceBelow = sValuePtr->spacing2/2;
+ }
+ dlPtr->height += dlPtr->spaceAbove + dlPtr->spaceBelow;
+ dlPtr->baseline += dlPtr->spaceAbove;
+
+ /*
+ * Recompute line length: may have changed because of justification.
+ */
+
+ dlPtr->length = lastChunkPtr->x + lastChunkPtr->width;
+ return dlPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateDisplayInfo --
+ *
+ * This procedure is invoked to recompute some or all of the
+ * DLine structures for a text widget. At the time it is called
+ * the DLine structures still left in the widget are guaranteed
+ * to be correct except that (a) the y-coordinates aren't
+ * necessarily correct, (b) there may be missing structures
+ * (the DLine structures get removed as soon as they are potentially
+ * out-of-date), and (c) DLine structures that don't start at the
+ * beginning of a line may be incorrect if previous information in
+ * the same line changed size in a way that moved a line boundary
+ * (DLines for any info that changed will have been deleted, but
+ * not DLines for unchanged info in the same text line).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Upon return, the DLine information for textPtr correctly reflects
+ * the positions where characters will be displayed. However, this
+ * procedure doesn't actually bring the display up-to-date.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateDisplayInfo(textPtr)
+ TkText *textPtr; /* Text widget to update. */
+{
+ register TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ register DLine *dlPtr, *prevPtr;
+ TkTextIndex index;
+ TkTextLine *lastLinePtr;
+ int y, maxY, pixelOffset, maxOffset;
+
+ if (!(dInfoPtr->flags & DINFO_OUT_OF_DATE)) {
+ return;
+ }
+ dInfoPtr->flags &= ~DINFO_OUT_OF_DATE;
+
+ /*
+ * Delete any DLines that are now above the top of the window.
+ */
+
+ index = textPtr->topIndex;
+ dlPtr = FindDLine(dInfoPtr->dLinePtr, &index);
+ if ((dlPtr != NULL) && (dlPtr != dInfoPtr->dLinePtr)) {
+ FreeDLines(textPtr, dInfoPtr->dLinePtr, dlPtr, 1);
+ }
+
+ /*
+ *--------------------------------------------------------------
+ * Scan through the contents of the window from top to bottom,
+ * recomputing information for lines that are missing.
+ *--------------------------------------------------------------
+ */
+
+ lastLinePtr = TkBTreeFindLine(textPtr->tree,
+ TkBTreeNumLines(textPtr->tree));
+ dlPtr = dInfoPtr->dLinePtr;
+ prevPtr = NULL;
+ y = dInfoPtr->y;
+ maxY = dInfoPtr->maxY;
+ while (1) {
+ register DLine *newPtr;
+
+ if (index.linePtr == lastLinePtr) {
+ break;
+ }
+
+ /*
+ * There are three possibilities right now:
+ * (a) the next DLine (dlPtr) corresponds exactly to the next
+ * information we want to display: just use it as-is.
+ * (b) the next DLine corresponds to a different line, or to
+ * a segment that will be coming later in the same line:
+ * leave this DLine alone in the hopes that we'll be able
+ * to use it later, then create a new DLine in front of
+ * it.
+ * (c) the next DLine corresponds to a segment in the line we
+ * want, but it's a segment that has already been processed
+ * or will never be processed. Delete the DLine and try
+ * again.
+ *
+ * One other twist on all this. It's possible for 3D borders
+ * to interact between lines (see DisplayLineBackground) so if
+ * a line is relayed out and has styles with 3D borders, its
+ * neighbors have to be redrawn if they have 3D borders too,
+ * since the interactions could have changed (the neighbors
+ * don't have to be relayed out, just redrawn).
+ */
+
+ if ((dlPtr == NULL) || (dlPtr->index.linePtr != index.linePtr)) {
+ /*
+ * Case (b) -- must make new DLine.
+ */
+
+ makeNewDLine:
+ if (tkTextDebug) {
+ char string[TK_POS_CHARS];
+
+ /*
+ * Debugging is enabled, so keep a log of all the lines
+ * that were re-layed out. The test suite uses this
+ * information.
+ */
+
+ TkTextPrintIndex(&index, string);
+ Tcl_SetVar2(textPtr->interp, "tk_textRelayout", (char *) NULL,
+ string,
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+ }
+ newPtr = LayoutDLine(textPtr, &index);
+ if (prevPtr == NULL) {
+ dInfoPtr->dLinePtr = newPtr;
+ } else {
+ prevPtr->nextPtr = newPtr;
+ if (prevPtr->flags & HAS_3D_BORDER) {
+ prevPtr->oldY = -1;
+ }
+ }
+ newPtr->nextPtr = dlPtr;
+ dlPtr = newPtr;
+ } else {
+ /*
+ * DlPtr refers to the line we want. Next check the
+ * index within the line.
+ */
+
+ if (index.charIndex == dlPtr->index.charIndex) {
+ /*
+ * Case (a) -- can use existing display line as-is.
+ */
+
+ if ((dlPtr->flags & HAS_3D_BORDER) && (prevPtr != NULL)
+ && (prevPtr->flags & (NEW_LAYOUT))) {
+ dlPtr->oldY = -1;
+ }
+ goto lineOK;
+ }
+ if (index.charIndex < dlPtr->index.charIndex) {
+ goto makeNewDLine;
+ }
+
+ /*
+ * Case (c) -- dlPtr is useless. Discard it and start
+ * again with the next display line.
+ */
+
+ newPtr = dlPtr->nextPtr;
+ FreeDLines(textPtr, dlPtr, newPtr, 0);
+ dlPtr = newPtr;
+ if (prevPtr != NULL) {
+ prevPtr->nextPtr = newPtr;
+ } else {
+ dInfoPtr->dLinePtr = newPtr;
+ }
+ continue;
+ }
+
+ /*
+ * Advance to the start of the next line.
+ */
+
+ lineOK:
+ dlPtr->y = y;
+ y += dlPtr->height;
+ TkTextIndexForwChars(&index, dlPtr->count, &index);
+ prevPtr = dlPtr;
+ dlPtr = dlPtr->nextPtr;
+
+ /*
+ * If we switched text lines, delete any DLines left for the
+ * old text line.
+ */
+
+ if (index.linePtr != prevPtr->index.linePtr) {
+ register DLine *nextPtr;
+
+ nextPtr = dlPtr;
+ while ((nextPtr != NULL)
+ && (nextPtr->index.linePtr == prevPtr->index.linePtr)) {
+ nextPtr = nextPtr->nextPtr;
+ }
+ if (nextPtr != dlPtr) {
+ FreeDLines(textPtr, dlPtr, nextPtr, 0);
+ prevPtr->nextPtr = nextPtr;
+ dlPtr = nextPtr;
+ }
+ }
+
+ /*
+ * It's important to have the following check here rather than in
+ * the while statement for the loop, so that there's always at least
+ * one DLine generated, regardless of how small the window is. This
+ * keeps a lot of other code from breaking.
+ */
+
+ if (y >= maxY) {
+ break;
+ }
+ }
+
+ /*
+ * Delete any DLine structures that don't fit on the screen.
+ */
+
+ FreeDLines(textPtr, dlPtr, (DLine *) NULL, 1);
+
+ /*
+ *--------------------------------------------------------------
+ * If there is extra space at the bottom of the window (because
+ * we've hit the end of the text), then bring in more lines at
+ * the top of the window, if there are any, to fill in the view.
+ *--------------------------------------------------------------
+ */
+
+ if (y < maxY) {
+ int lineNum, spaceLeft, charsToCount;
+ DLine *lowestPtr;
+
+ /*
+ * Layout an entire text line (potentially > 1 display line),
+ * then link in as many display lines as fit without moving
+ * the bottom line out of the window. Repeat this until
+ * all the extra space has been used up or we've reached the
+ * beginning of the text.
+ */
+
+ spaceLeft = maxY - y;
+ lineNum = TkBTreeLineIndex(dInfoPtr->dLinePtr->index.linePtr);
+ charsToCount = dInfoPtr->dLinePtr->index.charIndex;
+ if (charsToCount == 0) {
+ charsToCount = INT_MAX;
+ lineNum--;
+ }
+ for ( ; (lineNum >= 0) && (spaceLeft > 0); lineNum--) {
+ index.linePtr = TkBTreeFindLine(textPtr->tree, lineNum);
+ index.charIndex = 0;
+ lowestPtr = NULL;
+ do {
+ dlPtr = LayoutDLine(textPtr, &index);
+ dlPtr->nextPtr = lowestPtr;
+ lowestPtr = dlPtr;
+ TkTextIndexForwChars(&index, dlPtr->count, &index);
+ charsToCount -= dlPtr->count;
+ } while ((charsToCount > 0)
+ && (index.linePtr == lowestPtr->index.linePtr));
+
+ /*
+ * Scan through the display lines from the bottom one up to
+ * the top one.
+ */
+
+ while (lowestPtr != NULL) {
+ dlPtr = lowestPtr;
+ spaceLeft -= dlPtr->height;
+ if (spaceLeft < 0) {
+ break;
+ }
+ lowestPtr = dlPtr->nextPtr;
+ dlPtr->nextPtr = dInfoPtr->dLinePtr;
+ dInfoPtr->dLinePtr = dlPtr;
+ if (tkTextDebug) {
+ char string[TK_POS_CHARS];
+
+ TkTextPrintIndex(&dlPtr->index, string);
+ Tcl_SetVar2(textPtr->interp, "tk_textRelayout",
+ (char *) NULL, string,
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+ }
+ }
+ FreeDLines(textPtr, lowestPtr, (DLine *) NULL, 0);
+ charsToCount = INT_MAX;
+ }
+
+ /*
+ * Now we're all done except that the y-coordinates in all the
+ * DLines are wrong and the top index for the text is wrong.
+ * Update them.
+ */
+
+ textPtr->topIndex = dInfoPtr->dLinePtr->index;
+ y = dInfoPtr->y;
+ for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL;
+ dlPtr = dlPtr->nextPtr) {
+ if (y > dInfoPtr->maxY) {
+ panic("Added too many new lines in UpdateDisplayInfo");
+ }
+ dlPtr->y = y;
+ y += dlPtr->height;
+ }
+ }
+
+ /*
+ *--------------------------------------------------------------
+ * If the old top or bottom line has scrolled elsewhere on the
+ * screen, we may not be able to re-use its old contents by
+ * copying bits (e.g., a beveled edge that was drawn when it was
+ * at the top or bottom won't be drawn when the line is in the
+ * middle and its neighbor has a matching background). Similarly,
+ * if the new top or bottom line came from somewhere else on the
+ * screen, we may not be able to copy the old bits.
+ *--------------------------------------------------------------
+ */
+
+ dlPtr = dInfoPtr->dLinePtr;
+ if ((dlPtr->flags & HAS_3D_BORDER) && !(dlPtr->flags & TOP_LINE)) {
+ dlPtr->oldY = -1;
+ }
+ while (1) {
+ if ((dlPtr->flags & TOP_LINE) && (dlPtr != dInfoPtr->dLinePtr)
+ && (dlPtr->flags & HAS_3D_BORDER)) {
+ dlPtr->oldY = -1;
+ }
+ if ((dlPtr->flags & BOTTOM_LINE) && (dlPtr->nextPtr != NULL)
+ && (dlPtr->flags & HAS_3D_BORDER)) {
+ dlPtr->oldY = -1;
+ }
+ if (dlPtr->nextPtr == NULL) {
+ if ((dlPtr->flags & HAS_3D_BORDER)
+ && !(dlPtr->flags & BOTTOM_LINE)) {
+ dlPtr->oldY = -1;
+ }
+ dlPtr->flags &= ~TOP_LINE;
+ dlPtr->flags |= BOTTOM_LINE;
+ break;
+ }
+ dlPtr->flags &= ~(TOP_LINE|BOTTOM_LINE);
+ dlPtr = dlPtr->nextPtr;
+ }
+ dInfoPtr->dLinePtr->flags |= TOP_LINE;
+
+ /*
+ * Arrange for scrollbars to be updated.
+ */
+
+ textPtr->flags |= UPDATE_SCROLLBARS;
+
+ /*
+ *--------------------------------------------------------------
+ * Deal with horizontal scrolling:
+ * 1. If there's empty space to the right of the longest line,
+ * shift the screen to the right to fill in the empty space.
+ * 2. If the desired horizontal scroll position has changed,
+ * force a full redisplay of all the lines in the widget.
+ * 3. If the wrap mode isn't "none" then re-scroll to the base
+ * position.
+ *--------------------------------------------------------------
+ */
+
+ dInfoPtr->maxLength = 0;
+ for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL;
+ dlPtr = dlPtr->nextPtr) {
+ if (dlPtr->length > dInfoPtr->maxLength) {
+ dInfoPtr->maxLength = dlPtr->length;
+ }
+ }
+ maxOffset = (dInfoPtr->maxLength - (dInfoPtr->maxX - dInfoPtr->x)
+ + textPtr->charWidth - 1)/textPtr->charWidth;
+ if (dInfoPtr->newCharOffset > maxOffset) {
+ dInfoPtr->newCharOffset = maxOffset;
+ }
+ if (dInfoPtr->newCharOffset < 0) {
+ dInfoPtr->newCharOffset = 0;
+ }
+ pixelOffset = dInfoPtr->newCharOffset * textPtr->charWidth;
+ if (pixelOffset != dInfoPtr->curPixelOffset) {
+ dInfoPtr->curPixelOffset = pixelOffset;
+ for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL;
+ dlPtr = dlPtr->nextPtr) {
+ dlPtr->oldY = -1;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeDLines --
+ *
+ * This procedure is called to free up all of the resources
+ * associated with one or more DLine structures.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory gets freed and various other resources are released.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeDLines(textPtr, firstPtr, lastPtr, unlink)
+ TkText *textPtr; /* Information about overall text
+ * widget. */
+ register DLine *firstPtr; /* Pointer to first DLine to free up. */
+ DLine *lastPtr; /* Pointer to DLine just after last
+ * one to free (NULL means everything
+ * starting with firstPtr). */
+ int unlink; /* 1 means DLines are currently linked
+ * into the list rooted at
+ * textPtr->dInfoPtr->dLinePtr and
+ * they have to be unlinked. 0 means
+ * just free without unlinking. */
+{
+ register TkTextDispChunk *chunkPtr, *nextChunkPtr;
+ register DLine *nextDLinePtr;
+
+ if (unlink) {
+ if (textPtr->dInfoPtr->dLinePtr == firstPtr) {
+ textPtr->dInfoPtr->dLinePtr = lastPtr;
+ } else {
+ register DLine *prevPtr;
+ for (prevPtr = textPtr->dInfoPtr->dLinePtr;
+ prevPtr->nextPtr != firstPtr; prevPtr = prevPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ prevPtr->nextPtr = lastPtr;
+ }
+ }
+ while (firstPtr != lastPtr) {
+ nextDLinePtr = firstPtr->nextPtr;
+ for (chunkPtr = firstPtr->chunkPtr; chunkPtr != NULL;
+ chunkPtr = nextChunkPtr) {
+ if (chunkPtr->undisplayProc != NULL) {
+ (*chunkPtr->undisplayProc)(textPtr, chunkPtr);
+ }
+ FreeStyle(textPtr, chunkPtr->stylePtr);
+ nextChunkPtr = chunkPtr->nextPtr;
+ ckfree((char *) chunkPtr);
+ }
+ ckfree((char *) firstPtr);
+ firstPtr = nextDLinePtr;
+ }
+ textPtr->dInfoPtr->dLinesInvalidated = 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplayDLine --
+ *
+ * This procedure is invoked to draw a single line on the
+ * screen.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The line given by dlPtr is drawn at its correct position in
+ * textPtr's window. Note that this is one *display* line, not
+ * one *text* line.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplayDLine(textPtr, dlPtr, prevPtr, pixmap)
+ TkText *textPtr; /* Text widget in which to draw line. */
+ register DLine *dlPtr; /* Information about line to draw. */
+ DLine *prevPtr; /* Line just before one to draw, or NULL
+ * if dlPtr is the top line. */
+ Pixmap pixmap; /* Pixmap to use for double-buffering.
+ * Caller must make sure it's large enough
+ * to hold line. */
+{
+ register TkTextDispChunk *chunkPtr;
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ Display *display;
+ int height, x;
+
+ /*
+ * First, clear the area of the line to the background color for the
+ * text widget.
+ */
+
+ display = Tk_Display(textPtr->tkwin);
+ Tk_Fill3DRectangle(textPtr->tkwin, pixmap, textPtr->border, 0, 0,
+ Tk_Width(textPtr->tkwin), dlPtr->height, 0, TK_RELIEF_FLAT);
+
+ /*
+ * Next, draw background information for the whole line.
+ */
+
+ DisplayLineBackground(textPtr, dlPtr, prevPtr, pixmap);
+
+ /*
+ * Make another pass through all of the chunks to redraw the
+ * insertion cursor, if it is visible on this line. Must do
+ * it here rather than in the foreground pass below because
+ * otherwise a wide insertion cursor will obscure the character
+ * to its left.
+ */
+
+ if (textPtr->state == tkNormalUid) {
+ for (chunkPtr = dlPtr->chunkPtr; (chunkPtr != NULL);
+ chunkPtr = chunkPtr->nextPtr) {
+ x = chunkPtr->x + dInfoPtr->x - dInfoPtr->curPixelOffset;
+ if (chunkPtr->displayProc == TkTextInsertDisplayProc) {
+ (*chunkPtr->displayProc)(chunkPtr, x, dlPtr->spaceAbove,
+ dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow,
+ dlPtr->baseline - dlPtr->spaceAbove, display, pixmap,
+ dlPtr->y + dlPtr->spaceAbove);
+ }
+ }
+ }
+
+ /*
+ * Make yet another pass through all of the chunks to redraw all of
+ * foreground information. Note: we have to call the displayProc
+ * even for chunks that are off-screen. This is needed, for
+ * example, so that embedded windows can be unmapped in this case.
+ * Conve
+ */
+
+ for (chunkPtr = dlPtr->chunkPtr; (chunkPtr != NULL);
+ chunkPtr = chunkPtr->nextPtr) {
+ if (chunkPtr->displayProc == TkTextInsertDisplayProc) {
+ /*
+ * Already displayed the insertion cursor above. Don't
+ * do it again here.
+ */
+
+ continue;
+ }
+ x = chunkPtr->x + dInfoPtr->x - dInfoPtr->curPixelOffset;
+ if ((x + chunkPtr->width <= 0) || (x >= dInfoPtr->maxX)) {
+ /*
+ * Note: we have to call the displayProc even for chunks
+ * that are off-screen. This is needed, for example, so
+ * that embedded windows can be unmapped in this case.
+ * Display the chunk at a coordinate that can be clearly
+ * identified by the displayProc as being off-screen to
+ * the left (the displayProc may not be able to tell if
+ * something is off to the right).
+ */
+
+ (*chunkPtr->displayProc)(chunkPtr, -chunkPtr->width,
+ dlPtr->spaceAbove,
+ dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow,
+ dlPtr->baseline - dlPtr->spaceAbove, display, pixmap,
+ dlPtr->y + dlPtr->spaceAbove);
+ } else {
+ (*chunkPtr->displayProc)(chunkPtr, x, dlPtr->spaceAbove,
+ dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow,
+ dlPtr->baseline - dlPtr->spaceAbove, display, pixmap,
+ dlPtr->y + dlPtr->spaceAbove);
+ }
+ if (dInfoPtr->dLinesInvalidated) {
+ return;
+ }
+ }
+
+ /*
+ * Copy the pixmap onto the screen. If this is the last line on
+ * the screen then copy a piece of the line, so that it doesn't
+ * overflow into the border area. Another special trick: copy the
+ * padding area to the left of the line; this is because the
+ * insertion cursor sometimes overflows onto that area and we want
+ * to get as much of the cursor as possible.
+ */
+
+ height = dlPtr->height;
+ if ((height + dlPtr->y) > dInfoPtr->maxY) {
+ height = dInfoPtr->maxY - dlPtr->y;
+ }
+ XCopyArea(display, pixmap, Tk_WindowId(textPtr->tkwin), dInfoPtr->copyGC,
+ dInfoPtr->x, 0, (unsigned) (dInfoPtr->maxX - dInfoPtr->x),
+ (unsigned) height, dInfoPtr->x, dlPtr->y);
+ linesRedrawn++;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayLineBackground --
+ *
+ * This procedure is called to fill in the background for
+ * a display line. It draws 3D borders cleverly so that
+ * adjacent chunks with the same style (whether on the same
+ * line or different lines) have a single 3D border around
+ * the whole region.
+ *
+ * Results:
+ * There is no return value. Pixmap is filled in with background
+ * information for dlPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayLineBackground(textPtr, dlPtr, prevPtr, pixmap)
+ TkText *textPtr; /* Text widget containing line. */
+ register DLine *dlPtr; /* Information about line to draw. */
+ DLine *prevPtr; /* Line just above dlPtr, or NULL if dlPtr
+ * is the top-most line in the window. */
+ Pixmap pixmap; /* Pixmap to use for double-buffering.
+ * Caller must make sure it's large enough
+ * to hold line. Caller must also have
+ * filled it with the background color for
+ * the widget. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ TkTextDispChunk *chunkPtr; /* Pointer to chunk in the current line. */
+ TkTextDispChunk *chunkPtr2; /* Pointer to chunk in the line above or
+ * below the current one. NULL if we're to
+ * the left of or to the right of the chunks
+ * in the line. */
+ TkTextDispChunk *nextPtr2; /* Next chunk after chunkPtr2 (it's not the
+ * same as chunkPtr2->nextPtr in the case
+ * where chunkPtr2 is NULL because the line
+ * is indented). */
+ int leftX; /* The left edge of the region we're
+ * currently working on. */
+ int leftXIn; /* 1 means beveled edge at leftX slopes right
+ * as it goes down, 0 means it slopes left
+ * as it goes down. */
+ int rightX; /* Right edge of chunkPtr. */
+ int rightX2; /* Right edge of chunkPtr2. */
+ int matchLeft; /* Does the style of this line match that
+ * of its neighbor just to the left of
+ * the current x coordinate? */
+ int matchRight; /* Does line's style match its neighbor
+ * just to the right of the current x-coord? */
+ int minX, maxX, xOffset;
+ StyleValues *sValuePtr;
+ Display *display;
+
+ /*
+ * Pass 1: scan through dlPtr from left to right. For each range of
+ * chunks with the same style, draw the main background for the style
+ * plus the vertical parts of the 3D borders (the left and right
+ * edges).
+ */
+
+ display = Tk_Display(textPtr->tkwin);
+ minX = dInfoPtr->curPixelOffset;
+ xOffset = dInfoPtr->x - minX;
+ maxX = minX + dInfoPtr->maxX - dInfoPtr->x;
+ chunkPtr = dlPtr->chunkPtr;
+
+ /*
+ * Note A: in the following statement, and a few others later in
+ * this file marked with "See Note A above", the right side of the
+ * assignment was replaced with 0 on 6/18/97. This has the effect
+ * of highlighting the empty space to the left of a line whenever
+ * the leftmost character of the line is highlighted. This way,
+ * multi-line highlights always line up along their left edges.
+ * However, this may look funny in the case where a single word is
+ * highlighted. To undo the change, replace "leftX = 0" with "leftX
+ * = chunkPtr->x" and "rightX2 = 0" with "rightX2 = nextPtr2->x"
+ * here and at all the marked points below. This restores the old
+ * behavior where empty space to the left of a line is not
+ * highlighted, leaving a ragged left edge for multi-line
+ * highlights.
+ */
+
+ leftX = 0;
+ for (; leftX < maxX; chunkPtr = chunkPtr->nextPtr) {
+ if ((chunkPtr->nextPtr != NULL)
+ && SAME_BACKGROUND(chunkPtr->nextPtr->stylePtr,
+ chunkPtr->stylePtr)) {
+ continue;
+ }
+ sValuePtr = chunkPtr->stylePtr->sValuePtr;
+ rightX = chunkPtr->x + chunkPtr->width;
+ if ((chunkPtr->nextPtr == NULL) && (rightX < maxX)) {
+ rightX = maxX;
+ }
+ if (chunkPtr->stylePtr->bgGC != None) {
+ XFillRectangle(display, pixmap, chunkPtr->stylePtr->bgGC,
+ leftX + xOffset, 0, (unsigned int) (rightX - leftX),
+ (unsigned int) dlPtr->height);
+ if (sValuePtr->relief != TK_RELIEF_FLAT) {
+ Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ leftX + xOffset, 0, sValuePtr->borderWidth,
+ dlPtr->height, 1, sValuePtr->relief);
+ Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ rightX - sValuePtr->borderWidth + xOffset,
+ 0, sValuePtr->borderWidth, dlPtr->height, 0,
+ sValuePtr->relief);
+ }
+ }
+ leftX = rightX;
+ }
+
+ /*
+ * Pass 2: draw the horizontal bevels along the top of the line. To
+ * do this, scan through dlPtr from left to right while simultaneously
+ * scanning through the line just above dlPtr. ChunkPtr2 and nextPtr2
+ * refer to two adjacent chunks in the line above.
+ */
+
+ chunkPtr = dlPtr->chunkPtr;
+ leftX = 0; /* See Note A above. */
+ leftXIn = 1;
+ rightX = chunkPtr->x + chunkPtr->width;
+ if ((chunkPtr->nextPtr == NULL) && (rightX < maxX)) {
+ rightX = maxX;
+ }
+ chunkPtr2 = NULL;
+ if (prevPtr != NULL) {
+ /*
+ * Find the chunk in the previous line that covers leftX.
+ */
+
+ nextPtr2 = prevPtr->chunkPtr;
+ rightX2 = 0; /* See Note A above. */
+ while (rightX2 <= leftX) {
+ chunkPtr2 = nextPtr2;
+ if (chunkPtr2 == NULL) {
+ break;
+ }
+ nextPtr2 = chunkPtr2->nextPtr;
+ rightX2 = chunkPtr2->x + chunkPtr2->width;
+ if (nextPtr2 == NULL) {
+ rightX2 = INT_MAX;
+ }
+ }
+ } else {
+ nextPtr2 = NULL;
+ rightX2 = INT_MAX;
+ }
+
+ while (leftX < maxX) {
+ matchLeft = (chunkPtr2 != NULL)
+ && SAME_BACKGROUND(chunkPtr2->stylePtr, chunkPtr->stylePtr);
+ sValuePtr = chunkPtr->stylePtr->sValuePtr;
+ if (rightX <= rightX2) {
+ /*
+ * The chunk in our line is about to end. If its style
+ * changes then draw the bevel for the current style.
+ */
+
+ if ((chunkPtr->nextPtr == NULL)
+ || !SAME_BACKGROUND(chunkPtr->stylePtr,
+ chunkPtr->nextPtr->stylePtr)) {
+ if (!matchLeft && (sValuePtr->relief != TK_RELIEF_FLAT)) {
+ Tk_3DHorizontalBevel(textPtr->tkwin, pixmap,
+ sValuePtr->border, leftX + xOffset, 0,
+ rightX - leftX, sValuePtr->borderWidth, leftXIn,
+ 1, 1, sValuePtr->relief);
+ }
+ leftX = rightX;
+ leftXIn = 1;
+
+ /*
+ * If the chunk in the line above is also ending at
+ * the same point then advance to the next chunk in
+ * that line.
+ */
+
+ if ((rightX == rightX2) && (chunkPtr2 != NULL)) {
+ goto nextChunk2;
+ }
+ }
+ chunkPtr = chunkPtr->nextPtr;
+ if (chunkPtr == NULL) {
+ break;
+ }
+ rightX = chunkPtr->x + chunkPtr->width;
+ if ((chunkPtr->nextPtr == NULL) && (rightX < maxX)) {
+ rightX = maxX;
+ }
+ continue;
+ }
+
+ /*
+ * The chunk in the line above is ending at an x-position where
+ * there is no change in the style of the current line. If the
+ * style above matches the current line on one side of the change
+ * but not on the other, we have to draw an L-shaped piece of
+ * bevel.
+ */
+
+ matchRight = (nextPtr2 != NULL)
+ && SAME_BACKGROUND(nextPtr2->stylePtr, chunkPtr->stylePtr);
+ if (matchLeft && !matchRight) {
+ if (sValuePtr->relief != TK_RELIEF_FLAT) {
+ Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ rightX2 - sValuePtr->borderWidth + xOffset, 0,
+ sValuePtr->borderWidth, sValuePtr->borderWidth, 0,
+ sValuePtr->relief);
+ }
+ leftX = rightX2 - sValuePtr->borderWidth;
+ leftXIn = 0;
+ } else if (!matchLeft && matchRight
+ && (sValuePtr->relief != TK_RELIEF_FLAT)) {
+ Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ rightX2 + xOffset, 0, sValuePtr->borderWidth,
+ sValuePtr->borderWidth, 1, sValuePtr->relief);
+ Tk_3DHorizontalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ leftX + xOffset, 0, rightX2 + sValuePtr->borderWidth -leftX,
+ sValuePtr->borderWidth, leftXIn, 0, 1,
+ sValuePtr->relief);
+ }
+
+ nextChunk2:
+ chunkPtr2 = nextPtr2;
+ if (chunkPtr2 == NULL) {
+ rightX2 = INT_MAX;
+ } else {
+ nextPtr2 = chunkPtr2->nextPtr;
+ rightX2 = chunkPtr2->x + chunkPtr2->width;
+ if (nextPtr2 == NULL) {
+ rightX2 = INT_MAX;
+ }
+ }
+ }
+ /*
+ * Pass 3: draw the horizontal bevels along the bottom of the line.
+ * This uses the same approach as pass 2.
+ */
+
+ chunkPtr = dlPtr->chunkPtr;
+ leftX = 0; /* See Note A above. */
+ leftXIn = 0;
+ rightX = chunkPtr->x + chunkPtr->width;
+ if ((chunkPtr->nextPtr == NULL) && (rightX < maxX)) {
+ rightX = maxX;
+ }
+ chunkPtr2 = NULL;
+ if (dlPtr->nextPtr != NULL) {
+ /*
+ * Find the chunk in the previous line that covers leftX.
+ */
+
+ nextPtr2 = dlPtr->nextPtr->chunkPtr;
+ rightX2 = 0; /* See Note A above. */
+ while (rightX2 <= leftX) {
+ chunkPtr2 = nextPtr2;
+ if (chunkPtr2 == NULL) {
+ break;
+ }
+ nextPtr2 = chunkPtr2->nextPtr;
+ rightX2 = chunkPtr2->x + chunkPtr2->width;
+ if (nextPtr2 == NULL) {
+ rightX2 = INT_MAX;
+ }
+ }
+ } else {
+ nextPtr2 = NULL;
+ rightX2 = INT_MAX;
+ }
+
+ while (leftX < maxX) {
+ matchLeft = (chunkPtr2 != NULL)
+ && SAME_BACKGROUND(chunkPtr2->stylePtr, chunkPtr->stylePtr);
+ sValuePtr = chunkPtr->stylePtr->sValuePtr;
+ if (rightX <= rightX2) {
+ if ((chunkPtr->nextPtr == NULL)
+ || !SAME_BACKGROUND(chunkPtr->stylePtr,
+ chunkPtr->nextPtr->stylePtr)) {
+ if (!matchLeft && (sValuePtr->relief != TK_RELIEF_FLAT)) {
+ Tk_3DHorizontalBevel(textPtr->tkwin, pixmap,
+ sValuePtr->border, leftX + xOffset,
+ dlPtr->height - sValuePtr->borderWidth,
+ rightX - leftX, sValuePtr->borderWidth, leftXIn,
+ 0, 0, sValuePtr->relief);
+ }
+ leftX = rightX;
+ leftXIn = 0;
+ if ((rightX == rightX2) && (chunkPtr2 != NULL)) {
+ goto nextChunk2b;
+ }
+ }
+ chunkPtr = chunkPtr->nextPtr;
+ if (chunkPtr == NULL) {
+ break;
+ }
+ rightX = chunkPtr->x + chunkPtr->width;
+ if ((chunkPtr->nextPtr == NULL) && (rightX < maxX)) {
+ rightX = maxX;
+ }
+ continue;
+ }
+
+ matchRight = (nextPtr2 != NULL)
+ && SAME_BACKGROUND(nextPtr2->stylePtr, chunkPtr->stylePtr);
+ if (matchLeft && !matchRight) {
+ if (sValuePtr->relief != TK_RELIEF_FLAT) {
+ Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ rightX2 - sValuePtr->borderWidth + xOffset,
+ dlPtr->height - sValuePtr->borderWidth,
+ sValuePtr->borderWidth, sValuePtr->borderWidth, 0,
+ sValuePtr->relief);
+ }
+ leftX = rightX2 - sValuePtr->borderWidth;
+ leftXIn = 1;
+ } else if (!matchLeft && matchRight
+ && (sValuePtr->relief != TK_RELIEF_FLAT)) {
+ Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ rightX2 + xOffset, dlPtr->height - sValuePtr->borderWidth,
+ sValuePtr->borderWidth, sValuePtr->borderWidth,
+ 1, sValuePtr->relief);
+ Tk_3DHorizontalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ leftX + xOffset, dlPtr->height - sValuePtr->borderWidth,
+ rightX2 + sValuePtr->borderWidth - leftX,
+ sValuePtr->borderWidth, leftXIn, 1, 0, sValuePtr->relief);
+ }
+
+ nextChunk2b:
+ chunkPtr2 = nextPtr2;
+ if (chunkPtr2 == NULL) {
+ rightX2 = INT_MAX;
+ } else {
+ nextPtr2 = chunkPtr2->nextPtr;
+ rightX2 = chunkPtr2->x + chunkPtr2->width;
+ if (nextPtr2 == NULL) {
+ rightX2 = INT_MAX;
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplayText --
+ *
+ * This procedure is invoked as a when-idle handler to update the
+ * display. It only redisplays the parts of the text widget that
+ * are out of date.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information is redrawn on the screen.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplayText(clientData)
+ ClientData clientData; /* Information about widget. */
+{
+ register TkText *textPtr = (TkText *) clientData;
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ Tk_Window tkwin;
+ register DLine *dlPtr;
+ DLine *prevPtr;
+ Pixmap pixmap;
+ int maxHeight, borders;
+ int bottomY = 0; /* Initialization needed only to stop
+ * compiler warnings. */
+ Tcl_Interp *interp;
+
+ if (textPtr->tkwin == NULL) {
+
+ /*
+ * The widget has been deleted. Don't do anything.
+ */
+
+ return;
+ }
+
+ interp = textPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+
+ if (tkTextDebug) {
+ Tcl_SetVar2(interp, "tk_textRelayout", (char *) NULL, "",
+ TCL_GLOBAL_ONLY);
+ }
+
+ if (textPtr->tkwin == NULL) {
+
+ /*
+ * The widget has been deleted. Don't do anything.
+ */
+
+ goto end;
+ }
+
+ if (!Tk_IsMapped(textPtr->tkwin) || (dInfoPtr->maxX <= dInfoPtr->x)
+ || (dInfoPtr->maxY <= dInfoPtr->y)) {
+ UpdateDisplayInfo(textPtr);
+ dInfoPtr->flags &= ~REDRAW_PENDING;
+ goto doScrollbars;
+ }
+ numRedisplays++;
+ if (tkTextDebug) {
+ Tcl_SetVar2(interp, "tk_textRedraw", (char *) NULL, "",
+ TCL_GLOBAL_ONLY);
+ }
+
+ if (textPtr->tkwin == NULL) {
+
+ /*
+ * The widget has been deleted. Don't do anything.
+ */
+
+ goto end;
+ }
+
+ /*
+ * Choose a new current item if that is needed (this could cause
+ * event handlers to be invoked, hence the preserve/release calls
+ * and the loop, since the handlers could conceivably necessitate
+ * yet another current item calculation). The tkwin check is because
+ * the whole window could go away in the Tcl_Release call.
+ */
+
+ while (dInfoPtr->flags & REPICK_NEEDED) {
+ Tcl_Preserve((ClientData) textPtr);
+ dInfoPtr->flags &= ~REPICK_NEEDED;
+ TkTextPickCurrent(textPtr, &textPtr->pickEvent);
+ tkwin = textPtr->tkwin;
+ Tcl_Release((ClientData) textPtr);
+ if (tkwin == NULL) {
+ goto end;
+ }
+ }
+
+ /*
+ * First recompute what's supposed to be displayed.
+ */
+
+ UpdateDisplayInfo(textPtr);
+ dInfoPtr->dLinesInvalidated = 0;
+
+ /*
+ * See if it's possible to bring some parts of the screen up-to-date
+ * by scrolling (copying from other parts of the screen).
+ */
+
+ for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL; dlPtr = dlPtr->nextPtr) {
+ register DLine *dlPtr2;
+ int offset, height, y, oldY;
+ TkRegion damageRgn;
+
+ if ((dlPtr->oldY == -1) || (dlPtr->y == dlPtr->oldY)
+ || ((dlPtr->oldY + dlPtr->height) > dInfoPtr->maxY)) {
+ continue;
+ }
+
+ /*
+ * This line is already drawn somewhere in the window so it only
+ * needs to be copied to its new location. See if there's a group
+ * of lines that can all be copied together.
+ */
+
+ offset = dlPtr->y - dlPtr->oldY;
+ height = dlPtr->height;
+ y = dlPtr->y;
+ for (dlPtr2 = dlPtr->nextPtr; dlPtr2 != NULL;
+ dlPtr2 = dlPtr2->nextPtr) {
+ if ((dlPtr2->oldY == -1)
+ || ((dlPtr2->oldY + offset) != dlPtr2->y)
+ || ((dlPtr2->oldY + dlPtr2->height) > dInfoPtr->maxY)) {
+ break;
+ }
+ height += dlPtr2->height;
+ }
+
+ /*
+ * Reduce the height of the area being copied if necessary to
+ * avoid overwriting the border area.
+ */
+
+ if ((y + height) > dInfoPtr->maxY) {
+ height = dInfoPtr->maxY -y;
+ }
+ oldY = dlPtr->oldY;
+
+ /*
+ * Update the lines we are going to scroll to show that they
+ * have been copied.
+ */
+
+ while (1) {
+ dlPtr->oldY = dlPtr->y;
+ if (dlPtr->nextPtr == dlPtr2) {
+ break;
+ }
+ dlPtr = dlPtr->nextPtr;
+ }
+
+ /*
+ * Scan through the lines following the copied ones to see if
+ * we are going to overwrite them with the copy operation.
+ * If so, mark them for redisplay.
+ */
+
+ for ( ; dlPtr2 != NULL; dlPtr2 = dlPtr2->nextPtr) {
+ if ((dlPtr2->oldY != -1)
+ && ((dlPtr2->oldY + dlPtr2->height) > y)
+ && (dlPtr2->oldY < (y + height))) {
+ dlPtr2->oldY = -1;
+ }
+ }
+
+ /*
+ * Now scroll the lines. This may generate damage which we
+ * handle by calling TextInvalidateRegion to mark the display
+ * blocks as stale.
+ */
+
+ damageRgn = TkCreateRegion();
+ if (TkScrollWindow(textPtr->tkwin, dInfoPtr->scrollGC,
+ dInfoPtr->x, oldY,
+ (dInfoPtr->maxX - dInfoPtr->x), height,
+ 0, y - oldY, damageRgn)) {
+ TextInvalidateRegion(textPtr, damageRgn);
+ }
+ numCopies++;
+ TkDestroyRegion(damageRgn);
+ }
+
+ /*
+ * Clear the REDRAW_PENDING flag here. This is actually pretty
+ * tricky. We want to wait until *after* doing the scrolling,
+ * since that could generate more areas to redraw and don't
+ * want to reschedule a redisplay for them. On the other hand,
+ * we can't wait until after all the redisplaying, because the
+ * act of redisplaying could actually generate more redisplays
+ * (e.g. in the case of a nested window with event bindings triggered
+ * by redisplay).
+ */
+
+ dInfoPtr->flags &= ~REDRAW_PENDING;
+
+ /*
+ * Redraw the borders if that's needed.
+ */
+
+ if (dInfoPtr->flags & REDRAW_BORDERS) {
+ if (tkTextDebug) {
+ Tcl_SetVar2(interp, "tk_textRedraw", (char *) NULL, "borders",
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+ }
+
+ if (textPtr->tkwin == NULL) {
+
+ /*
+ * The widget has been deleted. Don't do anything.
+ */
+
+ goto end;
+ }
+
+ Tk_Draw3DRectangle(textPtr->tkwin, Tk_WindowId(textPtr->tkwin),
+ textPtr->border, textPtr->highlightWidth,
+ textPtr->highlightWidth,
+ Tk_Width(textPtr->tkwin) - 2*textPtr->highlightWidth,
+ Tk_Height(textPtr->tkwin) - 2*textPtr->highlightWidth,
+ textPtr->borderWidth, textPtr->relief);
+ if (textPtr->highlightWidth != 0) {
+ GC gc;
+
+ if (textPtr->flags & GOT_FOCUS) {
+ gc = Tk_GCForColor(textPtr->highlightColorPtr,
+ Tk_WindowId(textPtr->tkwin));
+ } else {
+ gc = Tk_GCForColor(textPtr->highlightBgColorPtr,
+ Tk_WindowId(textPtr->tkwin));
+ }
+ Tk_DrawFocusHighlight(textPtr->tkwin, gc, textPtr->highlightWidth,
+ Tk_WindowId(textPtr->tkwin));
+ }
+ borders = textPtr->borderWidth + textPtr->highlightWidth;
+ if (textPtr->padY > 0) {
+ Tk_Fill3DRectangle(textPtr->tkwin, Tk_WindowId(textPtr->tkwin),
+ textPtr->border, borders, borders,
+ Tk_Width(textPtr->tkwin) - 2*borders, textPtr->padY,
+ 0, TK_RELIEF_FLAT);
+ Tk_Fill3DRectangle(textPtr->tkwin, Tk_WindowId(textPtr->tkwin),
+ textPtr->border, borders,
+ Tk_Height(textPtr->tkwin) - borders - textPtr->padY,
+ Tk_Width(textPtr->tkwin) - 2*borders,
+ textPtr->padY, 0, TK_RELIEF_FLAT);
+ }
+ if (textPtr->padX > 0) {
+ Tk_Fill3DRectangle(textPtr->tkwin, Tk_WindowId(textPtr->tkwin),
+ textPtr->border, borders, borders + textPtr->padY,
+ textPtr->padX,
+ Tk_Height(textPtr->tkwin) - 2*borders -2*textPtr->padY,
+ 0, TK_RELIEF_FLAT);
+ Tk_Fill3DRectangle(textPtr->tkwin, Tk_WindowId(textPtr->tkwin),
+ textPtr->border,
+ Tk_Width(textPtr->tkwin) - borders - textPtr->padX,
+ borders + textPtr->padY, textPtr->padX,
+ Tk_Height(textPtr->tkwin) - 2*borders -2*textPtr->padY,
+ 0, TK_RELIEF_FLAT);
+ }
+ dInfoPtr->flags &= ~REDRAW_BORDERS;
+ }
+
+ /*
+ * Now we have to redraw the lines that couldn't be updated by
+ * scrolling. First, compute the height of the largest line and
+ * allocate an off-screen pixmap to use for double-buffered
+ * displays.
+ */
+
+ maxHeight = -1;
+ for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL;
+ dlPtr = dlPtr->nextPtr) {
+ if ((dlPtr->height > maxHeight) && (dlPtr->oldY != dlPtr->y)) {
+ maxHeight = dlPtr->height;
+ }
+ bottomY = dlPtr->y + dlPtr->height;
+ }
+ if (maxHeight > dInfoPtr->maxY) {
+ maxHeight = dInfoPtr->maxY;
+ }
+ if (maxHeight > 0) {
+ pixmap = Tk_GetPixmap(Tk_Display(textPtr->tkwin),
+ Tk_WindowId(textPtr->tkwin), Tk_Width(textPtr->tkwin),
+ maxHeight, Tk_Depth(textPtr->tkwin));
+ for (prevPtr = NULL, dlPtr = textPtr->dInfoPtr->dLinePtr;
+ (dlPtr != NULL) && (dlPtr->y < dInfoPtr->maxY);
+ prevPtr = dlPtr, dlPtr = dlPtr->nextPtr) {
+ if (dlPtr->oldY != dlPtr->y) {
+ if (tkTextDebug) {
+ char string[TK_POS_CHARS];
+ TkTextPrintIndex(&dlPtr->index, string);
+ Tcl_SetVar2(textPtr->interp, "tk_textRedraw",
+ (char *) NULL, string,
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+ }
+ DisplayDLine(textPtr, dlPtr, prevPtr, pixmap);
+ if (dInfoPtr->dLinesInvalidated) {
+ Tk_FreePixmap(Tk_Display(textPtr->tkwin), pixmap);
+ return;
+ }
+ dlPtr->oldY = dlPtr->y;
+ dlPtr->flags &= ~NEW_LAYOUT;
+ }
+ }
+ Tk_FreePixmap(Tk_Display(textPtr->tkwin), pixmap);
+ }
+
+ /*
+ * See if we need to refresh the part of the window below the
+ * last line of text (if there is any such area). Refresh the
+ * padding area on the left too, since the insertion cursor might
+ * have been displayed there previously).
+ */
+
+ if (dInfoPtr->topOfEof > dInfoPtr->maxY) {
+ dInfoPtr->topOfEof = dInfoPtr->maxY;
+ }
+ if (bottomY < dInfoPtr->topOfEof) {
+ if (tkTextDebug) {
+ Tcl_SetVar2(textPtr->interp, "tk_textRedraw",
+ (char *) NULL, "eof",
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+ }
+
+ if (textPtr->tkwin == NULL) {
+
+ /*
+ * The widget has been deleted. Don't do anything.
+ */
+
+ goto end;
+ }
+
+ Tk_Fill3DRectangle(textPtr->tkwin, Tk_WindowId(textPtr->tkwin),
+ textPtr->border, dInfoPtr->x - textPtr->padX, bottomY,
+ dInfoPtr->maxX - (dInfoPtr->x - textPtr->padX),
+ dInfoPtr->topOfEof-bottomY, 0, TK_RELIEF_FLAT);
+ }
+ dInfoPtr->topOfEof = bottomY;
+
+ doScrollbars:
+
+ /*
+ * Update the vertical scrollbar, if there is one. Note: it's
+ * important to clear REDRAW_PENDING here, just in case the
+ * scroll procedure does something that requires redisplay.
+ */
+
+ if (textPtr->flags & UPDATE_SCROLLBARS) {
+ textPtr->flags &= ~UPDATE_SCROLLBARS;
+ if (textPtr->yScrollCmd != NULL) {
+ GetYView(textPtr->interp, textPtr, 1);
+ }
+
+ if (textPtr->tkwin == NULL) {
+
+ /*
+ * The widget has been deleted. Don't do anything.
+ */
+
+ goto end;
+ }
+
+ /*
+ * Update the horizontal scrollbar, if any.
+ */
+
+ if (textPtr->xScrollCmd != NULL) {
+ GetXView(textPtr->interp, textPtr, 1);
+ }
+ }
+
+end:
+ Tcl_Release((ClientData) interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextEventuallyRepick --
+ *
+ * This procedure is invoked whenever something happens that
+ * could change the current character or the tags associated
+ * with it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A repick is scheduled as an idle handler.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+void
+TkTextEventuallyRepick(textPtr)
+ TkText *textPtr; /* Widget record for text widget. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+
+ dInfoPtr->flags |= REPICK_NEEDED;
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ dInfoPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextRedrawRegion --
+ *
+ * This procedure is invoked to schedule a redisplay for a given
+ * region of a text widget. The redisplay itself may not occur
+ * immediately: it's scheduled as a when-idle handler.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information will eventually be redrawn on the screen.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+void
+TkTextRedrawRegion(textPtr, x, y, width, height)
+ TkText *textPtr; /* Widget record for text widget. */
+ int x, y; /* Coordinates of upper-left corner of area
+ * to be redrawn, in pixels relative to
+ * textPtr's window. */
+ int width, height; /* Width and height of area to be redrawn. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ TkRegion damageRgn = TkCreateRegion();
+ XRectangle rect;
+
+ rect.x = x;
+ rect.y = y;
+ rect.width = width;
+ rect.height = height;
+ TkUnionRectWithRegion(&rect, damageRgn, damageRgn);
+
+ TextInvalidateRegion(textPtr, damageRgn);
+
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ dInfoPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
+ }
+ TkDestroyRegion(damageRgn);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextInvalidateRegion --
+ *
+ * Mark a region of text as invalid.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Updates the display information for the text widget.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TextInvalidateRegion(textPtr, region)
+ TkText *textPtr; /* Widget record for text widget. */
+ TkRegion region; /* Region of area to redraw. */
+{
+ register DLine *dlPtr;
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ int maxY, inset;
+ XRectangle rect;
+
+ /*
+ * Find all lines that overlap the given region and mark them for
+ * redisplay.
+ */
+
+ TkClipBox(region, &rect);
+ maxY = rect.y + rect.height;
+ for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL;
+ dlPtr = dlPtr->nextPtr) {
+ if ((dlPtr->oldY != -1) && (TkRectInRegion(region, rect.x, dlPtr->y,
+ rect.width, (unsigned int) dlPtr->height) != RectangleOut)) {
+ dlPtr->oldY = -1;
+ }
+ }
+ if (dInfoPtr->topOfEof < maxY) {
+ dInfoPtr->topOfEof = maxY;
+ }
+
+ /*
+ * Schedule the redisplay operation if there isn't one already
+ * scheduled.
+ */
+
+ inset = textPtr->borderWidth + textPtr->highlightWidth;
+ if ((rect.x < (inset + textPtr->padX))
+ || (rect.y < (inset + textPtr->padY))
+ || ((int) (rect.x + rect.width) > (Tk_Width(textPtr->tkwin)
+ - inset - textPtr->padX))
+ || (maxY > (Tk_Height(textPtr->tkwin) - inset - textPtr->padY))) {
+ dInfoPtr->flags |= REDRAW_BORDERS;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextChanged --
+ *
+ * This procedure is invoked when info in a text widget is about
+ * to be modified in a way that changes how it is displayed (e.g.
+ * characters were inserted or deleted, or tag information was
+ * changed). This procedure must be called *before* a change is
+ * made, so that indexes in the display information are still
+ * valid.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The range of character between index1Ptr (inclusive) and
+ * index2Ptr (exclusive) will be redisplayed at some point in the
+ * future (the actual redisplay is scheduled as a when-idle handler).
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextChanged(textPtr, index1Ptr, index2Ptr)
+ TkText *textPtr; /* Widget record for text widget. */
+ TkTextIndex *index1Ptr; /* Index of first character to redisplay. */
+ TkTextIndex *index2Ptr; /* Index of character just after last one
+ * to redisplay. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ DLine *firstPtr, *lastPtr;
+ TkTextIndex rounded;
+
+ /*
+ * Schedule both a redisplay and a recomputation of display information.
+ * It's done here rather than the end of the procedure for two reasons:
+ *
+ * 1. If there are no display lines to update we'll want to return
+ * immediately, well before the end of the procedure.
+ * 2. It's important to arrange for the redisplay BEFORE calling
+ * FreeDLines. The reason for this is subtle and has to do with
+ * embedded windows. The chunk delete procedure for an embedded
+ * window will schedule an idle handler to unmap the window.
+ * However, we want the idle handler for redisplay to be called
+ * first, so that it can put the embedded window back on the screen
+ * again (if appropriate). This will prevent the window from ever
+ * being unmapped, and thereby avoid flashing.
+ */
+
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
+ }
+ dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED;
+
+ /*
+ * Find the DLines corresponding to index1Ptr and index2Ptr. There
+ * is one tricky thing here, which is that we have to relayout in
+ * units of whole text lines: round index1Ptr back to the beginning
+ * of its text line, and include all the display lines after index2,
+ * up to the end of its text line. This is necessary because the
+ * indices stored in the display lines will no longer be valid. It's
+ * also needed because any edit could change the way lines wrap.
+ */
+
+ rounded = *index1Ptr;
+ rounded.charIndex = 0;
+ firstPtr = FindDLine(dInfoPtr->dLinePtr, &rounded);
+ if (firstPtr == NULL) {
+ return;
+ }
+ lastPtr = FindDLine(dInfoPtr->dLinePtr, index2Ptr);
+ while ((lastPtr != NULL)
+ && (lastPtr->index.linePtr == index2Ptr->linePtr)) {
+ lastPtr = lastPtr->nextPtr;
+ }
+
+ /*
+ * Delete all the DLines from firstPtr up to but not including lastPtr.
+ */
+
+ FreeDLines(textPtr, firstPtr, lastPtr, 1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextRedrawTag --
+ *
+ * This procedure is invoked to request a redraw of all characters
+ * in a given range that have a particular tag on or off. It's
+ * called, for example, when tag options change.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information on the screen may be redrawn, and the layout of
+ * the screen may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextRedrawTag(textPtr, index1Ptr, index2Ptr, tagPtr, withTag)
+ TkText *textPtr; /* Widget record for text widget. */
+ TkTextIndex *index1Ptr; /* First character in range to consider
+ * for redisplay. NULL means start at
+ * beginning of text. */
+ TkTextIndex *index2Ptr; /* Character just after last one to consider
+ * for redisplay. NULL means process all
+ * the characters in the text. */
+ TkTextTag *tagPtr; /* Information about tag. */
+ int withTag; /* 1 means redraw characters that have the
+ * tag, 0 means redraw those without. */
+{
+ register DLine *dlPtr;
+ DLine *endPtr;
+ int tagOn;
+ TkTextSearch search;
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ TkTextIndex *curIndexPtr;
+ TkTextIndex endOfText, *endIndexPtr;
+
+ /*
+ * Round up the starting position if it's before the first line
+ * visible on the screen (we only care about what's on the screen).
+ */
+
+ dlPtr = dInfoPtr->dLinePtr;
+ if (dlPtr == NULL) {
+ return;
+ }
+ if ((index1Ptr == NULL) || (TkTextIndexCmp(&dlPtr->index, index1Ptr) > 0)) {
+ index1Ptr = &dlPtr->index;
+ }
+
+ /*
+ * Set the stopping position if it wasn't specified.
+ */
+
+ if (index2Ptr == NULL) {
+ index2Ptr = TkTextMakeIndex(textPtr->tree,
+ TkBTreeNumLines(textPtr->tree), 0, &endOfText);
+ }
+
+ /*
+ * Initialize a search through all transitions on the tag, starting
+ * with the first transition where the tag's current state is different
+ * from what it will eventually be.
+ */
+
+ TkBTreeStartSearch(index1Ptr, index2Ptr, tagPtr, &search);
+ /*
+ * Make our own curIndex because at this point search.curIndex
+ * may not equal index1Ptr->curIndex in the case the first tag toggle
+ * comes after index1Ptr (See the use of FindTagStart in TkBTreeStartSearch)
+ */
+ curIndexPtr = index1Ptr;
+ tagOn = TkBTreeCharTagged(index1Ptr, tagPtr);
+ if (tagOn != withTag) {
+ if (!TkBTreeNextTag(&search)) {
+ return;
+ }
+ curIndexPtr = &search.curIndex;
+ }
+
+ /*
+ * Schedule a redisplay and layout recalculation if they aren't
+ * already pending. This has to be done before calling FreeDLines,
+ * for the reason given in TkTextChanged.
+ */
+
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
+ }
+ dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED;
+
+ /*
+ * Each loop through the loop below is for one range of characters
+ * where the tag's current state is different than its eventual
+ * state. At the top of the loop, search contains information about
+ * the first character in the range.
+ */
+
+ while (1) {
+ /*
+ * Find the first DLine structure in the range. Note: if the
+ * desired character isn't the first in its text line, then look
+ * for the character just before it instead. This is needed to
+ * handle the case where the first character of a wrapped
+ * display line just got smaller, so that it now fits on the
+ * line before: need to relayout the line containing the
+ * previous character.
+ */
+
+ if (curIndexPtr->charIndex == 0) {
+ dlPtr = FindDLine(dlPtr, curIndexPtr);
+ } else {
+ TkTextIndex tmp;
+
+ tmp = *curIndexPtr;
+ tmp.charIndex -= 1;
+ dlPtr = FindDLine(dlPtr, &tmp);
+ }
+ if (dlPtr == NULL) {
+ break;
+ }
+
+ /*
+ * Find the first DLine structure that's past the end of the range.
+ */
+
+ if (!TkBTreeNextTag(&search)) {
+ endIndexPtr = index2Ptr;
+ } else {
+ curIndexPtr = &search.curIndex;
+ endIndexPtr = curIndexPtr;
+ }
+ endPtr = FindDLine(dlPtr, endIndexPtr);
+ if ((endPtr != NULL) && (endPtr->index.linePtr == endIndexPtr->linePtr)
+ && (endPtr->index.charIndex < endIndexPtr->charIndex)) {
+ endPtr = endPtr->nextPtr;
+ }
+
+ /*
+ * Delete all of the display lines in the range, so that they'll
+ * be re-layed out and redrawn.
+ */
+
+ FreeDLines(textPtr, dlPtr, endPtr, 1);
+ dlPtr = endPtr;
+
+ /*
+ * Find the first text line in the next range.
+ */
+
+ if (!TkBTreeNextTag(&search)) {
+ break;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextRelayoutWindow --
+ *
+ * This procedure is called when something has happened that
+ * invalidates the whole layout of characters on the screen, such
+ * as a change in a configuration option for the overall text
+ * widget or a change in the window size. It causes all display
+ * information to be recomputed and the window to be redrawn.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All the display information will be recomputed for the window
+ * and the window will be redrawn.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextRelayoutWindow(textPtr)
+ TkText *textPtr; /* Widget record for text widget. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ GC new;
+ XGCValues gcValues;
+
+ /*
+ * Schedule the window redisplay. See TkTextChanged for the
+ * reason why this has to be done before any calls to FreeDLines.
+ */
+
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
+ }
+ dInfoPtr->flags |= REDRAW_PENDING|REDRAW_BORDERS|DINFO_OUT_OF_DATE
+ |REPICK_NEEDED;
+
+ /*
+ * (Re-)create the graphics context for drawing the traversal
+ * highlight.
+ */
+
+ gcValues.graphics_exposures = False;
+ new = Tk_GetGC(textPtr->tkwin, GCGraphicsExposures, &gcValues);
+ if (dInfoPtr->copyGC != None) {
+ Tk_FreeGC(textPtr->display, dInfoPtr->copyGC);
+ }
+ dInfoPtr->copyGC = new;
+
+ /*
+ * Throw away all the current layout information.
+ */
+
+ FreeDLines(textPtr, dInfoPtr->dLinePtr, (DLine *) NULL, 1);
+ dInfoPtr->dLinePtr = NULL;
+
+ /*
+ * Recompute some overall things for the layout. Even if the
+ * window gets very small, pretend that there's at least one
+ * pixel of drawing space in it.
+ */
+
+ if (textPtr->highlightWidth < 0) {
+ textPtr->highlightWidth = 0;
+ }
+ dInfoPtr->x = textPtr->highlightWidth + textPtr->borderWidth
+ + textPtr->padX;
+ dInfoPtr->y = textPtr->highlightWidth + textPtr->borderWidth
+ + textPtr->padY;
+ dInfoPtr->maxX = Tk_Width(textPtr->tkwin) - textPtr->highlightWidth
+ - textPtr->borderWidth - textPtr->padX;
+ if (dInfoPtr->maxX <= dInfoPtr->x) {
+ dInfoPtr->maxX = dInfoPtr->x + 1;
+ }
+ dInfoPtr->maxY = Tk_Height(textPtr->tkwin) - textPtr->highlightWidth
+ - textPtr->borderWidth - textPtr->padY;
+ if (dInfoPtr->maxY <= dInfoPtr->y) {
+ dInfoPtr->maxY = dInfoPtr->y + 1;
+ }
+ dInfoPtr->topOfEof = dInfoPtr->maxY;
+
+ /*
+ * If the upper-left character isn't the first in a line, recompute
+ * it. This is necessary because a change in the window's size
+ * or options could change the way lines wrap.
+ */
+
+ if (textPtr->topIndex.charIndex != 0) {
+ MeasureUp(textPtr, &textPtr->topIndex, 0, &textPtr->topIndex);
+ }
+
+ /*
+ * Invalidate cached scrollbar positions, so that scrollbars
+ * sliders will be udpated.
+ */
+
+ dInfoPtr->xScrollFirst = dInfoPtr->xScrollLast = -1;
+ dInfoPtr->yScrollFirst = dInfoPtr->yScrollLast = -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextSetYView --
+ *
+ * This procedure is called to specify what lines are to be
+ * displayed in a text widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The display will (eventually) be updated so that the position
+ * given by "indexPtr" is visible on the screen at the position
+ * determined by "pickPlace".
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextSetYView(textPtr, indexPtr, pickPlace)
+ TkText *textPtr; /* Widget record for text widget. */
+ TkTextIndex *indexPtr; /* Position that is to appear somewhere
+ * in the view. */
+ int pickPlace; /* 0 means topLine must appear at top of
+ * screen. 1 means we get to pick where it
+ * appears: minimize screen motion or else
+ * display line at center of screen. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ register DLine *dlPtr;
+ int bottomY, close, lineIndex;
+ TkTextIndex tmpIndex, rounded;
+ Tk_FontMetrics fm;
+
+ /*
+ * If the specified position is the extra line at the end of the
+ * text, round it back to the last real line.
+ */
+
+ lineIndex = TkBTreeLineIndex(indexPtr->linePtr);
+ if (lineIndex == TkBTreeNumLines(indexPtr->tree)) {
+ TkTextIndexBackChars(indexPtr, 1, &rounded);
+ indexPtr = &rounded;
+ }
+
+ if (!pickPlace) {
+ /*
+ * The specified position must go at the top of the screen.
+ * Just leave all the DLine's alone: we may be able to reuse
+ * some of the information that's currently on the screen
+ * without redisplaying it all.
+ */
+
+ if (indexPtr->charIndex == 0) {
+ textPtr->topIndex = *indexPtr;
+ } else {
+ MeasureUp(textPtr, indexPtr, 0, &textPtr->topIndex);
+ }
+ goto scheduleUpdate;
+ }
+
+ /*
+ * We have to pick where to display the index. First, bring
+ * the display information up to date and see if the index will be
+ * completely visible in the current screen configuration. If so
+ * then there's nothing to do.
+ */
+
+ if (dInfoPtr->flags & DINFO_OUT_OF_DATE) {
+ UpdateDisplayInfo(textPtr);
+ }
+ dlPtr = FindDLine(dInfoPtr->dLinePtr, indexPtr);
+ if (dlPtr != NULL) {
+ if ((dlPtr->y + dlPtr->height) > dInfoPtr->maxY) {
+ /*
+ * Part of the line hangs off the bottom of the screen;
+ * pretend the whole line is off-screen.
+ */
+
+ dlPtr = NULL;
+ } else if ((dlPtr->index.linePtr == indexPtr->linePtr)
+ && (dlPtr->index.charIndex <= indexPtr->charIndex)) {
+ return;
+ }
+ }
+
+ /*
+ * The desired line isn't already on-screen. Figure out what
+ * it means to be "close" to the top or bottom of the screen.
+ * Close means within 1/3 of the screen height or within three
+ * lines, whichever is greater. Add one extra line also, to
+ * account for the way MeasureUp rounds.
+ */
+
+ Tk_GetFontMetrics(textPtr->tkfont, &fm);
+ bottomY = (dInfoPtr->y + dInfoPtr->maxY + fm.linespace)/2;
+ close = (dInfoPtr->maxY - dInfoPtr->y)/3;
+ if (close < 3*fm.linespace) {
+ close = 3*fm.linespace;
+ }
+ close += fm.linespace;
+ if (dlPtr != NULL) {
+ /*
+ * The desired line is above the top of screen. If it is
+ * "close" to the top of the window then make it the top
+ * line on the screen.
+ */
+
+ MeasureUp(textPtr, &textPtr->topIndex, close, &tmpIndex);
+ if (TkTextIndexCmp(&tmpIndex, indexPtr) <= 0) {
+ MeasureUp(textPtr, indexPtr, 0, &textPtr->topIndex);
+ goto scheduleUpdate;
+ }
+ } else {
+ /*
+ * The desired line is below the bottom of the screen. If it is
+ * "close" to the bottom of the screen then position it at the
+ * bottom of the screen.
+ */
+
+ MeasureUp(textPtr, indexPtr, close, &tmpIndex);
+ if (FindDLine(dInfoPtr->dLinePtr, &tmpIndex) != NULL) {
+ bottomY = dInfoPtr->maxY - dInfoPtr->y;
+ }
+ }
+
+ /*
+ * Our job now is to arrange the display so that indexPtr appears
+ * as low on the screen as possible but with its bottom no lower
+ * than bottomY. BottomY is the bottom of the window if the
+ * desired line is just below the current screen, otherwise it
+ * is a half-line lower than the center of the window.
+ */
+
+ MeasureUp(textPtr, indexPtr, bottomY, &textPtr->topIndex);
+
+ scheduleUpdate:
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
+ }
+ dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MeasureUp --
+ *
+ * Given one index, find the index of the first character
+ * on the highest display line that would be displayed no more
+ * than "distance" pixels above the given index.
+ *
+ * Results:
+ * *dstPtr is filled in with the index of the first character
+ * on a display line. The display line is found by measuring
+ * up "distance" pixels above the pixel just below an imaginary
+ * display line that contains srcPtr. If the display line
+ * that covers this coordinate actually extends above the
+ * coordinate, then return the index of the next lower line
+ * instead (i.e. the returned index will be completely visible
+ * at or below the given y-coordinate).
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+MeasureUp(textPtr, srcPtr, distance, dstPtr)
+ TkText *textPtr; /* Text widget in which to measure. */
+ TkTextIndex *srcPtr; /* Index of character from which to start
+ * measuring. */
+ int distance; /* Vertical distance in pixels measured
+ * from the pixel just below the lowest
+ * one in srcPtr's line. */
+ TkTextIndex *dstPtr; /* Index to fill in with result. */
+{
+ int lineNum; /* Number of current line. */
+ int charsToCount; /* Maximum number of characters to measure
+ * in current line. */
+ TkTextIndex bestIndex; /* Best candidate seen so far for result. */
+ TkTextIndex index;
+ DLine *dlPtr, *lowestPtr;
+ int noBestYet; /* 1 means bestIndex hasn't been set. */
+
+ noBestYet = 1;
+ charsToCount = srcPtr->charIndex + 1;
+ index.tree = srcPtr->tree;
+ for (lineNum = TkBTreeLineIndex(srcPtr->linePtr); lineNum >= 0;
+ lineNum--) {
+ /*
+ * Layout an entire text line (potentially > 1 display line).
+ * For the first line, which contains srcPtr, only layout the
+ * part up through srcPtr (charsToCount is non-infinite to
+ * accomplish this). Make a list of all the display lines
+ * in backwards order (the lowest DLine on the screen is first
+ * in the list).
+ */
+
+ index.linePtr = TkBTreeFindLine(srcPtr->tree, lineNum);
+ index.charIndex = 0;
+ lowestPtr = NULL;
+ do {
+ dlPtr = LayoutDLine(textPtr, &index);
+ dlPtr->nextPtr = lowestPtr;
+ lowestPtr = dlPtr;
+ TkTextIndexForwChars(&index, dlPtr->count, &index);
+ charsToCount -= dlPtr->count;
+ } while ((charsToCount > 0) && (index.linePtr == dlPtr->index.linePtr));
+
+ /*
+ * Scan through the display lines to see if we've covered enough
+ * vertical distance. If so, save the starting index for the
+ * line at the desired location.
+ */
+
+ for (dlPtr = lowestPtr; dlPtr != NULL; dlPtr = dlPtr->nextPtr) {
+ distance -= dlPtr->height;
+ if (distance < 0) {
+ *dstPtr = (noBestYet) ? dlPtr->index : bestIndex;
+ break;
+ }
+ bestIndex = dlPtr->index;
+ noBestYet = 0;
+ }
+
+ /*
+ * Discard the display lines, then either return or prepare
+ * for the next display line to lay out.
+ */
+
+ FreeDLines(textPtr, lowestPtr, (DLine *) NULL, 0);
+ if (distance < 0) {
+ return;
+ }
+ charsToCount = INT_MAX; /* Consider all chars. in next line. */
+ }
+
+ /*
+ * Ran off the beginning of the text. Return the first character
+ * in the text.
+ */
+
+ TkTextMakeIndex(textPtr->tree, 0, 0, dstPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextSeeCmd --
+ *
+ * This procedure is invoked to process the "see" option for
+ * the widget command for text widgets. See the user documentation
+ * for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextSeeCmd(textPtr, interp, argc, argv)
+ TkText *textPtr; /* Information about text widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. Someone else has already
+ * parsed this command enough to know that
+ * argv[1] is "see". */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ TkTextIndex index;
+ int x, y, width, height, lineWidth, charCount, oneThird, delta;
+ DLine *dlPtr;
+ TkTextDispChunk *chunkPtr;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " see index\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[2], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the specified position is the extra line at the end of the
+ * text, round it back to the last real line.
+ */
+
+ if (TkBTreeLineIndex(index.linePtr) == TkBTreeNumLines(index.tree)) {
+ TkTextIndexBackChars(&index, 1, &index);
+ }
+
+ /*
+ * First get the desired position into the vertical range of the window.
+ */
+
+ TkTextSetYView(textPtr, &index, 1);
+
+ /*
+ * Now make sure that the character is in view horizontally.
+ */
+
+ if (dInfoPtr->flags & DINFO_OUT_OF_DATE) {
+ UpdateDisplayInfo(textPtr);
+ }
+ lineWidth = dInfoPtr->maxX - dInfoPtr->x;
+ if (dInfoPtr->maxLength < lineWidth) {
+ return TCL_OK;
+ }
+
+ /*
+ * Find the chunk that contains the desired index.
+ */
+
+ dlPtr = FindDLine(dInfoPtr->dLinePtr, &index);
+ charCount = index.charIndex - dlPtr->index.charIndex;
+ for (chunkPtr = dlPtr->chunkPtr; ; chunkPtr = chunkPtr->nextPtr) {
+ if (charCount < chunkPtr->numChars) {
+ break;
+ }
+ charCount -= chunkPtr->numChars;
+ }
+
+ /*
+ * Call a chunk-specific procedure to find the horizontal range of
+ * the character within the chunk.
+ */
+
+ (*chunkPtr->bboxProc)(chunkPtr, charCount, dlPtr->y + dlPtr->spaceAbove,
+ dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow,
+ dlPtr->baseline - dlPtr->spaceAbove, &x, &y, &width,
+ &height);
+ delta = x - dInfoPtr->curPixelOffset;
+ oneThird = lineWidth/3;
+ if (delta < 0) {
+ if (delta < -oneThird) {
+ dInfoPtr->newCharOffset = (x - lineWidth/2)/textPtr->charWidth;
+ } else {
+ dInfoPtr->newCharOffset -= ((-delta) + textPtr->charWidth - 1)
+ / textPtr->charWidth;
+ }
+ } else {
+ delta -= (lineWidth - width);
+ if (delta > 0) {
+ if (delta > oneThird) {
+ dInfoPtr->newCharOffset = (x - lineWidth/2)/textPtr->charWidth;
+ } else {
+ dInfoPtr->newCharOffset += (delta + textPtr->charWidth - 1)
+ / textPtr->charWidth;
+ }
+ } else {
+ return TCL_OK;
+ }
+ }
+ dInfoPtr->flags |= DINFO_OUT_OF_DATE;
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ dInfoPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextXviewCmd --
+ *
+ * This procedure is invoked to process the "xview" option for
+ * the widget command for text widgets. See the user documentation
+ * for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextXviewCmd(textPtr, interp, argc, argv)
+ TkText *textPtr; /* Information about text widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. Someone else has already
+ * parsed this command enough to know that
+ * argv[1] is "xview". */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ int type, charsPerPage, count, newOffset;
+ double fraction;
+
+ if (dInfoPtr->flags & DINFO_OUT_OF_DATE) {
+ UpdateDisplayInfo(textPtr);
+ }
+
+ if (argc == 2) {
+ GetXView(interp, textPtr, 0);
+ return TCL_OK;
+ }
+
+ newOffset = dInfoPtr->newCharOffset;
+ type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ return TCL_ERROR;
+ case TK_SCROLL_MOVETO:
+ if (fraction > 1.0) {
+ fraction = 1.0;
+ }
+ if (fraction < 0) {
+ fraction = 0;
+ }
+ newOffset = (int) (((fraction * dInfoPtr->maxLength) / textPtr->charWidth)
+ + 0.5);
+ break;
+ case TK_SCROLL_PAGES:
+ charsPerPage = ((dInfoPtr->maxX - dInfoPtr->x) / textPtr->charWidth)
+ - 2;
+ if (charsPerPage < 1) {
+ charsPerPage = 1;
+ }
+ newOffset += charsPerPage*count;
+ break;
+ case TK_SCROLL_UNITS:
+ newOffset += count;
+ break;
+ }
+
+ dInfoPtr->newCharOffset = newOffset;
+ dInfoPtr->flags |= DINFO_OUT_OF_DATE;
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ dInfoPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ScrollByLines --
+ *
+ * This procedure is called to scroll a text widget up or down
+ * by a given number of lines.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The view in textPtr's window changes to reflect the value
+ * of "offset".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ScrollByLines(textPtr, offset)
+ TkText *textPtr; /* Widget to scroll. */
+ int offset; /* Amount by which to scroll, in *screen*
+ * lines. Positive means that information
+ * later in text becomes visible, negative
+ * means that information earlier in the
+ * text becomes visible. */
+{
+ int i, charsToCount, lineNum;
+ TkTextIndex new, index;
+ TkTextLine *lastLinePtr;
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ DLine *dlPtr, *lowestPtr;
+
+ if (offset < 0) {
+ /*
+ * Must scroll up (to show earlier information in the text).
+ * The code below is similar to that in MeasureUp, except that
+ * it counts lines instead of pixels.
+ */
+
+ charsToCount = textPtr->topIndex.charIndex + 1;
+ index.tree = textPtr->tree;
+ offset--; /* Skip line containing topIndex. */
+ for (lineNum = TkBTreeLineIndex(textPtr->topIndex.linePtr);
+ lineNum >= 0; lineNum--) {
+ index.linePtr = TkBTreeFindLine(textPtr->tree, lineNum);
+ index.charIndex = 0;
+ lowestPtr = NULL;
+ do {
+ dlPtr = LayoutDLine(textPtr, &index);
+ dlPtr->nextPtr = lowestPtr;
+ lowestPtr = dlPtr;
+ TkTextIndexForwChars(&index, dlPtr->count, &index);
+ charsToCount -= dlPtr->count;
+ } while ((charsToCount > 0)
+ && (index.linePtr == dlPtr->index.linePtr));
+
+ for (dlPtr = lowestPtr; dlPtr != NULL; dlPtr = dlPtr->nextPtr) {
+ offset++;
+ if (offset == 0) {
+ textPtr->topIndex = dlPtr->index;
+ break;
+ }
+ }
+
+ /*
+ * Discard the display lines, then either return or prepare
+ * for the next display line to lay out.
+ */
+
+ FreeDLines(textPtr, lowestPtr, (DLine *) NULL, 0);
+ if (offset >= 0) {
+ goto scheduleUpdate;
+ }
+ charsToCount = INT_MAX;
+ }
+
+ /*
+ * Ran off the beginning of the text. Return the first character
+ * in the text.
+ */
+
+ TkTextMakeIndex(textPtr->tree, 0, 0, &textPtr->topIndex);
+ } else {
+ /*
+ * Scrolling down, to show later information in the text.
+ * Just count lines from the current top of the window.
+ */
+
+ lastLinePtr = TkBTreeFindLine(textPtr->tree,
+ TkBTreeNumLines(textPtr->tree));
+ for (i = 0; i < offset; i++) {
+ dlPtr = LayoutDLine(textPtr, &textPtr->topIndex);
+ dlPtr->nextPtr = NULL;
+ TkTextIndexForwChars(&textPtr->topIndex, dlPtr->count, &new);
+ FreeDLines(textPtr, dlPtr, (DLine *) NULL, 0);
+ if (new.linePtr == lastLinePtr) {
+ break;
+ }
+ textPtr->topIndex = new;
+ }
+ }
+
+ scheduleUpdate:
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
+ }
+ dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextYviewCmd --
+ *
+ * This procedure is invoked to process the "yview" option for
+ * the widget command for text widgets. See the user documentation
+ * for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextYviewCmd(textPtr, interp, argc, argv)
+ TkText *textPtr; /* Information about text widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. Someone else has already
+ * parsed this command enough to know that
+ * argv[1] is "yview". */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ int pickPlace, lineNum, type, charsInLine;
+ Tk_FontMetrics fm;
+ int pixels, count;
+ size_t switchLength;
+ double fraction;
+ TkTextIndex index, new;
+ TkTextLine *lastLinePtr;
+ DLine *dlPtr;
+
+ if (dInfoPtr->flags & DINFO_OUT_OF_DATE) {
+ UpdateDisplayInfo(textPtr);
+ }
+
+ if (argc == 2) {
+ GetYView(interp, textPtr, 0);
+ return TCL_OK;
+ }
+
+ /*
+ * Next, handle the old syntax: "pathName yview ?-pickplace? where"
+ */
+
+ pickPlace = 0;
+ if (argv[2][0] == '-') {
+ switchLength = strlen(argv[2]);
+ if ((switchLength >= 2)
+ && (strncmp(argv[2], "-pickplace", switchLength) == 0)) {
+ pickPlace = 1;
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " yview -pickplace lineNum|index\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ }
+ if ((argc == 3) || pickPlace) {
+ if (Tcl_GetInt(interp, argv[2+pickPlace], &lineNum) == TCL_OK) {
+ TkTextMakeIndex(textPtr->tree, lineNum, 0, &index);
+ TkTextSetYView(textPtr, &index, 0);
+ return TCL_OK;
+ }
+
+ /*
+ * The argument must be a regular text index.
+ */
+
+ Tcl_ResetResult(interp);
+ if (TkTextGetIndex(interp, textPtr, argv[2+pickPlace],
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ TkTextSetYView(textPtr, &index, pickPlace);
+ return TCL_OK;
+ }
+
+ /*
+ * New syntax: dispatch based on argv[2].
+ */
+
+ type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ return TCL_ERROR;
+ case TK_SCROLL_MOVETO:
+ if (fraction > 1.0) {
+ fraction = 1.0;
+ }
+ if (fraction < 0) {
+ fraction = 0;
+ }
+ fraction *= TkBTreeNumLines(textPtr->tree);
+ lineNum = (int) fraction;
+ TkTextMakeIndex(textPtr->tree, lineNum, 0, &index);
+ charsInLine = TkBTreeCharsInLine(index.linePtr);
+ index.charIndex = (int)((charsInLine * (fraction-lineNum)) + 0.5);
+ if (index.charIndex >= charsInLine) {
+ TkTextMakeIndex(textPtr->tree, lineNum+1, 0, &index);
+ }
+ TkTextSetYView(textPtr, &index, 0);
+ break;
+ case TK_SCROLL_PAGES:
+ /*
+ * Scroll up or down by screenfuls. Actually, use the
+ * window height minus two lines, so that there's some
+ * overlap between adjacent pages.
+ */
+
+ Tk_GetFontMetrics(textPtr->tkfont, &fm);
+ if (count < 0) {
+ pixels = (dInfoPtr->maxY - 2*fm.linespace - dInfoPtr->y)*(-count)
+ + fm.linespace;
+ MeasureUp(textPtr, &textPtr->topIndex, pixels, &new);
+ if (TkTextIndexCmp(&textPtr->topIndex, &new) == 0) {
+ /*
+ * A page of scrolling ended up being less than one line.
+ * Scroll one line anyway.
+ */
+
+ count = -1;
+ goto scrollByLines;
+ }
+ textPtr->topIndex = new;
+ } else {
+ /*
+ * Scrolling down by pages. Layout lines starting at the
+ * top index and count through the desired vertical distance.
+ */
+
+ pixels = (dInfoPtr->maxY - 2*fm.linespace - dInfoPtr->y)*count;
+ lastLinePtr = TkBTreeFindLine(textPtr->tree,
+ TkBTreeNumLines(textPtr->tree));
+ do {
+ dlPtr = LayoutDLine(textPtr, &textPtr->topIndex);
+ dlPtr->nextPtr = NULL;
+ TkTextIndexForwChars(&textPtr->topIndex, dlPtr->count,
+ &new);
+ pixels -= dlPtr->height;
+ FreeDLines(textPtr, dlPtr, (DLine *) NULL, 0);
+ if (new.linePtr == lastLinePtr) {
+ break;
+ }
+ textPtr->topIndex = new;
+ } while (pixels > 0);
+ }
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
+ }
+ dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED;
+ break;
+ case TK_SCROLL_UNITS:
+ scrollByLines:
+ ScrollByLines(textPtr, count);
+ break;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextScanCmd --
+ *
+ * This procedure is invoked to process the "scan" option for
+ * the widget command for text widgets. See the user documentation
+ * for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextScanCmd(textPtr, interp, argc, argv)
+ register TkText *textPtr; /* Information about text widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. Someone else has already
+ * parsed this command enough to know that
+ * argv[1] is "scan". */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ TkTextIndex index;
+ int c, x, y, totalScroll, newChar, maxChar;
+ Tk_FontMetrics fm;
+ size_t length;
+
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " scan mark|dragto x y\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[3], &x) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[4], &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ c = argv[2][0];
+ length = strlen(argv[2]);
+ if ((c == 'd') && (strncmp(argv[2], "dragto", length) == 0)) {
+ /*
+ * Amplify the difference between the current position and the
+ * mark position to compute how much the view should shift, then
+ * update the mark position to correspond to the new view. If we
+ * run off the edge of the text, reset the mark point so that the
+ * current position continues to correspond to the edge of the
+ * window. This means that the picture will start dragging as
+ * soon as the mouse reverses direction (without this reset, might
+ * have to slide mouse a long ways back before the picture starts
+ * moving again).
+ */
+
+ newChar = dInfoPtr->scanMarkChar + (10*(dInfoPtr->scanMarkX - x))
+ / (textPtr->charWidth);
+ maxChar = 1 + (dInfoPtr->maxLength - (dInfoPtr->maxX - dInfoPtr->x)
+ + textPtr->charWidth - 1)/textPtr->charWidth;
+ if (newChar < 0) {
+ dInfoPtr->scanMarkChar = newChar = 0;
+ dInfoPtr->scanMarkX = x;
+ } else if (newChar > maxChar) {
+ dInfoPtr->scanMarkChar = newChar = maxChar;
+ dInfoPtr->scanMarkX = x;
+ }
+ dInfoPtr->newCharOffset = newChar;
+
+ Tk_GetFontMetrics(textPtr->tkfont, &fm);
+ totalScroll = (10*(dInfoPtr->scanMarkY - y)) / fm.linespace;
+ if (totalScroll != dInfoPtr->scanTotalScroll) {
+ index = textPtr->topIndex;
+ ScrollByLines(textPtr, totalScroll-dInfoPtr->scanTotalScroll);
+ dInfoPtr->scanTotalScroll = totalScroll;
+ if ((index.linePtr == textPtr->topIndex.linePtr) &&
+ (index.charIndex == textPtr->topIndex.charIndex)) {
+ dInfoPtr->scanTotalScroll = 0;
+ dInfoPtr->scanMarkY = y;
+ }
+ }
+ } else if ((c == 'm') && (strncmp(argv[2], "mark", length) == 0)) {
+ dInfoPtr->scanMarkChar = dInfoPtr->newCharOffset;
+ dInfoPtr->scanMarkX = x;
+ dInfoPtr->scanTotalScroll = 0;
+ dInfoPtr->scanMarkY = y;
+ } else {
+ Tcl_AppendResult(interp, "bad scan option \"", argv[2],
+ "\": must be mark or dragto", (char *) NULL);
+ return TCL_ERROR;
+ }
+ dInfoPtr->flags |= DINFO_OUT_OF_DATE;
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ dInfoPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetXView --
+ *
+ * This procedure computes the fractions that indicate what's
+ * visible in a text window and, optionally, evaluates a
+ * Tcl script to report them to the text's associated scrollbar.
+ *
+ * Results:
+ * If report is zero, then interp->result is filled in with
+ * two real numbers separated by a space, giving the position of
+ * the left and right edges of the window as fractions from 0 to
+ * 1, where 0 means the left edge of the text and 1 means the right
+ * edge. If report is non-zero, then interp->result isn't modified
+ * directly, but instead a script is evaluated in interp to report
+ * the new horizontal scroll position to the scrollbar (if the scroll
+ * position hasn't changed then no script is invoked).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetXView(interp, textPtr, report)
+ Tcl_Interp *interp; /* If "report" is FALSE, string
+ * describing visible range gets
+ * stored in interp->result. */
+ TkText *textPtr; /* Information about text widget. */
+ int report; /* Non-zero means report info to
+ * scrollbar if it has changed. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ char buffer[200];
+ double first, last;
+ int code;
+
+ if (dInfoPtr->maxLength > 0) {
+ first = ((double) dInfoPtr->curPixelOffset)
+ / dInfoPtr->maxLength;
+ last = first + ((double) (dInfoPtr->maxX - dInfoPtr->x))
+ / dInfoPtr->maxLength;
+ if (last > 1.0) {
+ last = 1.0;
+ }
+ } else {
+ first = 0;
+ last = 1.0;
+ }
+ if (!report) {
+ sprintf(interp->result, "%g %g", first, last);
+ return;
+ }
+ if ((first == dInfoPtr->xScrollFirst) && (last == dInfoPtr->xScrollLast)) {
+ return;
+ }
+ dInfoPtr->xScrollFirst = first;
+ dInfoPtr->xScrollLast = last;
+ sprintf(buffer, " %g %g", first, last);
+ code = Tcl_VarEval(interp, textPtr->xScrollCmd,
+ buffer, (char *) NULL);
+ if (code != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (horizontal scrolling command executed by text)");
+ Tcl_BackgroundError(interp);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetYView --
+ *
+ * This procedure computes the fractions that indicate what's
+ * visible in a text window and, optionally, evaluates a
+ * Tcl script to report them to the text's associated scrollbar.
+ *
+ * Results:
+ * If report is zero, then interp->result is filled in with
+ * two real numbers separated by a space, giving the position of
+ * the top and bottom of the window as fractions from 0 to 1, where
+ * 0 means the beginning of the text and 1 means the end. If
+ * report is non-zero, then interp->result isn't modified directly,
+ * but a script is evaluated in interp to report the new scroll
+ * position to the scrollbar (if the scroll position hasn't changed
+ * then no script is invoked).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetYView(interp, textPtr, report)
+ Tcl_Interp *interp; /* If "report" is FALSE, string
+ * describing visible range gets
+ * stored in interp->result. */
+ TkText *textPtr; /* Information about text widget. */
+ int report; /* Non-zero means report info to
+ * scrollbar if it has changed. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ char buffer[200];
+ double first, last;
+ DLine *dlPtr;
+ int totalLines, code, count;
+
+ dlPtr = dInfoPtr->dLinePtr;
+ totalLines = TkBTreeNumLines(textPtr->tree);
+ first = ((double) TkBTreeLineIndex(dlPtr->index.linePtr))
+ + ((double) dlPtr->index.charIndex)
+ / (TkBTreeCharsInLine(dlPtr->index.linePtr));
+ first /= totalLines;
+ while (1) {
+ if ((dlPtr->y + dlPtr->height) > dInfoPtr->maxY) {
+ /*
+ * The last line is only partially visible, so don't
+ * count its characters in what's visible.
+ */
+ count = 0;
+ break;
+ }
+ if (dlPtr->nextPtr == NULL) {
+ count = dlPtr->count;
+ break;
+ }
+ dlPtr = dlPtr->nextPtr;
+ }
+ last = ((double) TkBTreeLineIndex(dlPtr->index.linePtr))
+ + ((double) (dlPtr->index.charIndex + count))
+ / (TkBTreeCharsInLine(dlPtr->index.linePtr));
+ last /= totalLines;
+ if (!report) {
+ sprintf(interp->result, "%g %g", first, last);
+ return;
+ }
+ if ((first == dInfoPtr->yScrollFirst) && (last == dInfoPtr->yScrollLast)) {
+ return;
+ }
+ dInfoPtr->yScrollFirst = first;
+ dInfoPtr->yScrollLast = last;
+ sprintf(buffer, " %g %g", first, last);
+ code = Tcl_VarEval(interp, textPtr->yScrollCmd,
+ buffer, (char *) NULL);
+ if (code != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (vertical scrolling command executed by text)");
+ Tcl_BackgroundError(interp);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindDLine --
+ *
+ * This procedure is called to find the DLine corresponding to a
+ * given text index.
+ *
+ * Results:
+ * The return value is a pointer to the first DLine found in the
+ * list headed by dlPtr that displays information at or after the
+ * specified position. If there is no such line in the list then
+ * NULL is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DLine *
+FindDLine(dlPtr, indexPtr)
+ register DLine *dlPtr; /* Pointer to first in list of DLines
+ * to search. */
+ TkTextIndex *indexPtr; /* Index of desired character. */
+{
+ TkTextLine *linePtr;
+
+ if (dlPtr == NULL) {
+ return NULL;
+ }
+ if (TkBTreeLineIndex(indexPtr->linePtr)
+ < TkBTreeLineIndex(dlPtr->index.linePtr)) {
+ /*
+ * The first display line is already past the desired line.
+ */
+ return dlPtr;
+ }
+
+ /*
+ * Find the first display line that covers the desired text line.
+ */
+
+ linePtr = dlPtr->index.linePtr;
+ while (linePtr != indexPtr->linePtr) {
+ while (dlPtr->index.linePtr == linePtr) {
+ dlPtr = dlPtr->nextPtr;
+ if (dlPtr == NULL) {
+ return NULL;
+ }
+ }
+ linePtr = TkBTreeNextLine(linePtr);
+ if (linePtr == NULL) {
+ panic("FindDLine reached end of text");
+ }
+ }
+ if (indexPtr->linePtr != dlPtr->index.linePtr) {
+ return dlPtr;
+ }
+
+ /*
+ * Now get to the right position within the text line.
+ */
+
+ while (indexPtr->charIndex >= (dlPtr->index.charIndex + dlPtr->count)) {
+ dlPtr = dlPtr->nextPtr;
+ if ((dlPtr == NULL) || (dlPtr->index.linePtr != indexPtr->linePtr)) {
+ break;
+ }
+ }
+ return dlPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextPixelIndex --
+ *
+ * Given an (x,y) coordinate on the screen, find the location of
+ * the character closest to that location.
+ *
+ * Results:
+ * The index at *indexPtr is modified to refer to the character
+ * on the display that is closest to (x,y).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextPixelIndex(textPtr, x, y, indexPtr)
+ TkText *textPtr; /* Widget record for text widget. */
+ int x, y; /* Pixel coordinates of point in widget's
+ * window. */
+ TkTextIndex *indexPtr; /* This index gets filled in with the
+ * index of the character nearest to (x,y). */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ register DLine *dlPtr;
+ register TkTextDispChunk *chunkPtr;
+
+ /*
+ * Make sure that all of the layout information about what's
+ * displayed where on the screen is up-to-date.
+ */
+
+ if (dInfoPtr->flags & DINFO_OUT_OF_DATE) {
+ UpdateDisplayInfo(textPtr);
+ }
+
+ /*
+ * If the coordinates are above the top of the window, then adjust
+ * them to refer to the upper-right corner of the window. If they're
+ * off to one side or the other, then adjust to the closest side.
+ */
+
+ if (y < dInfoPtr->y) {
+ y = dInfoPtr->y;
+ x = dInfoPtr->x;
+ }
+ if (x >= dInfoPtr->maxX) {
+ x = dInfoPtr->maxX - 1;
+ }
+ if (x < dInfoPtr->x) {
+ x = dInfoPtr->x;
+ }
+
+ /*
+ * Find the display line containing the desired y-coordinate.
+ */
+
+ for (dlPtr = dInfoPtr->dLinePtr; y >= (dlPtr->y + dlPtr->height);
+ dlPtr = dlPtr->nextPtr) {
+ if (dlPtr->nextPtr == NULL) {
+ /*
+ * Y-coordinate is off the bottom of the displayed text.
+ * Use the last character on the last line.
+ */
+
+ x = dInfoPtr->maxX - 1;
+ break;
+ }
+ }
+
+ /*
+ * Scan through the line's chunks to find the one that contains
+ * the desired x-coordinate. Before doing this, translate the
+ * x-coordinate from the coordinate system of the window to the
+ * coordinate system of the line (to take account of x-scrolling).
+ */
+
+ *indexPtr = dlPtr->index;
+ x = x - dInfoPtr->x + dInfoPtr->curPixelOffset;
+ for (chunkPtr = dlPtr->chunkPtr; x >= (chunkPtr->x + chunkPtr->width);
+ indexPtr->charIndex += chunkPtr->numChars,
+ chunkPtr = chunkPtr->nextPtr) {
+ if (chunkPtr->nextPtr == NULL) {
+ indexPtr->charIndex += chunkPtr->numChars - 1;
+ return;
+ }
+ }
+
+ /*
+ * If the chunk has more than one character in it, ask it which
+ * character is at the desired location.
+ */
+
+ if (chunkPtr->numChars > 1) {
+ indexPtr->charIndex += (*chunkPtr->measureProc)(chunkPtr, x);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextCharBbox --
+ *
+ * Given an index, find the bounding box of the screen area
+ * occupied by that character.
+ *
+ * Results:
+ * Zero is returned if the character is on the screen. -1
+ * means the character isn't on the screen. If the return value
+ * is 0, then the bounding box of the part of the character that's
+ * visible on the screen is returned to *xPtr, *yPtr, *widthPtr,
+ * and *heightPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkTextCharBbox(textPtr, indexPtr, xPtr, yPtr, widthPtr, heightPtr)
+ TkText *textPtr; /* Widget record for text widget. */
+ TkTextIndex *indexPtr; /* Index of character whose bounding
+ * box is desired. */
+ int *xPtr, *yPtr; /* Filled with character's upper-left
+ * coordinate. */
+ int *widthPtr, *heightPtr; /* Filled in with character's dimensions. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ DLine *dlPtr;
+ register TkTextDispChunk *chunkPtr;
+ int index;
+
+ /*
+ * Make sure that all of the screen layout information is up to date.
+ */
+
+ if (dInfoPtr->flags & DINFO_OUT_OF_DATE) {
+ UpdateDisplayInfo(textPtr);
+ }
+
+ /*
+ * Find the display line containing the desired index.
+ */
+
+ dlPtr = FindDLine(dInfoPtr->dLinePtr, indexPtr);
+ if ((dlPtr == NULL) || (TkTextIndexCmp(&dlPtr->index, indexPtr) > 0)) {
+ return -1;
+ }
+
+ /*
+ * Find the chunk within the line that contains the desired
+ * index.
+ */
+
+ index = indexPtr->charIndex - dlPtr->index.charIndex;
+ for (chunkPtr = dlPtr->chunkPtr; ; chunkPtr = chunkPtr->nextPtr) {
+ if (chunkPtr == NULL) {
+ return -1;
+ }
+ if (index < chunkPtr->numChars) {
+ break;
+ }
+ index -= chunkPtr->numChars;
+ }
+
+ /*
+ * Call a chunk-specific procedure to find the horizontal range of
+ * the character within the chunk, then fill in the vertical range.
+ * The x-coordinate returned by bboxProc is a coordinate within a
+ * line, not a coordinate on the screen. Translate it to reflect
+ * horizontal scrolling.
+ */
+
+ (*chunkPtr->bboxProc)(chunkPtr, index, dlPtr->y + dlPtr->spaceAbove,
+ dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow,
+ dlPtr->baseline - dlPtr->spaceAbove, xPtr, yPtr, widthPtr,
+ heightPtr);
+ *xPtr = *xPtr + dInfoPtr->x - dInfoPtr->curPixelOffset;
+ if ((index == (chunkPtr->numChars-1)) && (chunkPtr->nextPtr == NULL)) {
+ /*
+ * Last character in display line. Give it all the space up to
+ * the line.
+ */
+
+ if (*xPtr > dInfoPtr->maxX) {
+ *xPtr = dInfoPtr->maxX;
+ }
+ *widthPtr = dInfoPtr->maxX - *xPtr;
+ }
+ if ((*xPtr + *widthPtr) <= dInfoPtr->x) {
+ return -1;
+ }
+ if ((*xPtr + *widthPtr) > dInfoPtr->maxX) {
+ *widthPtr = dInfoPtr->maxX - *xPtr;
+ if (*widthPtr <= 0) {
+ return -1;
+ }
+ }
+ if ((*yPtr + *heightPtr) > dInfoPtr->maxY) {
+ *heightPtr = dInfoPtr->maxY - *yPtr;
+ if (*heightPtr <= 0) {
+ return -1;
+ }
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextDLineInfo --
+ *
+ * Given an index, return information about the display line
+ * containing that character.
+ *
+ * Results:
+ * Zero is returned if the character is on the screen. -1
+ * means the character isn't on the screen. If the return value
+ * is 0, then information is returned in the variables pointed
+ * to by xPtr, yPtr, widthPtr, heightPtr, and basePtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkTextDLineInfo(textPtr, indexPtr, xPtr, yPtr, widthPtr, heightPtr, basePtr)
+ TkText *textPtr; /* Widget record for text widget. */
+ TkTextIndex *indexPtr; /* Index of character whose bounding
+ * box is desired. */
+ int *xPtr, *yPtr; /* Filled with line's upper-left
+ * coordinate. */
+ int *widthPtr, *heightPtr; /* Filled in with line's dimensions. */
+ int *basePtr; /* Filled in with the baseline position,
+ * measured as an offset down from *yPtr. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ DLine *dlPtr;
+
+ /*
+ * Make sure that all of the screen layout information is up to date.
+ */
+
+ if (dInfoPtr->flags & DINFO_OUT_OF_DATE) {
+ UpdateDisplayInfo(textPtr);
+ }
+
+ /*
+ * Find the display line containing the desired index.
+ */
+
+ dlPtr = FindDLine(dInfoPtr->dLinePtr, indexPtr);
+ if ((dlPtr == NULL) || (TkTextIndexCmp(&dlPtr->index, indexPtr) > 0)) {
+ return -1;
+ }
+
+ *xPtr = dInfoPtr->x - dInfoPtr->curPixelOffset + dlPtr->chunkPtr->x;
+ *widthPtr = dlPtr->length - dlPtr->chunkPtr->x;
+ *yPtr = dlPtr->y;
+ if ((dlPtr->y + dlPtr->height) > dInfoPtr->maxY) {
+ *heightPtr = dInfoPtr->maxY - dlPtr->y;
+ } else {
+ *heightPtr = dlPtr->height;
+ }
+ *basePtr = dlPtr->baseline;
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextCharLayoutProc --
+ *
+ * This procedure is the "layoutProc" for character segments.
+ *
+ * Results:
+ * If there is something to display for the chunk then a
+ * non-zero value is returned and the fields of chunkPtr
+ * will be filled in (see the declaration of TkTextDispChunk
+ * in tkText.h for details). If zero is returned it means
+ * that no characters from this chunk fit in the window.
+ * If -1 is returned it means that this segment just doesn't
+ * need to be displayed (never happens for text).
+ *
+ * Side effects:
+ * Memory is allocated to hold additional information about
+ * the chunk.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextCharLayoutProc(textPtr, indexPtr, segPtr, offset, maxX, maxChars,
+ noCharsYet, wrapMode, chunkPtr)
+ TkText *textPtr; /* Text widget being layed out. */
+ TkTextIndex *indexPtr; /* Index of first character to lay out
+ * (corresponds to segPtr and offset). */
+ TkTextSegment *segPtr; /* Segment being layed out. */
+ int offset; /* Offset within segment of first character
+ * to consider. */
+ int maxX; /* Chunk must not occupy pixels at this
+ * position or higher. */
+ int maxChars; /* Chunk must not include more than this
+ * many characters. */
+ int noCharsYet; /* Non-zero means no characters have been
+ * assigned to this display line yet. */
+ Tk_Uid wrapMode; /* How to handle line wrapping: tkTextCharUid,
+ * tkTextNoneUid, or tkTextWordUid. */
+ register TkTextDispChunk *chunkPtr;
+ /* Structure to fill in with information
+ * about this chunk. The x field has already
+ * been set by the caller. */
+{
+ Tk_Font tkfont;
+ int nextX, charsThatFit, count;
+ CharInfo *ciPtr;
+ char *p;
+ TkTextSegment *nextPtr;
+ Tk_FontMetrics fm;
+
+ /*
+ * Figure out how many characters will fit in the space we've got.
+ * Include the next character, even though it won't fit completely,
+ * if any of the following is true:
+ * (a) the chunk contains no characters and the display line contains
+ * no characters yet (i.e. the line isn't wide enough to hold
+ * even a single character).
+ * (b) at least one pixel of the character is visible, we haven't
+ * already exceeded the character limit, and the next character
+ * is a white space character.
+ */
+
+ p = segPtr->body.chars + offset;
+ tkfont = chunkPtr->stylePtr->sValuePtr->tkfont;
+ charsThatFit = MeasureChars(tkfont, p, maxChars, chunkPtr->x, maxX, 0,
+ &nextX);
+ if (charsThatFit < maxChars) {
+ if ((charsThatFit == 0) && noCharsYet) {
+ charsThatFit = 1;
+ MeasureChars(tkfont, p, 1, chunkPtr->x, INT_MAX, 0, &nextX);
+ }
+ if ((nextX < maxX) && ((p[charsThatFit] == ' ')
+ || (p[charsThatFit] == '\t'))) {
+ /*
+ * Space characters are funny, in that they are considered
+ * to fit if there is at least one pixel of space left on the
+ * line. Just give the space character whatever space is left.
+ */
+
+ nextX = maxX;
+ charsThatFit++;
+ }
+ if (p[charsThatFit] == '\n') {
+ /*
+ * A newline character takes up no space, so if the previous
+ * character fits then so does the newline.
+ */
+
+ charsThatFit++;
+ }
+ if (charsThatFit == 0) {
+ return 0;
+ }
+ }
+
+ Tk_GetFontMetrics(tkfont, &fm);
+
+ /*
+ * Fill in the chunk structure and allocate and initialize a
+ * CharInfo structure. If the last character is a newline
+ * then don't bother to display it.
+ */
+
+ chunkPtr->displayProc = CharDisplayProc;
+ chunkPtr->undisplayProc = CharUndisplayProc;
+ chunkPtr->measureProc = CharMeasureProc;
+ chunkPtr->bboxProc = CharBboxProc;
+ chunkPtr->numChars = charsThatFit;
+ chunkPtr->minAscent = fm.ascent + chunkPtr->stylePtr->sValuePtr->offset;
+ chunkPtr->minDescent = fm.descent - chunkPtr->stylePtr->sValuePtr->offset;
+ chunkPtr->minHeight = 0;
+ chunkPtr->width = nextX - chunkPtr->x;
+ chunkPtr->breakIndex = -1;
+ ciPtr = (CharInfo *) ckalloc((unsigned)
+ (sizeof(CharInfo) - 3 + charsThatFit));
+ chunkPtr->clientData = (ClientData) ciPtr;
+ ciPtr->numChars = charsThatFit;
+ strncpy(ciPtr->chars, p, (size_t) charsThatFit);
+ if (p[charsThatFit-1] == '\n') {
+ ciPtr->numChars--;
+ }
+
+ /*
+ * Compute a break location. If we're in word wrap mode, a
+ * break can occur after any space character, or at the end of
+ * the chunk if the next segment (ignoring those with zero size)
+ * is not a character segment.
+ */
+
+ if (wrapMode != tkTextWordUid) {
+ chunkPtr->breakIndex = chunkPtr->numChars;
+ } else {
+ for (count = charsThatFit, p += charsThatFit-1; count > 0;
+ count--, p--) {
+ if (isspace(UCHAR(*p))) {
+ chunkPtr->breakIndex = count;
+ break;
+ }
+ }
+ if ((charsThatFit+offset) == segPtr->size) {
+ for (nextPtr = segPtr->nextPtr; nextPtr != NULL;
+ nextPtr = nextPtr->nextPtr) {
+ if (nextPtr->size != 0) {
+ if (nextPtr->typePtr != &tkTextCharType) {
+ chunkPtr->breakIndex = chunkPtr->numChars;
+ }
+ break;
+ }
+ }
+ }
+ }
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CharDisplayProc --
+ *
+ * This procedure is called to display a character chunk on
+ * the screen or in an off-screen pixmap.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Graphics are drawn.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CharDisplayProc(chunkPtr, x, y, height, baseline, display, dst, screenY)
+ TkTextDispChunk *chunkPtr; /* Chunk that is to be drawn. */
+ int x; /* X-position in dst at which to
+ * draw this chunk (may differ from
+ * the x-position in the chunk because
+ * of scrolling). */
+ int y; /* Y-position at which to draw this
+ * chunk in dst. */
+ int height; /* Total height of line. */
+ int baseline; /* Offset of baseline from y. */
+ Display *display; /* Display to use for drawing. */
+ Drawable dst; /* Pixmap or window in which to draw
+ * chunk. */
+ int screenY; /* Y-coordinate in text window that
+ * corresponds to y. */
+{
+ CharInfo *ciPtr = (CharInfo *) chunkPtr->clientData;
+ TextStyle *stylePtr;
+ StyleValues *sValuePtr;
+ int offsetChars, offsetX;
+
+ if ((x + chunkPtr->width) <= 0) {
+ /*
+ * The chunk is off-screen.
+ */
+
+ return;
+ }
+
+ stylePtr = chunkPtr->stylePtr;
+ sValuePtr = stylePtr->sValuePtr;
+
+ /*
+ * If the text sticks out way to the left of the window, skip
+ * over the characters that aren't in the visible part of the
+ * window. This is essential if x is very negative (such as
+ * less than 32K); otherwise overflow problems will occur
+ * in servers that use 16-bit arithmetic, like X.
+ */
+
+ offsetX = x;
+ offsetChars = 0;
+ if (x < 0) {
+ offsetChars = MeasureChars(sValuePtr->tkfont, ciPtr->chars,
+ ciPtr->numChars, x, 0, x - chunkPtr->x, &offsetX);
+ }
+
+ /*
+ * Draw the text, underline, and overstrike for this chunk.
+ */
+
+ if (ciPtr->numChars > offsetChars) {
+ int numChars = ciPtr->numChars - offsetChars;
+ char *string = ciPtr->chars + offsetChars;
+
+ if ((numChars > 0) && (string[numChars - 1] == '\t')) {
+ numChars--;
+ }
+ Tk_DrawChars(display, dst, stylePtr->fgGC, sValuePtr->tkfont, string,
+ numChars, offsetX, y + baseline - sValuePtr->offset);
+ if (sValuePtr->underline) {
+ Tk_UnderlineChars(display, dst, stylePtr->fgGC, sValuePtr->tkfont,
+ ciPtr->chars + offsetChars, offsetX,
+ y + baseline - sValuePtr->offset,
+ 0, numChars);
+
+ }
+ if (sValuePtr->overstrike) {
+ Tk_FontMetrics fm;
+
+ Tk_GetFontMetrics(sValuePtr->tkfont, &fm);
+ Tk_UnderlineChars(display, dst, stylePtr->fgGC, sValuePtr->tkfont,
+ ciPtr->chars + offsetChars, offsetX,
+ y + baseline - sValuePtr->offset
+ - fm.descent - (fm.ascent * 3) / 10,
+ 0, numChars);
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CharUndisplayProc --
+ *
+ * This procedure is called when a character chunk is no
+ * longer going to be displayed. It frees up resources
+ * that were allocated to display the chunk.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory and other resources get freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CharUndisplayProc(textPtr, chunkPtr)
+ TkText *textPtr; /* Overall information about text
+ * widget. */
+ TkTextDispChunk *chunkPtr; /* Chunk that is about to be freed. */
+{
+ CharInfo *ciPtr = (CharInfo *) chunkPtr->clientData;
+
+ ckfree((char *) ciPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CharMeasureProc --
+ *
+ * This procedure is called to determine which character in
+ * a character chunk lies over a given x-coordinate.
+ *
+ * Results:
+ * The return value is the index *within the chunk* of the
+ * character that covers the position given by "x".
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CharMeasureProc(chunkPtr, x)
+ TkTextDispChunk *chunkPtr; /* Chunk containing desired coord. */
+ int x; /* X-coordinate, in same coordinate
+ * system as chunkPtr->x. */
+{
+ CharInfo *ciPtr = (CharInfo *) chunkPtr->clientData;
+ int endX;
+
+ return MeasureChars(chunkPtr->stylePtr->sValuePtr->tkfont, ciPtr->chars,
+ chunkPtr->numChars-1, chunkPtr->x, x, 0, &endX);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CharBboxProc --
+ *
+ * This procedure is called to compute the bounding box of
+ * the area occupied by a single character.
+ *
+ * Results:
+ * There is no return value. *xPtr and *yPtr are filled in
+ * with the coordinates of the upper left corner of the
+ * character, and *widthPtr and *heightPtr are filled in with
+ * the dimensions of the character in pixels. Note: not all
+ * of the returned bbox is necessarily visible on the screen
+ * (the rightmost part might be off-screen to the right,
+ * and the bottommost part might be off-screen to the bottom).
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CharBboxProc(chunkPtr, index, y, lineHeight, baseline, xPtr, yPtr,
+ widthPtr, heightPtr)
+ TkTextDispChunk *chunkPtr; /* Chunk containing desired char. */
+ int index; /* Index of desired character within
+ * the chunk. */
+ int y; /* Topmost pixel in area allocated
+ * for this line. */
+ int lineHeight; /* Height of line, in pixels. */
+ int baseline; /* Location of line's baseline, in
+ * pixels measured down from y. */
+ int *xPtr, *yPtr; /* Gets filled in with coords of
+ * character's upper-left pixel.
+ * X-coord is in same coordinate
+ * system as chunkPtr->x. */
+ int *widthPtr; /* Gets filled in with width of
+ * character, in pixels. */
+ int *heightPtr; /* Gets filled in with height of
+ * character, in pixels. */
+{
+ CharInfo *ciPtr = (CharInfo *) chunkPtr->clientData;
+ int maxX;
+
+ maxX = chunkPtr->width + chunkPtr->x;
+ MeasureChars(chunkPtr->stylePtr->sValuePtr->tkfont, ciPtr->chars, index,
+ chunkPtr->x, 1000000, 0, xPtr);
+
+ if (index == ciPtr->numChars) {
+ /*
+ * This situation only happens if the last character in a line
+ * is a space character, in which case it absorbs all of the
+ * extra space in the line (see TkTextCharLayoutProc).
+ */
+
+ *widthPtr = maxX - *xPtr;
+ } else if ((ciPtr->chars[index] == '\t')
+ && (index == (ciPtr->numChars-1))) {
+ /*
+ * The desired character is a tab character that terminates a
+ * chunk; give it all the space left in the chunk.
+ */
+
+ *widthPtr = maxX - *xPtr;
+ } else {
+ MeasureChars(chunkPtr->stylePtr->sValuePtr->tkfont,
+ ciPtr->chars + index, 1, *xPtr, 1000000, 0, widthPtr);
+ if (*widthPtr > maxX) {
+ *widthPtr = maxX - *xPtr;
+ } else {
+ *widthPtr -= *xPtr;
+ }
+ }
+ *yPtr = y + baseline - chunkPtr->minAscent;
+ *heightPtr = chunkPtr->minAscent + chunkPtr->minDescent;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AdjustForTab --
+ *
+ * This procedure is called to move a series of chunks right
+ * in order to align them with a tab stop.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The width of chunkPtr gets adjusted so that it absorbs the
+ * extra space due to the tab. The x locations in all the chunks
+ * after chunkPtr are adjusted rightward to align with the tab
+ * stop given by tabArrayPtr and index.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AdjustForTab(textPtr, tabArrayPtr, index, chunkPtr)
+ TkText *textPtr; /* Information about the text widget as
+ * a whole. */
+ TkTextTabArray *tabArrayPtr; /* Information about the tab stops
+ * that apply to this line. May be
+ * NULL to indicate default tabbing
+ * (every 8 chars). */
+ int index; /* Index of current tab stop. */
+ TkTextDispChunk *chunkPtr; /* Chunk whose last character is
+ * the tab; the following chunks
+ * contain information to be shifted
+ * right. */
+
+{
+ int x, desired, delta, width, decimal, i, gotDigit;
+ TkTextDispChunk *chunkPtr2, *decimalChunkPtr;
+ CharInfo *ciPtr;
+ int tabX, prev, spaceWidth;
+ char *p;
+ TkTextTabAlign alignment;
+
+ if (chunkPtr->nextPtr == NULL) {
+ /*
+ * Nothing after the actual tab; just return.
+ */
+
+ return;
+ }
+
+ /*
+ * If no tab information has been given, do the usual thing:
+ * round up to the next boundary of 8 average-sized characters.
+ */
+
+ x = chunkPtr->nextPtr->x;
+ if ((tabArrayPtr == NULL) || (tabArrayPtr->numTabs == 0)) {
+ /*
+ * No tab information has been given, so use the default
+ * interpretation of tabs.
+ */
+
+ desired = NextTabStop(textPtr->tkfont, x, 0);
+ goto update;
+ }
+
+ if (index < tabArrayPtr->numTabs) {
+ alignment = tabArrayPtr->tabs[index].alignment;
+ tabX = tabArrayPtr->tabs[index].location;
+ } else {
+ /*
+ * Ran out of tab stops; compute a tab position by extrapolating
+ * from the last two tab positions.
+ */
+
+ if (tabArrayPtr->numTabs > 1) {
+ prev = tabArrayPtr->tabs[tabArrayPtr->numTabs-2].location;
+ } else {
+ prev = 0;
+ }
+ alignment = tabArrayPtr->tabs[tabArrayPtr->numTabs-1].alignment;
+ tabX = tabArrayPtr->tabs[tabArrayPtr->numTabs-1].location
+ + (index + 1 - tabArrayPtr->numTabs)
+ * (tabArrayPtr->tabs[tabArrayPtr->numTabs-1].location - prev);
+ }
+
+ if (alignment == LEFT) {
+ desired = tabX;
+ goto update;
+ }
+
+ if ((alignment == CENTER) || (alignment == RIGHT)) {
+ /*
+ * Compute the width of all the information in the tab group,
+ * then use it to pick a desired location.
+ */
+
+ width = 0;
+ for (chunkPtr2 = chunkPtr->nextPtr; chunkPtr2 != NULL;
+ chunkPtr2 = chunkPtr2->nextPtr) {
+ width += chunkPtr2->width;
+ }
+ if (alignment == CENTER) {
+ desired = tabX - width/2;
+ } else {
+ desired = tabX - width;
+ }
+ goto update;
+ }
+
+ /*
+ * Must be numeric alignment. Search through the text to be
+ * tabbed, looking for the last , or . before the first character
+ * that isn't a number, comma, period, or sign.
+ */
+
+ decimalChunkPtr = NULL;
+ decimal = gotDigit = 0;
+ for (chunkPtr2 = chunkPtr->nextPtr; chunkPtr2 != NULL;
+ chunkPtr2 = chunkPtr2->nextPtr) {
+ if (chunkPtr2->displayProc != CharDisplayProc) {
+ continue;
+ }
+ ciPtr = (CharInfo *) chunkPtr2->clientData;
+ for (p = ciPtr->chars, i = 0; i < ciPtr->numChars; p++, i++) {
+ if (isdigit(UCHAR(*p))) {
+ gotDigit = 1;
+ } else if ((*p == '.') || (*p == ',')) {
+ decimal = p-ciPtr->chars;
+ decimalChunkPtr = chunkPtr2;
+ } else if (gotDigit) {
+ if (decimalChunkPtr == NULL) {
+ decimal = p-ciPtr->chars;
+ decimalChunkPtr = chunkPtr2;
+ }
+ goto endOfNumber;
+ }
+ }
+ }
+ endOfNumber:
+ if (decimalChunkPtr != NULL) {
+ int curX;
+
+ ciPtr = (CharInfo *) decimalChunkPtr->clientData;
+ MeasureChars(decimalChunkPtr->stylePtr->sValuePtr->tkfont,
+ ciPtr->chars, decimal, decimalChunkPtr->x, 1000000, 0, &curX);
+ desired = tabX - (curX - x);
+ goto update;
+ } else {
+ /*
+ * There wasn't a decimal point. Right justify the text.
+ */
+
+ width = 0;
+ for (chunkPtr2 = chunkPtr->nextPtr; chunkPtr2 != NULL;
+ chunkPtr2 = chunkPtr2->nextPtr) {
+ width += chunkPtr2->width;
+ }
+ desired = tabX - width;
+ }
+
+ /*
+ * Shift all of the chunks to the right so that the left edge is
+ * at the desired location, then expand the chunk containing the
+ * tab. Be sure that the tab occupies at least the width of a
+ * space character.
+ */
+
+ update:
+ delta = desired - x;
+ MeasureChars(textPtr->tkfont, " ", 1, 0, INT_MAX, 0, &spaceWidth);
+ if (delta < spaceWidth) {
+ delta = spaceWidth;
+ }
+ for (chunkPtr2 = chunkPtr->nextPtr; chunkPtr2 != NULL;
+ chunkPtr2 = chunkPtr2->nextPtr) {
+ chunkPtr2->x += delta;
+ }
+ chunkPtr->width += delta;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SizeOfTab --
+ *
+ * This returns an estimate of the amount of white space that will
+ * be consumed by a tab.
+ *
+ * Results:
+ * The return value is the minimum number of pixels that will
+ * be occupied by the index'th tab of tabArrayPtr, assuming that
+ * the current position on the line is x and the end of the
+ * line is maxX. For numeric tabs, this is a conservative
+ * estimate. The return value is always >= 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SizeOfTab(textPtr, tabArrayPtr, index, x, maxX)
+ TkText *textPtr; /* Information about the text widget as
+ * a whole. */
+ TkTextTabArray *tabArrayPtr; /* Information about the tab stops
+ * that apply to this line. NULL
+ * means use default tabbing (every
+ * 8 chars.) */
+ int index; /* Index of current tab stop. */
+ int x; /* Current x-location in line. Only
+ * used if tabArrayPtr == NULL. */
+ int maxX; /* X-location of pixel just past the
+ * right edge of the line. */
+{
+ int tabX, prev, result, spaceWidth;
+ TkTextTabAlign alignment;
+
+ if ((tabArrayPtr == NULL) || (tabArrayPtr->numTabs == 0)) {
+ tabX = NextTabStop(textPtr->tkfont, x, 0);
+ return tabX - x;
+ }
+ if (index < tabArrayPtr->numTabs) {
+ tabX = tabArrayPtr->tabs[index].location;
+ alignment = tabArrayPtr->tabs[index].alignment;
+ } else {
+ /*
+ * Ran out of tab stops; compute a tab position by extrapolating
+ * from the last two tab positions.
+ */
+
+ if (tabArrayPtr->numTabs > 1) {
+ prev = tabArrayPtr->tabs[tabArrayPtr->numTabs-2].location;
+ } else {
+ prev = 0;
+ }
+ tabX = tabArrayPtr->tabs[tabArrayPtr->numTabs-1].location
+ + (index + 1 - tabArrayPtr->numTabs)
+ * (tabArrayPtr->tabs[tabArrayPtr->numTabs-1].location - prev);
+ alignment = tabArrayPtr->tabs[tabArrayPtr->numTabs-1].alignment;
+ }
+ if (alignment == CENTER) {
+ /*
+ * Be very careful in the arithmetic below, because maxX may
+ * be the largest positive number: watch out for integer
+ * overflow.
+ */
+
+ if ((maxX-tabX) < (tabX - x)) {
+ result = (maxX - x) - 2*(maxX - tabX);
+ } else {
+ result = 0;
+ }
+ goto done;
+ }
+ if (alignment == RIGHT) {
+ result = 0;
+ goto done;
+ }
+
+ /*
+ * Note: this treats NUMERIC alignment the same as LEFT
+ * alignment, which is somewhat conservative. However, it's
+ * pretty tricky at this point to figure out exactly where
+ * the damn decimal point will be.
+ */
+
+ if (tabX > x) {
+ result = tabX - x;
+ } else {
+ result = 0;
+ }
+
+ done:
+ MeasureChars(textPtr->tkfont, " ", 1, 0, INT_MAX, 0, &spaceWidth);
+ if (result < spaceWidth) {
+ result = spaceWidth;
+ }
+ return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * NextTabStop --
+ *
+ * Given the current position, determine where the next default
+ * tab stop would be located. This procedure is called when the
+ * current chunk in the text has no tabs defined and so the default
+ * tab spacing for the font should be used.
+ *
+ * Results:
+ * The location in pixels of the next tab stop.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+NextTabStop(tkfont, x, tabOrigin)
+ Tk_Font tkfont; /* Font in which chunk that contains tab
+ * stop will be drawn. */
+ int x; /* X-position in pixels where last
+ * character was drawn. The next tab stop
+ * occurs somewhere after this location. */
+ int tabOrigin; /* The origin for tab stops. May be
+ * non-zero if text has been scrolled. */
+{
+ int tabWidth, rem;
+
+ tabWidth = Tk_TextWidth(tkfont, "0", 1) * 8;
+ if (tabWidth == 0) {
+ tabWidth = 1;
+ }
+
+ x += tabWidth;
+ rem = (x - tabOrigin) % tabWidth;
+ if (rem < 0) {
+ rem += tabWidth;
+ }
+ x -= rem;
+ return x;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * MeasureChars --
+ *
+ * Determine the number of characters from the string that will fit
+ * in the given horizontal span. The measurement is done under the
+ * assumption that Tk_DisplayChars will be used to actually display
+ * the characters.
+ *
+ * If tabs are encountered in the string, they will be expanded
+ * to the next tab stop, unless the TK_IGNORE_TABS flag is specified.
+ *
+ * If a newline is encountered in the string, the line will be
+ * broken at that point, unless the TK_NEWSLINES_NOT_SPECIAL flag
+ * is specified.
+ *
+ * Results:
+ * The return value is the number of characters from source
+ * that fit in the span given by startX and maxX. *nextXPtr
+ * is filled in with the x-coordinate at which the first
+ * character that didn't fit would be drawn, if it were to
+ * be drawn.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+MeasureChars(tkfont, source, maxChars, startX, maxX, tabOrigin, nextXPtr)
+ Tk_Font tkfont; /* Font in which to draw characters. */
+ CONST char *source; /* Characters to be displayed. Need not
+ * be NULL-terminated. */
+ int maxChars; /* Maximum # of characters to consider from
+ * source. */
+ int startX; /* X-position at which first character will
+ * be drawn. */
+ int maxX; /* Don't consider any character that would
+ * cross this x-position. */
+ int tabOrigin; /* X-location that serves as "origin" for
+ * tab stops. */
+ int *nextXPtr; /* Return x-position of terminating
+ * character here. */
+{
+ int curX, width, ch;
+ CONST char *special, *end, *start;
+
+ ch = 0; /* lint. */
+ curX = startX;
+ special = source;
+ end = source + maxChars;
+ for (start = source; start < end; ) {
+ if (start >= special) {
+ /*
+ * Find the next special character in the string.
+ */
+
+ for (special = start; special < end; special++) {
+ ch = *special;
+ if ((ch == '\t') || (ch == '\n')) {
+ break;
+ }
+ }
+ }
+
+ /*
+ * Special points at the next special character (or the end of the
+ * string). Process characters between start and special.
+ */
+
+ if (curX >= maxX) {
+ break;
+ }
+ start += Tk_MeasureChars(tkfont, start, special - start, maxX - curX,
+ 0, &width);
+ curX += width;
+ if (start < special) {
+ /*
+ * No more chars fit in line.
+ */
+
+ break;
+ }
+ if (special < end) {
+ if (ch == '\t') {
+ start++;
+ } else {
+ break;
+ }
+ }
+ }
+
+ *nextXPtr = curX;
+ return start - source;
+}
diff --git a/generic/tkTextImage.c b/generic/tkTextImage.c
new file mode 100644
index 0000000..b5e363f
--- /dev/null
+++ b/generic/tkTextImage.c
@@ -0,0 +1,898 @@
+/*
+ * tkImage.c --
+ *
+ * This file contains code that allows images to be
+ * nested inside text widgets. It also implements the "image"
+ * widget command for texts.
+ *
+ * Copyright (c) 1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkTextImage.c 1.7 97/08/25 15:47:27
+ */
+
+#include "tk.h"
+#include "tkText.h"
+#include "tkPort.h"
+
+/*
+ * Definitions for alignment values:
+ */
+
+#define ALIGN_BOTTOM 0
+#define ALIGN_CENTER 1
+#define ALIGN_TOP 2
+#define ALIGN_BASELINE 3
+
+/*
+ * Macro that determines the size of an embedded image segment:
+ */
+
+#define EI_SEG_SIZE ((unsigned) (Tk_Offset(TkTextSegment, body) \
+ + sizeof(TkTextEmbImage)))
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static int AlignParseProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin, char *value,
+ char *widgRec, int offset));
+static char * AlignPrintProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr));
+static TkTextSegment * EmbImageCleanupProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+static void EmbImageCheckProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+static void EmbImageBboxProc _ANSI_ARGS_((TkTextDispChunk *chunkPtr,
+ int index, int y, int lineHeight, int baseline,
+ int *xPtr, int *yPtr, int *widthPtr,
+ int *heightPtr));
+static int EmbImageConfigure _ANSI_ARGS_((TkText *textPtr,
+ TkTextSegment *eiPtr, int argc, char **argv));
+static int EmbImageDeleteProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr, int treeGone));
+static void EmbImageDisplayProc _ANSI_ARGS_((
+ TkTextDispChunk *chunkPtr, int x, int y,
+ int lineHeight, int baseline, Display *display,
+ Drawable dst, int screenY));
+static int EmbImageLayoutProc _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *indexPtr, TkTextSegment *segPtr,
+ int offset, int maxX, int maxChars,
+ int noCharsYet, Tk_Uid wrapMode,
+ TkTextDispChunk *chunkPtr));
+static void EmbImageProc _ANSI_ARGS_((ClientData clientData,
+ int x, int y, int width, int height,
+ int imageWidth, int imageHeight));
+
+/*
+ * The following structure declares the "embedded image" segment type.
+ */
+
+static Tk_SegType tkTextEmbImageType = {
+ "image", /* name */
+ 0, /* leftGravity */
+ (Tk_SegSplitProc *) NULL, /* splitProc */
+ EmbImageDeleteProc, /* deleteProc */
+ EmbImageCleanupProc, /* cleanupProc */
+ (Tk_SegLineChangeProc *) NULL, /* lineChangeProc */
+ EmbImageLayoutProc, /* layoutProc */
+ EmbImageCheckProc /* checkProc */
+};
+
+/*
+ * Information used for parsing image configuration options:
+ */
+
+static Tk_CustomOption alignOption = {AlignParseProc, AlignPrintProc,
+ (ClientData) NULL};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_CUSTOM, "-align", (char *) NULL, (char *) NULL,
+ "center", 0, TK_CONFIG_DONT_SET_DEFAULT, &alignOption},
+ {TK_CONFIG_PIXELS, "-padx", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(TkTextEmbImage, padX),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_PIXELS, "-pady", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(TkTextEmbImage, padY),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_STRING, "-image", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextEmbImage, imageString),
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-name", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextEmbImage, imageName),
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextImageCmd --
+ *
+ * This procedure implements the "image" widget command
+ * for text widgets. See the user documentation for details
+ * on what it does.
+ *
+ * Results:
+ * A standard Tcl result or error.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextImageCmd(textPtr, interp, argc, argv)
+ register TkText *textPtr; /* Information about text widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. Someone else has already
+ * parsed this command enough to know that
+ * argv[1] is "image". */
+{
+ size_t length;
+ register TkTextSegment *eiPtr;
+
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " image option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ length = strlen(argv[2]);
+ if ((strncmp(argv[2], "cget", length) == 0) && (length >= 2)) {
+ TkTextIndex index;
+ TkTextSegment *eiPtr;
+
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " image cget index option\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ eiPtr = TkTextIndexToSeg(&index, (int *) NULL);
+ if (eiPtr->typePtr != &tkTextEmbImageType) {
+ Tcl_AppendResult(interp, "no embedded image at index \"",
+ argv[3], "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return Tk_ConfigureValue(interp, textPtr->tkwin, configSpecs,
+ (char *) &eiPtr->body.ei, argv[4], 0);
+ } else if ((strncmp(argv[2], "configure", length) == 0) && (length >= 2)) {
+ TkTextIndex index;
+ TkTextSegment *eiPtr;
+
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " image configure index ?option value ...?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ eiPtr = TkTextIndexToSeg(&index, (int *) NULL);
+ if (eiPtr->typePtr != &tkTextEmbImageType) {
+ Tcl_AppendResult(interp, "no embedded image at index \"",
+ argv[3], "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc == 4) {
+ return Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,
+ (char *) &eiPtr->body.ei, (char *) NULL, 0);
+ } else if (argc == 5) {
+ return Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,
+ (char *) &eiPtr->body.ei, argv[4], 0);
+ } else {
+ TkTextChanged(textPtr, &index, &index);
+ return EmbImageConfigure(textPtr, eiPtr, argc-4, argv+4);
+ }
+ } else if ((strncmp(argv[2], "create", length) == 0) && (length >= 2)) {
+ TkTextIndex index;
+ int lineIndex;
+
+ /*
+ * Add a new image. Find where to put the new image, and
+ * mark that position for redisplay.
+ */
+
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " image create index ?option value ...?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Don't allow insertions on the last (dummy) line of the text.
+ */
+
+ lineIndex = TkBTreeLineIndex(index.linePtr);
+ if (lineIndex == TkBTreeNumLines(textPtr->tree)) {
+ lineIndex--;
+ TkTextMakeIndex(textPtr->tree, lineIndex, 1000000, &index);
+ }
+
+ /*
+ * Create the new image segment and initialize it.
+ */
+
+ eiPtr = (TkTextSegment *) ckalloc(EI_SEG_SIZE);
+ eiPtr->typePtr = &tkTextEmbImageType;
+ eiPtr->size = 1;
+ eiPtr->body.ei.textPtr = textPtr;
+ eiPtr->body.ei.linePtr = NULL;
+ eiPtr->body.ei.imageName = NULL;
+ eiPtr->body.ei.imageString = NULL;
+ eiPtr->body.ei.name = NULL;
+ eiPtr->body.ei.image = NULL;
+ eiPtr->body.ei.align = ALIGN_CENTER;
+ eiPtr->body.ei.padX = eiPtr->body.ei.padY = 0;
+ eiPtr->body.ei.chunkCount = 0;
+
+ /*
+ * Link the segment into the text widget, then configure it (delete
+ * it again if the configuration fails).
+ */
+
+ TkTextChanged(textPtr, &index, &index);
+ TkBTreeLinkSegment(eiPtr, &index);
+ if (EmbImageConfigure(textPtr, eiPtr, argc-4, argv+4) != TCL_OK) {
+ TkTextIndex index2;
+
+ TkTextIndexForwChars(&index, 1, &index2);
+ TkBTreeDeleteChars(&index, &index2);
+ return TCL_ERROR;
+ }
+ } else if (strncmp(argv[2], "names", length) == 0) {
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " image names\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (hPtr = Tcl_FirstHashEntry(&textPtr->imageTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendElement(interp,
+ Tcl_GetHashKey(&textPtr->markTable, hPtr));
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad image option \"", argv[2],
+ "\": must be cget, configure, create, or names",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbImageConfigure --
+ *
+ * This procedure is called to handle configuration options
+ * for an embedded image, using an argc/argv list.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then interp->result contains an error message..
+ *
+ * Side effects:
+ * Configuration information for the embedded image changes,
+ * such as alignment, or name of the image.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+EmbImageConfigure(textPtr, eiPtr, argc, argv)
+ TkText *textPtr; /* Information about text widget that
+ * contains embedded image. */
+ TkTextSegment *eiPtr; /* Embedded image to be configured. */
+ int argc; /* Number of strings in argv. */
+ char **argv; /* Array of strings describing configuration
+ * options. */
+{
+ Tk_Image image;
+ Tcl_DString newName;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ int new;
+ char *name;
+ int count = 0; /* The counter for picking a unique name */
+ int conflict = 0; /* True if we have a name conflict */
+ unsigned int len; /* length of image name */
+
+ if (Tk_ConfigureWidget(textPtr->interp, textPtr->tkwin, configSpecs,
+ argc, argv, (char *) &eiPtr->body.ei,TK_CONFIG_ARGV_ONLY)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the image. Save the old image around and don't free it
+ * until after the new one is allocated. This keeps the reference
+ * count from going to zero so the image doesn't have to be recreated
+ * if it hasn't changed.
+ */
+
+ if (eiPtr->body.ei.imageString != NULL) {
+ image = Tk_GetImage(textPtr->interp, textPtr->tkwin, eiPtr->body.ei.imageString,
+ EmbImageProc, (ClientData) eiPtr);
+ if (image == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (eiPtr->body.ei.image != NULL) {
+ Tk_FreeImage(eiPtr->body.ei.image);
+ }
+ eiPtr->body.ei.image = image;
+
+ if (eiPtr->body.ei.name != NULL) {
+ return TCL_OK;
+ }
+
+ /*
+ * Find a unique name for this image. Use imageName (or imageString)
+ * if available, otherwise tack on a #nn and use it. If a name is already
+ * associated with this image, delete the name.
+ */
+
+ name = eiPtr->body.ei.imageName;
+ if (name == NULL) {
+ name = eiPtr->body.ei.imageString;
+ }
+ if (name == NULL) {
+ Tcl_AppendResult(textPtr->interp,"Either a \"-name\" ",
+ "or a \"-image\" argument must be provided ",
+ "to the \"image create\" subcommand.",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ len = strlen(name);
+ for (hPtr = Tcl_FirstHashEntry(&textPtr->imageTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ char *haveName = Tcl_GetHashKey(&textPtr->imageTable, hPtr);
+ if (strncmp(name, haveName, len) == 0) {
+ new = 0;
+ sscanf(haveName+len,"#%d",&new);
+ if (new > count) {
+ count = new;
+ }
+ if (len == (int) strlen(haveName)) {
+ conflict = 1;
+ }
+ }
+ }
+
+ Tcl_DStringInit(&newName);
+ Tcl_DStringAppend(&newName,name, -1);
+
+ if (conflict) {
+ char buf[10];
+ sprintf(buf, "#%d",count+1);
+ Tcl_DStringAppend(&newName,buf, -1);
+ }
+ name = Tcl_DStringValue(&newName);
+ hPtr = Tcl_CreateHashEntry(&textPtr->imageTable, name, &new);
+ Tcl_SetHashValue(hPtr, eiPtr);
+ Tcl_AppendResult(textPtr->interp, name , (char *) NULL);
+ eiPtr->body.ei.name = ckalloc((unsigned) Tcl_DStringLength(&newName)+1);
+ strcpy(eiPtr->body.ei.name,name);
+ Tcl_DStringFree(&newName);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * AlignParseProc --
+ *
+ * This procedure is invoked by Tk_ConfigureWidget during
+ * option processing to handle "-align" options for embedded
+ * images.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * The alignment for the embedded image may change.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+AlignParseProc(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* Not used.*/
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_Window tkwin; /* Window for text widget. */
+ char *value; /* Value of option. */
+ char *widgRec; /* Pointer to TkTextEmbWindow
+ * structure. */
+ int offset; /* Offset into item (ignored). */
+{
+ register TkTextEmbImage *embPtr = (TkTextEmbImage *) widgRec;
+
+ if (strcmp(value, "baseline") == 0) {
+ embPtr->align = ALIGN_BASELINE;
+ } else if (strcmp(value, "bottom") == 0) {
+ embPtr->align = ALIGN_BOTTOM;
+ } else if (strcmp(value, "center") == 0) {
+ embPtr->align = ALIGN_CENTER;
+ } else if (strcmp(value, "top") == 0) {
+ embPtr->align = ALIGN_TOP;
+ } else {
+ Tcl_AppendResult(interp, "bad alignment \"", value,
+ "\": must be baseline, bottom, center, or top",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * AlignPrintProc --
+ *
+ * This procedure is invoked by the Tk configuration code
+ * to produce a printable string for the "-align" configuration
+ * option for embedded images.
+ *
+ * Results:
+ * The return value is a string describing the embedded
+ * images's current alignment.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+AlignPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
+ ClientData clientData; /* Ignored. */
+ Tk_Window tkwin; /* Window for text widget. */
+ char *widgRec; /* Pointer to TkTextEmbImage
+ * structure. */
+ int offset; /* Ignored. */
+ Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with
+ * information about how to reclaim
+ * storage for return string. */
+{
+ switch (((TkTextEmbImage *) widgRec)->align) {
+ case ALIGN_BASELINE:
+ return "baseline";
+ case ALIGN_BOTTOM:
+ return "bottom";
+ case ALIGN_CENTER:
+ return "center";
+ case ALIGN_TOP:
+ return "top";
+ default:
+ return "??";
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbImageDeleteProc --
+ *
+ * This procedure is invoked by the text B-tree code whenever
+ * an embedded image lies in a range of characters being deleted.
+ *
+ * Results:
+ * Returns 0 to indicate that the deletion has been accepted.
+ *
+ * Side effects:
+ * The embedded image is deleted, if it exists, and any resources
+ * associated with it are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+EmbImageDeleteProc(eiPtr, linePtr, treeGone)
+ TkTextSegment *eiPtr; /* Segment being deleted. */
+ TkTextLine *linePtr; /* Line containing segment. */
+ int treeGone; /* Non-zero means the entire tree is
+ * being deleted, so everything must
+ * get cleaned up. */
+{
+ Tcl_HashEntry *hPtr;
+
+ if (eiPtr->body.ei.image != NULL) {
+ hPtr = Tcl_FindHashEntry(&eiPtr->body.ei.textPtr->imageTable,
+ eiPtr->body.ei.name);
+ if (hPtr != NULL) {
+ /*
+ * (It's possible for there to be no hash table entry for this
+ * image, if an error occurred while creating the image segment
+ * but before the image got added to the table)
+ */
+
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ Tk_FreeImage(eiPtr->body.ei.image);
+ }
+ Tk_FreeOptions(configSpecs, (char *) &eiPtr->body.ei,
+ eiPtr->body.ei.textPtr->display, 0);
+ if (eiPtr->body.ei.name != NULL) {
+ ckfree(eiPtr->body.ei.name);
+ }
+ ckfree((char *) eiPtr);
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbImageCleanupProc --
+ *
+ * This procedure is invoked by the B-tree code whenever a
+ * segment containing an embedded image is moved from one
+ * line to another.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The linePtr field of the segment gets updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static TkTextSegment *
+EmbImageCleanupProc(eiPtr, linePtr)
+ TkTextSegment *eiPtr; /* Mark segment that's being moved. */
+ TkTextLine *linePtr; /* Line that now contains segment. */
+{
+ eiPtr->body.ei.linePtr = linePtr;
+ return eiPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbImageLayoutProc --
+ *
+ * This procedure is the "layoutProc" for embedded image
+ * segments.
+ *
+ * Results:
+ * 1 is returned to indicate that the segment should be
+ * displayed. The chunkPtr structure is filled in.
+ *
+ * Side effects:
+ * None, except for filling in chunkPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /*ARGSUSED*/
+static int
+EmbImageLayoutProc(textPtr, indexPtr, eiPtr, offset, maxX, maxChars,
+ noCharsYet, wrapMode, chunkPtr)
+ TkText *textPtr; /* Text widget being layed out. */
+ TkTextIndex *indexPtr; /* Identifies first character in chunk. */
+ TkTextSegment *eiPtr; /* Segment corresponding to indexPtr. */
+ int offset; /* Offset within segPtr corresponding to
+ * indexPtr (always 0). */
+ int maxX; /* Chunk must not occupy pixels at this
+ * position or higher. */
+ int maxChars; /* Chunk must not include more than this
+ * many characters. */
+ int noCharsYet; /* Non-zero means no characters have been
+ * assigned to this line yet. */
+ Tk_Uid wrapMode; /* Wrap mode to use for line: tkTextCharUid,
+ * tkTextNoneUid, or tkTextWordUid. */
+ register TkTextDispChunk *chunkPtr;
+ /* Structure to fill in with information
+ * about this chunk. The x field has already
+ * been set by the caller. */
+{
+ int width, height;
+
+ if (offset != 0) {
+ panic("Non-zero offset in EmbImageLayoutProc");
+ }
+
+ /*
+ * See if there's room for this image on this line.
+ */
+
+ if (eiPtr->body.ei.image == NULL) {
+ width = 0;
+ height = 0;
+ } else {
+ Tk_SizeOfImage(eiPtr->body.ei.image, &width, &height);
+ width += 2*eiPtr->body.ei.padX;
+ height += 2*eiPtr->body.ei.padY;
+ }
+ if ((width > (maxX - chunkPtr->x))
+ && !noCharsYet && (textPtr->wrapMode != tkTextNoneUid)) {
+ return 0;
+ }
+
+ /*
+ * Fill in the chunk structure.
+ */
+
+ chunkPtr->displayProc = EmbImageDisplayProc;
+ chunkPtr->undisplayProc = (Tk_ChunkUndisplayProc *) NULL;
+ chunkPtr->measureProc = (Tk_ChunkMeasureProc *) NULL;
+ chunkPtr->bboxProc = EmbImageBboxProc;
+ chunkPtr->numChars = 1;
+ if (eiPtr->body.ei.align == ALIGN_BASELINE) {
+ chunkPtr->minAscent = height - eiPtr->body.ei.padY;
+ chunkPtr->minDescent = eiPtr->body.ei.padY;
+ chunkPtr->minHeight = 0;
+ } else {
+ chunkPtr->minAscent = 0;
+ chunkPtr->minDescent = 0;
+ chunkPtr->minHeight = height;
+ }
+ chunkPtr->width = width;
+ chunkPtr->breakIndex = -1;
+ chunkPtr->breakIndex = 1;
+ chunkPtr->clientData = (ClientData) eiPtr;
+ eiPtr->body.ei.chunkCount += 1;
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbImageCheckProc --
+ *
+ * This procedure is invoked by the B-tree code to perform
+ * consistency checks on embedded images.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The procedure panics if it detects anything wrong with
+ * the embedded image.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbImageCheckProc(eiPtr, linePtr)
+ TkTextSegment *eiPtr; /* Segment to check. */
+ TkTextLine *linePtr; /* Line containing segment. */
+{
+ if (eiPtr->nextPtr == NULL) {
+ panic("EmbImageCheckProc: embedded image is last segment in line");
+ }
+ if (eiPtr->size != 1) {
+ panic("EmbImageCheckProc: embedded image has size %d", eiPtr->size);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbImageDisplayProc --
+ *
+ * This procedure is invoked by the text displaying code
+ * when it is time to actually draw an embedded image
+ * chunk on the screen.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The embedded image gets moved to the correct location
+ * and drawn onto the display.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbImageDisplayProc(chunkPtr, x, y, lineHeight, baseline, display, dst, screenY)
+ TkTextDispChunk *chunkPtr; /* Chunk that is to be drawn. */
+ int x; /* X-position in dst at which to
+ * draw this chunk (differs from
+ * the x-position in the chunk because
+ * of scrolling). */
+ int y; /* Top of rectangular bounding box
+ * for line: tells where to draw this
+ * chunk in dst (x-position is in
+ * the chunk itself). */
+ int lineHeight; /* Total height of line. */
+ int baseline; /* Offset of baseline from y. */
+ Display *display; /* Display to use for drawing. */
+ Drawable dst; /* Pixmap or window in which to draw */
+ int screenY; /* Y-coordinate in text window that
+ * corresponds to y. */
+{
+ TkTextSegment *eiPtr = (TkTextSegment *) chunkPtr->clientData;
+ int lineX, imageX, imageY, width, height;
+ Tk_Image image;
+
+ image = eiPtr->body.ei.image;
+ if (image == NULL) {
+ return;
+ }
+ if ((x + chunkPtr->width) <= 0) {
+ return;
+ }
+
+ /*
+ * Compute the image's location and size in the text widget, taking
+ * into account the align value for the image.
+ */
+
+ EmbImageBboxProc(chunkPtr, 0, y, lineHeight, baseline, &lineX,
+ &imageY, &width, &height);
+ imageX = lineX - chunkPtr->x + x;
+
+ Tk_RedrawImage(image, 0, 0, width, height, dst,
+ imageX, imageY);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbImageBboxProc --
+ *
+ * This procedure is called to compute the bounding box of
+ * the area occupied by an embedded image.
+ *
+ * Results:
+ * There is no return value. *xPtr and *yPtr are filled in
+ * with the coordinates of the upper left corner of the
+ * image, and *widthPtr and *heightPtr are filled in with
+ * the dimensions of the image in pixels. Note: not all
+ * of the returned bbox is necessarily visible on the screen
+ * (the rightmost part might be off-screen to the right,
+ * and the bottommost part might be off-screen to the bottom).
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbImageBboxProc(chunkPtr, index, y, lineHeight, baseline, xPtr, yPtr,
+ widthPtr, heightPtr)
+ TkTextDispChunk *chunkPtr; /* Chunk containing desired char. */
+ int index; /* Index of desired character within
+ * the chunk. */
+ int y; /* Topmost pixel in area allocated
+ * for this line. */
+ int lineHeight; /* Total height of line. */
+ int baseline; /* Location of line's baseline, in
+ * pixels measured down from y. */
+ int *xPtr, *yPtr; /* Gets filled in with coords of
+ * character's upper-left pixel. */
+ int *widthPtr; /* Gets filled in with width of
+ * character, in pixels. */
+ int *heightPtr; /* Gets filled in with height of
+ * character, in pixels. */
+{
+ TkTextSegment *eiPtr = (TkTextSegment *) chunkPtr->clientData;
+ Tk_Image image;
+
+ image = eiPtr->body.ei.image;
+ if (image != NULL) {
+ Tk_SizeOfImage(image, widthPtr, heightPtr);
+ } else {
+ *widthPtr = 0;
+ *heightPtr = 0;
+ }
+ *xPtr = chunkPtr->x + eiPtr->body.ei.padX;
+ switch (eiPtr->body.ei.align) {
+ case ALIGN_BOTTOM:
+ *yPtr = y + (lineHeight - *heightPtr - eiPtr->body.ei.padY);
+ break;
+ case ALIGN_CENTER:
+ *yPtr = y + (lineHeight - *heightPtr)/2;
+ break;
+ case ALIGN_TOP:
+ *yPtr = y + eiPtr->body.ei.padY;
+ break;
+ case ALIGN_BASELINE:
+ *yPtr = y + (baseline - *heightPtr);
+ break;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextImageIndex --
+ *
+ * Given the name of an embedded image within a text widget,
+ * returns an index corresponding to the image's position
+ * in the text.
+ *
+ * Results:
+ * The return value is 1 if there is an embedded image by
+ * the given name in the text widget, 0 otherwise. If the
+ * image exists, *indexPtr is filled in with its index.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextImageIndex(textPtr, name, indexPtr)
+ TkText *textPtr; /* Text widget containing image. */
+ char *name; /* Name of image. */
+ TkTextIndex *indexPtr; /* Index information gets stored here. */
+{
+ Tcl_HashEntry *hPtr;
+ TkTextSegment *eiPtr;
+
+ hPtr = Tcl_FindHashEntry(&textPtr->imageTable, name);
+ if (hPtr == NULL) {
+ return 0;
+ }
+ eiPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr);
+ indexPtr->tree = textPtr->tree;
+ indexPtr->linePtr = eiPtr->body.ei.linePtr;
+ indexPtr->charIndex = TkTextSegToOffset(eiPtr, indexPtr->linePtr);
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbImageProc --
+ *
+ * This procedure is called by the image code whenever an
+ * image or its contents changes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image will be redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbImageProc(clientData, x, y, width, height, imgWidth, imgHeight)
+ ClientData clientData; /* Pointer to widget record. */
+ int x, y; /* Upper left pixel (within image)
+ * that must be redisplayed. */
+ int width, height; /* Dimensions of area to redisplay
+ * (may be <= 0). */
+ int imgWidth, imgHeight; /* New dimensions of image. */
+
+{
+ TkTextSegment *eiPtr = (TkTextSegment *) clientData;
+ TkTextIndex index;
+
+ index.tree = eiPtr->body.ei.textPtr->tree;
+ index.linePtr = eiPtr->body.ei.linePtr;
+ index.charIndex = TkTextSegToOffset(eiPtr, eiPtr->body.ei.linePtr);
+ TkTextChanged(eiPtr->body.ei.textPtr, &index, &index);
+}
diff --git a/generic/tkTextIndex.c b/generic/tkTextIndex.c
new file mode 100644
index 0000000..d88d88a
--- /dev/null
+++ b/generic/tkTextIndex.c
@@ -0,0 +1,840 @@
+/*
+ * tkTextIndex.c --
+ *
+ * This module provides procedures that manipulate indices for
+ * text widgets.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkTextIndex.c 1.15 97/06/17 17:49:24
+ */
+
+#include "default.h"
+#include "tkPort.h"
+#include "tkInt.h"
+#include "tkText.h"
+
+/*
+ * Index to use to select last character in line (very large integer):
+ */
+
+#define LAST_CHAR 1000000
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static char * ForwBack _ANSI_ARGS_((char *string,
+ TkTextIndex *indexPtr));
+static char * StartEnd _ANSI_ARGS_(( char *string,
+ TkTextIndex *indexPtr));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextMakeIndex --
+ *
+ * Given a line index and a character index, look things up
+ * in the B-tree and fill in a TkTextIndex structure.
+ *
+ * Results:
+ * The structure at *indexPtr is filled in with information
+ * about the character at lineIndex and charIndex (or the
+ * closest existing character, if the specified one doesn't
+ * exist), and indexPtr is returned as result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+TkTextIndex *
+TkTextMakeIndex(tree, lineIndex, charIndex, indexPtr)
+ TkTextBTree tree; /* Tree that lineIndex and charIndex refer
+ * to. */
+ int lineIndex; /* Index of desired line (0 means first
+ * line of text). */
+ int charIndex; /* Index of desired character. */
+ TkTextIndex *indexPtr; /* Structure to fill in. */
+{
+ register TkTextSegment *segPtr;
+ int index;
+
+ indexPtr->tree = tree;
+ if (lineIndex < 0) {
+ lineIndex = 0;
+ charIndex = 0;
+ }
+ if (charIndex < 0) {
+ charIndex = 0;
+ }
+ indexPtr->linePtr = TkBTreeFindLine(tree, lineIndex);
+ if (indexPtr->linePtr == NULL) {
+ indexPtr->linePtr = TkBTreeFindLine(tree, TkBTreeNumLines(tree));
+ charIndex = 0;
+ }
+
+ /*
+ * Verify that the index is within the range of the line.
+ * If not, just use the index of the last character in the line.
+ */
+
+ for (index = 0, segPtr = indexPtr->linePtr->segPtr; ;
+ segPtr = segPtr->nextPtr) {
+ if (segPtr == NULL) {
+ indexPtr->charIndex = index-1;
+ break;
+ }
+ index += segPtr->size;
+ if (index > charIndex) {
+ indexPtr->charIndex = charIndex;
+ break;
+ }
+ }
+ return indexPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextIndexToSeg --
+ *
+ * Given an index, this procedure returns the segment and
+ * offset within segment for the index.
+ *
+ * Results:
+ * The return value is a pointer to the segment referred to
+ * by indexPtr; this will always be a segment with non-zero
+ * size. The variable at *offsetPtr is set to hold the
+ * integer offset within the segment of the character
+ * given by indexPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+TkTextSegment *
+TkTextIndexToSeg(indexPtr, offsetPtr)
+ TkTextIndex *indexPtr; /* Text index. */
+ int *offsetPtr; /* Where to store offset within
+ * segment, or NULL if offset isn't
+ * wanted. */
+{
+ register TkTextSegment *segPtr;
+ int offset;
+
+ for (offset = indexPtr->charIndex, segPtr = indexPtr->linePtr->segPtr;
+ offset >= segPtr->size;
+ offset -= segPtr->size, segPtr = segPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ if (offsetPtr != NULL) {
+ *offsetPtr = offset;
+ }
+ return segPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextSegToOffset --
+ *
+ * Given a segment pointer and the line containing it, this
+ * procedure returns the offset of the segment within its
+ * line.
+ *
+ * Results:
+ * The return value is the offset (within its line) of the
+ * first character in segPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextSegToOffset(segPtr, linePtr)
+ TkTextSegment *segPtr; /* Segment whose offset is desired. */
+ TkTextLine *linePtr; /* Line containing segPtr. */
+{
+ TkTextSegment *segPtr2;
+ int offset;
+
+ offset = 0;
+ for (segPtr2 = linePtr->segPtr; segPtr2 != segPtr;
+ segPtr2 = segPtr2->nextPtr) {
+ offset += segPtr2->size;
+ }
+ return offset;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextGetIndex --
+ *
+ * Given a string, return the line and character indices that
+ * it describes.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If
+ * TCL_OK is returned, then everything went well and the index
+ * at *indexPtr is filled in; otherwise TCL_ERROR is returned
+ * and an error message is left in interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkTextGetIndex(interp, textPtr, string, indexPtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ TkText *textPtr; /* Information about text widget. */
+ char *string; /* Textual description of position. */
+ TkTextIndex *indexPtr; /* Index structure to fill in. */
+{
+ register char *p;
+ char *end, *endOfBase;
+ Tcl_HashEntry *hPtr;
+ TkTextTag *tagPtr;
+ TkTextSearch search;
+ TkTextIndex first, last;
+ int wantLast, result;
+ char c;
+
+ /*
+ *---------------------------------------------------------------------
+ * Stage 1: check to see if the index consists of nothing but a mark
+ * name. We do this check now even though it's also done later, in
+ * order to allow mark names that include funny characters such as
+ * spaces or "+1c".
+ *---------------------------------------------------------------------
+ */
+
+ if (TkTextMarkNameToIndex(textPtr, string, indexPtr) == TCL_OK) {
+ return TCL_OK;
+ }
+
+ /*
+ *------------------------------------------------
+ * Stage 2: start again by parsing the base index.
+ *------------------------------------------------
+ */
+
+ indexPtr->tree = textPtr->tree;
+
+ /*
+ * First look for the form "tag.first" or "tag.last" where "tag"
+ * is the name of a valid tag. Try to use up as much as possible
+ * of the string in this check (strrchr instead of strchr below).
+ * Doing the check now, and in this way, allows tag names to include
+ * funny characters like "@" or "+1c".
+ */
+
+ p = strrchr(string, '.');
+ if (p != NULL) {
+ if ((p[1] == 'f') && (strncmp(p+1, "first", 5) == 0)) {
+ wantLast = 0;
+ endOfBase = p+6;
+ } else if ((p[1] == 'l') && (strncmp(p+1, "last", 4) == 0)) {
+ wantLast = 1;
+ endOfBase = p+5;
+ } else {
+ goto tryxy;
+ }
+ *p = 0;
+ hPtr = Tcl_FindHashEntry(&textPtr->tagTable, string);
+ *p = '.';
+ if (hPtr == NULL) {
+ goto tryxy;
+ }
+ tagPtr = (TkTextTag *) Tcl_GetHashValue(hPtr);
+ TkTextMakeIndex(textPtr->tree, 0, 0, &first);
+ TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0,
+ &last);
+ TkBTreeStartSearch(&first, &last, tagPtr, &search);
+ if (!TkBTreeCharTagged(&first, tagPtr) && !TkBTreeNextTag(&search)) {
+ Tcl_AppendResult(interp,
+ "text doesn't contain any characters tagged with \"",
+ Tcl_GetHashKey(&textPtr->tagTable, hPtr), "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ *indexPtr = search.curIndex;
+ if (wantLast) {
+ while (TkBTreeNextTag(&search)) {
+ *indexPtr = search.curIndex;
+ }
+ }
+ goto gotBase;
+ }
+
+ tryxy:
+ if (string[0] == '@') {
+ /*
+ * Find character at a given x,y location in the window.
+ */
+
+ int x, y;
+
+ p = string+1;
+ x = strtol(p, &end, 0);
+ if ((end == p) || (*end != ',')) {
+ goto error;
+ }
+ p = end+1;
+ y = strtol(p, &end, 0);
+ if (end == p) {
+ goto error;
+ }
+ TkTextPixelIndex(textPtr, x, y, indexPtr);
+ endOfBase = end;
+ goto gotBase;
+ }
+
+ if (isdigit(UCHAR(string[0])) || (string[0] == '-')) {
+ int lineIndex, charIndex;
+
+ /*
+ * Base is identified with line and character indices.
+ */
+
+ lineIndex = strtol(string, &end, 0) - 1;
+ if ((end == string) || (*end != '.')) {
+ goto error;
+ }
+ p = end+1;
+ if ((*p == 'e') && (strncmp(p, "end", 3) == 0)) {
+ charIndex = LAST_CHAR;
+ endOfBase = p+3;
+ } else {
+ charIndex = strtol(p, &end, 0);
+ if (end == p) {
+ goto error;
+ }
+ endOfBase = end;
+ }
+ TkTextMakeIndex(textPtr->tree, lineIndex, charIndex, indexPtr);
+ goto gotBase;
+ }
+
+ for (p = string; *p != 0; p++) {
+ if (isspace(UCHAR(*p)) || (*p == '+') || (*p == '-')) {
+ break;
+ }
+ }
+ endOfBase = p;
+ if (string[0] == '.') {
+ /*
+ * See if the base position is the name of an embedded window.
+ */
+
+ c = *endOfBase;
+ *endOfBase = 0;
+ result = TkTextWindowIndex(textPtr, string, indexPtr);
+ *endOfBase = c;
+ if (result != 0) {
+ goto gotBase;
+ }
+ }
+ if ((string[0] == 'e')
+ && (strncmp(string, "end", (size_t) (endOfBase-string)) == 0)) {
+ /*
+ * Base position is end of text.
+ */
+
+ TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
+ 0, indexPtr);
+ goto gotBase;
+ } else {
+ /*
+ * See if the base position is the name of a mark.
+ */
+
+ c = *endOfBase;
+ *endOfBase = 0;
+ result = TkTextMarkNameToIndex(textPtr, string, indexPtr);
+ *endOfBase = c;
+ if (result == TCL_OK) {
+ goto gotBase;
+ }
+
+ /*
+ * See if the base position is the name of an embedded image
+ */
+
+ c = *endOfBase;
+ *endOfBase = 0;
+ result = TkTextImageIndex(textPtr, string, indexPtr);
+ *endOfBase = c;
+ if (result != 0) {
+ goto gotBase;
+ }
+ }
+ goto error;
+
+ /*
+ *-------------------------------------------------------------------
+ * Stage 3: process zero or more modifiers. Each modifier is either
+ * a keyword like "wordend" or "linestart", or it has the form
+ * "op count units" where op is + or -, count is a number, and units
+ * is "chars" or "lines".
+ *-------------------------------------------------------------------
+ */
+
+ gotBase:
+ p = endOfBase;
+ while (1) {
+ while (isspace(UCHAR(*p))) {
+ p++;
+ }
+ if (*p == 0) {
+ break;
+ }
+
+ if ((*p == '+') || (*p == '-')) {
+ p = ForwBack(p, indexPtr);
+ } else {
+ p = StartEnd(p, indexPtr);
+ }
+ if (p == NULL) {
+ goto error;
+ }
+ }
+ return TCL_OK;
+
+ error:
+ Tcl_AppendResult(interp, "bad text index \"", string, "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextPrintIndex --
+ *
+ *
+ * This procedure generates a string description of an index,
+ * suitable for reading in again later.
+ *
+ * Results:
+ * The characters pointed to by string are modified.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextPrintIndex(indexPtr, string)
+ TkTextIndex *indexPtr; /* Pointer to index. */
+ char *string; /* Place to store the position. Must have
+ * at least TK_POS_CHARS characters. */
+{
+ sprintf(string, "%d.%d", TkBTreeLineIndex(indexPtr->linePtr) + 1,
+ indexPtr->charIndex);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextIndexCmp --
+ *
+ * Compare two indices to see which one is earlier in
+ * the text.
+ *
+ * Results:
+ * The return value is 0 if index1Ptr and index2Ptr refer
+ * to the same position in the file, -1 if index1Ptr refers
+ * to an earlier position than index2Ptr, and 1 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextIndexCmp(index1Ptr, index2Ptr)
+ TkTextIndex *index1Ptr; /* First index. */
+ TkTextIndex *index2Ptr; /* Second index. */
+{
+ int line1, line2;
+
+ if (index1Ptr->linePtr == index2Ptr->linePtr) {
+ if (index1Ptr->charIndex < index2Ptr->charIndex) {
+ return -1;
+ } else if (index1Ptr->charIndex > index2Ptr->charIndex) {
+ return 1;
+ } else {
+ return 0;
+ }
+ }
+ line1 = TkBTreeLineIndex(index1Ptr->linePtr);
+ line2 = TkBTreeLineIndex(index2Ptr->linePtr);
+ if (line1 < line2) {
+ return -1;
+ }
+ if (line1 > line2) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ForwBack --
+ *
+ * This procedure handles +/- modifiers for indices to adjust
+ * the index forwards or backwards.
+ *
+ * Results:
+ * If the modifier in string is successfully parsed then the
+ * return value is the address of the first character after the
+ * modifier, and *indexPtr is updated to reflect the modifier.
+ * If there is a syntax error in the modifier then NULL is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+ForwBack(string, indexPtr)
+ char *string; /* String to parse for additional info
+ * about modifier (count and units).
+ * Points to "+" or "-" that starts
+ * modifier. */
+ TkTextIndex *indexPtr; /* Index to update as specified in string. */
+{
+ register char *p;
+ char *end, *units;
+ int count, lineIndex;
+ size_t length;
+
+ /*
+ * Get the count (how many units forward or backward).
+ */
+
+ p = string+1;
+ while (isspace(UCHAR(*p))) {
+ p++;
+ }
+ count = strtol(p, &end, 0);
+ if (end == p) {
+ return NULL;
+ }
+ p = end;
+ while (isspace(UCHAR(*p))) {
+ p++;
+ }
+
+ /*
+ * Find the end of this modifier (next space or + or - character),
+ * then parse the unit specifier and update the position
+ * accordingly.
+ */
+
+ units = p;
+ while ((*p != 0) && !isspace(UCHAR(*p)) && (*p != '+') && (*p != '-')) {
+ p++;
+ }
+ length = p - units;
+ if ((*units == 'c') && (strncmp(units, "chars", length) == 0)) {
+ if (*string == '+') {
+ TkTextIndexForwChars(indexPtr, count, indexPtr);
+ } else {
+ TkTextIndexBackChars(indexPtr, count, indexPtr);
+ }
+ } else if ((*units == 'l') && (strncmp(units, "lines", length) == 0)) {
+ lineIndex = TkBTreeLineIndex(indexPtr->linePtr);
+ if (*string == '+') {
+ lineIndex += count;
+ } else {
+ lineIndex -= count;
+
+ /*
+ * The check below retains the character position, even
+ * if the line runs off the start of the file. Without
+ * it, the character position will get reset to 0 by
+ * TkTextMakeIndex.
+ */
+
+ if (lineIndex < 0) {
+ lineIndex = 0;
+ }
+ }
+ TkTextMakeIndex(indexPtr->tree, lineIndex, indexPtr->charIndex,
+ indexPtr);
+ } else {
+ return NULL;
+ }
+ return p;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextIndexForwChars --
+ *
+ * Given an index for a text widget, this procedure creates a
+ * new index that points "count" characters ahead of the source
+ * index.
+ *
+ * Results:
+ * *dstPtr is modified to refer to the character "count" characters
+ * after srcPtr, or to the last character in the file if there aren't
+ * "count" characters left in the file.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+void
+TkTextIndexForwChars(srcPtr, count, dstPtr)
+ TkTextIndex *srcPtr; /* Source index. */
+ int count; /* How many characters forward to
+ * move. May be negative. */
+ TkTextIndex *dstPtr; /* Destination index: gets modified. */
+{
+ TkTextLine *linePtr;
+ TkTextSegment *segPtr;
+ int lineLength;
+
+ if (count < 0) {
+ TkTextIndexBackChars(srcPtr, -count, dstPtr);
+ return;
+ }
+
+ *dstPtr = *srcPtr;
+ dstPtr->charIndex += count;
+ while (1) {
+ /*
+ * Compute the length of the current line.
+ */
+
+ lineLength = 0;
+ for (segPtr = dstPtr->linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ lineLength += segPtr->size;
+ }
+
+ /*
+ * If the new index is in the same line then we're done.
+ * Otherwise go on to the next line.
+ */
+
+ if (dstPtr->charIndex < lineLength) {
+ return;
+ }
+ dstPtr->charIndex -= lineLength;
+ linePtr = TkBTreeNextLine(dstPtr->linePtr);
+ if (linePtr == NULL) {
+ dstPtr->charIndex = lineLength - 1;
+ return;
+ }
+ dstPtr->linePtr = linePtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextIndexBackChars --
+ *
+ * Given an index for a text widget, this procedure creates a
+ * new index that points "count" characters earlier than the
+ * source index.
+ *
+ * Results:
+ * *dstPtr is modified to refer to the character "count" characters
+ * before srcPtr, or to the first character in the file if there aren't
+ * "count" characters earlier than srcPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextIndexBackChars(srcPtr, count, dstPtr)
+ TkTextIndex *srcPtr; /* Source index. */
+ int count; /* How many characters backward to
+ * move. May be negative. */
+ TkTextIndex *dstPtr; /* Destination index: gets modified. */
+{
+ TkTextSegment *segPtr;
+ int lineIndex;
+
+ if (count < 0) {
+ TkTextIndexForwChars(srcPtr, -count, dstPtr);
+ return;
+ }
+
+ *dstPtr = *srcPtr;
+ dstPtr->charIndex -= count;
+ lineIndex = -1;
+ while (dstPtr->charIndex < 0) {
+ /*
+ * Move back one line in the text. If we run off the beginning
+ * of the file then just return the first character in the text.
+ */
+
+ if (lineIndex < 0) {
+ lineIndex = TkBTreeLineIndex(dstPtr->linePtr);
+ }
+ if (lineIndex == 0) {
+ dstPtr->charIndex = 0;
+ return;
+ }
+ lineIndex--;
+ dstPtr->linePtr = TkBTreeFindLine(dstPtr->tree, lineIndex);
+
+ /*
+ * Compute the length of the line and add that to dstPtr->charIndex.
+ */
+
+ for (segPtr = dstPtr->linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ dstPtr->charIndex += segPtr->size;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StartEnd --
+ *
+ * This procedure handles modifiers like "wordstart" and "lineend"
+ * to adjust indices forwards or backwards.
+ *
+ * Results:
+ * If the modifier is successfully parsed then the return value
+ * is the address of the first character after the modifier, and
+ * *indexPtr is updated to reflect the modifier. If there is a
+ * syntax error in the modifier then NULL is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+StartEnd(string, indexPtr)
+ char *string; /* String to parse for additional info
+ * about modifier (count and units).
+ * Points to first character of modifer
+ * word. */
+ TkTextIndex *indexPtr; /* Index to mdoify based on string. */
+{
+ char *p;
+ int c, offset;
+ size_t length;
+ register TkTextSegment *segPtr;
+
+ /*
+ * Find the end of the modifier word.
+ */
+
+ for (p = string; isalnum(UCHAR(*p)); p++) {
+ /* Empty loop body. */
+ }
+ length = p-string;
+ if ((*string == 'l') && (strncmp(string, "lineend", length) == 0)
+ && (length >= 5)) {
+ indexPtr->charIndex = 0;
+ for (segPtr = indexPtr->linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ indexPtr->charIndex += segPtr->size;
+ }
+ indexPtr->charIndex -= 1;
+ } else if ((*string == 'l') && (strncmp(string, "linestart", length) == 0)
+ && (length >= 5)) {
+ indexPtr->charIndex = 0;
+ } else if ((*string == 'w') && (strncmp(string, "wordend", length) == 0)
+ && (length >= 5)) {
+ int firstChar = 1;
+
+ /*
+ * If the current character isn't part of a word then just move
+ * forward one character. Otherwise move forward until finding
+ * a character that isn't part of a word and stop there.
+ */
+
+ segPtr = TkTextIndexToSeg(indexPtr, &offset);
+ while (1) {
+ if (segPtr->typePtr == &tkTextCharType) {
+ c = segPtr->body.chars[offset];
+ if (!isalnum(UCHAR(c)) && (c != '_')) {
+ break;
+ }
+ firstChar = 0;
+ }
+ offset += 1;
+ indexPtr->charIndex += 1;
+ if (offset >= segPtr->size) {
+ segPtr = TkTextIndexToSeg(indexPtr, &offset);
+ }
+ }
+ if (firstChar) {
+ TkTextIndexForwChars(indexPtr, 1, indexPtr);
+ }
+ } else if ((*string == 'w') && (strncmp(string, "wordstart", length) == 0)
+ && (length >= 5)) {
+ int firstChar = 1;
+
+ /*
+ * Starting with the current character, look for one that's not
+ * part of a word and keep moving backward until you find one.
+ * Then if the character found wasn't the first one, move forward
+ * again one position.
+ */
+
+ segPtr = TkTextIndexToSeg(indexPtr, &offset);
+ while (1) {
+ if (segPtr->typePtr == &tkTextCharType) {
+ c = segPtr->body.chars[offset];
+ if (!isalnum(UCHAR(c)) && (c != '_')) {
+ break;
+ }
+ firstChar = 0;
+ }
+ offset -= 1;
+ indexPtr->charIndex -= 1;
+ if (offset < 0) {
+ if (indexPtr->charIndex < 0) {
+ indexPtr->charIndex = 0;
+ goto done;
+ }
+ segPtr = TkTextIndexToSeg(indexPtr, &offset);
+ }
+ }
+ if (!firstChar) {
+ TkTextIndexForwChars(indexPtr, 1, indexPtr);
+ }
+ } else {
+ return NULL;
+ }
+ done:
+ return p;
+}
diff --git a/generic/tkTextMark.c b/generic/tkTextMark.c
new file mode 100644
index 0000000..0d12c98
--- /dev/null
+++ b/generic/tkTextMark.c
@@ -0,0 +1,775 @@
+/*
+ * tkTextMark.c --
+ *
+ * This file contains the procedure that implement marks for
+ * text widgets.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkTextMark.c 1.18 97/10/20 11:12:50
+ */
+
+#include "tkInt.h"
+#include "tkText.h"
+#include "tkPort.h"
+
+/*
+ * Macro that determines the size of a mark segment:
+ */
+
+#define MSEG_SIZE ((unsigned) (Tk_Offset(TkTextSegment, body) \
+ + sizeof(TkTextMark)))
+
+/*
+ * Forward references for procedures defined in this file:
+ */
+
+static void InsertUndisplayProc _ANSI_ARGS_((TkText *textPtr,
+ TkTextDispChunk *chunkPtr));
+static int MarkDeleteProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr, int treeGone));
+static TkTextSegment * MarkCleanupProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+static void MarkCheckProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+static int MarkLayoutProc _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *indexPtr, TkTextSegment *segPtr,
+ int offset, int maxX, int maxChars,
+ int noCharsYet, Tk_Uid wrapMode,
+ TkTextDispChunk *chunkPtr));
+static int MarkFindNext _ANSI_ARGS_((Tcl_Interp *interp,
+ TkText *textPtr, char *markName));
+static int MarkFindPrev _ANSI_ARGS_((Tcl_Interp *interp,
+ TkText *textPtr, char *markName));
+
+
+/*
+ * The following structures declare the "mark" segment types.
+ * There are actually two types for marks, one with left gravity
+ * and one with right gravity. They are identical except for
+ * their gravity property.
+ */
+
+Tk_SegType tkTextRightMarkType = {
+ "mark", /* name */
+ 0, /* leftGravity */
+ (Tk_SegSplitProc *) NULL, /* splitProc */
+ MarkDeleteProc, /* deleteProc */
+ MarkCleanupProc, /* cleanupProc */
+ (Tk_SegLineChangeProc *) NULL, /* lineChangeProc */
+ MarkLayoutProc, /* layoutProc */
+ MarkCheckProc /* checkProc */
+};
+
+Tk_SegType tkTextLeftMarkType = {
+ "mark", /* name */
+ 1, /* leftGravity */
+ (Tk_SegSplitProc *) NULL, /* splitProc */
+ MarkDeleteProc, /* deleteProc */
+ MarkCleanupProc, /* cleanupProc */
+ (Tk_SegLineChangeProc *) NULL, /* lineChangeProc */
+ MarkLayoutProc, /* layoutProc */
+ MarkCheckProc /* checkProc */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextMarkCmd --
+ *
+ * This procedure is invoked to process the "mark" options of
+ * the widget command for text widgets. See the user documentation
+ * for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextMarkCmd(textPtr, interp, argc, argv)
+ register TkText *textPtr; /* Information about text widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. Someone else has already
+ * parsed this command enough to know that
+ * argv[1] is "mark". */
+{
+ int c, i;
+ size_t length;
+ Tcl_HashEntry *hPtr;
+ TkTextSegment *markPtr;
+ Tcl_HashSearch search;
+ TkTextIndex index;
+ Tk_SegType *newTypePtr;
+
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " mark option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = argv[2][0];
+ length = strlen(argv[2]);
+ if ((c == 'g') && (strncmp(argv[2], "gravity", length) == 0)) {
+ if (argc < 4 || argc > 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " mark gravity markName ?gravity?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ hPtr = Tcl_FindHashEntry(&textPtr->markTable, argv[3]);
+ if (hPtr == NULL) {
+ Tcl_AppendResult(interp, "there is no mark named \"",
+ argv[3], "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ markPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr);
+ if (argc == 4) {
+ if (markPtr->typePtr == &tkTextRightMarkType) {
+ interp->result = "right";
+ } else {
+ interp->result = "left";
+ }
+ return TCL_OK;
+ }
+ length = strlen(argv[4]);
+ c = argv[4][0];
+ if ((c == 'l') && (strncmp(argv[4], "left", length) == 0)) {
+ newTypePtr = &tkTextLeftMarkType;
+ } else if ((c == 'r') && (strncmp(argv[4], "right", length) == 0)) {
+ newTypePtr = &tkTextRightMarkType;
+ } else {
+ Tcl_AppendResult(interp, "bad mark gravity \"",
+ argv[4], "\": must be left or right", (char *) NULL);
+ return TCL_ERROR;
+ }
+ TkTextMarkSegToIndex(textPtr, markPtr, &index);
+ TkBTreeUnlinkSegment(textPtr->tree, markPtr,
+ markPtr->body.mark.linePtr);
+ markPtr->typePtr = newTypePtr;
+ TkBTreeLinkSegment(markPtr, &index);
+ } else if ((c == 'n') && (strncmp(argv[2], "names", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " mark names\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (hPtr = Tcl_FirstHashEntry(&textPtr->markTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendElement(interp,
+ Tcl_GetHashKey(&textPtr->markTable, hPtr));
+ }
+ } else if ((c == 'n') && (strncmp(argv[2], "next", length) == 0)) {
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " mark next index\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return MarkFindNext(interp, textPtr, argv[3]);
+ } else if ((c == 'p') && (strncmp(argv[2], "previous", length) == 0)) {
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " mark previous index\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return MarkFindPrev(interp, textPtr, argv[3]);
+ } else if ((c == 's') && (strncmp(argv[2], "set", length) == 0)) {
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " mark set markName index\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[4], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ TkTextSetMark(textPtr, argv[3], &index);
+ } else if ((c == 'u') && (strncmp(argv[2], "unset", length) == 0)) {
+ for (i = 3; i < argc; i++) {
+ hPtr = Tcl_FindHashEntry(&textPtr->markTable, argv[i]);
+ if (hPtr != NULL) {
+ markPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr);
+ if ((markPtr == textPtr->insertMarkPtr)
+ || (markPtr == textPtr->currentMarkPtr)) {
+ continue;
+ }
+ TkBTreeUnlinkSegment(textPtr->tree, markPtr,
+ markPtr->body.mark.linePtr);
+ Tcl_DeleteHashEntry(hPtr);
+ ckfree((char *) markPtr);
+ }
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad mark option \"", argv[2],
+ "\": must be gravity, names, next, previous, set, or unset",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextSetMark --
+ *
+ * Set a mark to a particular position, creating a new mark if
+ * one doesn't already exist.
+ *
+ * Results:
+ * The return value is a pointer to the mark that was just set.
+ *
+ * Side effects:
+ * A new mark is created, or an existing mark is moved.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkTextSegment *
+TkTextSetMark(textPtr, name, indexPtr)
+ TkText *textPtr; /* Text widget in which to create mark. */
+ char *name; /* Name of mark to set. */
+ TkTextIndex *indexPtr; /* Where to set mark. */
+{
+ Tcl_HashEntry *hPtr;
+ TkTextSegment *markPtr;
+ TkTextIndex insertIndex;
+ int new;
+
+ hPtr = Tcl_CreateHashEntry(&textPtr->markTable, name, &new);
+ markPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr);
+ if (!new) {
+ /*
+ * If this is the insertion point that's being moved, be sure
+ * to force a display update at the old position. Also, don't
+ * let the insertion cursor be after the final newline of the
+ * file.
+ */
+
+ if (markPtr == textPtr->insertMarkPtr) {
+ TkTextIndex index, index2;
+ TkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index);
+ TkTextIndexForwChars(&index, 1, &index2);
+ TkTextChanged(textPtr, &index, &index2);
+ if (TkBTreeLineIndex(indexPtr->linePtr)
+ == TkBTreeNumLines(textPtr->tree)) {
+ TkTextIndexBackChars(indexPtr, 1, &insertIndex);
+ indexPtr = &insertIndex;
+ }
+ }
+ TkBTreeUnlinkSegment(textPtr->tree, markPtr,
+ markPtr->body.mark.linePtr);
+ } else {
+ markPtr = (TkTextSegment *) ckalloc(MSEG_SIZE);
+ markPtr->typePtr = &tkTextRightMarkType;
+ markPtr->size = 0;
+ markPtr->body.mark.textPtr = textPtr;
+ markPtr->body.mark.linePtr = indexPtr->linePtr;
+ markPtr->body.mark.hPtr = hPtr;
+ Tcl_SetHashValue(hPtr, markPtr);
+ }
+ TkBTreeLinkSegment(markPtr, indexPtr);
+
+ /*
+ * If the mark is the insertion cursor, then update the screen at the
+ * mark's new location.
+ */
+
+ if (markPtr == textPtr->insertMarkPtr) {
+ TkTextIndex index2;
+
+ TkTextIndexForwChars(indexPtr, 1, &index2);
+ TkTextChanged(textPtr, indexPtr, &index2);
+ }
+ return markPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextMarkSegToIndex --
+ *
+ * Given a segment that is a mark, create an index that
+ * refers to the next text character (or other text segment
+ * with non-zero size) after the mark.
+ *
+ * Results:
+ * *IndexPtr is filled in with index information.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkTextMarkSegToIndex(textPtr, markPtr, indexPtr)
+ TkText *textPtr; /* Text widget containing mark. */
+ TkTextSegment *markPtr; /* Mark segment. */
+ TkTextIndex *indexPtr; /* Index information gets stored here. */
+{
+ TkTextSegment *segPtr;
+
+ indexPtr->tree = textPtr->tree;
+ indexPtr->linePtr = markPtr->body.mark.linePtr;
+ indexPtr->charIndex = 0;
+ for (segPtr = indexPtr->linePtr->segPtr; segPtr != markPtr;
+ segPtr = segPtr->nextPtr) {
+ indexPtr->charIndex += segPtr->size;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextMarkNameToIndex --
+ *
+ * Given the name of a mark, return an index corresponding
+ * to the mark name.
+ *
+ * Results:
+ * The return value is TCL_OK if "name" exists as a mark in
+ * the text widget. In this case *indexPtr is filled in with
+ * the next segment whose after the mark whose size is
+ * non-zero. TCL_ERROR is returned if the mark doesn't exist
+ * in the text widget.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextMarkNameToIndex(textPtr, name, indexPtr)
+ TkText *textPtr; /* Text widget containing mark. */
+ char *name; /* Name of mark. */
+ TkTextIndex *indexPtr; /* Index information gets stored here. */
+{
+ Tcl_HashEntry *hPtr;
+
+ hPtr = Tcl_FindHashEntry(&textPtr->markTable, name);
+ if (hPtr == NULL) {
+ return TCL_ERROR;
+ }
+ TkTextMarkSegToIndex(textPtr, (TkTextSegment *) Tcl_GetHashValue(hPtr),
+ indexPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MarkDeleteProc --
+ *
+ * This procedure is invoked by the text B-tree code whenever
+ * a mark lies in a range of characters being deleted.
+ *
+ * Results:
+ * Returns 1 to indicate that deletion has been rejected.
+ *
+ * Side effects:
+ * None (even if the whole tree is being deleted we don't
+ * free up the mark; it will be done elsewhere).
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+MarkDeleteProc(segPtr, linePtr, treeGone)
+ TkTextSegment *segPtr; /* Segment being deleted. */
+ TkTextLine *linePtr; /* Line containing segment. */
+ int treeGone; /* Non-zero means the entire tree is
+ * being deleted, so everything must
+ * get cleaned up. */
+{
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MarkCleanupProc --
+ *
+ * This procedure is invoked by the B-tree code whenever a
+ * mark segment is moved from one line to another.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The linePtr field of the segment gets updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static TkTextSegment *
+MarkCleanupProc(markPtr, linePtr)
+ TkTextSegment *markPtr; /* Mark segment that's being moved. */
+ TkTextLine *linePtr; /* Line that now contains segment. */
+{
+ markPtr->body.mark.linePtr = linePtr;
+ return markPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MarkLayoutProc --
+ *
+ * This procedure is the "layoutProc" for mark segments.
+ *
+ * Results:
+ * If the mark isn't the insertion cursor then the return
+ * value is -1 to indicate that this segment shouldn't be
+ * displayed. If the mark is the insertion character then
+ * 1 is returned and the chunkPtr structure is filled in.
+ *
+ * Side effects:
+ * None, except for filling in chunkPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /*ARGSUSED*/
+static int
+MarkLayoutProc(textPtr, indexPtr, segPtr, offset, maxX, maxChars,
+ noCharsYet, wrapMode, chunkPtr)
+ TkText *textPtr; /* Text widget being layed out. */
+ TkTextIndex *indexPtr; /* Identifies first character in chunk. */
+ TkTextSegment *segPtr; /* Segment corresponding to indexPtr. */
+ int offset; /* Offset within segPtr corresponding to
+ * indexPtr (always 0). */
+ int maxX; /* Chunk must not occupy pixels at this
+ * position or higher. */
+ int maxChars; /* Chunk must not include more than this
+ * many characters. */
+ int noCharsYet; /* Non-zero means no characters have been
+ * assigned to this line yet. */
+ Tk_Uid wrapMode; /* Not used. */
+ register TkTextDispChunk *chunkPtr;
+ /* Structure to fill in with information
+ * about this chunk. The x field has already
+ * been set by the caller. */
+{
+ if (segPtr != textPtr->insertMarkPtr) {
+ return -1;
+ }
+
+ chunkPtr->displayProc = TkTextInsertDisplayProc;
+ chunkPtr->undisplayProc = InsertUndisplayProc;
+ chunkPtr->measureProc = (Tk_ChunkMeasureProc *) NULL;
+ chunkPtr->bboxProc = (Tk_ChunkBboxProc *) NULL;
+ chunkPtr->numChars = 0;
+ chunkPtr->minAscent = 0;
+ chunkPtr->minDescent = 0;
+ chunkPtr->minHeight = 0;
+ chunkPtr->width = 0;
+
+ /*
+ * Note: can't break a line after the insertion cursor: this
+ * prevents the insertion cursor from being stranded at the end
+ * of a line.
+ */
+
+ chunkPtr->breakIndex = -1;
+ chunkPtr->clientData = (ClientData) textPtr;
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextInsertDisplayProc --
+ *
+ * This procedure is called to display the insertion
+ * cursor.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Graphics are drawn.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+void
+TkTextInsertDisplayProc(chunkPtr, x, y, height, baseline, display, dst, screenY)
+ TkTextDispChunk *chunkPtr; /* Chunk that is to be drawn. */
+ int x; /* X-position in dst at which to
+ * draw this chunk (may differ from
+ * the x-position in the chunk because
+ * of scrolling). */
+ int y; /* Y-position at which to draw this
+ * chunk in dst (x-position is in
+ * the chunk itself). */
+ int height; /* Total height of line. */
+ int baseline; /* Offset of baseline from y. */
+ Display *display; /* Display to use for drawing. */
+ Drawable dst; /* Pixmap or window in which to draw
+ * chunk. */
+ int screenY; /* Y-coordinate in text window that
+ * corresponds to y. */
+{
+ TkText *textPtr = (TkText *) chunkPtr->clientData;
+ int halfWidth = textPtr->insertWidth/2;
+
+ if ((x + halfWidth) < 0) {
+ /*
+ * The insertion cursor is off-screen. Just return.
+ */
+
+ return;
+ }
+
+ /*
+ * As a special hack to keep the cursor visible on mono displays
+ * (or anywhere else that the selection and insertion cursors
+ * have the same color) write the default background in the cursor
+ * area (instead of nothing) when the cursor isn't on. Otherwise
+ * the selection might hide the cursor.
+ */
+
+ if (textPtr->flags & INSERT_ON) {
+ Tk_Fill3DRectangle(textPtr->tkwin, dst, textPtr->insertBorder,
+ x - textPtr->insertWidth/2, y, textPtr->insertWidth,
+ height, textPtr->insertBorderWidth, TK_RELIEF_RAISED);
+ } else if (textPtr->selBorder == textPtr->insertBorder) {
+ Tk_Fill3DRectangle(textPtr->tkwin, dst, textPtr->border,
+ x - textPtr->insertWidth/2, y, textPtr->insertWidth,
+ height, 0, TK_RELIEF_FLAT);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * InsertUndisplayProc --
+ *
+ * This procedure is called when the insertion cursor is no
+ * longer at a visible point on the display. It does nothing
+ * right now.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+InsertUndisplayProc(textPtr, chunkPtr)
+ TkText *textPtr; /* Overall information about text
+ * widget. */
+ TkTextDispChunk *chunkPtr; /* Chunk that is about to be freed. */
+{
+ return;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MarkCheckProc --
+ *
+ * This procedure is invoked by the B-tree code to perform
+ * consistency checks on mark segments.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The procedure panics if it detects anything wrong with
+ * the mark.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+MarkCheckProc(markPtr, linePtr)
+ TkTextSegment *markPtr; /* Segment to check. */
+ TkTextLine *linePtr; /* Line containing segment. */
+{
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+
+ if (markPtr->body.mark.linePtr != linePtr) {
+ panic("MarkCheckProc: markPtr->body.mark.linePtr bogus");
+ }
+
+ /*
+ * Make sure that the mark is still present in the text's mark
+ * hash table.
+ */
+
+ for (hPtr = Tcl_FirstHashEntry(&markPtr->body.mark.textPtr->markTable,
+ &search); hPtr != markPtr->body.mark.hPtr;
+ hPtr = Tcl_NextHashEntry(&search)) {
+ if (hPtr == NULL) {
+ panic("MarkCheckProc couldn't find hash table entry for mark");
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MarkFindNext --
+ *
+ * This procedure searches forward for the next mark.
+ *
+ * Results:
+ * A standard Tcl result, which is a mark name or an empty string.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+MarkFindNext(interp, textPtr, string)
+ Tcl_Interp *interp; /* For error reporting */
+ TkText *textPtr; /* The widget */
+ char *string; /* The starting index or mark name */
+{
+ TkTextIndex index;
+ Tcl_HashEntry *hPtr;
+ register TkTextSegment *segPtr;
+ int offset;
+
+
+ hPtr = Tcl_FindHashEntry(&textPtr->markTable, string);
+ if (hPtr != NULL) {
+ /*
+ * If given a mark name, return the next mark in the list of
+ * segments, even if it happens to be at the same character position.
+ */
+ segPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr);
+ TkTextMarkSegToIndex(textPtr, segPtr, &index);
+ segPtr = segPtr->nextPtr;
+ } else {
+ /*
+ * For non-mark name indices we want to return any marks that
+ * are right at the index.
+ */
+ if (TkTextGetIndex(interp, textPtr, string, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ for (offset = 0, segPtr = index.linePtr->segPtr;
+ segPtr != NULL && offset < index.charIndex;
+ offset += segPtr->size, segPtr = segPtr->nextPtr) {
+ /* Empty loop body */ ;
+ }
+ }
+ while (1) {
+ /*
+ * segPtr points at the first possible candidate,
+ * or NULL if we ran off the end of the line.
+ */
+ for ( ; segPtr != NULL ; segPtr = segPtr->nextPtr) {
+ if (segPtr->typePtr == &tkTextRightMarkType ||
+ segPtr->typePtr == &tkTextLeftMarkType) {
+ Tcl_SetResult(interp,
+ Tcl_GetHashKey(&textPtr->markTable, segPtr->body.mark.hPtr),
+ TCL_STATIC);
+ return TCL_OK;
+ }
+ }
+ index.linePtr = TkBTreeNextLine(index.linePtr);
+ if (index.linePtr == (TkTextLine *) NULL) {
+ return TCL_OK;
+ }
+ index.charIndex = 0;
+ segPtr = index.linePtr->segPtr;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MarkFindPrev --
+ *
+ * This procedure searches backwards for the previous mark.
+ *
+ * Results:
+ * A standard Tcl result, which is a mark name or an empty string.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+MarkFindPrev(interp, textPtr, string)
+ Tcl_Interp *interp; /* For error reporting */
+ TkText *textPtr; /* The widget */
+ char *string; /* The starting index or mark name */
+{
+ TkTextIndex index;
+ Tcl_HashEntry *hPtr;
+ register TkTextSegment *segPtr, *seg2Ptr, *prevPtr;
+ int offset;
+
+
+ hPtr = Tcl_FindHashEntry(&textPtr->markTable, string);
+ if (hPtr != NULL) {
+ /*
+ * If given a mark name, return the previous mark in the list of
+ * segments, even if it happens to be at the same character position.
+ */
+ segPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr);
+ TkTextMarkSegToIndex(textPtr, segPtr, &index);
+ } else {
+ /*
+ * For non-mark name indices we do not return any marks that
+ * are right at the index.
+ */
+ if (TkTextGetIndex(interp, textPtr, string, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ for (offset = 0, segPtr = index.linePtr->segPtr;
+ segPtr != NULL && offset < index.charIndex;
+ offset += segPtr->size, segPtr = segPtr->nextPtr) {
+ /* Empty loop body */ ;
+ }
+ }
+ while (1) {
+ /*
+ * segPtr points just past the first possible candidate,
+ * or at the begining of the line.
+ */
+ for (prevPtr = NULL, seg2Ptr = index.linePtr->segPtr;
+ seg2Ptr != NULL && seg2Ptr != segPtr;
+ seg2Ptr = seg2Ptr->nextPtr) {
+ if (seg2Ptr->typePtr == &tkTextRightMarkType ||
+ seg2Ptr->typePtr == &tkTextLeftMarkType) {
+ prevPtr = seg2Ptr;
+ }
+ }
+ if (prevPtr != NULL) {
+ Tcl_SetResult(interp,
+ Tcl_GetHashKey(&textPtr->markTable, prevPtr->body.mark.hPtr),
+ TCL_STATIC);
+ return TCL_OK;
+ }
+ index.linePtr = TkBTreePreviousLine(index.linePtr);
+ if (index.linePtr == (TkTextLine *) NULL) {
+ return TCL_OK;
+ }
+ segPtr = NULL;
+ }
+}
diff --git a/generic/tkTextTag.c b/generic/tkTextTag.c
new file mode 100644
index 0000000..b5b04be
--- /dev/null
+++ b/generic/tkTextTag.c
@@ -0,0 +1,1376 @@
+/*
+ * tkTextTag.c --
+ *
+ * This module implements the "tag" subcommand of the widget command
+ * for text widgets, plus most of the other high-level functions
+ * related to tags.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkTextTag.c 1.39 97/02/07 13:51:52
+ */
+
+#include "default.h"
+#include "tkPort.h"
+#include "tk.h"
+#include "tkText.h"
+
+/*
+ * Information used for parsing tag configuration information:
+ */
+
+static Tk_ConfigSpec tagConfigSpecs[] = {
+ {TK_CONFIG_BORDER, "-background", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, border), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-bgstipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, bgStipple), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-borderwidth", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(TkTextTag, bdString),
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-fgstipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, fgStipple), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_FONT, "-font", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, tkfont), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-foreground", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, fgColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-justify", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, justifyString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-lmargin1", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, lMargin1String), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-lmargin2", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, lMargin2String), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-offset", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, offsetString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-overstrike", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, overstrikeString),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-relief", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, reliefString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-rmargin", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, rMarginString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-spacing1", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, spacing1String), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-spacing2", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, spacing2String), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-spacing3", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, spacing3String), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-tabs", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, tabString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-underline", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, underlineString),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_UID, "-wrap", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, wrapMode),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void ChangeTagPriority _ANSI_ARGS_((TkText *textPtr,
+ TkTextTag *tagPtr, int prio));
+static TkTextTag * FindTag _ANSI_ARGS_((Tcl_Interp *interp,
+ TkText *textPtr, char *tagName));
+static void SortTags _ANSI_ARGS_((int numTags,
+ TkTextTag **tagArrayPtr));
+static int TagSortProc _ANSI_ARGS_((CONST VOID *first,
+ CONST VOID *second));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextTagCmd --
+ *
+ * This procedure is invoked to process the "tag" options of
+ * the widget command for text widgets. See the user documentation
+ * for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextTagCmd(textPtr, interp, argc, argv)
+ register TkText *textPtr; /* Information about text widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. Someone else has already
+ * parsed this command enough to know that
+ * argv[1] is "tag". */
+{
+ int c, i, addTag;
+ size_t length;
+ char *fullOption;
+ register TkTextTag *tagPtr;
+ TkTextIndex first, last, index1, index2;
+
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = argv[2][0];
+ length = strlen(argv[2]);
+ if ((c == 'a') && (strncmp(argv[2], "add", length) == 0)) {
+ fullOption = "add";
+ addTag = 1;
+
+ addAndRemove:
+ if (argc < 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag ", fullOption,
+ " tagName index1 ?index2 index1 index2 ...?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ tagPtr = TkTextCreateTag(textPtr, argv[3]);
+ for (i = 4; i < argc; i += 2) {
+ if (TkTextGetIndex(interp, textPtr, argv[i], &index1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (argc > (i+1)) {
+ if (TkTextGetIndex(interp, textPtr, argv[i+1], &index2)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (TkTextIndexCmp(&index1, &index2) >= 0) {
+ return TCL_OK;
+ }
+ } else {
+ index2 = index1;
+ TkTextIndexForwChars(&index2, 1, &index2);
+ }
+
+ if (tagPtr->affectsDisplay) {
+ TkTextRedrawTag(textPtr, &index1, &index2, tagPtr, !addTag);
+ } else {
+ /*
+ * Still need to trigger enter/leave events on tags that
+ * have changed.
+ */
+
+ TkTextEventuallyRepick(textPtr);
+ }
+ TkBTreeTag(&index1, &index2, tagPtr, addTag);
+
+ /*
+ * If the tag is "sel" then grab the selection if we're supposed
+ * to export it and don't already have it. Also, invalidate
+ * partially-completed selection retrievals.
+ */
+
+ if (tagPtr == textPtr->selTagPtr) {
+ if (addTag && textPtr->exportSelection
+ && !(textPtr->flags & GOT_SELECTION)) {
+ Tk_OwnSelection(textPtr->tkwin, XA_PRIMARY,
+ TkTextLostSelection, (ClientData) textPtr);
+ textPtr->flags |= GOT_SELECTION;
+ }
+ textPtr->abortSelections = 1;
+ }
+ }
+ } else if ((c == 'b') && (strncmp(argv[2], "bind", length) == 0)) {
+ if ((argc < 4) || (argc > 6)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag bind tagName ?sequence? ?command?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ tagPtr = TkTextCreateTag(textPtr, argv[3]);
+
+ /*
+ * Make a binding table if the widget doesn't already have
+ * one.
+ */
+
+ if (textPtr->bindingTable == NULL) {
+ textPtr->bindingTable = Tk_CreateBindingTable(interp);
+ }
+
+ if (argc == 6) {
+ int append = 0;
+ unsigned long mask;
+
+ if (argv[5][0] == 0) {
+ return Tk_DeleteBinding(interp, textPtr->bindingTable,
+ (ClientData) tagPtr, argv[4]);
+ }
+ if (argv[5][0] == '+') {
+ argv[5]++;
+ append = 1;
+ }
+ mask = Tk_CreateBinding(interp, textPtr->bindingTable,
+ (ClientData) tagPtr, argv[4], argv[5], append);
+ if (mask == 0) {
+ return TCL_ERROR;
+ }
+ if (mask & (unsigned) ~(ButtonMotionMask|Button1MotionMask
+ |Button2MotionMask|Button3MotionMask|Button4MotionMask
+ |Button5MotionMask|ButtonPressMask|ButtonReleaseMask
+ |EnterWindowMask|LeaveWindowMask|KeyPressMask
+ |KeyReleaseMask|PointerMotionMask|VirtualEventMask)) {
+ Tk_DeleteBinding(interp, textPtr->bindingTable,
+ (ClientData) tagPtr, argv[4]);
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "requested illegal events; ",
+ "only key, button, motion, enter, leave, and virtual ",
+ "events may be used", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if (argc == 5) {
+ char *command;
+
+ command = Tk_GetBinding(interp, textPtr->bindingTable,
+ (ClientData) tagPtr, argv[4]);
+ if (command == NULL) {
+ return TCL_ERROR;
+ }
+ interp->result = command;
+ } else {
+ Tk_GetAllBindings(interp, textPtr->bindingTable,
+ (ClientData) tagPtr);
+ }
+ } else if ((c == 'c') && (strncmp(argv[2], "cget", length) == 0)
+ && (length >= 2)) {
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag cget tagName option\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ tagPtr = FindTag(interp, textPtr, argv[3]);
+ if (tagPtr == NULL) {
+ return TCL_ERROR;
+ }
+ return Tk_ConfigureValue(interp, textPtr->tkwin, tagConfigSpecs,
+ (char *) tagPtr, argv[4], 0);
+ } else if ((c == 'c') && (strncmp(argv[2], "configure", length) == 0)
+ && (length >= 2)) {
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag configure tagName ?option? ?value? ",
+ "?option value ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ tagPtr = TkTextCreateTag(textPtr, argv[3]);
+ if (argc == 4) {
+ return Tk_ConfigureInfo(interp, textPtr->tkwin, tagConfigSpecs,
+ (char *) tagPtr, (char *) NULL, 0);
+ } else if (argc == 5) {
+ return Tk_ConfigureInfo(interp, textPtr->tkwin, tagConfigSpecs,
+ (char *) tagPtr, argv[4], 0);
+ } else {
+ int result;
+
+ result = Tk_ConfigureWidget(interp, textPtr->tkwin, tagConfigSpecs,
+ argc-4, argv+4, (char *) tagPtr, 0);
+ /*
+ * Some of the configuration options, like -underline
+ * and -justify, require additional translation (this is
+ * needed because we need to distinguish a particular value
+ * of an option from "unspecified").
+ */
+
+ if (tagPtr->bdString != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin, tagPtr->bdString,
+ &tagPtr->borderWidth) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (tagPtr->borderWidth < 0) {
+ tagPtr->borderWidth = 0;
+ }
+ }
+ if (tagPtr->reliefString != NULL) {
+ if (Tk_GetRelief(interp, tagPtr->reliefString,
+ &tagPtr->relief) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->justifyString != NULL) {
+ if (Tk_GetJustify(interp, tagPtr->justifyString,
+ &tagPtr->justify) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->lMargin1String != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin,
+ tagPtr->lMargin1String, &tagPtr->lMargin1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->lMargin2String != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin,
+ tagPtr->lMargin2String, &tagPtr->lMargin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->offsetString != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin, tagPtr->offsetString,
+ &tagPtr->offset) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->overstrikeString != NULL) {
+ if (Tcl_GetBoolean(interp, tagPtr->overstrikeString,
+ &tagPtr->overstrike) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->rMarginString != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin,
+ tagPtr->rMarginString, &tagPtr->rMargin) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->spacing1String != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin,
+ tagPtr->spacing1String, &tagPtr->spacing1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (tagPtr->spacing1 < 0) {
+ tagPtr->spacing1 = 0;
+ }
+ }
+ if (tagPtr->spacing2String != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin,
+ tagPtr->spacing2String, &tagPtr->spacing2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (tagPtr->spacing2 < 0) {
+ tagPtr->spacing2 = 0;
+ }
+ }
+ if (tagPtr->spacing3String != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin,
+ tagPtr->spacing3String, &tagPtr->spacing3) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (tagPtr->spacing3 < 0) {
+ tagPtr->spacing3 = 0;
+ }
+ }
+ if (tagPtr->tabArrayPtr != NULL) {
+ ckfree((char *) tagPtr->tabArrayPtr);
+ tagPtr->tabArrayPtr = NULL;
+ }
+ if (tagPtr->tabString != NULL) {
+ tagPtr->tabArrayPtr = TkTextGetTabs(interp, textPtr->tkwin,
+ tagPtr->tabString);
+ if (tagPtr->tabArrayPtr == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->underlineString != NULL) {
+ if (Tcl_GetBoolean(interp, tagPtr->underlineString,
+ &tagPtr->underline) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if ((tagPtr->wrapMode != NULL)
+ && (tagPtr->wrapMode != tkTextCharUid)
+ && (tagPtr->wrapMode != tkTextNoneUid)
+ && (tagPtr->wrapMode != tkTextWordUid)) {
+ Tcl_AppendResult(interp, "bad wrap mode \"", tagPtr->wrapMode,
+ "\": must be char, none, or word", (char *) NULL);
+ tagPtr->wrapMode = NULL;
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the "sel" tag was changed, be sure to mirror information
+ * from the tag back into the text widget record. NOTE: we
+ * don't have to free up information in the widget record
+ * before overwriting it, because it was mirrored in the tag
+ * and hence freed when the tag field was overwritten.
+ */
+
+ if (tagPtr == textPtr->selTagPtr) {
+ textPtr->selBorder = tagPtr->border;
+ textPtr->selBdString = tagPtr->bdString;
+ textPtr->selFgColorPtr = tagPtr->fgColor;
+ }
+ tagPtr->affectsDisplay = 0;
+ if ((tagPtr->border != NULL)
+ || (tagPtr->bdString != NULL)
+ || (tagPtr->reliefString != NULL)
+ || (tagPtr->bgStipple != None)
+ || (tagPtr->fgColor != NULL) || (tagPtr->tkfont != None)
+ || (tagPtr->fgStipple != None)
+ || (tagPtr->justifyString != NULL)
+ || (tagPtr->lMargin1String != NULL)
+ || (tagPtr->lMargin2String != NULL)
+ || (tagPtr->offsetString != NULL)
+ || (tagPtr->overstrikeString != NULL)
+ || (tagPtr->rMarginString != NULL)
+ || (tagPtr->spacing1String != NULL)
+ || (tagPtr->spacing2String != NULL)
+ || (tagPtr->spacing3String != NULL)
+ || (tagPtr->tabString != NULL)
+ || (tagPtr->underlineString != NULL)
+ || (tagPtr->wrapMode != NULL)) {
+ tagPtr->affectsDisplay = 1;
+ }
+ TkTextRedrawTag(textPtr, (TkTextIndex *) NULL,
+ (TkTextIndex *) NULL, tagPtr, 1);
+ return result;
+ }
+ } else if ((c == 'd') && (strncmp(argv[2], "delete", length) == 0)) {
+ Tcl_HashEntry *hPtr;
+
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag delete tagName tagName ...\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (i = 3; i < argc; i++) {
+ hPtr = Tcl_FindHashEntry(&textPtr->tagTable, argv[i]);
+ if (hPtr == NULL) {
+ continue;
+ }
+ tagPtr = (TkTextTag *) Tcl_GetHashValue(hPtr);
+ if (tagPtr == textPtr->selTagPtr) {
+ continue;
+ }
+ if (tagPtr->affectsDisplay) {
+ TkTextRedrawTag(textPtr, (TkTextIndex *) NULL,
+ (TkTextIndex *) NULL, tagPtr, 1);
+ }
+ TkBTreeTag(TkTextMakeIndex(textPtr->tree, 0, 0, &first),
+ TkTextMakeIndex(textPtr->tree,
+ TkBTreeNumLines(textPtr->tree), 0, &last),
+ tagPtr, 0);
+ Tcl_DeleteHashEntry(hPtr);
+ if (textPtr->bindingTable != NULL) {
+ Tk_DeleteAllBindings(textPtr->bindingTable,
+ (ClientData) tagPtr);
+ }
+
+ /*
+ * Update the tag priorities to reflect the deletion of this tag.
+ */
+
+ ChangeTagPriority(textPtr, tagPtr, textPtr->numTags-1);
+ textPtr->numTags -= 1;
+ TkTextFreeTag(textPtr, tagPtr);
+ }
+ } else if ((c == 'l') && (strncmp(argv[2], "lower", length) == 0)) {
+ TkTextTag *tagPtr2;
+ int prio;
+
+ if ((argc != 4) && (argc != 5)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag lower tagName ?belowThis?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ tagPtr = FindTag(interp, textPtr, argv[3]);
+ if (tagPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (argc == 5) {
+ tagPtr2 = FindTag(interp, textPtr, argv[4]);
+ if (tagPtr2 == NULL) {
+ return TCL_ERROR;
+ }
+ if (tagPtr->priority < tagPtr2->priority) {
+ prio = tagPtr2->priority - 1;
+ } else {
+ prio = tagPtr2->priority;
+ }
+ } else {
+ prio = 0;
+ }
+ ChangeTagPriority(textPtr, tagPtr, prio);
+ TkTextRedrawTag(textPtr, (TkTextIndex *) NULL, (TkTextIndex *) NULL,
+ tagPtr, 1);
+ } else if ((c == 'n') && (strncmp(argv[2], "names", length) == 0)
+ && (length >= 2)) {
+ TkTextTag **arrayPtr;
+ int arraySize;
+
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag names ?index?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc == 3) {
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+
+ arrayPtr = (TkTextTag **) ckalloc((unsigned)
+ (textPtr->numTags * sizeof(TkTextTag *)));
+ for (i = 0, hPtr = Tcl_FirstHashEntry(&textPtr->tagTable, &search);
+ hPtr != NULL; i++, hPtr = Tcl_NextHashEntry(&search)) {
+ arrayPtr[i] = (TkTextTag *) Tcl_GetHashValue(hPtr);
+ }
+ arraySize = textPtr->numTags;
+ } else {
+ if (TkTextGetIndex(interp, textPtr, argv[3], &index1)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ arrayPtr = TkBTreeGetTags(&index1, &arraySize);
+ if (arrayPtr == NULL) {
+ return TCL_OK;
+ }
+ }
+ SortTags(arraySize, arrayPtr);
+ for (i = 0; i < arraySize; i++) {
+ tagPtr = arrayPtr[i];
+ Tcl_AppendElement(interp, tagPtr->name);
+ }
+ ckfree((char *) arrayPtr);
+ } else if ((c == 'n') && (strncmp(argv[2], "nextrange", length) == 0)
+ && (length >= 2)) {
+ TkTextSearch tSearch;
+ char position[TK_POS_CHARS];
+
+ if ((argc != 5) && (argc != 6)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag nextrange tagName index1 ?index2?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ tagPtr = FindTag((Tcl_Interp *) NULL, textPtr, argv[3]);
+ if (tagPtr == NULL) {
+ return TCL_OK;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[4], &index1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
+ 0, &last);
+ if (argc == 5) {
+ index2 = last;
+ } else if (TkTextGetIndex(interp, textPtr, argv[5], &index2)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * The search below is a bit tricky. Rather than use the B-tree
+ * facilities to stop the search at index2, let it search up
+ * until the end of the file but check for a position past index2
+ * ourselves. The reason for doing it this way is that we only
+ * care whether the *start* of the range is before index2; once
+ * we find the start, we don't want TkBTreeNextTag to abort the
+ * search because the end of the range is after index2.
+ */
+
+ TkBTreeStartSearch(&index1, &last, tagPtr, &tSearch);
+ if (TkBTreeCharTagged(&index1, tagPtr)) {
+ TkTextSegment *segPtr;
+ int offset;
+
+ /*
+ * The first character is tagged. See if there is an
+ * on-toggle just before the character. If not, then
+ * skip to the end of this tagged range.
+ */
+
+ for (segPtr = index1.linePtr->segPtr, offset = index1.charIndex;
+ offset >= 0;
+ offset -= segPtr->size, segPtr = segPtr->nextPtr) {
+ if ((offset == 0) && (segPtr->typePtr == &tkTextToggleOnType)
+ && (segPtr->body.toggle.tagPtr == tagPtr)) {
+ goto gotStart;
+ }
+ }
+ if (!TkBTreeNextTag(&tSearch)) {
+ return TCL_OK;
+ }
+ }
+
+ /*
+ * Find the start of the tagged range.
+ */
+
+ if (!TkBTreeNextTag(&tSearch)) {
+ return TCL_OK;
+ }
+ gotStart:
+ if (TkTextIndexCmp(&tSearch.curIndex, &index2) >= 0) {
+ return TCL_OK;
+ }
+ TkTextPrintIndex(&tSearch.curIndex, position);
+ Tcl_AppendElement(interp, position);
+ TkBTreeNextTag(&tSearch);
+ TkTextPrintIndex(&tSearch.curIndex, position);
+ Tcl_AppendElement(interp, position);
+ } else if ((c == 'p') && (strncmp(argv[2], "prevrange", length) == 0)
+ && (length >= 2)) {
+ TkTextSearch tSearch;
+ char position1[TK_POS_CHARS];
+ char position2[TK_POS_CHARS];
+
+ if ((argc != 5) && (argc != 6)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag prevrange tagName index1 ?index2?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ tagPtr = FindTag((Tcl_Interp *) NULL, textPtr, argv[3]);
+ if (tagPtr == NULL) {
+ return TCL_OK;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[4], &index1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (argc == 5) {
+ TkTextMakeIndex(textPtr->tree, 0, 0, &index2);
+ } else if (TkTextGetIndex(interp, textPtr, argv[5], &index2)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * The search below is a bit weird. The previous toggle can be
+ * either an on or off toggle. If it is an on toggle, then we
+ * need to turn around and search forward for the end toggle.
+ * Otherwise we keep searching backwards.
+ */
+
+ TkBTreeStartSearchBack(&index1, &index2, tagPtr, &tSearch);
+
+ if (!TkBTreePrevTag(&tSearch)) {
+ return TCL_OK;
+ }
+ if (tSearch.segPtr->typePtr == &tkTextToggleOnType) {
+ TkTextPrintIndex(&tSearch.curIndex, position1);
+ TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
+ 0, &last);
+ TkBTreeStartSearch(&tSearch.curIndex, &last, tagPtr, &tSearch);
+ TkBTreeNextTag(&tSearch);
+ TkTextPrintIndex(&tSearch.curIndex, position2);
+ } else {
+ TkTextPrintIndex(&tSearch.curIndex, position2);
+ TkBTreePrevTag(&tSearch);
+ if (TkTextIndexCmp(&tSearch.curIndex, &index2) < 0) {
+ return TCL_OK;
+ }
+ TkTextPrintIndex(&tSearch.curIndex, position1);
+ }
+ Tcl_AppendElement(interp, position1);
+ Tcl_AppendElement(interp, position2);
+ } else if ((c == 'r') && (strncmp(argv[2], "raise", length) == 0)
+ && (length >= 3)) {
+ TkTextTag *tagPtr2;
+ int prio;
+
+ if ((argc != 4) && (argc != 5)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag raise tagName ?aboveThis?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ tagPtr = FindTag(interp, textPtr, argv[3]);
+ if (tagPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (argc == 5) {
+ tagPtr2 = FindTag(interp, textPtr, argv[4]);
+ if (tagPtr2 == NULL) {
+ return TCL_ERROR;
+ }
+ if (tagPtr->priority <= tagPtr2->priority) {
+ prio = tagPtr2->priority;
+ } else {
+ prio = tagPtr2->priority + 1;
+ }
+ } else {
+ prio = textPtr->numTags-1;
+ }
+ ChangeTagPriority(textPtr, tagPtr, prio);
+ TkTextRedrawTag(textPtr, (TkTextIndex *) NULL, (TkTextIndex *) NULL,
+ tagPtr, 1);
+ } else if ((c == 'r') && (strncmp(argv[2], "ranges", length) == 0)
+ && (length >= 3)) {
+ TkTextSearch tSearch;
+ char position[TK_POS_CHARS];
+
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag ranges tagName\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ tagPtr = FindTag((Tcl_Interp *) NULL, textPtr, argv[3]);
+ if (tagPtr == NULL) {
+ return TCL_OK;
+ }
+ TkTextMakeIndex(textPtr->tree, 0, 0, &first);
+ TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
+ 0, &last);
+ TkBTreeStartSearch(&first, &last, tagPtr, &tSearch);
+ if (TkBTreeCharTagged(&first, tagPtr)) {
+ TkTextPrintIndex(&first, position);
+ Tcl_AppendElement(interp, position);
+ }
+ while (TkBTreeNextTag(&tSearch)) {
+ TkTextPrintIndex(&tSearch.curIndex, position);
+ Tcl_AppendElement(interp, position);
+ }
+ } else if ((c == 'r') && (strncmp(argv[2], "remove", length) == 0)
+ && (length >= 2)) {
+ fullOption = "remove";
+ addTag = 0;
+ goto addAndRemove;
+ } else {
+ Tcl_AppendResult(interp, "bad tag option \"", argv[2],
+ "\": must be add, bind, cget, configure, delete, lower, ",
+ "names, nextrange, raise, ranges, or remove",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextCreateTag --
+ *
+ * Find the record describing a tag within a given text widget,
+ * creating a new record if one doesn't already exist.
+ *
+ * Results:
+ * The return value is a pointer to the TkTextTag record for tagName.
+ *
+ * Side effects:
+ * A new tag record is created if there isn't one already defined
+ * for tagName.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkTextTag *
+TkTextCreateTag(textPtr, tagName)
+ TkText *textPtr; /* Widget in which tag is being used. */
+ char *tagName; /* Name of desired tag. */
+{
+ register TkTextTag *tagPtr;
+ Tcl_HashEntry *hPtr;
+ int new;
+
+ hPtr = Tcl_CreateHashEntry(&textPtr->tagTable, tagName, &new);
+ if (!new) {
+ return (TkTextTag *) Tcl_GetHashValue(hPtr);
+ }
+
+ /*
+ * No existing entry. Create a new one, initialize it, and add a
+ * pointer to it to the hash table entry.
+ */
+
+ tagPtr = (TkTextTag *) ckalloc(sizeof(TkTextTag));
+ tagPtr->name = Tcl_GetHashKey(&textPtr->tagTable, hPtr);
+ tagPtr->toggleCount = 0;
+ tagPtr->tagRootPtr = NULL;
+ tagPtr->priority = textPtr->numTags;
+ tagPtr->border = NULL;
+ tagPtr->bdString = NULL;
+ tagPtr->borderWidth = 0;
+ tagPtr->reliefString = NULL;
+ tagPtr->relief = TK_RELIEF_FLAT;
+ tagPtr->bgStipple = None;
+ tagPtr->fgColor = NULL;
+ tagPtr->tkfont = NULL;
+ tagPtr->fgStipple = None;
+ tagPtr->justifyString = NULL;
+ tagPtr->justify = TK_JUSTIFY_LEFT;
+ tagPtr->lMargin1String = NULL;
+ tagPtr->lMargin1 = 0;
+ tagPtr->lMargin2String = NULL;
+ tagPtr->lMargin2 = 0;
+ tagPtr->offsetString = NULL;
+ tagPtr->offset = 0;
+ tagPtr->overstrikeString = NULL;
+ tagPtr->overstrike = 0;
+ tagPtr->rMarginString = NULL;
+ tagPtr->rMargin = 0;
+ tagPtr->spacing1String = NULL;
+ tagPtr->spacing1 = 0;
+ tagPtr->spacing2String = NULL;
+ tagPtr->spacing2 = 0;
+ tagPtr->spacing3String = NULL;
+ tagPtr->spacing3 = 0;
+ tagPtr->tabString = NULL;
+ tagPtr->tabArrayPtr = NULL;
+ tagPtr->underlineString = NULL;
+ tagPtr->underline = 0;
+ tagPtr->wrapMode = NULL;
+ tagPtr->affectsDisplay = 0;
+ textPtr->numTags++;
+ Tcl_SetHashValue(hPtr, tagPtr);
+ return tagPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindTag --
+ *
+ * See if tag is defined for a given widget.
+ *
+ * Results:
+ * If tagName is defined in textPtr, a pointer to its TkTextTag
+ * structure is returned. Otherwise NULL is returned and an
+ * error message is recorded in interp->result unless interp
+ * is NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkTextTag *
+FindTag(interp, textPtr, tagName)
+ Tcl_Interp *interp; /* Interpreter to use for error message;
+ * if NULL, then don't record an error
+ * message. */
+ TkText *textPtr; /* Widget in which tag is being used. */
+ char *tagName; /* Name of desired tag. */
+{
+ Tcl_HashEntry *hPtr;
+
+ hPtr = Tcl_FindHashEntry(&textPtr->tagTable, tagName);
+ if (hPtr != NULL) {
+ return (TkTextTag *) Tcl_GetHashValue(hPtr);
+ }
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "tag \"", tagName,
+ "\" isn't defined in text widget", (char *) NULL);
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextFreeTag --
+ *
+ * This procedure is called when a tag is deleted to free up the
+ * memory and other resources associated with the tag.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory and other resources are freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextFreeTag(textPtr, tagPtr)
+ TkText *textPtr; /* Info about overall widget. */
+ register TkTextTag *tagPtr; /* Tag being deleted. */
+{
+ if (tagPtr->border != None) {
+ Tk_Free3DBorder(tagPtr->border);
+ }
+ if (tagPtr->bdString != NULL) {
+ ckfree(tagPtr->bdString);
+ }
+ if (tagPtr->reliefString != NULL) {
+ ckfree(tagPtr->reliefString);
+ }
+ if (tagPtr->bgStipple != None) {
+ Tk_FreeBitmap(textPtr->display, tagPtr->bgStipple);
+ }
+ if (tagPtr->fgColor != None) {
+ Tk_FreeColor(tagPtr->fgColor);
+ }
+ Tk_FreeFont(tagPtr->tkfont);
+ if (tagPtr->fgStipple != None) {
+ Tk_FreeBitmap(textPtr->display, tagPtr->fgStipple);
+ }
+ if (tagPtr->justifyString != NULL) {
+ ckfree(tagPtr->justifyString);
+ }
+ if (tagPtr->lMargin1String != NULL) {
+ ckfree(tagPtr->lMargin1String);
+ }
+ if (tagPtr->lMargin2String != NULL) {
+ ckfree(tagPtr->lMargin2String);
+ }
+ if (tagPtr->offsetString != NULL) {
+ ckfree(tagPtr->offsetString);
+ }
+ if (tagPtr->overstrikeString != NULL) {
+ ckfree(tagPtr->overstrikeString);
+ }
+ if (tagPtr->rMarginString != NULL) {
+ ckfree(tagPtr->rMarginString);
+ }
+ if (tagPtr->spacing1String != NULL) {
+ ckfree(tagPtr->spacing1String);
+ }
+ if (tagPtr->spacing2String != NULL) {
+ ckfree(tagPtr->spacing2String);
+ }
+ if (tagPtr->spacing3String != NULL) {
+ ckfree(tagPtr->spacing3String);
+ }
+ if (tagPtr->tabString != NULL) {
+ ckfree(tagPtr->tabString);
+ }
+ if (tagPtr->tabArrayPtr != NULL) {
+ ckfree((char *) tagPtr->tabArrayPtr);
+ }
+ if (tagPtr->underlineString != NULL) {
+ ckfree(tagPtr->underlineString);
+ }
+ ckfree((char *) tagPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SortTags --
+ *
+ * This procedure sorts an array of tag pointers in increasing
+ * order of priority, optimizing for the common case where the
+ * array is small.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SortTags(numTags, tagArrayPtr)
+ int numTags; /* Number of tag pointers at *tagArrayPtr. */
+ TkTextTag **tagArrayPtr; /* Pointer to array of pointers. */
+{
+ int i, j, prio;
+ register TkTextTag **tagPtrPtr;
+ TkTextTag **maxPtrPtr, *tmp;
+
+ if (numTags < 2) {
+ return;
+ }
+ if (numTags < 20) {
+ for (i = numTags-1; i > 0; i--, tagArrayPtr++) {
+ maxPtrPtr = tagPtrPtr = tagArrayPtr;
+ prio = tagPtrPtr[0]->priority;
+ for (j = i, tagPtrPtr++; j > 0; j--, tagPtrPtr++) {
+ if (tagPtrPtr[0]->priority < prio) {
+ prio = tagPtrPtr[0]->priority;
+ maxPtrPtr = tagPtrPtr;
+ }
+ }
+ tmp = *maxPtrPtr;
+ *maxPtrPtr = *tagArrayPtr;
+ *tagArrayPtr = tmp;
+ }
+ } else {
+ qsort((VOID *) tagArrayPtr, (unsigned) numTags, sizeof (TkTextTag *),
+ TagSortProc);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TagSortProc --
+ *
+ * This procedure is called by qsort when sorting an array of
+ * tags in priority order.
+ *
+ * Results:
+ * The return value is -1 if the first argument should be before
+ * the second element (i.e. it has lower priority), 0 if it's
+ * equivalent (this should never happen!), and 1 if it should be
+ * after the second element.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TagSortProc(first, second)
+ CONST VOID *first, *second; /* Elements to be compared. */
+{
+ TkTextTag *tagPtr1, *tagPtr2;
+
+ tagPtr1 = * (TkTextTag **) first;
+ tagPtr2 = * (TkTextTag **) second;
+ return tagPtr1->priority - tagPtr2->priority;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChangeTagPriority --
+ *
+ * This procedure changes the priority of a tag by modifying
+ * its priority and the priorities of other tags that are affected
+ * by the change.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Priorities may be changed for some or all of the tags in
+ * textPtr. The tags will be arranged so that there is exactly
+ * one tag at each priority level between 0 and textPtr->numTags-1,
+ * with tagPtr at priority "prio".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ChangeTagPriority(textPtr, tagPtr, prio)
+ TkText *textPtr; /* Information about text widget. */
+ TkTextTag *tagPtr; /* Tag whose priority is to be
+ * changed. */
+ int prio; /* New priority for tag. */
+{
+ int low, high, delta;
+ register TkTextTag *tagPtr2;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+
+ if (prio < 0) {
+ prio = 0;
+ }
+ if (prio >= textPtr->numTags) {
+ prio = textPtr->numTags-1;
+ }
+ if (prio == tagPtr->priority) {
+ return;
+ } else if (prio < tagPtr->priority) {
+ low = prio;
+ high = tagPtr->priority-1;
+ delta = 1;
+ } else {
+ low = tagPtr->priority+1;
+ high = prio;
+ delta = -1;
+ }
+ for (hPtr = Tcl_FirstHashEntry(&textPtr->tagTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ tagPtr2 = (TkTextTag *) Tcl_GetHashValue(hPtr);
+ if ((tagPtr2->priority >= low) && (tagPtr2->priority <= high)) {
+ tagPtr2->priority += delta;
+ }
+ }
+ tagPtr->priority = prio;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextBindProc --
+ *
+ * This procedure is invoked by the Tk dispatcher to handle
+ * events associated with bindings on items.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the command invoked as part of the binding
+ * (if there was any).
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkTextBindProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to canvas structure. */
+ XEvent *eventPtr; /* Pointer to X event that just
+ * happened. */
+{
+ TkText *textPtr = (TkText *) clientData;
+ int repick = 0;
+
+# define AnyButtonMask (Button1Mask|Button2Mask|Button3Mask\
+ |Button4Mask|Button5Mask)
+
+ Tcl_Preserve((ClientData) textPtr);
+
+ /*
+ * This code simulates grabs for mouse buttons by keeping track
+ * of whether a button is pressed and refusing to pick a new current
+ * character while a button is pressed.
+ */
+
+ if (eventPtr->type == ButtonPress) {
+ textPtr->flags |= BUTTON_DOWN;
+ } else if (eventPtr->type == ButtonRelease) {
+ int mask;
+
+ switch (eventPtr->xbutton.button) {
+ case Button1:
+ mask = Button1Mask;
+ break;
+ case Button2:
+ mask = Button2Mask;
+ break;
+ case Button3:
+ mask = Button3Mask;
+ break;
+ case Button4:
+ mask = Button4Mask;
+ break;
+ case Button5:
+ mask = Button5Mask;
+ break;
+ default:
+ mask = 0;
+ break;
+ }
+ if ((eventPtr->xbutton.state & AnyButtonMask) == (unsigned) mask) {
+ textPtr->flags &= ~BUTTON_DOWN;
+ repick = 1;
+ }
+ } else if ((eventPtr->type == EnterNotify)
+ || (eventPtr->type == LeaveNotify)) {
+ if (eventPtr->xcrossing.state & AnyButtonMask) {
+ textPtr->flags |= BUTTON_DOWN;
+ } else {
+ textPtr->flags &= ~BUTTON_DOWN;
+ }
+ TkTextPickCurrent(textPtr, eventPtr);
+ goto done;
+ } else if (eventPtr->type == MotionNotify) {
+ if (eventPtr->xmotion.state & AnyButtonMask) {
+ textPtr->flags |= BUTTON_DOWN;
+ } else {
+ textPtr->flags &= ~BUTTON_DOWN;
+ }
+ TkTextPickCurrent(textPtr, eventPtr);
+ }
+ if ((textPtr->numCurTags > 0) && (textPtr->bindingTable != NULL)
+ && (textPtr->tkwin != NULL)) {
+ Tk_BindEvent(textPtr->bindingTable, eventPtr, textPtr->tkwin,
+ textPtr->numCurTags, (ClientData *) textPtr->curTagArrayPtr);
+ }
+ if (repick) {
+ unsigned int oldState;
+
+ oldState = eventPtr->xbutton.state;
+ eventPtr->xbutton.state &= ~(Button1Mask|Button2Mask
+ |Button3Mask|Button4Mask|Button5Mask);
+ TkTextPickCurrent(textPtr, eventPtr);
+ eventPtr->xbutton.state = oldState;
+ }
+
+ done:
+ Tcl_Release((ClientData) textPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextPickCurrent --
+ *
+ * Find the character containing the coordinates in an event
+ * and place the "current" mark on that character. If the
+ * "current" mark has moved then generate a fake leave event
+ * on the old current character and a fake enter event on the new
+ * current character.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The current mark for textPtr may change. If it does,
+ * then the commands associated with character entry and leave
+ * could do just about anything. For example, the text widget
+ * might be deleted. It is up to the caller to protect itself
+ * with calls to Tcl_Preserve and Tcl_Release.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkTextPickCurrent(textPtr, eventPtr)
+ register TkText *textPtr; /* Text widget in which to select
+ * current character. */
+ XEvent *eventPtr; /* Event describing location of
+ * mouse cursor. Must be EnterWindow,
+ * LeaveWindow, ButtonRelease, or
+ * MotionNotify. */
+{
+ TkTextIndex index;
+ TkTextTag **oldArrayPtr, **newArrayPtr;
+ TkTextTag **copyArrayPtr = NULL; /* Initialization needed to prevent
+ * compiler warning. */
+
+ int numOldTags, numNewTags, i, j, size;
+ XEvent event;
+
+ /*
+ * If a button is down, then don't do anything at all; we'll be
+ * called again when all buttons are up, and we can repick then.
+ * This implements a form of mouse grabbing.
+ */
+
+ if (textPtr->flags & BUTTON_DOWN) {
+ if (((eventPtr->type == EnterNotify) || (eventPtr->type == LeaveNotify))
+ && ((eventPtr->xcrossing.mode == NotifyGrab)
+ || (eventPtr->xcrossing.mode == NotifyUngrab))) {
+ /*
+ * Special case: the window is being entered or left because
+ * of a grab or ungrab. In this case, repick after all.
+ * Furthermore, clear BUTTON_DOWN to release the simulated
+ * grab.
+ */
+
+ textPtr->flags &= ~BUTTON_DOWN;
+ } else {
+ return;
+ }
+ }
+
+ /*
+ * Save information about this event in the widget in case we have
+ * to synthesize more enter and leave events later (e.g. because a
+ * character was deleted, causing a new character to be underneath
+ * the mouse cursor). Also translate MotionNotify events into
+ * EnterNotify events, since that's what gets reported to event
+ * handlers when the current character changes.
+ */
+
+ if (eventPtr != &textPtr->pickEvent) {
+ if ((eventPtr->type == MotionNotify)
+ || (eventPtr->type == ButtonRelease)) {
+ textPtr->pickEvent.xcrossing.type = EnterNotify;
+ textPtr->pickEvent.xcrossing.serial = eventPtr->xmotion.serial;
+ textPtr->pickEvent.xcrossing.send_event
+ = eventPtr->xmotion.send_event;
+ textPtr->pickEvent.xcrossing.display = eventPtr->xmotion.display;
+ textPtr->pickEvent.xcrossing.window = eventPtr->xmotion.window;
+ textPtr->pickEvent.xcrossing.root = eventPtr->xmotion.root;
+ textPtr->pickEvent.xcrossing.subwindow = None;
+ textPtr->pickEvent.xcrossing.time = eventPtr->xmotion.time;
+ textPtr->pickEvent.xcrossing.x = eventPtr->xmotion.x;
+ textPtr->pickEvent.xcrossing.y = eventPtr->xmotion.y;
+ textPtr->pickEvent.xcrossing.x_root = eventPtr->xmotion.x_root;
+ textPtr->pickEvent.xcrossing.y_root = eventPtr->xmotion.y_root;
+ textPtr->pickEvent.xcrossing.mode = NotifyNormal;
+ textPtr->pickEvent.xcrossing.detail = NotifyNonlinear;
+ textPtr->pickEvent.xcrossing.same_screen
+ = eventPtr->xmotion.same_screen;
+ textPtr->pickEvent.xcrossing.focus = False;
+ textPtr->pickEvent.xcrossing.state = eventPtr->xmotion.state;
+ } else {
+ textPtr->pickEvent = *eventPtr;
+ }
+ }
+
+ /*
+ * Find the new current character, then find and sort all of the
+ * tags associated with it.
+ */
+
+ if (textPtr->pickEvent.type != LeaveNotify) {
+ TkTextPixelIndex(textPtr, textPtr->pickEvent.xcrossing.x,
+ textPtr->pickEvent.xcrossing.y, &index);
+ newArrayPtr = TkBTreeGetTags(&index, &numNewTags);
+ SortTags(numNewTags, newArrayPtr);
+ } else {
+ newArrayPtr = NULL;
+ numNewTags = 0;
+ }
+
+ /*
+ * Resort the tags associated with the previous marked character
+ * (the priorities might have changed), then make a copy of the
+ * new tags, and compare the old tags to the copy, nullifying
+ * any tags that are present in both groups (i.e. the tags that
+ * haven't changed).
+ */
+
+ SortTags(textPtr->numCurTags, textPtr->curTagArrayPtr);
+ if (numNewTags > 0) {
+ size = numNewTags * sizeof(TkTextTag *);
+ copyArrayPtr = (TkTextTag **) ckalloc((unsigned) size);
+ memcpy((VOID *) copyArrayPtr, (VOID *) newArrayPtr, (size_t) size);
+ for (i = 0; i < textPtr->numCurTags; i++) {
+ for (j = 0; j < numNewTags; j++) {
+ if (textPtr->curTagArrayPtr[i] == copyArrayPtr[j]) {
+ textPtr->curTagArrayPtr[i] = NULL;
+ copyArrayPtr[j] = NULL;
+ break;
+ }
+ }
+ }
+ }
+
+ /*
+ * Invoke the binding system with a LeaveNotify event for all of
+ * the tags that have gone away. We have to be careful here,
+ * because it's possible that the binding could do something
+ * (like calling tkwait) that eventually modifies
+ * textPtr->curTagArrayPtr. To avoid problems in situations like
+ * this, update curTagArrayPtr to its new value before invoking
+ * any bindings, and don't use it any more here.
+ */
+
+ numOldTags = textPtr->numCurTags;
+ textPtr->numCurTags = numNewTags;
+ oldArrayPtr = textPtr->curTagArrayPtr;
+ textPtr->curTagArrayPtr = newArrayPtr;
+ if (numOldTags != 0) {
+ if ((textPtr->bindingTable != NULL) && (textPtr->tkwin != NULL)) {
+ event = textPtr->pickEvent;
+ event.type = LeaveNotify;
+
+ /*
+ * Always use a detail of NotifyAncestor. Besides being
+ * consistent, this avoids problems where the binding code
+ * will discard NotifyInferior events.
+ */
+
+ event.xcrossing.detail = NotifyAncestor;
+ Tk_BindEvent(textPtr->bindingTable, &event, textPtr->tkwin,
+ numOldTags, (ClientData *) oldArrayPtr);
+ }
+ ckfree((char *) oldArrayPtr);
+ }
+
+ /*
+ * Reset the "current" mark (be careful to recompute its location,
+ * since it might have changed during an event binding). Then
+ * invoke the binding system with an EnterNotify event for all of
+ * the tags that have just appeared.
+ */
+
+ TkTextPixelIndex(textPtr, textPtr->pickEvent.xcrossing.x,
+ textPtr->pickEvent.xcrossing.y, &index);
+ TkTextSetMark(textPtr, "current", &index);
+ if (numNewTags != 0) {
+ if ((textPtr->bindingTable != NULL) && (textPtr->tkwin != NULL)) {
+ event = textPtr->pickEvent;
+ event.type = EnterNotify;
+ event.xcrossing.detail = NotifyAncestor;
+ Tk_BindEvent(textPtr->bindingTable, &event, textPtr->tkwin,
+ numNewTags, (ClientData *) copyArrayPtr);
+ }
+ ckfree((char *) copyArrayPtr);
+ }
+}
diff --git a/generic/tkTextWind.c b/generic/tkTextWind.c
new file mode 100644
index 0000000..6452d13
--- /dev/null
+++ b/generic/tkTextWind.c
@@ -0,0 +1,1176 @@
+/*
+ * tkTextWind.c --
+ *
+ * This file contains code that allows arbitrary windows to be
+ * nested inside text widgets. It also implements the "window"
+ * widget command for texts.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkTextWind.c 1.14 97/04/25 16:52:09
+ */
+
+#include "tk.h"
+#include "tkText.h"
+#include "tkPort.h"
+
+/*
+ * The following structure is the official type record for the
+ * embedded window geometry manager:
+ */
+
+static void EmbWinRequestProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+static void EmbWinLostSlaveProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+
+static Tk_GeomMgr textGeomType = {
+ "text", /* name */
+ EmbWinRequestProc, /* requestProc */
+ EmbWinLostSlaveProc, /* lostSlaveProc */
+};
+
+/*
+ * Definitions for alignment values:
+ */
+
+#define ALIGN_BOTTOM 0
+#define ALIGN_CENTER 1
+#define ALIGN_TOP 2
+#define ALIGN_BASELINE 3
+
+/*
+ * Macro that determines the size of an embedded window segment:
+ */
+
+#define EW_SEG_SIZE ((unsigned) (Tk_Offset(TkTextSegment, body) \
+ + sizeof(TkTextEmbWindow)))
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static int AlignParseProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin, char *value,
+ char *widgRec, int offset));
+static char * AlignPrintProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr));
+static TkTextSegment * EmbWinCleanupProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+static void EmbWinCheckProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+static void EmbWinBboxProc _ANSI_ARGS_((TkTextDispChunk *chunkPtr,
+ int index, int y, int lineHeight, int baseline,
+ int *xPtr, int *yPtr, int *widthPtr,
+ int *heightPtr));
+static int EmbWinConfigure _ANSI_ARGS_((TkText *textPtr,
+ TkTextSegment *ewPtr, int argc, char **argv));
+static void EmbWinDelayedUnmap _ANSI_ARGS_((
+ ClientData clientData));
+static int EmbWinDeleteProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr, int treeGone));
+static void EmbWinDisplayProc _ANSI_ARGS_((
+ TkTextDispChunk *chunkPtr, int x, int y,
+ int lineHeight, int baseline, Display *display,
+ Drawable dst, int screenY));
+static int EmbWinLayoutProc _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *indexPtr, TkTextSegment *segPtr,
+ int offset, int maxX, int maxChars,
+ int noCharsYet, Tk_Uid wrapMode,
+ TkTextDispChunk *chunkPtr));
+static void EmbWinStructureProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void EmbWinUndisplayProc _ANSI_ARGS_((TkText *textPtr,
+ TkTextDispChunk *chunkPtr));
+
+/*
+ * The following structure declares the "embedded window" segment type.
+ */
+
+static Tk_SegType tkTextEmbWindowType = {
+ "window", /* name */
+ 0, /* leftGravity */
+ (Tk_SegSplitProc *) NULL, /* splitProc */
+ EmbWinDeleteProc, /* deleteProc */
+ EmbWinCleanupProc, /* cleanupProc */
+ (Tk_SegLineChangeProc *) NULL, /* lineChangeProc */
+ EmbWinLayoutProc, /* layoutProc */
+ EmbWinCheckProc /* checkProc */
+};
+
+/*
+ * Information used for parsing window configuration options:
+ */
+
+static Tk_CustomOption alignOption = {AlignParseProc, AlignPrintProc,
+ (ClientData) NULL};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_CUSTOM, "-align", (char *) NULL, (char *) NULL,
+ "center", 0, TK_CONFIG_DONT_SET_DEFAULT, &alignOption},
+ {TK_CONFIG_STRING, "-create", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextEmbWindow, create),
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_INT, "-padx", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(TkTextEmbWindow, padX),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_INT, "-pady", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(TkTextEmbWindow, padY),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_BOOLEAN, "-stretch", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(TkTextEmbWindow, stretch),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_WINDOW, "-window", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextEmbWindow, tkwin),
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextWindowCmd --
+ *
+ * This procedure implements the "window" widget command
+ * for text widgets. See the user documentation for details
+ * on what it does.
+ *
+ * Results:
+ * A standard Tcl result or error.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextWindowCmd(textPtr, interp, argc, argv)
+ register TkText *textPtr; /* Information about text widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. Someone else has already
+ * parsed this command enough to know that
+ * argv[1] is "window". */
+{
+ size_t length;
+ register TkTextSegment *ewPtr;
+
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " window option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ length = strlen(argv[2]);
+ if ((strncmp(argv[2], "cget", length) == 0) && (length >= 2)) {
+ TkTextIndex index;
+ TkTextSegment *ewPtr;
+
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " window cget index option\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ ewPtr = TkTextIndexToSeg(&index, (int *) NULL);
+ if (ewPtr->typePtr != &tkTextEmbWindowType) {
+ Tcl_AppendResult(interp, "no embedded window at index \"",
+ argv[3], "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return Tk_ConfigureValue(interp, textPtr->tkwin, configSpecs,
+ (char *) &ewPtr->body.ew, argv[4], 0);
+ } else if ((strncmp(argv[2], "configure", length) == 0) && (length >= 2)) {
+ TkTextIndex index;
+ TkTextSegment *ewPtr;
+
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " window configure index ?option value ...?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ ewPtr = TkTextIndexToSeg(&index, (int *) NULL);
+ if (ewPtr->typePtr != &tkTextEmbWindowType) {
+ Tcl_AppendResult(interp, "no embedded window at index \"",
+ argv[3], "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc == 4) {
+ return Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,
+ (char *) &ewPtr->body.ew, (char *) NULL, 0);
+ } else if (argc == 5) {
+ return Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,
+ (char *) &ewPtr->body.ew, argv[4], 0);
+ } else {
+ TkTextChanged(textPtr, &index, &index);
+ return EmbWinConfigure(textPtr, ewPtr, argc-4, argv+4);
+ }
+ } else if ((strncmp(argv[2], "create", length) == 0) && (length >= 2)) {
+ TkTextIndex index;
+ int lineIndex;
+
+ /*
+ * Add a new window. Find where to put the new window, and
+ * mark that position for redisplay.
+ */
+
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " window create index ?option value ...?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Don't allow insertions on the last (dummy) line of the text.
+ */
+
+ lineIndex = TkBTreeLineIndex(index.linePtr);
+ if (lineIndex == TkBTreeNumLines(textPtr->tree)) {
+ lineIndex--;
+ TkTextMakeIndex(textPtr->tree, lineIndex, 1000000, &index);
+ }
+
+ /*
+ * Create the new window segment and initialize it.
+ */
+
+ ewPtr = (TkTextSegment *) ckalloc(EW_SEG_SIZE);
+ ewPtr->typePtr = &tkTextEmbWindowType;
+ ewPtr->size = 1;
+ ewPtr->body.ew.textPtr = textPtr;
+ ewPtr->body.ew.linePtr = NULL;
+ ewPtr->body.ew.tkwin = NULL;
+ ewPtr->body.ew.create = NULL;
+ ewPtr->body.ew.align = ALIGN_CENTER;
+ ewPtr->body.ew.padX = ewPtr->body.ew.padY = 0;
+ ewPtr->body.ew.stretch = 0;
+ ewPtr->body.ew.chunkCount = 0;
+ ewPtr->body.ew.displayed = 0;
+
+ /*
+ * Link the segment into the text widget, then configure it (delete
+ * it again if the configuration fails).
+ */
+
+ TkTextChanged(textPtr, &index, &index);
+ TkBTreeLinkSegment(ewPtr, &index);
+ if (EmbWinConfigure(textPtr, ewPtr, argc-4, argv+4) != TCL_OK) {
+ TkTextIndex index2;
+
+ TkTextIndexForwChars(&index, 1, &index2);
+ TkBTreeDeleteChars(&index, &index2);
+ return TCL_ERROR;
+ }
+ } else if (strncmp(argv[2], "names", length) == 0) {
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " window names\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (hPtr = Tcl_FirstHashEntry(&textPtr->windowTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendElement(interp,
+ Tcl_GetHashKey(&textPtr->markTable, hPtr));
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad window option \"", argv[2],
+ "\": must be cget, configure, create, or names",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinConfigure --
+ *
+ * This procedure is called to handle configuration options
+ * for an embedded window, using an argc/argv list.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then interp->result contains an error message..
+ *
+ * Side effects:
+ * Configuration information for the embedded window changes,
+ * such as alignment, stretching, or name of the embedded
+ * window.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+EmbWinConfigure(textPtr, ewPtr, argc, argv)
+ TkText *textPtr; /* Information about text widget that
+ * contains embedded window. */
+ TkTextSegment *ewPtr; /* Embedded window to be configured. */
+ int argc; /* Number of strings in argv. */
+ char **argv; /* Array of strings describing configuration
+ * options. */
+{
+ Tk_Window oldWindow;
+ Tcl_HashEntry *hPtr;
+ int new;
+
+ oldWindow = ewPtr->body.ew.tkwin;
+ if (Tk_ConfigureWidget(textPtr->interp, textPtr->tkwin, configSpecs,
+ argc, argv, (char *) &ewPtr->body.ew, TK_CONFIG_ARGV_ONLY)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (oldWindow != ewPtr->body.ew.tkwin) {
+ if (oldWindow != NULL) {
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&textPtr->windowTable,
+ Tk_PathName(oldWindow)));
+ Tk_DeleteEventHandler(oldWindow, StructureNotifyMask,
+ EmbWinStructureProc, (ClientData) ewPtr);
+ Tk_ManageGeometry(oldWindow, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ if (textPtr->tkwin != Tk_Parent(oldWindow)) {
+ Tk_UnmaintainGeometry(oldWindow, textPtr->tkwin);
+ } else {
+ Tk_UnmapWindow(oldWindow);
+ }
+ }
+ if (ewPtr->body.ew.tkwin != NULL) {
+ Tk_Window ancestor, parent;
+
+ /*
+ * Make sure that the text is either the parent of the
+ * embedded window or a descendant of that parent. Also,
+ * don't allow a top-level window to be managed inside
+ * a text.
+ */
+
+ parent = Tk_Parent(ewPtr->body.ew.tkwin);
+ for (ancestor = textPtr->tkwin; ;
+ ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ if (Tk_IsTopLevel(ancestor)) {
+ badMaster:
+ Tcl_AppendResult(textPtr->interp, "can't embed ",
+ Tk_PathName(ewPtr->body.ew.tkwin), " in ",
+ Tk_PathName(textPtr->tkwin), (char *) NULL);
+ ewPtr->body.ew.tkwin = NULL;
+ return TCL_ERROR;
+ }
+ }
+ if (Tk_IsTopLevel(ewPtr->body.ew.tkwin)
+ || (ewPtr->body.ew.tkwin == textPtr->tkwin)) {
+ goto badMaster;
+ }
+
+ /*
+ * Take over geometry management for the window, plus create
+ * an event handler to find out when it is deleted.
+ */
+
+ Tk_ManageGeometry(ewPtr->body.ew.tkwin, &textGeomType,
+ (ClientData) ewPtr);
+ Tk_CreateEventHandler(ewPtr->body.ew.tkwin, StructureNotifyMask,
+ EmbWinStructureProc, (ClientData) ewPtr);
+
+ /*
+ * Special trick! Must enter into the hash table *after*
+ * calling Tk_ManageGeometry: if the window was already managed
+ * elsewhere in this text, the Tk_ManageGeometry call will cause
+ * the entry to be removed, which could potentially lose the new
+ * entry.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&textPtr->windowTable,
+ Tk_PathName(ewPtr->body.ew.tkwin), &new);
+ Tcl_SetHashValue(hPtr, ewPtr);
+
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * AlignParseProc --
+ *
+ * This procedure is invoked by Tk_ConfigureWidget during
+ * option processing to handle "-align" options for embedded
+ * windows.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * The alignment for the embedded window may change.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+AlignParseProc(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* Not used.*/
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_Window tkwin; /* Window for text widget. */
+ char *value; /* Value of option. */
+ char *widgRec; /* Pointer to TkTextEmbWindow
+ * structure. */
+ int offset; /* Offset into item (ignored). */
+{
+ register TkTextEmbWindow *embPtr = (TkTextEmbWindow *) widgRec;
+
+ if (strcmp(value, "baseline") == 0) {
+ embPtr->align = ALIGN_BASELINE;
+ } else if (strcmp(value, "bottom") == 0) {
+ embPtr->align = ALIGN_BOTTOM;
+ } else if (strcmp(value, "center") == 0) {
+ embPtr->align = ALIGN_CENTER;
+ } else if (strcmp(value, "top") == 0) {
+ embPtr->align = ALIGN_TOP;
+ } else {
+ Tcl_AppendResult(interp, "bad alignment \"", value,
+ "\": must be baseline, bottom, center, or top",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * AlignPrintProc --
+ *
+ * This procedure is invoked by the Tk configuration code
+ * to produce a printable string for the "-align" configuration
+ * option for embedded windows.
+ *
+ * Results:
+ * The return value is a string describing the embedded
+ * window's current alignment.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+AlignPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
+ ClientData clientData; /* Ignored. */
+ Tk_Window tkwin; /* Window for text widget. */
+ char *widgRec; /* Pointer to TkTextEmbWindow
+ * structure. */
+ int offset; /* Ignored. */
+ Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with
+ * information about how to reclaim
+ * storage for return string. */
+{
+ switch (((TkTextEmbWindow *) widgRec)->align) {
+ case ALIGN_BASELINE:
+ return "baseline";
+ case ALIGN_BOTTOM:
+ return "bottom";
+ case ALIGN_CENTER:
+ return "center";
+ case ALIGN_TOP:
+ return "top";
+ default:
+ return "??";
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinStructureProc --
+ *
+ * This procedure is invoked by the Tk event loop whenever
+ * StructureNotify events occur for a window that's embedded
+ * in a text widget. This procedure's only purpose is to
+ * clean up when windows are deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is disassociated from the window segment, and
+ * the portion of the text is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbWinStructureProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to record describing window item. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ register TkTextSegment *ewPtr = (TkTextSegment *) clientData;
+ TkTextIndex index;
+
+ if (eventPtr->type != DestroyNotify) {
+ return;
+ }
+
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&ewPtr->body.ew.textPtr->windowTable,
+ Tk_PathName(ewPtr->body.ew.tkwin)));
+ ewPtr->body.ew.tkwin = NULL;
+ index.tree = ewPtr->body.ew.textPtr->tree;
+ index.linePtr = ewPtr->body.ew.linePtr;
+ index.charIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr);
+ TkTextChanged(ewPtr->body.ew.textPtr, &index, &index);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinRequestProc --
+ *
+ * This procedure is invoked whenever a window that's associated
+ * with a window canvas item changes its requested dimensions.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The size and location on the screen of the window may change,
+ * depending on the options specified for the window item.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+EmbWinRequestProc(clientData, tkwin)
+ ClientData clientData; /* Pointer to record for window item. */
+ Tk_Window tkwin; /* Window that changed its desired
+ * size. */
+{
+ TkTextSegment *ewPtr = (TkTextSegment *) clientData;
+ TkTextIndex index;
+
+ index.tree = ewPtr->body.ew.textPtr->tree;
+ index.linePtr = ewPtr->body.ew.linePtr;
+ index.charIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr);
+ TkTextChanged(ewPtr->body.ew.textPtr, &index, &index);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinLostSlaveProc --
+ *
+ * This procedure is invoked by the Tk geometry manager when
+ * a slave window managed by a text widget is claimed away
+ * by another geometry manager.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is disassociated from the window segment, and
+ * the portion of the text is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbWinLostSlaveProc(clientData, tkwin)
+ ClientData clientData; /* Pointer to record describing window item. */
+ Tk_Window tkwin; /* Window that was claimed away by another
+ * geometry manager. */
+{
+ register TkTextSegment *ewPtr = (TkTextSegment *) clientData;
+ TkTextIndex index;
+
+ Tk_DeleteEventHandler(ewPtr->body.ew.tkwin, StructureNotifyMask,
+ EmbWinStructureProc, (ClientData) ewPtr);
+ Tcl_CancelIdleCall(EmbWinDelayedUnmap, (ClientData) ewPtr);
+ if (ewPtr->body.ew.textPtr->tkwin != Tk_Parent(tkwin)) {
+ Tk_UnmaintainGeometry(tkwin, ewPtr->body.ew.textPtr->tkwin);
+ } else {
+ Tk_UnmapWindow(tkwin);
+ }
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&ewPtr->body.ew.textPtr->windowTable,
+ Tk_PathName(ewPtr->body.ew.tkwin)));
+ ewPtr->body.ew.tkwin = NULL;
+ index.tree = ewPtr->body.ew.textPtr->tree;
+ index.linePtr = ewPtr->body.ew.linePtr;
+ index.charIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr);
+ TkTextChanged(ewPtr->body.ew.textPtr, &index, &index);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinDeleteProc --
+ *
+ * This procedure is invoked by the text B-tree code whenever
+ * an embedded window lies in a range of characters being deleted.
+ *
+ * Results:
+ * Returns 0 to indicate that the deletion has been accepted.
+ *
+ * Side effects:
+ * The embedded window is deleted, if it exists, and any resources
+ * associated with it are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+EmbWinDeleteProc(ewPtr, linePtr, treeGone)
+ TkTextSegment *ewPtr; /* Segment being deleted. */
+ TkTextLine *linePtr; /* Line containing segment. */
+ int treeGone; /* Non-zero means the entire tree is
+ * being deleted, so everything must
+ * get cleaned up. */
+{
+ Tcl_HashEntry *hPtr;
+
+ if (ewPtr->body.ew.tkwin != NULL) {
+ hPtr = Tcl_FindHashEntry(&ewPtr->body.ew.textPtr->windowTable,
+ Tk_PathName(ewPtr->body.ew.tkwin));
+ if (hPtr != NULL) {
+ /*
+ * (It's possible for there to be no hash table entry for this
+ * window, if an error occurred while creating the window segment
+ * but before the window got added to the table)
+ */
+
+ Tcl_DeleteHashEntry(hPtr);
+ }
+
+ /*
+ * Delete the event handler for the window before destroying
+ * the window, so that EmbWinStructureProc doesn't get called
+ * (we'll already do everything that it would have done, and
+ * it will just get confused).
+ */
+
+ Tk_DeleteEventHandler(ewPtr->body.ew.tkwin, StructureNotifyMask,
+ EmbWinStructureProc, (ClientData) ewPtr);
+ Tk_DestroyWindow(ewPtr->body.ew.tkwin);
+ }
+ Tcl_CancelIdleCall(EmbWinDelayedUnmap, (ClientData) ewPtr);
+ Tk_FreeOptions(configSpecs, (char *) &ewPtr->body.ew,
+ ewPtr->body.ew.textPtr->display, 0);
+ ckfree((char *) ewPtr);
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinCleanupProc --
+ *
+ * This procedure is invoked by the B-tree code whenever a
+ * segment containing an embedded window is moved from one
+ * line to another.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The linePtr field of the segment gets updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static TkTextSegment *
+EmbWinCleanupProc(ewPtr, linePtr)
+ TkTextSegment *ewPtr; /* Mark segment that's being moved. */
+ TkTextLine *linePtr; /* Line that now contains segment. */
+{
+ ewPtr->body.ew.linePtr = linePtr;
+ return ewPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinLayoutProc --
+ *
+ * This procedure is the "layoutProc" for embedded window
+ * segments.
+ *
+ * Results:
+ * 1 is returned to indicate that the segment should be
+ * displayed. The chunkPtr structure is filled in.
+ *
+ * Side effects:
+ * None, except for filling in chunkPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /*ARGSUSED*/
+static int
+EmbWinLayoutProc(textPtr, indexPtr, ewPtr, offset, maxX, maxChars,
+ noCharsYet, wrapMode, chunkPtr)
+ TkText *textPtr; /* Text widget being layed out. */
+ TkTextIndex *indexPtr; /* Identifies first character in chunk. */
+ TkTextSegment *ewPtr; /* Segment corresponding to indexPtr. */
+ int offset; /* Offset within segPtr corresponding to
+ * indexPtr (always 0). */
+ int maxX; /* Chunk must not occupy pixels at this
+ * position or higher. */
+ int maxChars; /* Chunk must not include more than this
+ * many characters. */
+ int noCharsYet; /* Non-zero means no characters have been
+ * assigned to this line yet. */
+ Tk_Uid wrapMode; /* Wrap mode to use for line: tkTextCharUid,
+ * tkTextNoneUid, or tkTextWordUid. */
+ register TkTextDispChunk *chunkPtr;
+ /* Structure to fill in with information
+ * about this chunk. The x field has already
+ * been set by the caller. */
+{
+ int width, height;
+
+ if (offset != 0) {
+ panic("Non-zero offset in EmbWinLayoutProc");
+ }
+
+ if ((ewPtr->body.ew.tkwin == NULL) && (ewPtr->body.ew.create != NULL)) {
+ int code, new;
+ Tcl_DString name;
+ Tk_Window ancestor;
+ Tcl_HashEntry *hPtr;
+
+ /*
+ * The window doesn't currently exist. Create it by evaluating
+ * the creation script. The script must return the window's
+ * path name: look up that name to get back to the window
+ * token. Then register ourselves as the geometry manager for
+ * the window.
+ */
+
+ code = Tcl_GlobalEval(textPtr->interp, ewPtr->body.ew.create);
+ if (code != TCL_OK) {
+ createError:
+ Tcl_BackgroundError(textPtr->interp);
+ goto gotWindow;
+ }
+ Tcl_DStringInit(&name);
+ Tcl_DStringAppend(&name, textPtr->interp->result, -1);
+ Tcl_ResetResult(textPtr->interp);
+ ewPtr->body.ew.tkwin = Tk_NameToWindow(textPtr->interp,
+ Tcl_DStringValue(&name), textPtr->tkwin);
+ if (ewPtr->body.ew.tkwin == NULL) {
+ goto createError;
+ }
+ for (ancestor = textPtr->tkwin; ;
+ ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == Tk_Parent(ewPtr->body.ew.tkwin)) {
+ break;
+ }
+ if (Tk_IsTopLevel(ancestor)) {
+ badMaster:
+ Tcl_AppendResult(textPtr->interp, "can't embed ",
+ Tk_PathName(ewPtr->body.ew.tkwin), " relative to ",
+ Tk_PathName(textPtr->tkwin), (char *) NULL);
+ Tcl_BackgroundError(textPtr->interp);
+ ewPtr->body.ew.tkwin = NULL;
+ goto gotWindow;
+ }
+ }
+ if (Tk_IsTopLevel(ewPtr->body.ew.tkwin)
+ || (textPtr->tkwin == ewPtr->body.ew.tkwin)) {
+ goto badMaster;
+ }
+ Tk_ManageGeometry(ewPtr->body.ew.tkwin, &textGeomType,
+ (ClientData) ewPtr);
+ Tk_CreateEventHandler(ewPtr->body.ew.tkwin, StructureNotifyMask,
+ EmbWinStructureProc, (ClientData) ewPtr);
+
+ /*
+ * Special trick! Must enter into the hash table *after*
+ * calling Tk_ManageGeometry: if the window was already managed
+ * elsewhere in this text, the Tk_ManageGeometry call will cause
+ * the entry to be removed, which could potentially lose the new
+ * entry.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&textPtr->windowTable,
+ Tk_PathName(ewPtr->body.ew.tkwin), &new);
+ Tcl_SetHashValue(hPtr, ewPtr);
+ }
+
+ /*
+ * See if there's room for this window on this line.
+ */
+
+ gotWindow:
+ if (ewPtr->body.ew.tkwin == NULL) {
+ width = 0;
+ height = 0;
+ } else {
+ width = Tk_ReqWidth(ewPtr->body.ew.tkwin) + 2*ewPtr->body.ew.padX;
+ height = Tk_ReqHeight(ewPtr->body.ew.tkwin) + 2*ewPtr->body.ew.padY;
+ }
+ if ((width > (maxX - chunkPtr->x))
+ && !noCharsYet && (textPtr->wrapMode != tkTextNoneUid)) {
+ return 0;
+ }
+
+ /*
+ * Fill in the chunk structure.
+ */
+
+ chunkPtr->displayProc = EmbWinDisplayProc;
+ chunkPtr->undisplayProc = EmbWinUndisplayProc;
+ chunkPtr->measureProc = (Tk_ChunkMeasureProc *) NULL;
+ chunkPtr->bboxProc = EmbWinBboxProc;
+ chunkPtr->numChars = 1;
+ if (ewPtr->body.ew.align == ALIGN_BASELINE) {
+ chunkPtr->minAscent = height - ewPtr->body.ew.padY;
+ chunkPtr->minDescent = ewPtr->body.ew.padY;
+ chunkPtr->minHeight = 0;
+ } else {
+ chunkPtr->minAscent = 0;
+ chunkPtr->minDescent = 0;
+ chunkPtr->minHeight = height;
+ }
+ chunkPtr->width = width;
+ chunkPtr->breakIndex = -1;
+ chunkPtr->breakIndex = 1;
+ chunkPtr->clientData = (ClientData) ewPtr;
+ ewPtr->body.ew.chunkCount += 1;
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinCheckProc --
+ *
+ * This procedure is invoked by the B-tree code to perform
+ * consistency checks on embedded windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The procedure panics if it detects anything wrong with
+ * the embedded window.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbWinCheckProc(ewPtr, linePtr)
+ TkTextSegment *ewPtr; /* Segment to check. */
+ TkTextLine *linePtr; /* Line containing segment. */
+{
+ if (ewPtr->nextPtr == NULL) {
+ panic("EmbWinCheckProc: embedded window is last segment in line");
+ }
+ if (ewPtr->size != 1) {
+ panic("EmbWinCheckProc: embedded window has size %d", ewPtr->size);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinDisplayProc --
+ *
+ * This procedure is invoked by the text displaying code
+ * when it is time to actually draw an embedded window
+ * chunk on the screen.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The embedded window gets moved to the correct location
+ * and mapped onto the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbWinDisplayProc(chunkPtr, x, y, lineHeight, baseline, display, dst, screenY)
+ TkTextDispChunk *chunkPtr; /* Chunk that is to be drawn. */
+ int x; /* X-position in dst at which to
+ * draw this chunk (differs from
+ * the x-position in the chunk because
+ * of scrolling). */
+ int y; /* Top of rectangular bounding box
+ * for line: tells where to draw this
+ * chunk in dst (x-position is in
+ * the chunk itself). */
+ int lineHeight; /* Total height of line. */
+ int baseline; /* Offset of baseline from y. */
+ Display *display; /* Display to use for drawing. */
+ Drawable dst; /* Pixmap or window in which to draw */
+ int screenY; /* Y-coordinate in text window that
+ * corresponds to y. */
+{
+ TkTextSegment *ewPtr = (TkTextSegment *) chunkPtr->clientData;
+ int lineX, windowX, windowY, width, height;
+ Tk_Window tkwin;
+
+ tkwin = ewPtr->body.ew.tkwin;
+ if (tkwin == NULL) {
+ return;
+ }
+ if ((x + chunkPtr->width) <= 0) {
+ /*
+ * The window is off-screen; just unmap it.
+ */
+
+ if (ewPtr->body.ew.textPtr->tkwin != Tk_Parent(tkwin)) {
+ Tk_UnmaintainGeometry(tkwin, ewPtr->body.ew.textPtr->tkwin);
+ } else {
+ Tk_UnmapWindow(tkwin);
+ }
+ return;
+ }
+
+ /*
+ * Compute the window's location and size in the text widget, taking
+ * into account the align and stretch values for the window.
+ */
+
+ EmbWinBboxProc(chunkPtr, 0, screenY, lineHeight, baseline, &lineX,
+ &windowY, &width, &height);
+ windowX = lineX - chunkPtr->x + x;
+
+ if (ewPtr->body.ew.textPtr->tkwin == Tk_Parent(tkwin)) {
+ if ((windowX != Tk_X(tkwin)) || (windowY != Tk_Y(tkwin))
+ || (Tk_ReqWidth(tkwin) != Tk_Width(tkwin))
+ || (height != Tk_Height(tkwin))) {
+ Tk_MoveResizeWindow(tkwin, windowX, windowY, width, height);
+ }
+ Tk_MapWindow(tkwin);
+ } else {
+ Tk_MaintainGeometry(tkwin, ewPtr->body.ew.textPtr->tkwin,
+ windowX, windowY, width, height);
+ }
+
+ /*
+ * Mark the window as displayed so that it won't get unmapped.
+ */
+
+ ewPtr->body.ew.displayed = 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinUndisplayProc --
+ *
+ * This procedure is called when the chunk for an embedded
+ * window is no longer going to be displayed. It arranges
+ * for the window associated with the chunk to be unmapped.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is scheduled for unmapping.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbWinUndisplayProc(textPtr, chunkPtr)
+ TkText *textPtr; /* Overall information about text
+ * widget. */
+ TkTextDispChunk *chunkPtr; /* Chunk that is about to be freed. */
+{
+ TkTextSegment *ewPtr = (TkTextSegment *) chunkPtr->clientData;
+
+ ewPtr->body.ew.chunkCount--;
+ if (ewPtr->body.ew.chunkCount == 0) {
+ /*
+ * Don't unmap the window immediately, since there's a good chance
+ * that it will immediately be redisplayed, perhaps even in the
+ * same place. Instead, schedule the window to be unmapped later;
+ * the call to EmbWinDelayedUnmap will be cancelled in the likely
+ * event that the unmap becomes unnecessary.
+ */
+
+ ewPtr->body.ew.displayed = 0;
+ Tcl_DoWhenIdle(EmbWinDelayedUnmap, (ClientData) ewPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinBboxProc --
+ *
+ * This procedure is called to compute the bounding box of
+ * the area occupied by an embedded window.
+ *
+ * Results:
+ * There is no return value. *xPtr and *yPtr are filled in
+ * with the coordinates of the upper left corner of the
+ * window, and *widthPtr and *heightPtr are filled in with
+ * the dimensions of the window in pixels. Note: not all
+ * of the returned bbox is necessarily visible on the screen
+ * (the rightmost part might be off-screen to the right,
+ * and the bottommost part might be off-screen to the bottom).
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbWinBboxProc(chunkPtr, index, y, lineHeight, baseline, xPtr, yPtr,
+ widthPtr, heightPtr)
+ TkTextDispChunk *chunkPtr; /* Chunk containing desired char. */
+ int index; /* Index of desired character within
+ * the chunk. */
+ int y; /* Topmost pixel in area allocated
+ * for this line. */
+ int lineHeight; /* Total height of line. */
+ int baseline; /* Location of line's baseline, in
+ * pixels measured down from y. */
+ int *xPtr, *yPtr; /* Gets filled in with coords of
+ * character's upper-left pixel. */
+ int *widthPtr; /* Gets filled in with width of
+ * character, in pixels. */
+ int *heightPtr; /* Gets filled in with height of
+ * character, in pixels. */
+{
+ TkTextSegment *ewPtr = (TkTextSegment *) chunkPtr->clientData;
+ Tk_Window tkwin;
+
+ tkwin = ewPtr->body.ew.tkwin;
+ if (tkwin != NULL) {
+ *widthPtr = Tk_ReqWidth(tkwin);
+ *heightPtr = Tk_ReqHeight(tkwin);
+ } else {
+ *widthPtr = 0;
+ *heightPtr = 0;
+ }
+ *xPtr = chunkPtr->x + ewPtr->body.ew.padX;
+ if (ewPtr->body.ew.stretch) {
+ if (ewPtr->body.ew.align == ALIGN_BASELINE) {
+ *heightPtr = baseline - ewPtr->body.ew.padY;
+ } else {
+ *heightPtr = lineHeight - 2*ewPtr->body.ew.padY;
+ }
+ }
+ switch (ewPtr->body.ew.align) {
+ case ALIGN_BOTTOM:
+ *yPtr = y + (lineHeight - *heightPtr - ewPtr->body.ew.padY);
+ break;
+ case ALIGN_CENTER:
+ *yPtr = y + (lineHeight - *heightPtr)/2;
+ break;
+ case ALIGN_TOP:
+ *yPtr = y + ewPtr->body.ew.padY;
+ break;
+ case ALIGN_BASELINE:
+ *yPtr = y + (baseline - *heightPtr);
+ break;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinDelayedUnmap --
+ *
+ * This procedure is an idle handler that does the actual
+ * work of unmapping an embedded window. See the comment
+ * in EmbWinUndisplayProc for details.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window gets unmapped, unless its chunk reference count
+ * has become non-zero again.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbWinDelayedUnmap(clientData)
+ ClientData clientData; /* Token for the window to
+ * be unmapped. */
+{
+ TkTextSegment *ewPtr = (TkTextSegment *) clientData;
+
+ if (!ewPtr->body.ew.displayed && (ewPtr->body.ew.tkwin != NULL)) {
+ if (ewPtr->body.ew.textPtr->tkwin != Tk_Parent(ewPtr->body.ew.tkwin)) {
+ Tk_UnmaintainGeometry(ewPtr->body.ew.tkwin,
+ ewPtr->body.ew.textPtr->tkwin);
+ } else {
+ Tk_UnmapWindow(ewPtr->body.ew.tkwin);
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextWindowIndex --
+ *
+ * Given the name of an embedded window within a text widget,
+ * returns an index corresponding to the window's position
+ * in the text.
+ *
+ * Results:
+ * The return value is 1 if there is an embedded window by
+ * the given name in the text widget, 0 otherwise. If the
+ * window exists, *indexPtr is filled in with its index.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextWindowIndex(textPtr, name, indexPtr)
+ TkText *textPtr; /* Text widget containing window. */
+ char *name; /* Name of window. */
+ TkTextIndex *indexPtr; /* Index information gets stored here. */
+{
+ Tcl_HashEntry *hPtr;
+ TkTextSegment *ewPtr;
+
+ hPtr = Tcl_FindHashEntry(&textPtr->windowTable, name);
+ if (hPtr == NULL) {
+ return 0;
+ }
+ ewPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr);
+ indexPtr->tree = textPtr->tree;
+ indexPtr->linePtr = ewPtr->body.ew.linePtr;
+ indexPtr->charIndex = TkTextSegToOffset(ewPtr, indexPtr->linePtr);
+ return 1;
+}
diff --git a/generic/tkTrig.c b/generic/tkTrig.c
new file mode 100644
index 0000000..52dd8ba
--- /dev/null
+++ b/generic/tkTrig.c
@@ -0,0 +1,1467 @@
+/*
+ * tkTrig.c --
+ *
+ * This file contains a collection of trigonometry utility
+ * routines that are used by Tk and in particular by the
+ * canvas code. It also has miscellaneous geometry functions
+ * used by canvases.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkTrig.c 1.27 97/03/07 11:34:35
+ */
+
+#include <stdio.h>
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkCanvas.h"
+
+#undef MIN
+#define MIN(a,b) (((a) < (b)) ? (a) : (b))
+#undef MAX
+#define MAX(a,b) (((a) > (b)) ? (a) : (b))
+#ifndef PI
+# define PI 3.14159265358979323846
+#endif /* PI */
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkLineToPoint --
+ *
+ * Compute the distance from a point to a finite line segment.
+ *
+ * Results:
+ * The return value is the distance from the line segment
+ * whose end-points are *end1Ptr and *end2Ptr to the point
+ * given by *pointPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+double
+TkLineToPoint(end1Ptr, end2Ptr, pointPtr)
+ double end1Ptr[2]; /* Coordinates of first end-point of line. */
+ double end2Ptr[2]; /* Coordinates of second end-point of line. */
+ double pointPtr[2]; /* Points to coords for point. */
+{
+ double x, y;
+
+ /*
+ * Compute the point on the line that is closest to the
+ * point. This must be done separately for vertical edges,
+ * horizontal edges, and other edges.
+ */
+
+ if (end1Ptr[0] == end2Ptr[0]) {
+
+ /*
+ * Vertical edge.
+ */
+
+ x = end1Ptr[0];
+ if (end1Ptr[1] >= end2Ptr[1]) {
+ y = MIN(end1Ptr[1], pointPtr[1]);
+ y = MAX(y, end2Ptr[1]);
+ } else {
+ y = MIN(end2Ptr[1], pointPtr[1]);
+ y = MAX(y, end1Ptr[1]);
+ }
+ } else if (end1Ptr[1] == end2Ptr[1]) {
+
+ /*
+ * Horizontal edge.
+ */
+
+ y = end1Ptr[1];
+ if (end1Ptr[0] >= end2Ptr[0]) {
+ x = MIN(end1Ptr[0], pointPtr[0]);
+ x = MAX(x, end2Ptr[0]);
+ } else {
+ x = MIN(end2Ptr[0], pointPtr[0]);
+ x = MAX(x, end1Ptr[0]);
+ }
+ } else {
+ double m1, b1, m2, b2;
+
+ /*
+ * The edge is neither horizontal nor vertical. Convert the
+ * edge to a line equation of the form y = m1*x + b1. Then
+ * compute a line perpendicular to this edge but passing
+ * through the point, also in the form y = m2*x + b2.
+ */
+
+ m1 = (end2Ptr[1] - end1Ptr[1])/(end2Ptr[0] - end1Ptr[0]);
+ b1 = end1Ptr[1] - m1*end1Ptr[0];
+ m2 = -1.0/m1;
+ b2 = pointPtr[1] - m2*pointPtr[0];
+ x = (b2 - b1)/(m1 - m2);
+ y = m1*x + b1;
+ if (end1Ptr[0] > end2Ptr[0]) {
+ if (x > end1Ptr[0]) {
+ x = end1Ptr[0];
+ y = end1Ptr[1];
+ } else if (x < end2Ptr[0]) {
+ x = end2Ptr[0];
+ y = end2Ptr[1];
+ }
+ } else {
+ if (x > end2Ptr[0]) {
+ x = end2Ptr[0];
+ y = end2Ptr[1];
+ } else if (x < end1Ptr[0]) {
+ x = end1Ptr[0];
+ y = end1Ptr[1];
+ }
+ }
+ }
+
+ /*
+ * Compute the distance to the closest point.
+ */
+
+ return hypot(pointPtr[0] - x, pointPtr[1] - y);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkLineToArea --
+ *
+ * Determine whether a line lies entirely inside, entirely
+ * outside, or overlapping a given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the line given by end1Ptr and end2Ptr
+ * is entirely outside the rectangle given by rectPtr. 0 is
+ * returned if the polygon overlaps the rectangle, and 1 is
+ * returned if the polygon is entirely inside the rectangle.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkLineToArea(end1Ptr, end2Ptr, rectPtr)
+ double end1Ptr[2]; /* X and y coordinates for one endpoint
+ * of line. */
+ double end2Ptr[2]; /* X and y coordinates for other endpoint
+ * of line. */
+ double rectPtr[4]; /* Points to coords for rectangle, in the
+ * order x1, y1, x2, y2. X1 must be no
+ * larger than x2, and y1 no larger than y2. */
+{
+ int inside1, inside2;
+
+ /*
+ * First check the two points individually to see whether they
+ * are inside the rectangle or not.
+ */
+
+ inside1 = (end1Ptr[0] >= rectPtr[0]) && (end1Ptr[0] <= rectPtr[2])
+ && (end1Ptr[1] >= rectPtr[1]) && (end1Ptr[1] <= rectPtr[3]);
+ inside2 = (end2Ptr[0] >= rectPtr[0]) && (end2Ptr[0] <= rectPtr[2])
+ && (end2Ptr[1] >= rectPtr[1]) && (end2Ptr[1] <= rectPtr[3]);
+ if (inside1 != inside2) {
+ return 0;
+ }
+ if (inside1 & inside2) {
+ return 1;
+ }
+
+ /*
+ * Both points are outside the rectangle, but still need to check
+ * for intersections between the line and the rectangle. Horizontal
+ * and vertical lines are particularly easy, so handle them
+ * separately.
+ */
+
+ if (end1Ptr[0] == end2Ptr[0]) {
+ /*
+ * Vertical line.
+ */
+
+ if (((end1Ptr[1] >= rectPtr[1]) ^ (end2Ptr[1] >= rectPtr[1]))
+ && (end1Ptr[0] >= rectPtr[0])
+ && (end1Ptr[0] <= rectPtr[2])) {
+ return 0;
+ }
+ } else if (end1Ptr[1] == end2Ptr[1]) {
+ /*
+ * Horizontal line.
+ */
+
+ if (((end1Ptr[0] >= rectPtr[0]) ^ (end2Ptr[0] >= rectPtr[0]))
+ && (end1Ptr[1] >= rectPtr[1])
+ && (end1Ptr[1] <= rectPtr[3])) {
+ return 0;
+ }
+ } else {
+ double m, x, y, low, high;
+
+ /*
+ * Diagonal line. Compute slope of line and use
+ * for intersection checks against each of the
+ * sides of the rectangle: left, right, bottom, top.
+ */
+
+ m = (end2Ptr[1] - end1Ptr[1])/(end2Ptr[0] - end1Ptr[0]);
+ if (end1Ptr[0] < end2Ptr[0]) {
+ low = end1Ptr[0]; high = end2Ptr[0];
+ } else {
+ low = end2Ptr[0]; high = end1Ptr[0];
+ }
+
+ /*
+ * Left edge.
+ */
+
+ y = end1Ptr[1] + (rectPtr[0] - end1Ptr[0])*m;
+ if ((rectPtr[0] >= low) && (rectPtr[0] <= high)
+ && (y >= rectPtr[1]) && (y <= rectPtr[3])) {
+ return 0;
+ }
+
+ /*
+ * Right edge.
+ */
+
+ y += (rectPtr[2] - rectPtr[0])*m;
+ if ((y >= rectPtr[1]) && (y <= rectPtr[3])
+ && (rectPtr[2] >= low) && (rectPtr[2] <= high)) {
+ return 0;
+ }
+
+ /*
+ * Bottom edge.
+ */
+
+ if (end1Ptr[1] < end2Ptr[1]) {
+ low = end1Ptr[1]; high = end2Ptr[1];
+ } else {
+ low = end2Ptr[1]; high = end1Ptr[1];
+ }
+ x = end1Ptr[0] + (rectPtr[1] - end1Ptr[1])/m;
+ if ((x >= rectPtr[0]) && (x <= rectPtr[2])
+ && (rectPtr[1] >= low) && (rectPtr[1] <= high)) {
+ return 0;
+ }
+
+ /*
+ * Top edge.
+ */
+
+ x += (rectPtr[3] - rectPtr[1])/m;
+ if ((x >= rectPtr[0]) && (x <= rectPtr[2])
+ && (rectPtr[3] >= low) && (rectPtr[3] <= high)) {
+ return 0;
+ }
+ }
+ return -1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkThickPolyLineToArea --
+ *
+ * This procedure is called to determine whether a connected
+ * series of line segments lies entirely inside, entirely
+ * outside, or overlapping a given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the lines are entirely outside the area,
+ * 0 if they overlap, and 1 if they are entirely inside the
+ * given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TkThickPolyLineToArea(coordPtr, numPoints, width, capStyle, joinStyle, rectPtr)
+ double *coordPtr; /* Points to an array of coordinates for
+ * the polyline: x0, y0, x1, y1, ... */
+ int numPoints; /* Total number of points at *coordPtr. */
+ double width; /* Width of each line segment. */
+ int capStyle; /* How are end-points of polyline drawn?
+ * CapRound, CapButt, or CapProjecting. */
+ int joinStyle; /* How are joints in polyline drawn?
+ * JoinMiter, JoinRound, or JoinBevel. */
+ double *rectPtr; /* Rectangular area to check against. */
+{
+ double radius, poly[10];
+ int count;
+ int changedMiterToBevel; /* Non-zero means that a mitered corner
+ * had to be treated as beveled after all
+ * because the angle was < 11 degrees. */
+ int inside; /* Tentative guess about what to return,
+ * based on all points seen so far: one
+ * means everything seen so far was
+ * inside the area; -1 means everything
+ * was outside the area. 0 means overlap
+ * has been found. */
+
+ radius = width/2.0;
+ inside = -1;
+
+ if ((coordPtr[0] >= rectPtr[0]) && (coordPtr[0] <= rectPtr[2])
+ && (coordPtr[1] >= rectPtr[1]) && (coordPtr[1] <= rectPtr[3])) {
+ inside = 1;
+ }
+
+ /*
+ * Iterate through all of the edges of the line, computing a polygon
+ * for each edge and testing the area against that polygon. In
+ * addition, there are additional tests to deal with rounded joints
+ * and caps.
+ */
+
+ changedMiterToBevel = 0;
+ for (count = numPoints; count >= 2; count--, coordPtr += 2) {
+
+ /*
+ * If rounding is done around the first point of the edge
+ * then test a circular region around the point with the
+ * area.
+ */
+
+ if (((capStyle == CapRound) && (count == numPoints))
+ || ((joinStyle == JoinRound) && (count != numPoints))) {
+ poly[0] = coordPtr[0] - radius;
+ poly[1] = coordPtr[1] - radius;
+ poly[2] = coordPtr[0] + radius;
+ poly[3] = coordPtr[1] + radius;
+ if (TkOvalToArea(poly, rectPtr) != inside) {
+ return 0;
+ }
+ }
+
+ /*
+ * Compute the polygonal shape corresponding to this edge,
+ * consisting of two points for the first point of the edge
+ * and two points for the last point of the edge.
+ */
+
+ if (count == numPoints) {
+ TkGetButtPoints(coordPtr+2, coordPtr, width,
+ capStyle == CapProjecting, poly, poly+2);
+ } else if ((joinStyle == JoinMiter) && !changedMiterToBevel) {
+ poly[0] = poly[6];
+ poly[1] = poly[7];
+ poly[2] = poly[4];
+ poly[3] = poly[5];
+ } else {
+ TkGetButtPoints(coordPtr+2, coordPtr, width, 0, poly, poly+2);
+
+ /*
+ * If the last joint was beveled, then also check a
+ * polygon comprising the last two points of the previous
+ * polygon and the first two from this polygon; this checks
+ * the wedges that fill the beveled joint.
+ */
+
+ if ((joinStyle == JoinBevel) || changedMiterToBevel) {
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ if (TkPolygonToArea(poly, 5, rectPtr) != inside) {
+ return 0;
+ }
+ changedMiterToBevel = 0;
+ }
+ }
+ if (count == 2) {
+ TkGetButtPoints(coordPtr, coordPtr+2, width,
+ capStyle == CapProjecting, poly+4, poly+6);
+ } else if (joinStyle == JoinMiter) {
+ if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
+ (double) width, poly+4, poly+6) == 0) {
+ changedMiterToBevel = 1;
+ TkGetButtPoints(coordPtr, coordPtr+2, width, 0, poly+4,
+ poly+6);
+ }
+ } else {
+ TkGetButtPoints(coordPtr, coordPtr+2, width, 0, poly+4, poly+6);
+ }
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ if (TkPolygonToArea(poly, 5, rectPtr) != inside) {
+ return 0;
+ }
+ }
+
+ /*
+ * If caps are rounded, check the cap around the final point
+ * of the line.
+ */
+
+ if (capStyle == CapRound) {
+ poly[0] = coordPtr[0] - radius;
+ poly[1] = coordPtr[1] - radius;
+ poly[2] = coordPtr[0] + radius;
+ poly[3] = coordPtr[1] + radius;
+ if (TkOvalToArea(poly, rectPtr) != inside) {
+ return 0;
+ }
+ }
+
+ return inside;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkPolygonToPoint --
+ *
+ * Compute the distance from a point to a polygon.
+ *
+ * Results:
+ * The return value is 0.0 if the point referred to by
+ * pointPtr is within the polygon referred to by polyPtr
+ * and numPoints. Otherwise the return value is the
+ * distance of the point from the polygon.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+double
+TkPolygonToPoint(polyPtr, numPoints, pointPtr)
+ double *polyPtr; /* Points to an array coordinates for
+ * closed polygon: x0, y0, x1, y1, ...
+ * The polygon may be self-intersecting. */
+ int numPoints; /* Total number of points at *polyPtr. */
+ double *pointPtr; /* Points to coords for point. */
+{
+ double bestDist; /* Closest distance between point and
+ * any edge in polygon. */
+ int intersections; /* Number of edges in the polygon that
+ * intersect a ray extending vertically
+ * upwards from the point to infinity. */
+ int count;
+ register double *pPtr;
+
+ /*
+ * Iterate through all of the edges in the polygon, updating
+ * bestDist and intersections.
+ *
+ * TRICKY POINT: when computing intersections, include left
+ * x-coordinate of line within its range, but not y-coordinate.
+ * Otherwise if the point lies exactly below a vertex we'll
+ * count it as two intersections.
+ */
+
+ bestDist = 1.0e36;
+ intersections = 0;
+
+ for (count = numPoints, pPtr = polyPtr; count > 1; count--, pPtr += 2) {
+ double x, y, dist;
+
+ /*
+ * Compute the point on the current edge closest to the point
+ * and update the intersection count. This must be done
+ * separately for vertical edges, horizontal edges, and
+ * other edges.
+ */
+
+ if (pPtr[2] == pPtr[0]) {
+
+ /*
+ * Vertical edge.
+ */
+
+ x = pPtr[0];
+ if (pPtr[1] >= pPtr[3]) {
+ y = MIN(pPtr[1], pointPtr[1]);
+ y = MAX(y, pPtr[3]);
+ } else {
+ y = MIN(pPtr[3], pointPtr[1]);
+ y = MAX(y, pPtr[1]);
+ }
+ } else if (pPtr[3] == pPtr[1]) {
+
+ /*
+ * Horizontal edge.
+ */
+
+ y = pPtr[1];
+ if (pPtr[0] >= pPtr[2]) {
+ x = MIN(pPtr[0], pointPtr[0]);
+ x = MAX(x, pPtr[2]);
+ if ((pointPtr[1] < y) && (pointPtr[0] < pPtr[0])
+ && (pointPtr[0] >= pPtr[2])) {
+ intersections++;
+ }
+ } else {
+ x = MIN(pPtr[2], pointPtr[0]);
+ x = MAX(x, pPtr[0]);
+ if ((pointPtr[1] < y) && (pointPtr[0] < pPtr[2])
+ && (pointPtr[0] >= pPtr[0])) {
+ intersections++;
+ }
+ }
+ } else {
+ double m1, b1, m2, b2;
+ int lower; /* Non-zero means point below line. */
+
+ /*
+ * The edge is neither horizontal nor vertical. Convert the
+ * edge to a line equation of the form y = m1*x + b1. Then
+ * compute a line perpendicular to this edge but passing
+ * through the point, also in the form y = m2*x + b2.
+ */
+
+ m1 = (pPtr[3] - pPtr[1])/(pPtr[2] - pPtr[0]);
+ b1 = pPtr[1] - m1*pPtr[0];
+ m2 = -1.0/m1;
+ b2 = pointPtr[1] - m2*pointPtr[0];
+ x = (b2 - b1)/(m1 - m2);
+ y = m1*x + b1;
+ if (pPtr[0] > pPtr[2]) {
+ if (x > pPtr[0]) {
+ x = pPtr[0];
+ y = pPtr[1];
+ } else if (x < pPtr[2]) {
+ x = pPtr[2];
+ y = pPtr[3];
+ }
+ } else {
+ if (x > pPtr[2]) {
+ x = pPtr[2];
+ y = pPtr[3];
+ } else if (x < pPtr[0]) {
+ x = pPtr[0];
+ y = pPtr[1];
+ }
+ }
+ lower = (m1*pointPtr[0] + b1) > pointPtr[1];
+ if (lower && (pointPtr[0] >= MIN(pPtr[0], pPtr[2]))
+ && (pointPtr[0] < MAX(pPtr[0], pPtr[2]))) {
+ intersections++;
+ }
+ }
+
+ /*
+ * Compute the distance to the closest point, and see if that
+ * is the best distance seen so far.
+ */
+
+ dist = hypot(pointPtr[0] - x, pointPtr[1] - y);
+ if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+
+ /*
+ * We've processed all of the points. If the number of intersections
+ * is odd, the point is inside the polygon.
+ */
+
+ if (intersections & 0x1) {
+ return 0.0;
+ }
+ return bestDist;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkPolygonToArea --
+ *
+ * Determine whether a polygon lies entirely inside, entirely
+ * outside, or overlapping a given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the polygon given by polyPtr and numPoints
+ * is entirely outside the rectangle given by rectPtr. 0 is
+ * returned if the polygon overlaps the rectangle, and 1 is
+ * returned if the polygon is entirely inside the rectangle.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkPolygonToArea(polyPtr, numPoints, rectPtr)
+ double *polyPtr; /* Points to an array coordinates for
+ * closed polygon: x0, y0, x1, y1, ...
+ * The polygon may be self-intersecting. */
+ int numPoints; /* Total number of points at *polyPtr. */
+ register double *rectPtr; /* Points to coords for rectangle, in the
+ * order x1, y1, x2, y2. X1 and y1 must
+ * be lower-left corner. */
+{
+ int state; /* State of all edges seen so far (-1 means
+ * outside, 1 means inside, won't ever be
+ * 0). */
+ int count;
+ register double *pPtr;
+
+ /*
+ * Iterate over all of the edges of the polygon and test them
+ * against the rectangle. Can quit as soon as the state becomes
+ * "intersecting".
+ */
+
+ state = TkLineToArea(polyPtr, polyPtr+2, rectPtr);
+ if (state == 0) {
+ return 0;
+ }
+ for (pPtr = polyPtr+2, count = numPoints-1; count >= 2;
+ pPtr += 2, count--) {
+ if (TkLineToArea(pPtr, pPtr+2, rectPtr) != state) {
+ return 0;
+ }
+ }
+
+ /*
+ * If all of the edges were inside the rectangle we're done.
+ * If all of the edges were outside, then the rectangle could
+ * still intersect the polygon (if it's entirely enclosed).
+ * Call TkPolygonToPoint to figure this out.
+ */
+
+ if (state == 1) {
+ return 1;
+ }
+ if (TkPolygonToPoint(polyPtr, numPoints, rectPtr) == 0.0) {
+ return 0;
+ }
+ return -1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkOvalToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * oval, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point given by *pointPtr is
+ * inside the oval. If the point isn't inside the
+ * oval then the return value is approximately the distance
+ * from the point to the oval. If the oval is filled, then
+ * anywhere in the interior is considered "inside"; if
+ * the oval isn't filled, then "inside" means only the area
+ * occupied by the outline.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+double
+TkOvalToPoint(ovalPtr, width, filled, pointPtr)
+ double ovalPtr[4]; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) defining oval's bounding
+ * box. */
+ double width; /* Width of outline for oval. */
+ int filled; /* Non-zero means oval should be treated as
+ * filled; zero means only consider outline. */
+ double pointPtr[2]; /* Coordinates of point. */
+{
+ double xDelta, yDelta, scaledDistance, distToOutline, distToCenter;
+ double xDiam, yDiam;
+
+ /*
+ * Compute the distance between the center of the oval and the
+ * point in question, using a coordinate system where the oval
+ * has been transformed to a circle with unit radius.
+ */
+
+ xDelta = (pointPtr[0] - (ovalPtr[0] + ovalPtr[2])/2.0);
+ yDelta = (pointPtr[1] - (ovalPtr[1] + ovalPtr[3])/2.0);
+ distToCenter = hypot(xDelta, yDelta);
+ scaledDistance = hypot(xDelta / ((ovalPtr[2] + width - ovalPtr[0])/2.0),
+ yDelta / ((ovalPtr[3] + width - ovalPtr[1])/2.0));
+
+
+ /*
+ * If the scaled distance is greater than 1 then it means no
+ * hit. Compute the distance from the point to the edge of
+ * the circle, then scale this distance back to the original
+ * coordinate system.
+ *
+ * Note: this distance isn't completely accurate. It's only
+ * an approximation, and it can overestimate the correct
+ * distance when the oval is eccentric.
+ */
+
+ if (scaledDistance > 1.0) {
+ return (distToCenter/scaledDistance) * (scaledDistance - 1.0);
+ }
+
+ /*
+ * Scaled distance less than 1 means the point is inside the
+ * outer edge of the oval. If this is a filled oval, then we
+ * have a hit. Otherwise, do the same computation as above
+ * (scale back to original coordinate system), but also check
+ * to see if the point is within the width of the outline.
+ */
+
+ if (filled) {
+ return 0.0;
+ }
+ if (scaledDistance > 1E-10) {
+ distToOutline = (distToCenter/scaledDistance) * (1.0 - scaledDistance)
+ - width;
+ } else {
+ /*
+ * Avoid dividing by a very small number (it could cause an
+ * arithmetic overflow). This problem occurs if the point is
+ * very close to the center of the oval.
+ */
+
+ xDiam = ovalPtr[2] - ovalPtr[0];
+ yDiam = ovalPtr[3] - ovalPtr[1];
+ if (xDiam < yDiam) {
+ distToOutline = (xDiam - width)/2;
+ } else {
+ distToOutline = (yDiam - width)/2;
+ }
+ }
+
+ if (distToOutline < 0.0) {
+ return 0.0;
+ }
+ return distToOutline;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkOvalToArea --
+ *
+ * Determine whether an oval lies entirely inside, entirely
+ * outside, or overlapping a given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the oval described by ovalPtr is entirely
+ * outside the rectangle given by rectPtr. 0 is returned if the
+ * oval overlaps the rectangle, and 1 is returned if the oval
+ * is entirely inside the rectangle.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkOvalToArea(ovalPtr, rectPtr)
+ register double *ovalPtr; /* Points to coordinates definining the
+ * bounding rectangle for the oval: x1, y1,
+ * x2, y2. X1 must be less than x2 and y1
+ * less than y2. */
+ register double *rectPtr; /* Points to coords for rectangle, in the
+ * order x1, y1, x2, y2. X1 and y1 must
+ * be lower-left corner. */
+{
+ double centerX, centerY, radX, radY, deltaX, deltaY;
+
+ /*
+ * First, see if oval is entirely inside rectangle or entirely
+ * outside rectangle.
+ */
+
+ if ((rectPtr[0] <= ovalPtr[0]) && (rectPtr[2] >= ovalPtr[2])
+ && (rectPtr[1] <= ovalPtr[1]) && (rectPtr[3] >= ovalPtr[3])) {
+ return 1;
+ }
+ if ((rectPtr[2] < ovalPtr[0]) || (rectPtr[0] > ovalPtr[2])
+ || (rectPtr[3] < ovalPtr[1]) || (rectPtr[1] > ovalPtr[3])) {
+ return -1;
+ }
+
+ /*
+ * Next, go through the rectangle side by side. For each side
+ * of the rectangle, find the point on the side that is closest
+ * to the oval's center, and see if that point is inside the
+ * oval. If at least one such point is inside the oval, then
+ * the rectangle intersects the oval.
+ */
+
+ centerX = (ovalPtr[0] + ovalPtr[2])/2;
+ centerY = (ovalPtr[1] + ovalPtr[3])/2;
+ radX = (ovalPtr[2] - ovalPtr[0])/2;
+ radY = (ovalPtr[3] - ovalPtr[1])/2;
+
+ deltaY = rectPtr[1] - centerY;
+ if (deltaY < 0.0) {
+ deltaY = centerY - rectPtr[3];
+ if (deltaY < 0.0) {
+ deltaY = 0;
+ }
+ }
+ deltaY /= radY;
+ deltaY *= deltaY;
+
+ /*
+ * Left side:
+ */
+
+ deltaX = (rectPtr[0] - centerX)/radX;
+ deltaX *= deltaX;
+ if ((deltaX + deltaY) <= 1.0) {
+ return 0;
+ }
+
+ /*
+ * Right side:
+ */
+
+ deltaX = (rectPtr[2] - centerX)/radX;
+ deltaX *= deltaX;
+ if ((deltaX + deltaY) <= 1.0) {
+ return 0;
+ }
+
+ deltaX = rectPtr[0] - centerX;
+ if (deltaX < 0.0) {
+ deltaX = centerX - rectPtr[2];
+ if (deltaX < 0.0) {
+ deltaX = 0;
+ }
+ }
+ deltaX /= radX;
+ deltaX *= deltaX;
+
+ /*
+ * Bottom side:
+ */
+
+ deltaY = (rectPtr[1] - centerY)/radY;
+ deltaY *= deltaY;
+ if ((deltaX + deltaY) < 1.0) {
+ return 0;
+ }
+
+ /*
+ * Top side:
+ */
+
+ deltaY = (rectPtr[3] - centerY)/radY;
+ deltaY *= deltaY;
+ if ((deltaX + deltaY) < 1.0) {
+ return 0;
+ }
+
+ return -1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkIncludePoint --
+ *
+ * Given a point and a generic canvas item header, expand
+ * the item's bounding box if needed to include the point.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The boudn.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+void
+TkIncludePoint(itemPtr, pointPtr)
+ register Tk_Item *itemPtr; /* Item whose bounding box is
+ * being calculated. */
+ double *pointPtr; /* Address of two doubles giving
+ * x and y coordinates of point. */
+{
+ int tmp;
+
+ tmp = (int) (pointPtr[0] + 0.5);
+ if (tmp < itemPtr->x1) {
+ itemPtr->x1 = tmp;
+ }
+ if (tmp > itemPtr->x2) {
+ itemPtr->x2 = tmp;
+ }
+ tmp = (int) (pointPtr[1] + 0.5);
+ if (tmp < itemPtr->y1) {
+ itemPtr->y1 = tmp;
+ }
+ if (tmp > itemPtr->y2) {
+ itemPtr->y2 = tmp;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkBezierScreenPoints --
+ *
+ * Given four control points, create a larger set of XPoints
+ * for a Bezier spline based on the points.
+ *
+ * Results:
+ * The array at *xPointPtr gets filled in with numSteps XPoints
+ * corresponding to the Bezier spline defined by the four
+ * control points. Note: no output point is generated for the
+ * first input point, but an output point *is* generated for
+ * the last input point.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkBezierScreenPoints(canvas, control, numSteps, xPointPtr)
+ Tk_Canvas canvas; /* Canvas in which curve is to be
+ * drawn. */
+ double control[]; /* Array of coordinates for four
+ * control points: x0, y0, x1, y1,
+ * ... x3 y3. */
+ int numSteps; /* Number of curve points to
+ * generate. */
+ register XPoint *xPointPtr; /* Where to put new points. */
+{
+ int i;
+ double u, u2, u3, t, t2, t3;
+
+ for (i = 1; i <= numSteps; i++, xPointPtr++) {
+ t = ((double) i)/((double) numSteps);
+ t2 = t*t;
+ t3 = t2*t;
+ u = 1.0 - t;
+ u2 = u*u;
+ u3 = u2*u;
+ Tk_CanvasDrawableCoords(canvas,
+ (control[0]*u3 + 3.0 * (control[2]*t*u2 + control[4]*t2*u)
+ + control[6]*t3),
+ (control[1]*u3 + 3.0 * (control[3]*t*u2 + control[5]*t2*u)
+ + control[7]*t3),
+ &xPointPtr->x, &xPointPtr->y);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkBezierPoints --
+ *
+ * Given four control points, create a larger set of points
+ * for a Bezier spline based on the points.
+ *
+ * Results:
+ * The array at *coordPtr gets filled in with 2*numSteps
+ * coordinates, which correspond to the Bezier spline defined
+ * by the four control points. Note: no output point is
+ * generated for the first input point, but an output point
+ * *is* generated for the last input point.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkBezierPoints(control, numSteps, coordPtr)
+ double control[]; /* Array of coordinates for four
+ * control points: x0, y0, x1, y1,
+ * ... x3 y3. */
+ int numSteps; /* Number of curve points to
+ * generate. */
+ register double *coordPtr; /* Where to put new points. */
+{
+ int i;
+ double u, u2, u3, t, t2, t3;
+
+ for (i = 1; i <= numSteps; i++, coordPtr += 2) {
+ t = ((double) i)/((double) numSteps);
+ t2 = t*t;
+ t3 = t2*t;
+ u = 1.0 - t;
+ u2 = u*u;
+ u3 = u2*u;
+ coordPtr[0] = control[0]*u3
+ + 3.0 * (control[2]*t*u2 + control[4]*t2*u) + control[6]*t3;
+ coordPtr[1] = control[1]*u3
+ + 3.0 * (control[3]*t*u2 + control[5]*t2*u) + control[7]*t3;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkMakeBezierCurve --
+ *
+ * Given a set of points, create a new set of points that fit
+ * parabolic splines to the line segments connecting the original
+ * points. Produces output points in either of two forms.
+ *
+ * Note: in spite of this procedure's name, it does *not* generate
+ * Bezier curves. Since only three control points are used for
+ * each curve segment, not four, the curves are actually just
+ * parabolic.
+ *
+ * Results:
+ * Either or both of the xPoints or dblPoints arrays are filled
+ * in. The return value is the number of points placed in the
+ * arrays. Note: if the first and last points are the same, then
+ * a closed curve is generated.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkMakeBezierCurve(canvas, pointPtr, numPoints, numSteps, xPoints, dblPoints)
+ Tk_Canvas canvas; /* Canvas in which curve is to be
+ * drawn. */
+ double *pointPtr; /* Array of input coordinates: x0,
+ * y0, x1, y1, etc.. */
+ int numPoints; /* Number of points at pointPtr. */
+ int numSteps; /* Number of steps to use for each
+ * spline segments (determines
+ * smoothness of curve). */
+ XPoint xPoints[]; /* Array of XPoints to fill in (e.g.
+ * for display. NULL means don't
+ * fill in any XPoints. */
+ double dblPoints[]; /* Array of points to fill in as
+ * doubles, in the form x0, y0,
+ * x1, y1, .... NULL means don't
+ * fill in anything in this form.
+ * Caller must make sure that this
+ * array has enough space. */
+{
+ int closed, outputPoints, i;
+ int numCoords = numPoints*2;
+ double control[8];
+
+ /*
+ * If the curve is a closed one then generate a special spline
+ * that spans the last points and the first ones. Otherwise
+ * just put the first point into the output.
+ */
+
+ outputPoints = 0;
+ if ((pointPtr[0] == pointPtr[numCoords-2])
+ && (pointPtr[1] == pointPtr[numCoords-1])) {
+ closed = 1;
+ control[0] = 0.5*pointPtr[numCoords-4] + 0.5*pointPtr[0];
+ control[1] = 0.5*pointPtr[numCoords-3] + 0.5*pointPtr[1];
+ control[2] = 0.167*pointPtr[numCoords-4] + 0.833*pointPtr[0];
+ control[3] = 0.167*pointPtr[numCoords-3] + 0.833*pointPtr[1];
+ control[4] = 0.833*pointPtr[0] + 0.167*pointPtr[2];
+ control[5] = 0.833*pointPtr[1] + 0.167*pointPtr[3];
+ control[6] = 0.5*pointPtr[0] + 0.5*pointPtr[2];
+ control[7] = 0.5*pointPtr[1] + 0.5*pointPtr[3];
+ if (xPoints != NULL) {
+ Tk_CanvasDrawableCoords(canvas, control[0], control[1],
+ &xPoints->x, &xPoints->y);
+ TkBezierScreenPoints(canvas, control, numSteps, xPoints+1);
+ xPoints += numSteps+1;
+ }
+ if (dblPoints != NULL) {
+ dblPoints[0] = control[0];
+ dblPoints[1] = control[1];
+ TkBezierPoints(control, numSteps, dblPoints+2);
+ dblPoints += 2*(numSteps+1);
+ }
+ outputPoints += numSteps+1;
+ } else {
+ closed = 0;
+ if (xPoints != NULL) {
+ Tk_CanvasDrawableCoords(canvas, pointPtr[0], pointPtr[1],
+ &xPoints->x, &xPoints->y);
+ xPoints += 1;
+ }
+ if (dblPoints != NULL) {
+ dblPoints[0] = pointPtr[0];
+ dblPoints[1] = pointPtr[1];
+ dblPoints += 2;
+ }
+ outputPoints += 1;
+ }
+
+ for (i = 2; i < numPoints; i++, pointPtr += 2) {
+ /*
+ * Set up the first two control points. This is done
+ * differently for the first spline of an open curve
+ * than for other cases.
+ */
+
+ if ((i == 2) && !closed) {
+ control[0] = pointPtr[0];
+ control[1] = pointPtr[1];
+ control[2] = 0.333*pointPtr[0] + 0.667*pointPtr[2];
+ control[3] = 0.333*pointPtr[1] + 0.667*pointPtr[3];
+ } else {
+ control[0] = 0.5*pointPtr[0] + 0.5*pointPtr[2];
+ control[1] = 0.5*pointPtr[1] + 0.5*pointPtr[3];
+ control[2] = 0.167*pointPtr[0] + 0.833*pointPtr[2];
+ control[3] = 0.167*pointPtr[1] + 0.833*pointPtr[3];
+ }
+
+ /*
+ * Set up the last two control points. This is done
+ * differently for the last spline of an open curve
+ * than for other cases.
+ */
+
+ if ((i == (numPoints-1)) && !closed) {
+ control[4] = .667*pointPtr[2] + .333*pointPtr[4];
+ control[5] = .667*pointPtr[3] + .333*pointPtr[5];
+ control[6] = pointPtr[4];
+ control[7] = pointPtr[5];
+ } else {
+ control[4] = .833*pointPtr[2] + .167*pointPtr[4];
+ control[5] = .833*pointPtr[3] + .167*pointPtr[5];
+ control[6] = 0.5*pointPtr[2] + 0.5*pointPtr[4];
+ control[7] = 0.5*pointPtr[3] + 0.5*pointPtr[5];
+ }
+
+ /*
+ * If the first two points coincide, or if the last
+ * two points coincide, then generate a single
+ * straight-line segment by outputting the last control
+ * point.
+ */
+
+ if (((pointPtr[0] == pointPtr[2]) && (pointPtr[1] == pointPtr[3]))
+ || ((pointPtr[2] == pointPtr[4])
+ && (pointPtr[3] == pointPtr[5]))) {
+ if (xPoints != NULL) {
+ Tk_CanvasDrawableCoords(canvas, control[6], control[7],
+ &xPoints[0].x, &xPoints[0].y);
+ xPoints++;
+ }
+ if (dblPoints != NULL) {
+ dblPoints[0] = control[6];
+ dblPoints[1] = control[7];
+ dblPoints += 2;
+ }
+ outputPoints += 1;
+ continue;
+ }
+
+ /*
+ * Generate a Bezier spline using the control points.
+ */
+
+
+ if (xPoints != NULL) {
+ TkBezierScreenPoints(canvas, control, numSteps, xPoints);
+ xPoints += numSteps;
+ }
+ if (dblPoints != NULL) {
+ TkBezierPoints(control, numSteps, dblPoints);
+ dblPoints += 2*numSteps;
+ }
+ outputPoints += numSteps;
+ }
+ return outputPoints;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkMakeBezierPostscript --
+ *
+ * This procedure generates Postscript commands that create
+ * a path corresponding to a given Bezier curve.
+ *
+ * Results:
+ * None. Postscript commands to generate the path are appended
+ * to interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkMakeBezierPostscript(interp, canvas, pointPtr, numPoints)
+ Tcl_Interp *interp; /* Interpreter in whose result the
+ * Postscript is to be stored. */
+ Tk_Canvas canvas; /* Canvas widget for which the
+ * Postscript is being generated. */
+ double *pointPtr; /* Array of input coordinates: x0,
+ * y0, x1, y1, etc.. */
+ int numPoints; /* Number of points at pointPtr. */
+{
+ int closed, i;
+ int numCoords = numPoints*2;
+ double control[8];
+ char buffer[200];
+
+ /*
+ * If the curve is a closed one then generate a special spline
+ * that spans the last points and the first ones. Otherwise
+ * just put the first point into the path.
+ */
+
+ if ((pointPtr[0] == pointPtr[numCoords-2])
+ && (pointPtr[1] == pointPtr[numCoords-1])) {
+ closed = 1;
+ control[0] = 0.5*pointPtr[numCoords-4] + 0.5*pointPtr[0];
+ control[1] = 0.5*pointPtr[numCoords-3] + 0.5*pointPtr[1];
+ control[2] = 0.167*pointPtr[numCoords-4] + 0.833*pointPtr[0];
+ control[3] = 0.167*pointPtr[numCoords-3] + 0.833*pointPtr[1];
+ control[4] = 0.833*pointPtr[0] + 0.167*pointPtr[2];
+ control[5] = 0.833*pointPtr[1] + 0.167*pointPtr[3];
+ control[6] = 0.5*pointPtr[0] + 0.5*pointPtr[2];
+ control[7] = 0.5*pointPtr[1] + 0.5*pointPtr[3];
+ sprintf(buffer, "%.15g %.15g moveto\n%.15g %.15g %.15g %.15g %.15g %.15g curveto\n",
+ control[0], Tk_CanvasPsY(canvas, control[1]),
+ control[2], Tk_CanvasPsY(canvas, control[3]),
+ control[4], Tk_CanvasPsY(canvas, control[5]),
+ control[6], Tk_CanvasPsY(canvas, control[7]));
+ } else {
+ closed = 0;
+ control[6] = pointPtr[0];
+ control[7] = pointPtr[1];
+ sprintf(buffer, "%.15g %.15g moveto\n",
+ control[6], Tk_CanvasPsY(canvas, control[7]));
+ }
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+
+ /*
+ * Cycle through all the remaining points in the curve, generating
+ * a curve section for each vertex in the linear path.
+ */
+
+ for (i = numPoints-2, pointPtr += 2; i > 0; i--, pointPtr += 2) {
+ control[2] = 0.333*control[6] + 0.667*pointPtr[0];
+ control[3] = 0.333*control[7] + 0.667*pointPtr[1];
+
+ /*
+ * Set up the last two control points. This is done
+ * differently for the last spline of an open curve
+ * than for other cases.
+ */
+
+ if ((i == 1) && !closed) {
+ control[6] = pointPtr[2];
+ control[7] = pointPtr[3];
+ } else {
+ control[6] = 0.5*pointPtr[0] + 0.5*pointPtr[2];
+ control[7] = 0.5*pointPtr[1] + 0.5*pointPtr[3];
+ }
+ control[4] = 0.333*control[6] + 0.667*pointPtr[0];
+ control[5] = 0.333*control[7] + 0.667*pointPtr[1];
+
+ sprintf(buffer, "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n",
+ control[2], Tk_CanvasPsY(canvas, control[3]),
+ control[4], Tk_CanvasPsY(canvas, control[5]),
+ control[6], Tk_CanvasPsY(canvas, control[7]));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkGetMiterPoints --
+ *
+ * Given three points forming an angle, compute the
+ * coordinates of the inside and outside points of
+ * the mitered corner formed by a line of a given
+ * width at that angle.
+ *
+ * Results:
+ * If the angle formed by the three points is less than
+ * 11 degrees then 0 is returned and m1 and m2 aren't
+ * modified. Otherwise 1 is returned and the points at
+ * m1 and m2 are filled in with the positions of the points
+ * of the mitered corner.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkGetMiterPoints(p1, p2, p3, width, m1, m2)
+ double p1[]; /* Points to x- and y-coordinates of point
+ * before vertex. */
+ double p2[]; /* Points to x- and y-coordinates of vertex
+ * for mitered joint. */
+ double p3[]; /* Points to x- and y-coordinates of point
+ * after vertex. */
+ double width; /* Width of line. */
+ double m1[]; /* Points to place to put "left" vertex
+ * point (see as you face from p1 to p2). */
+ double m2[]; /* Points to place to put "right" vertex
+ * point. */
+{
+ double theta1; /* Angle of segment p2-p1. */
+ double theta2; /* Angle of segment p2-p3. */
+ double theta; /* Angle between line segments (angle
+ * of joint). */
+ double theta3; /* Angle that bisects theta1 and
+ * theta2 and points to m1. */
+ double dist; /* Distance of miter points from p2. */
+ double deltaX, deltaY; /* X and y offsets cooresponding to
+ * dist (fudge factors for bounding
+ * box). */
+ double p1x, p1y, p2x, p2y, p3x, p3y;
+ static double elevenDegrees = (11.0*2.0*PI)/360.0;
+
+ /*
+ * Round the coordinates to integers to mimic what happens when the
+ * line segments are displayed; without this code, the bounding box
+ * of a mitered line can be miscomputed greatly.
+ */
+
+ p1x = floor(p1[0]+0.5);
+ p1y = floor(p1[1]+0.5);
+ p2x = floor(p2[0]+0.5);
+ p2y = floor(p2[1]+0.5);
+ p3x = floor(p3[0]+0.5);
+ p3y = floor(p3[1]+0.5);
+
+ if (p2y == p1y) {
+ theta1 = (p2x < p1x) ? 0 : PI;
+ } else if (p2x == p1x) {
+ theta1 = (p2y < p1y) ? PI/2.0 : -PI/2.0;
+ } else {
+ theta1 = atan2(p1y - p2y, p1x - p2x);
+ }
+ if (p3y == p2y) {
+ theta2 = (p3x > p2x) ? 0 : PI;
+ } else if (p3x == p2x) {
+ theta2 = (p3y > p2y) ? PI/2.0 : -PI/2.0;
+ } else {
+ theta2 = atan2(p3y - p2y, p3x - p2x);
+ }
+ theta = theta1 - theta2;
+ if (theta > PI) {
+ theta -= 2*PI;
+ } else if (theta < -PI) {
+ theta += 2*PI;
+ }
+ if ((theta < elevenDegrees) && (theta > -elevenDegrees)) {
+ return 0;
+ }
+ dist = 0.5*width/sin(0.5*theta);
+ if (dist < 0.0) {
+ dist = -dist;
+ }
+
+ /*
+ * Compute theta3 (make sure that it points to the left when
+ * looking from p1 to p2).
+ */
+
+ theta3 = (theta1 + theta2)/2.0;
+ if (sin(theta3 - (theta1 + PI)) < 0.0) {
+ theta3 += PI;
+ }
+ deltaX = dist*cos(theta3);
+ m1[0] = p2x + deltaX;
+ m2[0] = p2x - deltaX;
+ deltaY = dist*sin(theta3);
+ m1[1] = p2y + deltaY;
+ m2[1] = p2y - deltaY;
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkGetButtPoints --
+ *
+ * Given two points forming a line segment, compute the
+ * coordinates of two endpoints of a rectangle formed by
+ * bloating the line segment until it is width units wide.
+ *
+ * Results:
+ * There is no return value. M1 and m2 are filled in to
+ * correspond to m1 and m2 in the diagram below:
+ *
+ * ----------------* m1
+ * |
+ * p1 *---------------* p2
+ * |
+ * ----------------* m2
+ *
+ * M1 and m2 will be W units apart, with p2 centered between
+ * them and m1-m2 perpendicular to p1-p2. However, if
+ * "project" is true then m1 and m2 will be as follows:
+ *
+ * -------------------* m1
+ * p2 |
+ * p1 *---------------* |
+ * |
+ * -------------------* m2
+ *
+ * In this case p2 will be width/2 units from the segment m1-m2.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkGetButtPoints(p1, p2, width, project, m1, m2)
+ double p1[]; /* Points to x- and y-coordinates of point
+ * before vertex. */
+ double p2[]; /* Points to x- and y-coordinates of vertex
+ * for mitered joint. */
+ double width; /* Width of line. */
+ int project; /* Non-zero means project p2 by an additional
+ * width/2 before computing m1 and m2. */
+ double m1[]; /* Points to place to put "left" result
+ * point, as you face from p1 to p2. */
+ double m2[]; /* Points to place to put "right" result
+ * point. */
+{
+ double length; /* Length of p1-p2 segment. */
+ double deltaX, deltaY; /* Increments in coords. */
+
+ width *= 0.5;
+ length = hypot(p2[0] - p1[0], p2[1] - p1[1]);
+ if (length == 0.0) {
+ m1[0] = m2[0] = p2[0];
+ m1[1] = m2[1] = p2[1];
+ } else {
+ deltaX = -width * (p2[1] - p1[1]) / length;
+ deltaY = width * (p2[0] - p1[0]) / length;
+ m1[0] = p2[0] + deltaX;
+ m2[0] = p2[0] - deltaX;
+ m1[1] = p2[1] + deltaY;
+ m2[1] = p2[1] - deltaY;
+ if (project) {
+ m1[0] += deltaY;
+ m2[0] += deltaY;
+ m1[1] -= deltaX;
+ m2[1] -= deltaX;
+ }
+ }
+}
diff --git a/generic/tkUtil.c b/generic/tkUtil.c
new file mode 100644
index 0000000..ddb3db0
--- /dev/null
+++ b/generic/tkUtil.c
@@ -0,0 +1,348 @@
+/*
+ * tkUtil.c --
+ *
+ * This file contains miscellaneous utility procedures that
+ * are used by the rest of Tk, such as a procedure for drawing
+ * a focus highlight.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkUtil.c 1.13 97/06/06 11:16:22
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDrawInsetFocusHighlight --
+ *
+ * This procedure draws a rectangular ring around the outside of
+ * a widget to indicate that it has received the input focus. It
+ * takes an additional padding argument that specifies how much
+ * padding is present outside th widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A rectangle "width" pixels wide is drawn in "drawable",
+ * corresponding to the outer area of "tkwin".
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkDrawInsetFocusHighlight(tkwin, gc, width, drawable, padding)
+ Tk_Window tkwin; /* Window whose focus highlight ring is
+ * to be drawn. */
+ GC gc; /* Graphics context to use for drawing
+ * the highlight ring. */
+ int width; /* Width of the highlight ring, in pixels. */
+ Drawable drawable; /* Where to draw the ring (typically a
+ * pixmap for double buffering). */
+ int padding; /* Width of padding outside of widget. */
+{
+ XRectangle rects[4];
+
+ /*
+ * On the Macintosh the highlight ring needs to be "padded"
+ * out by one pixel. Unfortunantly, none of the Tk widgets
+ * had a notion of padding between the focus ring and the
+ * widget. So we add this padding here. This introduces
+ * two things to worry about:
+ *
+ * 1) The widget must draw the background color covering
+ * the focus ring area before calling Tk_DrawFocus.
+ * 2) It is impossible to draw a focus ring of width 1.
+ * (For the Macintosh Look & Feel use width of 3)
+ */
+#ifdef MAC_TCL
+ width--;
+#endif
+
+ rects[0].x = padding;
+ rects[0].y = padding;
+ rects[0].width = Tk_Width(tkwin) - (2 * padding);
+ rects[0].height = width;
+ rects[1].x = padding;
+ rects[1].y = Tk_Height(tkwin) - width - padding;
+ rects[1].width = Tk_Width(tkwin) - (2 * padding);
+ rects[1].height = width;
+ rects[2].x = padding;
+ rects[2].y = width + padding;
+ rects[2].width = width;
+ rects[2].height = Tk_Height(tkwin) - 2*width - 2*padding;
+ rects[3].x = Tk_Width(tkwin) - width - padding;
+ rects[3].y = rects[2].y;
+ rects[3].width = width;
+ rects[3].height = rects[2].height;
+ XFillRectangles(Tk_Display(tkwin), drawable, gc, rects, 4);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DrawFocusHighlight --
+ *
+ * This procedure draws a rectangular ring around the outside of
+ * a widget to indicate that it has received the input focus.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A rectangle "width" pixels wide is drawn in "drawable",
+ * corresponding to the outer area of "tkwin".
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_DrawFocusHighlight(tkwin, gc, width, drawable)
+ Tk_Window tkwin; /* Window whose focus highlight ring is
+ * to be drawn. */
+ GC gc; /* Graphics context to use for drawing
+ * the highlight ring. */
+ int width; /* Width of the highlight ring, in pixels. */
+ Drawable drawable; /* Where to draw the ring (typically a
+ * pixmap for double buffering). */
+{
+ TkDrawInsetFocusHighlight(tkwin, gc, width, drawable, 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetScrollInfo --
+ *
+ * This procedure is invoked to parse "xview" and "yview"
+ * scrolling commands for widgets using the new scrolling
+ * command syntax ("moveto" or "scroll" options).
+ *
+ * Results:
+ * The return value is either TK_SCROLL_MOVETO, TK_SCROLL_PAGES,
+ * TK_SCROLL_UNITS, or TK_SCROLL_ERROR. This indicates whether
+ * the command was successfully parsed and what form the command
+ * took. If TK_SCROLL_MOVETO, *dblPtr is filled in with the
+ * desired position; if TK_SCROLL_PAGES or TK_SCROLL_UNITS,
+ * *intPtr is filled in with the number of lines to move (may be
+ * negative); if TK_SCROLL_ERROR, interp->result contains an
+ * error message.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetScrollInfo(interp, argc, argv, dblPtr, intPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ int argc; /* # arguments for command. */
+ char **argv; /* Arguments for command. */
+ double *dblPtr; /* Filled in with argument "moveto"
+ * option, if any. */
+ int *intPtr; /* Filled in with number of pages
+ * or lines to scroll, if any. */
+{
+ int c;
+ size_t length;
+
+ length = strlen(argv[2]);
+ c = argv[2][0];
+ if ((c == 'm') && (strncmp(argv[2], "moveto", length) == 0)) {
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " ", argv[1], " moveto fraction\"",
+ (char *) NULL);
+ return TK_SCROLL_ERROR;
+ }
+ if (Tcl_GetDouble(interp, argv[3], dblPtr) != TCL_OK) {
+ return TK_SCROLL_ERROR;
+ }
+ return TK_SCROLL_MOVETO;
+ } else if ((c == 's')
+ && (strncmp(argv[2], "scroll", length) == 0)) {
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " ", argv[1], " scroll number units|pages\"",
+ (char *) NULL);
+ return TK_SCROLL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[3], intPtr) != TCL_OK) {
+ return TK_SCROLL_ERROR;
+ }
+ length = strlen(argv[4]);
+ c = argv[4][0];
+ if ((c == 'p') && (strncmp(argv[4], "pages", length) == 0)) {
+ return TK_SCROLL_PAGES;
+ } else if ((c == 'u')
+ && (strncmp(argv[4], "units", length) == 0)) {
+ return TK_SCROLL_UNITS;
+ } else {
+ Tcl_AppendResult(interp, "bad argument \"", argv[4],
+ "\": must be units or pages", (char *) NULL);
+ return TK_SCROLL_ERROR;
+ }
+ }
+ Tcl_AppendResult(interp, "unknown option \"", argv[2],
+ "\": must be moveto or scroll", (char *) NULL);
+ return TK_SCROLL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkComputeAnchor --
+ *
+ * Determine where to place a rectangle so that it will be properly
+ * anchored with respect to the given window. Used by widgets
+ * to align a box of text inside a window. When anchoring with
+ * respect to one of the sides, the rectangle be placed inside of
+ * the internal border of the window.
+ *
+ * Results:
+ * *xPtr and *yPtr set to the upper-left corner of the rectangle
+ * anchored in the window.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+void
+TkComputeAnchor(anchor, tkwin, padX, padY, innerWidth, innerHeight, xPtr, yPtr)
+ Tk_Anchor anchor; /* Desired anchor. */
+ Tk_Window tkwin; /* Anchored with respect to this window. */
+ int padX, padY; /* Use this extra padding inside window, in
+ * addition to the internal border. */
+ int innerWidth, innerHeight;/* Size of rectangle to anchor in window. */
+ int *xPtr, *yPtr; /* Returns upper-left corner of anchored
+ * rectangle. */
+{
+ switch (anchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_SW:
+ *xPtr = Tk_InternalBorderWidth(tkwin) + padX;
+ break;
+
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_S:
+ *xPtr = (Tk_Width(tkwin) - innerWidth) / 2;
+ break;
+
+ default:
+ *xPtr = Tk_Width(tkwin) - (Tk_InternalBorderWidth(tkwin) + padX)
+ - innerWidth;
+ break;
+ }
+
+ switch (anchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_NE:
+ *yPtr = Tk_InternalBorderWidth(tkwin) + padY;
+ break;
+
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_E:
+ *yPtr = (Tk_Height(tkwin) - innerHeight) / 2;
+ break;
+
+ default:
+ *yPtr = Tk_Height(tkwin) - Tk_InternalBorderWidth(tkwin) - padY
+ - innerHeight;
+ break;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkFindStateString --
+ *
+ * Given a lookup table, map a number to a string in the table.
+ *
+ * Results:
+ * If numKey was equal to the numeric key of one of the elements
+ * in the table, returns the string key of that element.
+ * Returns NULL if numKey was not equal to any of the numeric keys
+ * in the table.
+ *
+ * Side effects.
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+char *
+TkFindStateString(mapPtr, numKey)
+ CONST TkStateMap *mapPtr; /* The state table. */
+ int numKey; /* The key to try to find in the table. */
+{
+ for ( ; mapPtr->strKey != NULL; mapPtr++) {
+ if (numKey == mapPtr->numKey) {
+ return mapPtr->strKey;
+ }
+ }
+ return NULL;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkFindStateNum --
+ *
+ * Given a lookup table, map a string to a number in the table.
+ *
+ * Results:
+ * If strKey was equal to the string keys of one of the elements
+ * in the table, returns the numeric key of that element.
+ * Returns the numKey associated with the last element (the NULL
+ * string one) in the table if strKey was not equal to any of the
+ * string keys in the table. In that case, an error message is
+ * also left in interp->result (if interp is not NULL).
+ *
+ * Side effects.
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkFindStateNum(interp, field, mapPtr, strKey)
+ Tcl_Interp *interp; /* Interp for error reporting. */
+ CONST char *field; /* String to use when constructing error. */
+ CONST TkStateMap *mapPtr; /* Lookup table. */
+ CONST char *strKey; /* String to try to find in lookup table. */
+{
+ CONST TkStateMap *mPtr;
+
+ if (mapPtr->strKey == NULL) {
+ panic("TkFindStateNum: no choices in lookup table");
+ }
+
+ for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) {
+ if (strcmp(strKey, mPtr->strKey) == 0) {
+ return mPtr->numKey;
+ }
+ }
+ if (interp != NULL) {
+ mPtr = mapPtr;
+ Tcl_AppendResult(interp, "bad ", field, " value \"", strKey,
+ "\": must be ", mPtr->strKey, (char *) NULL);
+ for (mPtr++; mPtr->strKey != NULL; mPtr++) {
+ Tcl_AppendResult(interp, ", ", mPtr->strKey, (char *) NULL);
+ }
+ }
+ return mPtr->numKey;
+}
diff --git a/generic/tkVisual.c b/generic/tkVisual.c
new file mode 100644
index 0000000..207b905
--- /dev/null
+++ b/generic/tkVisual.c
@@ -0,0 +1,540 @@
+/*
+ * tkVisual.c --
+ *
+ * This file contains library procedures for allocating and
+ * freeing visuals and colormaps. This code is based on a
+ * prototype implementation by Paul Mackerras.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkVisual.c 1.19 97/04/25 16:52:17
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * The table below maps from symbolic names for visual classes
+ * to the associated X class symbols.
+ */
+
+typedef struct VisualDictionary {
+ char *name; /* Textual name of class. */
+ int minLength; /* Minimum # characters that must be
+ * specified for an unambiguous match. */
+ int class; /* X symbol for class. */
+} VisualDictionary;
+static VisualDictionary visualNames[] = {
+ {"best", 1, 0},
+ {"directcolor", 2, DirectColor},
+ {"grayscale", 1, GrayScale},
+ {"greyscale", 1, GrayScale},
+ {"pseudocolor", 1, PseudoColor},
+ {"staticcolor", 7, StaticColor},
+ {"staticgray", 7, StaticGray},
+ {"staticgrey", 7, StaticGray},
+ {"truecolor", 1, TrueColor},
+ {NULL, 0, 0},
+};
+
+/*
+ * One of the following structures exists for each distinct non-default
+ * colormap allocated for a display by Tk_GetColormap.
+ */
+
+struct TkColormap {
+ Colormap colormap; /* X's identifier for the colormap. */
+ Visual *visual; /* Visual for which colormap was
+ * allocated. */
+ int refCount; /* How many uses of the colormap are still
+ * outstanding (calls to Tk_GetColormap
+ * minus calls to Tk_FreeColormap). */
+ int shareable; /* 0 means this colormap was allocated by
+ * a call to Tk_GetColormap with "new",
+ * implying that the window wants it all
+ * for itself. 1 means that the colormap
+ * was allocated as a default for a particular
+ * visual, so it can be shared. */
+ struct TkColormap *nextPtr; /* Next in list of colormaps for this display,
+ * or NULL for end of list. */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetVisual --
+ *
+ * Given a string identifying a particular kind of visual, this
+ * procedure returns a visual and depth that matches the specification.
+ *
+ * Results:
+ * The return value is normally a pointer to a visual. If an
+ * error occurred in looking up the visual, NULL is returned and
+ * an error message is left in interp->result. The depth of the
+ * visual is returned to *depthPtr under normal returns. If
+ * colormapPtr is non-NULL, then this procedure also finds a
+ * suitable colormap for use with the visual in tkwin, and it
+ * returns that colormap in *colormapPtr unless an error occurs.
+ *
+ * Side effects:
+ * A new colormap may be allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Visual *
+Tk_GetVisual(interp, tkwin, string, depthPtr, colormapPtr)
+ Tcl_Interp *interp; /* Interpreter to use for error
+ * reporting. */
+ Tk_Window tkwin; /* Window in which visual will be
+ * used. */
+ char *string; /* String describing visual. See
+ * manual entry for details. */
+ int *depthPtr; /* The depth of the returned visual
+ * is stored here. */
+ Colormap *colormapPtr; /* If non-NULL, then a suitable
+ * colormap for visual is placed here.
+ * This colormap must eventually be
+ * freed by calling Tk_FreeColormap. */
+{
+ Tk_Window tkwin2;
+ XVisualInfo template, *visInfoList, *bestPtr;
+ long mask;
+ Visual *visual;
+ int length, c, numVisuals, prio, bestPrio, i;
+ char *p;
+ VisualDictionary *dictPtr;
+ TkColormap *cmapPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ /*
+ * Parse string and set up a template for use in searching for
+ * an appropriate visual.
+ */
+
+ c = string[0];
+ if (c == '.') {
+ /*
+ * The string must be a window name. If the window is on the
+ * same screen as tkwin, then just use its visual. Otherwise
+ * use the information about the visual as a template for the
+ * search.
+ */
+
+ tkwin2 = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin2 == NULL) {
+ return NULL;
+ }
+ visual = Tk_Visual(tkwin2);
+ if (Tk_Screen(tkwin) == Tk_Screen(tkwin2)) {
+ *depthPtr = Tk_Depth(tkwin2);
+ if (colormapPtr != NULL) {
+ /*
+ * Use the colormap from the other window too (but be sure
+ * to increment its reference count if it's one of the ones
+ * allocated here).
+ */
+
+ *colormapPtr = Tk_Colormap(tkwin2);
+ for (cmapPtr = dispPtr->cmapPtr; cmapPtr != NULL;
+ cmapPtr = cmapPtr->nextPtr) {
+ if (cmapPtr->colormap == *colormapPtr) {
+ cmapPtr->refCount += 1;
+ break;
+ }
+ }
+ }
+ return visual;
+ }
+ template.depth = Tk_Depth(tkwin2);
+ template.class = visual->class;
+ template.red_mask = visual->red_mask;
+ template.green_mask = visual->green_mask;
+ template.blue_mask = visual->blue_mask;
+ template.colormap_size = visual->map_entries;
+ template.bits_per_rgb = visual->bits_per_rgb;
+ mask = VisualDepthMask|VisualClassMask|VisualRedMaskMask
+ |VisualGreenMaskMask|VisualBlueMaskMask|VisualColormapSizeMask
+ |VisualBitsPerRGBMask;
+ } else if ((c == 0) || ((c == 'd') && (string[1] != 0)
+ && (strncmp(string, "default", strlen(string)) == 0))) {
+ /*
+ * Use the default visual for the window's screen.
+ */
+
+ if (colormapPtr != NULL) {
+ *colormapPtr = DefaultColormapOfScreen(Tk_Screen(tkwin));
+ }
+ *depthPtr = DefaultDepthOfScreen(Tk_Screen(tkwin));
+ return DefaultVisualOfScreen(Tk_Screen(tkwin));
+ } else if (isdigit(UCHAR(c))) {
+ int visualId;
+
+ /*
+ * This is a visual ID.
+ */
+
+ if (Tcl_GetInt(interp, string, &visualId) == TCL_ERROR) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad X identifier for visual: ",
+ string, "\"", (char *) NULL);
+ return NULL;
+ }
+ template.visualid = visualId;
+ mask = VisualIDMask;
+ } else {
+ /*
+ * Parse the string into a class name (or "best") optionally
+ * followed by whitespace and a depth.
+ */
+
+ for (p = string; *p != 0; p++) {
+ if (isspace(UCHAR(*p)) || isdigit(UCHAR(*p))) {
+ break;
+ }
+ }
+ length = p - string;
+ template.class = -1;
+ for (dictPtr = visualNames; dictPtr->name != NULL; dictPtr++) {
+ if ((dictPtr->name[0] == c) && (length >= dictPtr->minLength)
+ && (strncmp(string, dictPtr->name,
+ (size_t) length) == 0)) {
+ template.class = dictPtr->class;
+ break;
+ }
+ }
+ if (template.class == -1) {
+ Tcl_AppendResult(interp, "unknown or ambiguous visual name \"",
+ string, "\": class must be ", (char *) NULL);
+ for (dictPtr = visualNames; dictPtr->name != NULL; dictPtr++) {
+ Tcl_AppendResult(interp, dictPtr->name, ", ", (char *) NULL);
+ }
+ Tcl_AppendResult(interp, "or default", (char *) NULL);
+ return NULL;
+ }
+ while (isspace(UCHAR(*p))) {
+ p++;
+ }
+ if (*p == 0) {
+ template.depth = 10000;
+ } else {
+ if (Tcl_GetInt(interp, p, &template.depth) != TCL_OK) {
+ return NULL;
+ }
+ }
+ if (c == 'b') {
+ mask = 0;
+ } else {
+ mask = VisualClassMask;
+ }
+ }
+
+ /*
+ * Find all visuals that match the template we've just created,
+ * and return an error if there are none that match.
+ */
+
+ template.screen = Tk_ScreenNumber(tkwin);
+ mask |= VisualScreenMask;
+ visInfoList = XGetVisualInfo(Tk_Display(tkwin), mask, &template,
+ &numVisuals);
+ if (visInfoList == NULL) {
+ interp->result = "couldn't find an appropriate visual";
+ return NULL;
+ }
+
+ /*
+ * Search through the visuals that were returned to find the best
+ * one. The choice is based on the following criteria, in decreasing
+ * order of importance:
+ *
+ * 1. Depth: choose a visual with exactly the desired depth,
+ * else one with more bits than requested but as few bits
+ * as possible, else one with fewer bits but as many as
+ * possible.
+ * 2. Class: some visual classes are more desirable than others;
+ * pick the visual with the most desirable class.
+ * 3. Default: the default visual for the screen gets preference
+ * over other visuals, all else being equal.
+ */
+
+ bestPrio = 0;
+ bestPtr = NULL;
+ for (i = 0; i < numVisuals; i++) {
+ switch (visInfoList[i].class) {
+ case DirectColor: prio = 5; break;
+ case GrayScale: prio = 1; break;
+ case PseudoColor: prio = 7; break;
+ case StaticColor: prio = 3; break;
+ case StaticGray: prio = 1; break;
+ case TrueColor: prio = 5; break;
+ default: prio = 0; break;
+ }
+ if (visInfoList[i].visual
+ == DefaultVisualOfScreen(Tk_Screen(tkwin))) {
+ prio++;
+ }
+ if (bestPtr == NULL) {
+ goto newBest;
+ }
+ if (visInfoList[i].depth < bestPtr->depth) {
+ if (visInfoList[i].depth >= template.depth) {
+ goto newBest;
+ }
+ } else if (visInfoList[i].depth > bestPtr->depth) {
+ if (bestPtr->depth < template.depth) {
+ goto newBest;
+ }
+ } else {
+ if (prio > bestPrio) {
+ goto newBest;
+ }
+ }
+ continue;
+
+ newBest:
+ bestPtr = &visInfoList[i];
+ bestPrio = prio;
+ }
+ *depthPtr = bestPtr->depth;
+ visual = bestPtr->visual;
+ XFree((char *) visInfoList);
+
+ /*
+ * If we need to find a colormap for this visual, do it now.
+ * If the visual is the default visual for the screen, then
+ * use the default colormap. Otherwise search for an existing
+ * colormap that's shareable. If all else fails, create a new
+ * colormap.
+ */
+
+ if (colormapPtr != NULL) {
+ if (visual == DefaultVisualOfScreen(Tk_Screen(tkwin))) {
+ *colormapPtr = DefaultColormapOfScreen(Tk_Screen(tkwin));
+ } else {
+ for (cmapPtr = dispPtr->cmapPtr; cmapPtr != NULL;
+ cmapPtr = cmapPtr->nextPtr) {
+ if (cmapPtr->shareable && (cmapPtr->visual == visual)) {
+ *colormapPtr = cmapPtr->colormap;
+ cmapPtr->refCount += 1;
+ goto done;
+ }
+ }
+ cmapPtr = (TkColormap *) ckalloc(sizeof(TkColormap));
+ cmapPtr->colormap = XCreateColormap(Tk_Display(tkwin),
+ RootWindowOfScreen(Tk_Screen(tkwin)), visual,
+ AllocNone);
+ cmapPtr->visual = visual;
+ cmapPtr->refCount = 1;
+ cmapPtr->shareable = 1;
+ cmapPtr->nextPtr = dispPtr->cmapPtr;
+ dispPtr->cmapPtr = cmapPtr;
+ *colormapPtr = cmapPtr->colormap;
+ }
+ }
+
+ done:
+ return visual;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetColormap --
+ *
+ * Given a string identifying a colormap, this procedure finds
+ * an appropriate colormap.
+ *
+ * Results:
+ * The return value is normally the X resource identifier for the
+ * colormap. If an error occurs, None is returned and an error
+ * message is placed in interp->result.
+ *
+ * Side effects:
+ * A reference count is incremented for the colormap, so
+ * Tk_FreeColormap must eventually be called exactly once for
+ * each call to Tk_GetColormap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Colormap
+Tk_GetColormap(interp, tkwin, string)
+ Tcl_Interp *interp; /* Interpreter to use for error
+ * reporting. */
+ Tk_Window tkwin; /* Window where colormap will be
+ * used. */
+ char *string; /* String that identifies colormap:
+ * either "new" or the name of
+ * another window. */
+{
+ Colormap colormap;
+ TkColormap *cmapPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ Tk_Window other;
+
+ /*
+ * Allocate a new colormap, if that's what is wanted.
+ */
+
+ if (strcmp(string, "new") == 0) {
+ cmapPtr = (TkColormap *) ckalloc(sizeof(TkColormap));
+ cmapPtr->colormap = XCreateColormap(Tk_Display(tkwin),
+ RootWindowOfScreen(Tk_Screen(tkwin)), Tk_Visual(tkwin),
+ AllocNone);
+ cmapPtr->visual = Tk_Visual(tkwin);
+ cmapPtr->refCount = 1;
+ cmapPtr->shareable = 0;
+ cmapPtr->nextPtr = dispPtr->cmapPtr;
+ dispPtr->cmapPtr = cmapPtr;
+ return cmapPtr->colormap;
+ }
+
+ /*
+ * Use a colormap from an existing window. It must have the same
+ * visual as tkwin (which means, among other things, that the
+ * other window must be on the same screen).
+ */
+
+ other = Tk_NameToWindow(interp, string, tkwin);
+ if (other == NULL) {
+ return None;
+ }
+ if (Tk_Screen(other) != Tk_Screen(tkwin)) {
+ Tcl_AppendResult(interp, "can't use colormap for ", string,
+ ": not on same screen", (char *) NULL);
+ return None;
+ }
+ if (Tk_Visual(other) != Tk_Visual(tkwin)) {
+ Tcl_AppendResult(interp, "can't use colormap for ", string,
+ ": incompatible visuals", (char *) NULL);
+ return None;
+ }
+ colormap = Tk_Colormap(other);
+
+ /*
+ * If the colormap was a special one allocated by code in this file,
+ * increment its reference count.
+ */
+
+ for (cmapPtr = dispPtr->cmapPtr; cmapPtr != NULL;
+ cmapPtr = cmapPtr->nextPtr) {
+ if (cmapPtr->colormap == colormap) {
+ cmapPtr->refCount += 1;
+ }
+ }
+ return colormap;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeColormap --
+ *
+ * This procedure is called to release a colormap that was
+ * previously allocated by Tk_GetColormap.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The colormap's reference count is decremented. If this was the
+ * last reference to the colormap, then the colormap is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeColormap(display, colormap)
+ Display *display; /* Display for which colormap was
+ * allocated. */
+ Colormap colormap; /* Colormap that is no longer needed.
+ * Must have been returned by previous
+ * call to Tk_GetColormap, or
+ * preserved by a previous call to
+ * Tk_PreserveColormap. */
+{
+ TkDisplay *dispPtr;
+ TkColormap *cmapPtr, *prevPtr;
+
+ /*
+ * Find Tk's information about the display, then see if this
+ * colormap is a non-default one (if it's a default one, there
+ * won't be an entry for it in the display's list).
+ */
+
+ dispPtr = TkGetDisplay(display);
+ if (dispPtr == NULL) {
+ panic("unknown display passed to Tk_FreeColormap");
+ }
+ for (prevPtr = NULL, cmapPtr = dispPtr->cmapPtr; cmapPtr != NULL;
+ prevPtr = cmapPtr, cmapPtr = cmapPtr->nextPtr) {
+ if (cmapPtr->colormap == colormap) {
+ cmapPtr->refCount -= 1;
+ if (cmapPtr->refCount == 0) {
+ XFreeColormap(display, colormap);
+ if (prevPtr == NULL) {
+ dispPtr->cmapPtr = cmapPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = cmapPtr->nextPtr;
+ }
+ ckfree((char *) cmapPtr);
+ }
+ return;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PreserveColormap --
+ *
+ * This procedure is called to indicate to Tk that the specified
+ * colormap is being referenced from another location and should
+ * not be freed until all extra references are eliminated. The
+ * colormap must have been returned by Tk_GetColormap.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The colormap's reference count is incremented, so
+ * Tk_FreeColormap must eventually be called exactly once for
+ * each call to Tk_PreserveColormap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_PreserveColormap(display, colormap)
+ Display *display; /* Display for which colormap was
+ * allocated. */
+ Colormap colormap; /* Colormap that should be
+ * preserved. */
+{
+ TkDisplay *dispPtr;
+ TkColormap *cmapPtr;
+
+ /*
+ * Find Tk's information about the display, then see if this
+ * colormap is a non-default one (if it's a default one, there
+ * won't be an entry for it in the display's list).
+ */
+
+ dispPtr = TkGetDisplay(display);
+ if (dispPtr == NULL) {
+ panic("unknown display passed to Tk_PreserveColormap");
+ }
+ for (cmapPtr = dispPtr->cmapPtr; cmapPtr != NULL;
+ cmapPtr = cmapPtr->nextPtr) {
+ if (cmapPtr->colormap == colormap) {
+ cmapPtr->refCount += 1;
+ return;
+ }
+ }
+}
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
new file mode 100644
index 0000000..fc9060a
--- /dev/null
+++ b/generic/tkWindow.c
@@ -0,0 +1,2763 @@
+/*
+ * tkWindow.c --
+ *
+ * This file provides basic window-manipulation procedures,
+ * which are equivalent to procedures in Xlib (and even
+ * invoke them) but also maintain the local Tk_Window
+ * structure.
+ *
+ * Copyright (c) 1989-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkWindow.c 1.233 97/10/31 09:55:23
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * Count of number of main windows currently open in this process.
+ */
+
+static int numMainWindows;
+
+/*
+ * First in list of all main windows managed by this process.
+ */
+
+TkMainInfo *tkMainWindowList = NULL;
+
+/*
+ * List of all displays currently in use.
+ */
+
+TkDisplay *tkDisplayList = NULL;
+
+/*
+ * Have statics in this module been initialized?
+ */
+
+static int initialized = 0;
+
+/*
+ * The variables below hold several uid's that are used in many places
+ * in the toolkit.
+ */
+
+Tk_Uid tkDisabledUid = NULL;
+Tk_Uid tkActiveUid = NULL;
+Tk_Uid tkNormalUid = NULL;
+
+/*
+ * Default values for "changes" and "atts" fields of TkWindows. Note
+ * that Tk always requests all events for all windows, except StructureNotify
+ * events on internal windows: these events are generated internally.
+ */
+
+static XWindowChanges defChanges = {
+ 0, 0, 1, 1, 0, 0, Above
+};
+#define ALL_EVENTS_MASK \
+ KeyPressMask|KeyReleaseMask|ButtonPressMask|ButtonReleaseMask| \
+ EnterWindowMask|LeaveWindowMask|PointerMotionMask|ExposureMask| \
+ VisibilityChangeMask|PropertyChangeMask|ColormapChangeMask
+static XSetWindowAttributes defAtts= {
+ None, /* background_pixmap */
+ 0, /* background_pixel */
+ CopyFromParent, /* border_pixmap */
+ 0, /* border_pixel */
+ NorthWestGravity, /* bit_gravity */
+ NorthWestGravity, /* win_gravity */
+ NotUseful, /* backing_store */
+ (unsigned) ~0, /* backing_planes */
+ 0, /* backing_pixel */
+ False, /* save_under */
+ ALL_EVENTS_MASK, /* event_mask */
+ 0, /* do_not_propagate_mask */
+ False, /* override_redirect */
+ CopyFromParent, /* colormap */
+ None /* cursor */
+};
+
+/*
+ * The following structure defines all of the commands supported by
+ * Tk, and the C procedures that execute them.
+ */
+
+typedef struct {
+ char *name; /* Name of command. */
+ Tcl_CmdProc *cmdProc; /* Command's string-based procedure. */
+ Tcl_ObjCmdProc *objProc; /* Command's object-based procedure. */
+ int isSafe; /* If !0, this command will be exposed in
+ * a safe interpreter. Otherwise it will be
+ * hidden in a safe interpreter. */
+} TkCmd;
+
+static TkCmd commands[] = {
+ /*
+ * Commands that are part of the intrinsics:
+ */
+
+ {"bell", Tk_BellCmd, NULL, 0},
+ {"bind", Tk_BindCmd, NULL, 1},
+ {"bindtags", Tk_BindtagsCmd, NULL, 1},
+ {"clipboard", Tk_ClipboardCmd, NULL, 0},
+ {"destroy", Tk_DestroyCmd, NULL, 1},
+ {"event", Tk_EventCmd, NULL, 1},
+ {"focus", Tk_FocusCmd, NULL, 1},
+ {"font", NULL, Tk_FontObjCmd, 1},
+ {"grab", Tk_GrabCmd, NULL, 0},
+ {"grid", Tk_GridCmd, NULL, 1},
+ {"image", Tk_ImageCmd, NULL, 1},
+ {"lower", Tk_LowerCmd, NULL, 1},
+ {"option", Tk_OptionCmd, NULL, 1},
+ {"pack", Tk_PackCmd, NULL, 1},
+ {"place", Tk_PlaceCmd, NULL, 1},
+ {"raise", Tk_RaiseCmd, NULL, 1},
+ {"selection", Tk_SelectionCmd, NULL, 0},
+ {"tk", NULL, Tk_TkObjCmd, 0},
+ {"tkwait", Tk_TkwaitCmd, NULL, 1},
+ {"tk_chooseColor", Tk_ChooseColorCmd, NULL, 0},
+ {"tk_getOpenFile", Tk_GetOpenFileCmd, NULL, 0},
+ {"tk_getSaveFile", Tk_GetSaveFileCmd, NULL, 0},
+ {"tk_messageBox", Tk_MessageBoxCmd, NULL, 0},
+ {"update", Tk_UpdateCmd, NULL, 1},
+ {"winfo", NULL, Tk_WinfoObjCmd, 1},
+ {"wm", Tk_WmCmd, NULL, 0},
+
+ /*
+ * Widget class commands.
+ */
+ {"button", Tk_ButtonCmd, NULL, 1},
+ {"canvas", Tk_CanvasCmd, NULL, 1},
+ {"checkbutton", Tk_CheckbuttonCmd, NULL, 1},
+ {"entry", Tk_EntryCmd, NULL, 1},
+ {"frame", Tk_FrameCmd, NULL, 1},
+ {"label", Tk_LabelCmd, NULL, 1},
+ {"listbox", Tk_ListboxCmd, NULL, 1},
+ {"menu", Tk_MenuCmd, NULL, 0},
+ {"menubutton", Tk_MenubuttonCmd, NULL, 1},
+ {"message", Tk_MessageCmd, NULL, 1},
+ {"radiobutton", Tk_RadiobuttonCmd, NULL, 1},
+ {"scale", Tk_ScaleCmd, NULL, 1},
+ {"scrollbar", Tk_ScrollbarCmd, NULL, 1},
+ {"text", Tk_TextCmd, NULL, 1},
+ {"toplevel", Tk_ToplevelCmd, NULL, 0},
+
+ /*
+ * Misc.
+ */
+
+#ifdef MAC_TCL
+ {"unsupported1", TkUnsupported1Cmd, NULL, 1},
+#endif
+ {(char *) NULL, (int (*) _ANSI_ARGS_((ClientData, Tcl_Interp *, int, char **))) NULL, NULL, 0}
+};
+
+/*
+ * The variables and table below are used to parse arguments from
+ * the "argv" variable in Tk_Init.
+ */
+
+static int synchronize = 0;
+static char *name = NULL;
+static char *display = NULL;
+static char *geometry = NULL;
+static char *colormap = NULL;
+static char *use = NULL;
+static char *visual = NULL;
+static int rest = 0;
+
+static Tk_ArgvInfo argTable[] = {
+ {"-colormap", TK_ARGV_STRING, (char *) NULL, (char *) &colormap,
+ "Colormap for main window"},
+ {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
+ "Display to use"},
+ {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
+ "Initial geometry for window"},
+ {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
+ "Name to use for application"},
+ {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
+ "Use synchronous mode for display server"},
+ {"-visual", TK_ARGV_STRING, (char *) NULL, (char *) &visual,
+ "Visual for main window"},
+ {"-use", TK_ARGV_STRING, (char *) NULL, (char *) &use,
+ "Id of window in which to embed application"},
+ {"--", TK_ARGV_REST, (char *) 1, (char *) &rest,
+ "Pass all remaining arguments through to script"},
+ {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
+ (char *) NULL}
+};
+
+/*
+ * Forward declarations to procedures defined later in this file:
+ */
+
+static Tk_Window CreateTopLevelWindow _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window parent, char *name, char *screenName));
+static void DeleteWindowsExitProc _ANSI_ARGS_((
+ ClientData clientData));
+static TkDisplay * GetScreen _ANSI_ARGS_((Tcl_Interp *interp,
+ char *screenName, int *screenPtr));
+static int Initialize _ANSI_ARGS_((Tcl_Interp *interp));
+static int NameWindow _ANSI_ARGS_((Tcl_Interp *interp,
+ TkWindow *winPtr, TkWindow *parentPtr,
+ char *name));
+static void OpenIM _ANSI_ARGS_((TkDisplay *dispPtr));
+static void UnlinkWindow _ANSI_ARGS_((TkWindow *winPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateTopLevelWindow --
+ *
+ * Make a new window that will be at top-level (its parent will
+ * be the root window of a screen).
+ *
+ * Results:
+ * The return value is a token for the new window, or NULL if
+ * an error prevented the new window from being created. If
+ * NULL is returned, an error message will be left in
+ * interp->result.
+ *
+ * Side effects:
+ * A new window structure is allocated locally. An X
+ * window is NOT initially created, but will be created
+ * the first time the window is mapped.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tk_Window
+CreateTopLevelWindow(interp, parent, name, screenName)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ Tk_Window parent; /* Token for logical parent of new window
+ * (used for naming, options, etc.). May
+ * be NULL. */
+ char *name; /* Name for new window; if parent is
+ * non-NULL, must be unique among parent's
+ * children. */
+ char *screenName; /* Name of screen on which to create
+ * window. NULL means use DISPLAY environment
+ * variable to determine. Empty string means
+ * use parent's screen, or DISPLAY if no
+ * parent. */
+{
+ register TkWindow *winPtr;
+ register TkDisplay *dispPtr;
+ int screenId;
+
+ if (!initialized) {
+ initialized = 1;
+ tkActiveUid = Tk_GetUid("active");
+ tkDisabledUid = Tk_GetUid("disabled");
+ tkNormalUid = Tk_GetUid("normal");
+
+ /*
+ * Create built-in image types.
+ */
+
+ Tk_CreateImageType(&tkBitmapImageType);
+ Tk_CreateImageType(&tkPhotoImageType);
+
+ /*
+ * Create built-in photo image formats.
+ */
+
+ Tk_CreatePhotoImageFormat(&tkImgFmtGIF);
+ Tk_CreatePhotoImageFormat(&tkImgFmtPPM);
+
+ /*
+ * Create exit handler to delete all windows when the application
+ * exits.
+ */
+
+ Tcl_CreateExitHandler(DeleteWindowsExitProc, (ClientData) NULL);
+ }
+
+ if ((parent != NULL) && (screenName != NULL) && (screenName[0] == '\0')) {
+ dispPtr = ((TkWindow *) parent)->dispPtr;
+ screenId = Tk_ScreenNumber(parent);
+ } else {
+ dispPtr = GetScreen(interp, screenName, &screenId);
+ if (dispPtr == NULL) {
+ return (Tk_Window) NULL;
+ }
+ }
+
+ winPtr = TkAllocWindow(dispPtr, screenId, (TkWindow *) parent);
+
+ /*
+ * Force the window to use a border pixel instead of border pixmap.
+ * This is needed for the case where the window doesn't use the
+ * default visual. In this case, the default border is a pixmap
+ * inherited from the root window, which won't work because it will
+ * have the wrong visual.
+ */
+
+ winPtr->dirtyAtts |= CWBorderPixel;
+
+ /*
+ * (Need to set the TK_TOP_LEVEL flag immediately here; otherwise
+ * Tk_DestroyWindow will core dump if it is called before the flag
+ * has been set.)
+ */
+
+ winPtr->flags |= TK_TOP_LEVEL;
+
+ if (parent != NULL) {
+ if (NameWindow(interp, winPtr, (TkWindow *) parent, name) != TCL_OK) {
+ Tk_DestroyWindow((Tk_Window) winPtr);
+ return (Tk_Window) NULL;
+ }
+ }
+ TkWmNewWindow(winPtr);
+
+ return (Tk_Window) winPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetScreen --
+ *
+ * Given a string name for a display-plus-screen, find the
+ * TkDisplay structure for the display and return the screen
+ * number too.
+ *
+ * Results:
+ * The return value is a pointer to information about the display,
+ * or NULL if the display couldn't be opened. In this case, an
+ * error message is left in interp->result. The location at
+ * *screenPtr is overwritten with the screen number parsed from
+ * screenName.
+ *
+ * Side effects:
+ * A new connection is opened to the display if there is no
+ * connection already. A new TkDisplay data structure is also
+ * setup, if necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkDisplay *
+GetScreen(interp, screenName, screenPtr)
+ Tcl_Interp *interp; /* Place to leave error message. */
+ char *screenName; /* Name for screen. NULL or empty means
+ * use DISPLAY envariable. */
+ int *screenPtr; /* Where to store screen number. */
+{
+ register TkDisplay *dispPtr;
+ char *p;
+ int screenId;
+ size_t length;
+
+ /*
+ * Separate the screen number from the rest of the display
+ * name. ScreenName is assumed to have the syntax
+ * <display>.<screen> with the dot and the screen being
+ * optional.
+ */
+
+ screenName = TkGetDefaultScreenName(interp, screenName);
+ if (screenName == NULL) {
+ interp->result =
+ "no display name and no $DISPLAY environment variable";
+ return (TkDisplay *) NULL;
+ }
+ length = strlen(screenName);
+ screenId = 0;
+ p = screenName+length-1;
+ while (isdigit(UCHAR(*p)) && (p != screenName)) {
+ p--;
+ }
+ if ((*p == '.') && (p[1] != '\0')) {
+ length = p - screenName;
+ screenId = strtoul(p+1, (char **) NULL, 10);
+ }
+
+ /*
+ * See if we already have a connection to this display. If not,
+ * then open a new connection.
+ */
+
+ for (dispPtr = tkDisplayList; ; dispPtr = dispPtr->nextPtr) {
+ if (dispPtr == NULL) {
+ dispPtr = TkpOpenDisplay(screenName);
+ if (dispPtr == NULL) {
+ Tcl_AppendResult(interp, "couldn't connect to display \"",
+ screenName, "\"", (char *) NULL);
+ return (TkDisplay *) NULL;
+ }
+ dispPtr->nextPtr = tkDisplayList;
+ dispPtr->name = (char *) ckalloc((unsigned) (length+1));
+ dispPtr->lastEventTime = CurrentTime;
+ strncpy(dispPtr->name, screenName, length);
+ dispPtr->name[length] = '\0';
+ dispPtr->bindInfoStale = 1;
+ dispPtr->modeModMask = 0;
+ dispPtr->metaModMask = 0;
+ dispPtr->altModMask = 0;
+ dispPtr->numModKeyCodes = 0;
+ dispPtr->modKeyCodes = NULL;
+ OpenIM(dispPtr);
+ dispPtr->errorPtr = NULL;
+ dispPtr->deleteCount = 0;
+ dispPtr->commTkwin = NULL;
+ dispPtr->selectionInfoPtr = NULL;
+ dispPtr->multipleAtom = None;
+ dispPtr->clipWindow = NULL;
+ dispPtr->clipboardActive = 0;
+ dispPtr->clipboardAppPtr = NULL;
+ dispPtr->clipTargetPtr = NULL;
+ dispPtr->atomInit = 0;
+ dispPtr->cursorFont = None;
+ dispPtr->grabWinPtr = NULL;
+ dispPtr->eventualGrabWinPtr = NULL;
+ dispPtr->buttonWinPtr = NULL;
+ dispPtr->serverWinPtr = NULL;
+ dispPtr->firstGrabEventPtr = NULL;
+ dispPtr->lastGrabEventPtr = NULL;
+ dispPtr->grabFlags = 0;
+ TkInitXId(dispPtr);
+ dispPtr->destroyCount = 0;
+ dispPtr->lastDestroyRequest = 0;
+ dispPtr->cmapPtr = NULL;
+ dispPtr->implicitWinPtr = NULL;
+ dispPtr->focusPtr = NULL;
+ dispPtr->stressPtr = NULL;
+ dispPtr->delayedMotionPtr = NULL;
+ Tcl_InitHashTable(&dispPtr->winTable, TCL_ONE_WORD_KEYS);
+ dispPtr->refCount = 0;
+
+ tkDisplayList = dispPtr;
+ break;
+ }
+ if ((strncmp(dispPtr->name, screenName, length) == 0)
+ && (dispPtr->name[length] == '\0')) {
+ break;
+ }
+ }
+ if (screenId >= ScreenCount(dispPtr->display)) {
+ sprintf(interp->result, "bad screen number \"%d\"", screenId);
+ return (TkDisplay *) NULL;
+ }
+ *screenPtr = screenId;
+ return dispPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetDisplay --
+ *
+ * Given an X display, TkGetDisplay returns the TkDisplay
+ * structure for the display.
+ *
+ * Results:
+ * The return value is a pointer to information about the display,
+ * or NULL if the display did not have a TkDisplay structure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkDisplay *
+TkGetDisplay(display)
+ Display *display; /* X's display pointer */
+{
+ TkDisplay *dispPtr;
+
+ for (dispPtr = tkDisplayList; dispPtr != NULL;
+ dispPtr = dispPtr->nextPtr) {
+ if (dispPtr->display == display) {
+ break;
+ }
+ }
+ return dispPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkAllocWindow --
+ *
+ * This procedure creates and initializes a TkWindow structure.
+ *
+ * Results:
+ * The return value is a pointer to the new window.
+ *
+ * Side effects:
+ * A new window structure is allocated and all its fields are
+ * initialized.
+ *
+ *--------------------------------------------------------------
+ */
+
+TkWindow *
+TkAllocWindow(dispPtr, screenNum, parentPtr)
+ TkDisplay *dispPtr; /* Display associated with new window. */
+ int screenNum; /* Index of screen for new window. */
+ TkWindow *parentPtr; /* Parent from which this window should
+ * inherit visual information. NULL means
+ * use screen defaults instead of
+ * inheriting. */
+{
+ register TkWindow *winPtr;
+
+ winPtr = (TkWindow *) ckalloc(sizeof(TkWindow));
+ winPtr->display = dispPtr->display;
+ winPtr->dispPtr = dispPtr;
+ winPtr->screenNum = screenNum;
+ if ((parentPtr != NULL) && (parentPtr->display == winPtr->display)
+ && (parentPtr->screenNum == winPtr->screenNum)) {
+ winPtr->visual = parentPtr->visual;
+ winPtr->depth = parentPtr->depth;
+ } else {
+ winPtr->visual = DefaultVisual(dispPtr->display, screenNum);
+ winPtr->depth = DefaultDepth(dispPtr->display, screenNum);
+ }
+ winPtr->window = None;
+ winPtr->childList = NULL;
+ winPtr->lastChildPtr = NULL;
+ winPtr->parentPtr = NULL;
+ winPtr->nextPtr = NULL;
+ winPtr->mainPtr = NULL;
+ winPtr->pathName = NULL;
+ winPtr->nameUid = NULL;
+ winPtr->classUid = NULL;
+ winPtr->changes = defChanges;
+ winPtr->dirtyChanges = CWX|CWY|CWWidth|CWHeight|CWBorderWidth;
+ winPtr->atts = defAtts;
+ if ((parentPtr != NULL) && (parentPtr->display == winPtr->display)
+ && (parentPtr->screenNum == winPtr->screenNum)) {
+ winPtr->atts.colormap = parentPtr->atts.colormap;
+ } else {
+ winPtr->atts.colormap = DefaultColormap(dispPtr->display, screenNum);
+ }
+ winPtr->dirtyAtts = CWEventMask|CWColormap|CWBitGravity;
+ winPtr->flags = 0;
+ winPtr->handlerList = NULL;
+#ifdef TK_USE_INPUT_METHODS
+ winPtr->inputContext = NULL;
+#endif /* TK_USE_INPUT_METHODS */
+ winPtr->tagPtr = NULL;
+ winPtr->numTags = 0;
+ winPtr->optionLevel = -1;
+ winPtr->selHandlerList = NULL;
+ winPtr->geomMgrPtr = NULL;
+ winPtr->geomData = NULL;
+ winPtr->reqWidth = winPtr->reqHeight = 1;
+ winPtr->internalBorderWidth = 0;
+ winPtr->wmInfoPtr = NULL;
+ winPtr->classProcsPtr = NULL;
+ winPtr->instanceData = NULL;
+ winPtr->privatePtr = NULL;
+
+ return winPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NameWindow --
+ *
+ * This procedure is invoked to give a window a name and insert
+ * the window into the hierarchy associated with a particular
+ * application.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * See above.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NameWindow(interp, winPtr, parentPtr, name)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ register TkWindow *winPtr; /* Window that is to be named and inserted. */
+ TkWindow *parentPtr; /* Pointer to logical parent for winPtr
+ * (used for naming, options, etc.). */
+ char *name; /* Name for winPtr; must be unique among
+ * parentPtr's children. */
+{
+#define FIXED_SIZE 200
+ char staticSpace[FIXED_SIZE];
+ char *pathName;
+ int new;
+ Tcl_HashEntry *hPtr;
+ int length1, length2;
+
+ /*
+ * Setup all the stuff except name right away, then do the name stuff
+ * last. This is so that if the name stuff fails, everything else
+ * will be properly initialized (needed to destroy the window cleanly
+ * after the naming failure).
+ */
+ winPtr->parentPtr = parentPtr;
+ winPtr->nextPtr = NULL;
+ if (parentPtr->childList == NULL) {
+ parentPtr->childList = winPtr;
+ } else {
+ parentPtr->lastChildPtr->nextPtr = winPtr;
+ }
+ parentPtr->lastChildPtr = winPtr;
+ winPtr->mainPtr = parentPtr->mainPtr;
+ winPtr->mainPtr->refCount++;
+ winPtr->nameUid = Tk_GetUid(name);
+
+ /*
+ * Don't permit names that start with an upper-case letter: this
+ * will just cause confusion with class names in the option database.
+ */
+
+ if (isupper(UCHAR(name[0]))) {
+ Tcl_AppendResult(interp,
+ "window name starts with an upper-case letter: \"",
+ name, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * To permit names of arbitrary length, must be prepared to malloc
+ * a buffer to hold the new path name. To run fast in the common
+ * case where names are short, use a fixed-size buffer on the
+ * stack.
+ */
+
+ length1 = strlen(parentPtr->pathName);
+ length2 = strlen(name);
+ if ((length1+length2+2) <= FIXED_SIZE) {
+ pathName = staticSpace;
+ } else {
+ pathName = (char *) ckalloc((unsigned) (length1+length2+2));
+ }
+ if (length1 == 1) {
+ pathName[0] = '.';
+ strcpy(pathName+1, name);
+ } else {
+ strcpy(pathName, parentPtr->pathName);
+ pathName[length1] = '.';
+ strcpy(pathName+length1+1, name);
+ }
+ hPtr = Tcl_CreateHashEntry(&parentPtr->mainPtr->nameTable, pathName, &new);
+ if (pathName != staticSpace) {
+ ckfree(pathName);
+ }
+ if (!new) {
+ Tcl_AppendResult(interp, "window name \"", name,
+ "\" already exists in parent", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetHashValue(hPtr, winPtr);
+ winPtr->pathName = Tcl_GetHashKey(&parentPtr->mainPtr->nameTable, hPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCreateMainWindow --
+ *
+ * Make a new main window. A main window is a special kind of
+ * top-level window used as the outermost window in an
+ * application.
+ *
+ * Results:
+ * The return value is a token for the new window, or NULL if
+ * an error prevented the new window from being created. If
+ * NULL is returned, an error message will be left in
+ * interp->result.
+ *
+ * Side effects:
+ * A new window structure is allocated locally; "interp" is
+ * associated with the window and registered for "send" commands
+ * under "baseName". BaseName may be extended with an instance
+ * number in the form "#2" if necessary to make it globally
+ * unique. Tk-related commands are bound into interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+TkCreateMainWindow(interp, screenName, baseName)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ char *screenName; /* Name of screen on which to create
+ * window. Empty or NULL string means
+ * use DISPLAY environment variable. */
+ char *baseName; /* Base name for application; usually of the
+ * form "prog instance". */
+{
+ Tk_Window tkwin;
+ int dummy;
+ int isSafe;
+ Tcl_HashEntry *hPtr;
+ register TkMainInfo *mainPtr;
+ register TkWindow *winPtr;
+ register TkCmd *cmdPtr;
+
+ /*
+ * Panic if someone updated the TkWindow structure without
+ * also updating the Tk_FakeWin structure (or vice versa).
+ */
+
+ if (sizeof(TkWindow) != sizeof(Tk_FakeWin)) {
+ panic("TkWindow and Tk_FakeWin are not the same size");
+ }
+
+ /*
+ * Create the basic TkWindow structure.
+ */
+
+ tkwin = CreateTopLevelWindow(interp, (Tk_Window) NULL, baseName,
+ screenName);
+ if (tkwin == NULL) {
+ return NULL;
+ }
+
+ /*
+ * Create the TkMainInfo structure for this application, and set
+ * up name-related information for the new window.
+ */
+
+ winPtr = (TkWindow *) tkwin;
+ mainPtr = (TkMainInfo *) ckalloc(sizeof(TkMainInfo));
+ mainPtr->winPtr = winPtr;
+ mainPtr->refCount = 1;
+ mainPtr->interp = interp;
+ Tcl_InitHashTable(&mainPtr->nameTable, TCL_STRING_KEYS);
+ TkBindInit(mainPtr);
+ TkFontPkgInit(mainPtr);
+ mainPtr->tlFocusPtr = NULL;
+ mainPtr->displayFocusPtr = NULL;
+ mainPtr->optionRootPtr = NULL;
+ Tcl_InitHashTable(&mainPtr->imageTable, TCL_STRING_KEYS);
+ mainPtr->strictMotif = 0;
+ if (Tcl_LinkVar(interp, "tk_strictMotif", (char *) &mainPtr->strictMotif,
+ TCL_LINK_BOOLEAN) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ }
+ mainPtr->nextPtr = tkMainWindowList;
+ tkMainWindowList = mainPtr;
+ winPtr->mainPtr = mainPtr;
+ hPtr = Tcl_CreateHashEntry(&mainPtr->nameTable, ".", &dummy);
+ Tcl_SetHashValue(hPtr, winPtr);
+ winPtr->pathName = Tcl_GetHashKey(&mainPtr->nameTable, hPtr);
+
+ /*
+ * We have just created another Tk application; increment the refcount
+ * on the display pointer.
+ */
+
+ winPtr->dispPtr->refCount++;
+
+ /*
+ * Register the interpreter for "send" purposes.
+ */
+
+ winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, baseName));
+
+ /*
+ * Bind in Tk's commands.
+ */
+
+ isSafe = Tcl_IsSafe(interp);
+ for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) {
+ if ((cmdPtr->cmdProc == NULL) && (cmdPtr->objProc == NULL)) {
+ panic("TkCreateMainWindow: builtin command with NULL string and object procs");
+ }
+ if (cmdPtr->cmdProc != NULL) {
+ Tcl_CreateCommand(interp, cmdPtr->name, cmdPtr->cmdProc,
+ (ClientData) tkwin, (void (*) _ANSI_ARGS_((ClientData))) NULL);
+ } else {
+ Tcl_CreateObjCommand(interp, cmdPtr->name, cmdPtr->objProc,
+ (ClientData) tkwin, NULL);
+ }
+ if (isSafe) {
+ if (!(cmdPtr->isSafe)) {
+ Tcl_HideCommand(interp, cmdPtr->name, cmdPtr->name);
+ }
+ }
+ }
+
+ /*
+ * Set variables for the intepreter.
+ */
+
+ Tcl_SetVar(interp, "tk_patchLevel", TK_PATCH_LEVEL, TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "tk_version", TK_VERSION, TCL_GLOBAL_ONLY);
+
+ numMainWindows++;
+ return tkwin;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateWindow --
+ *
+ * Create a new internal or top-level window as a child of an
+ * existing window.
+ *
+ * Results:
+ * The return value is a token for the new window. This
+ * is not the same as X's token for the window. If an error
+ * occurred in creating the window (e.g. no such display or
+ * screen), then an error message is left in interp->result and
+ * NULL is returned.
+ *
+ * Side effects:
+ * A new window structure is allocated locally. An X
+ * window is not initially created, but will be created
+ * the first time the window is mapped.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_CreateWindow(interp, parent, name, screenName)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting.
+ * Interp->result is assumed to be
+ * initialized by the caller. */
+ Tk_Window parent; /* Token for parent of new window. */
+ char *name; /* Name for new window. Must be unique
+ * among parent's children. */
+ char *screenName; /* If NULL, new window will be internal on
+ * same screen as its parent. If non-NULL,
+ * gives name of screen on which to create
+ * new window; window will be a top-level
+ * window. */
+{
+ TkWindow *parentPtr = (TkWindow *) parent;
+ TkWindow *winPtr;
+
+ if ((parentPtr != NULL) && (parentPtr->flags & TK_ALREADY_DEAD)) {
+ Tcl_AppendResult(interp,
+ "can't create window: parent has been destroyed",
+ (char *) NULL);
+ return NULL;
+ } else if ((parentPtr != NULL) &&
+ (parentPtr->flags & TK_CONTAINER)) {
+ Tcl_AppendResult(interp,
+ "can't create window: its parent has -container = yes",
+ (char *) NULL);
+ return NULL;
+ }
+ if (screenName == NULL) {
+ winPtr = TkAllocWindow(parentPtr->dispPtr, parentPtr->screenNum,
+ parentPtr);
+ if (NameWindow(interp, winPtr, parentPtr, name) != TCL_OK) {
+ Tk_DestroyWindow((Tk_Window) winPtr);
+ return NULL;
+ } else {
+ return (Tk_Window) winPtr;
+ }
+ } else {
+ return CreateTopLevelWindow(interp, parent, name, screenName);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CreateWindowFromPath --
+ *
+ * This procedure is similar to Tk_CreateWindow except that
+ * it uses a path name to create the window, rather than a
+ * parent and a child name.
+ *
+ * Results:
+ * The return value is a token for the new window. This
+ * is not the same as X's token for the window. If an error
+ * occurred in creating the window (e.g. no such display or
+ * screen), then an error message is left in interp->result and
+ * NULL is returned.
+ *
+ * Side effects:
+ * A new window structure is allocated locally. An X
+ * window is not initially created, but will be created
+ * the first time the window is mapped.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_CreateWindowFromPath(interp, tkwin, pathName, screenName)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting.
+ * Interp->result is assumed to be
+ * initialized by the caller. */
+ Tk_Window tkwin; /* Token for any window in application
+ * that is to contain new window. */
+ char *pathName; /* Path name for new window within the
+ * application of tkwin. The parent of
+ * this window must already exist, but
+ * the window itself must not exist. */
+ char *screenName; /* If NULL, new window will be on same
+ * screen as its parent. If non-NULL,
+ * gives name of screen on which to create
+ * new window; window will be a top-level
+ * window. */
+{
+#define FIXED_SPACE 5
+ char fixedSpace[FIXED_SPACE+1];
+ char *p;
+ Tk_Window parent;
+ int numChars;
+
+ /*
+ * Strip the parent's name out of pathName (it's everything up
+ * to the last dot). There are two tricky parts: (a) must
+ * copy the parent's name somewhere else to avoid modifying
+ * the pathName string (for large names, space for the copy
+ * will have to be malloc'ed); (b) must special-case the
+ * situation where the parent is ".".
+ */
+
+ p = strrchr(pathName, '.');
+ if (p == NULL) {
+ Tcl_AppendResult(interp, "bad window path name \"", pathName,
+ "\"", (char *) NULL);
+ return NULL;
+ }
+ numChars = p-pathName;
+ if (numChars > FIXED_SPACE) {
+ p = (char *) ckalloc((unsigned) (numChars+1));
+ } else {
+ p = fixedSpace;
+ }
+ if (numChars == 0) {
+ *p = '.';
+ p[1] = '\0';
+ } else {
+ strncpy(p, pathName, (size_t) numChars);
+ p[numChars] = '\0';
+ }
+
+ /*
+ * Find the parent window.
+ */
+
+ parent = Tk_NameToWindow(interp, p, tkwin);
+ if (p != fixedSpace) {
+ ckfree(p);
+ }
+ if (parent == NULL) {
+ return NULL;
+ }
+ if (((TkWindow *) parent)->flags & TK_ALREADY_DEAD) {
+ Tcl_AppendResult(interp,
+ "can't create window: parent has been destroyed", (char *) NULL);
+ return NULL;
+ } else if (((TkWindow *) parent)->flags & TK_CONTAINER) {
+ Tcl_AppendResult(interp,
+ "can't create window: its parent has -container = yes",
+ (char *) NULL);
+ return NULL;
+ }
+
+ /*
+ * Create the window.
+ */
+
+ if (screenName == NULL) {
+ TkWindow *parentPtr = (TkWindow *) parent;
+ TkWindow *winPtr;
+
+ winPtr = TkAllocWindow(parentPtr->dispPtr, parentPtr->screenNum,
+ parentPtr);
+ if (NameWindow(interp, winPtr, parentPtr, pathName+numChars+1)
+ != TCL_OK) {
+ Tk_DestroyWindow((Tk_Window) winPtr);
+ return NULL;
+ } else {
+ return (Tk_Window) winPtr;
+ }
+ } else {
+ return CreateTopLevelWindow(interp, parent, pathName+numChars+1,
+ screenName);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DestroyWindow --
+ *
+ * Destroy an existing window. After this call, the caller
+ * should never again use the token.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is deleted, along with all of its children.
+ * Relevant callback procedures are invoked.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_DestroyWindow(tkwin)
+ Tk_Window tkwin; /* Window to destroy. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ XEvent event;
+
+ if (winPtr->flags & TK_ALREADY_DEAD) {
+ /*
+ * A destroy event binding caused the window to be destroyed
+ * again. Ignore the request.
+ */
+
+ return;
+ }
+ winPtr->flags |= TK_ALREADY_DEAD;
+
+ /*
+ * Some cleanup needs to be done immediately, rather than later,
+ * because it needs information that will be destoyed before we
+ * get to the main cleanup point. For example, TkFocusDeadWindow
+ * needs to access the parentPtr field from a window, but if
+ * a Destroy event handler deletes the window's parent this
+ * field will be NULL before the main cleanup point is reached.
+ */
+
+ TkFocusDeadWindow(winPtr);
+
+ /*
+ * If this is a main window, remove it from the list of main
+ * windows. This needs to be done now (rather than later with
+ * all the other main window cleanup) to handle situations where
+ * a destroy binding for a window calls "exit". In this case
+ * the child window cleanup isn't complete when exit is called,
+ * so the reference count of its application doesn't go to zero
+ * when exit calls Tk_DestroyWindow on ".", so the main window
+ * doesn't get removed from the list and exit loops infinitely.
+ * Even worse, if "destroy ." is called by the destroy binding
+ * before calling "exit", "exit" will attempt to destroy
+ * mainPtr->winPtr, which no longer exists, and there may be a
+ * core dump.
+ *
+ * Also decrement the display refcount so that if this is the
+ * last Tk application in this process on this display, the display
+ * can be closed and its data structures deleted.
+ */
+
+ if (winPtr->mainPtr->winPtr == winPtr) {
+ dispPtr->refCount--;
+ if (tkMainWindowList == winPtr->mainPtr) {
+ tkMainWindowList = winPtr->mainPtr->nextPtr;
+ } else {
+ TkMainInfo *prevPtr;
+
+ for (prevPtr = tkMainWindowList;
+ prevPtr->nextPtr != winPtr->mainPtr;
+ prevPtr = prevPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ prevPtr->nextPtr = winPtr->mainPtr->nextPtr;
+ }
+ numMainWindows--;
+ }
+
+ /*
+ * Recursively destroy children.
+ */
+
+ dispPtr->destroyCount++;
+ while (winPtr->childList != NULL) {
+ TkWindow *childPtr;
+ childPtr = winPtr->childList;
+ childPtr->flags |= TK_DONT_DESTROY_WINDOW;
+ Tk_DestroyWindow((Tk_Window) childPtr);
+ if (winPtr->childList == childPtr) {
+ /*
+ * The child didn't remove itself from the child list, so
+ * let's remove it here. This can happen in some strange
+ * conditions, such as when a Delete event handler for a
+ * window deletes the window's parent.
+ */
+
+ winPtr->childList = childPtr->nextPtr;
+ childPtr->parentPtr = NULL;
+ }
+ }
+ if ((winPtr->flags & (TK_CONTAINER|TK_BOTH_HALVES))
+ == (TK_CONTAINER|TK_BOTH_HALVES)) {
+ /*
+ * This is the container for an embedded application, and
+ * the embedded application is also in this process. Delete
+ * the embedded window in-line here, for the same reasons we
+ * delete children in-line (otherwise, for example, the Tk
+ * window may appear to exist even though its X window is
+ * gone; this could cause errors). Special note: it's possible
+ * that the embedded window has already been deleted, in which
+ * case TkpGetOtherWindow will return NULL.
+ */
+
+ TkWindow *childPtr;
+ childPtr = TkpGetOtherWindow(winPtr);
+ if (childPtr != NULL) {
+ childPtr->flags |= TK_DONT_DESTROY_WINDOW;
+ Tk_DestroyWindow((Tk_Window) childPtr);
+ }
+ }
+
+ /*
+ * Generate a DestroyNotify event. In order for the DestroyNotify
+ * event to be processed correctly, need to make sure the window
+ * exists. This is a bit of a kludge, and may be unnecessarily
+ * expensive, but without it no event handlers will get called for
+ * windows that don't exist yet.
+ *
+ * Note: if the window's pathName is NULL it means that the window
+ * was not successfully initialized in the first place, so we should
+ * not make the window exist or generate the event.
+ */
+
+ if (winPtr->pathName != NULL) {
+ if (winPtr->window == None) {
+ Tk_MakeWindowExist(tkwin);
+ }
+ event.type = DestroyNotify;
+ event.xdestroywindow.serial =
+ LastKnownRequestProcessed(winPtr->display);
+ event.xdestroywindow.send_event = False;
+ event.xdestroywindow.display = winPtr->display;
+ event.xdestroywindow.event = winPtr->window;
+ event.xdestroywindow.window = winPtr->window;
+ Tk_HandleEvent(&event);
+ }
+
+ /*
+ * Cleanup the data structures associated with this window.
+ */
+
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ TkWmDeadWindow(winPtr);
+ } else if (winPtr->flags & TK_WM_COLORMAP_WINDOW) {
+ TkWmRemoveFromColormapWindows(winPtr);
+ }
+ if (winPtr->window != None) {
+#if defined(MAC_TCL) || defined(__WIN32__)
+ XDestroyWindow(winPtr->display, winPtr->window);
+#else
+ if ((winPtr->flags & TK_TOP_LEVEL)
+ || !(winPtr->flags & TK_DONT_DESTROY_WINDOW)) {
+ /*
+ * The parent has already been destroyed and this isn't
+ * a top-level window, so this window will be destroyed
+ * implicitly when the parent's X window is destroyed;
+ * it's much faster not to do an explicit destroy of this
+ * X window.
+ */
+
+ dispPtr->lastDestroyRequest = NextRequest(winPtr->display);
+ XDestroyWindow(winPtr->display, winPtr->window);
+ }
+#endif
+ TkFreeWindowId(dispPtr, winPtr->window);
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->winTable,
+ (char *) winPtr->window));
+ winPtr->window = None;
+ }
+ dispPtr->destroyCount--;
+ UnlinkWindow(winPtr);
+ TkEventDeadWindow(winPtr);
+ TkBindDeadWindow(winPtr);
+#ifdef TK_USE_INPUT_METHODS
+ if (winPtr->inputContext != NULL) {
+ XDestroyIC(winPtr->inputContext);
+ }
+#endif /* TK_USE_INPUT_METHODS */
+ if (winPtr->tagPtr != NULL) {
+ TkFreeBindingTags(winPtr);
+ }
+ TkOptionDeadWindow(winPtr);
+ TkSelDeadWindow(winPtr);
+ TkGrabDeadWindow(winPtr);
+ if (winPtr->mainPtr != NULL) {
+ if (winPtr->pathName != NULL) {
+ Tk_DeleteAllBindings(winPtr->mainPtr->bindingTable,
+ (ClientData) winPtr->pathName);
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&winPtr->mainPtr->nameTable,
+ winPtr->pathName));
+ }
+ winPtr->mainPtr->refCount--;
+ if (winPtr->mainPtr->refCount == 0) {
+ register TkCmd *cmdPtr;
+
+ /*
+ * We just deleted the last window in the application. Delete
+ * the TkMainInfo structure too and replace all of Tk's commands
+ * with dummy commands that return errors. Also delete the
+ * "send" command to unregister the interpreter.
+ *
+ * NOTE: Only replace the commands it if the interpreter is
+ * not being deleted. If it *is*, the interpreter cleanup will
+ * do all the needed work.
+ */
+
+ if ((winPtr->mainPtr->interp != NULL) &&
+ (!Tcl_InterpDeleted(winPtr->mainPtr->interp))) {
+ for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) {
+ Tcl_CreateCommand(winPtr->mainPtr->interp, cmdPtr->name,
+ TkDeadAppCmd, (ClientData) NULL,
+ (void (*) _ANSI_ARGS_((ClientData))) NULL);
+ }
+ Tcl_CreateCommand(winPtr->mainPtr->interp, "send",
+ TkDeadAppCmd, (ClientData) NULL,
+ (void (*) _ANSI_ARGS_((ClientData))) NULL);
+ Tcl_UnlinkVar(winPtr->mainPtr->interp, "tk_strictMotif");
+ }
+
+ Tcl_DeleteHashTable(&winPtr->mainPtr->nameTable);
+ TkBindFree(winPtr->mainPtr);
+ TkFontPkgFree(winPtr->mainPtr);
+ TkDeleteAllImages(winPtr->mainPtr);
+
+ /*
+ * When embedding Tk into other applications, make sure
+ * that all destroy events reach the server. Otherwise
+ * the embedding application may also attempt to destroy
+ * the windows, resulting in an X error
+ */
+
+ if (winPtr->flags & TK_EMBEDDED) {
+ XSync(winPtr->display,False) ;
+ }
+ ckfree((char *) winPtr->mainPtr);
+
+ /*
+ * If no other applications are using the display, close the
+ * display now and relinquish its data structures.
+ */
+
+ if (dispPtr->refCount <= 0) {
+#ifdef NOT_YET
+ /*
+ * I have disabled this code because on Windows there are
+ * still order dependencies in close-down. All displays
+ * and resources will get closed down properly anyway at
+ * exit, through the exit handler.
+ */
+
+ TkDisplay *theDispPtr, *backDispPtr;
+
+ /*
+ * Splice this display out of the list of displays.
+ */
+
+ for (theDispPtr = tkDisplayList, backDispPtr = NULL;
+ (theDispPtr != winPtr->dispPtr) &&
+ (theDispPtr != NULL);
+ theDispPtr = theDispPtr->nextPtr) {
+ backDispPtr = theDispPtr;
+ }
+ if (theDispPtr == NULL) {
+ panic("could not find display to close!");
+ }
+ if (backDispPtr == NULL) {
+ tkDisplayList = theDispPtr->nextPtr;
+ } else {
+ backDispPtr->nextPtr = theDispPtr->nextPtr;
+ }
+
+ /*
+ * Found and spliced it out, now actually do the cleanup.
+ */
+
+ if (dispPtr->name != NULL) {
+ ckfree(dispPtr->name);
+ }
+
+ Tcl_DeleteHashTable(&(dispPtr->winTable));
+
+ /*
+ * Cannot yet close the display because we still have
+ * order of deletion problems. Defer until exit handling
+ * instead. At that time, the display will cleanly shut
+ * down (hopefully..). (JYL)
+ */
+
+ TkpCloseDisplay(dispPtr);
+
+ /*
+ * There is lots more to clean up, we leave it at this for
+ * the time being.
+ */
+#endif
+ }
+ }
+ }
+ ckfree((char *) winPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_MapWindow --
+ *
+ * Map a window within its parent. This may require the
+ * window and/or its parents to actually be created.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The given window will be mapped. Windows may also
+ * be created.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_MapWindow(tkwin)
+ Tk_Window tkwin; /* Token for window to map. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+ XEvent event;
+
+ if (winPtr->flags & TK_MAPPED) {
+ return;
+ }
+ if (winPtr->window == None) {
+ Tk_MakeWindowExist(tkwin);
+ }
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ /*
+ * Lots of special processing has to be done for top-level
+ * windows. Let tkWm.c handle everything itself.
+ */
+
+ TkWmMapWindow(winPtr);
+ return;
+ }
+ winPtr->flags |= TK_MAPPED;
+ XMapWindow(winPtr->display, winPtr->window);
+ event.type = MapNotify;
+ event.xmap.serial = LastKnownRequestProcessed(winPtr->display);
+ event.xmap.send_event = False;
+ event.xmap.display = winPtr->display;
+ event.xmap.event = winPtr->window;
+ event.xmap.window = winPtr->window;
+ event.xmap.override_redirect = winPtr->atts.override_redirect;
+ Tk_HandleEvent(&event);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_MakeWindowExist --
+ *
+ * Ensure that a particular window actually exists. This
+ * procedure shouldn't normally need to be invoked from
+ * outside the Tk package, but may be needed if someone
+ * wants to manipulate a window before mapping it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the procedure returns, the X window associated with
+ * tkwin is guaranteed to exist. This may require the
+ * window's ancestors to be created also.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_MakeWindowExist(tkwin)
+ Tk_Window tkwin; /* Token for window. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+ TkWindow *winPtr2;
+ Window parent;
+ Tcl_HashEntry *hPtr;
+ int new;
+
+ if (winPtr->window != None) {
+ return;
+ }
+
+ if ((winPtr->parentPtr == NULL) || (winPtr->flags & TK_TOP_LEVEL)) {
+ parent = XRootWindow(winPtr->display, winPtr->screenNum);
+ } else {
+ if (winPtr->parentPtr->window == None) {
+ Tk_MakeWindowExist((Tk_Window) winPtr->parentPtr);
+ }
+ parent = winPtr->parentPtr->window;
+ }
+
+ if (winPtr->classProcsPtr != NULL
+ && winPtr->classProcsPtr->createProc != NULL) {
+ winPtr->window = (*winPtr->classProcsPtr->createProc)(tkwin, parent,
+ winPtr->instanceData);
+ } else {
+ winPtr->window = TkpMakeWindow(winPtr, parent);
+ }
+
+ hPtr = Tcl_CreateHashEntry(&winPtr->dispPtr->winTable,
+ (char *) winPtr->window, &new);
+ Tcl_SetHashValue(hPtr, winPtr);
+ winPtr->dirtyAtts = 0;
+ winPtr->dirtyChanges = 0;
+#ifdef TK_USE_INPUT_METHODS
+ winPtr->inputContext = NULL;
+#endif /* TK_USE_INPUT_METHODS */
+
+ if (!(winPtr->flags & TK_TOP_LEVEL)) {
+ /*
+ * If any siblings higher up in the stacking order have already
+ * been created then move this window to its rightful position
+ * in the stacking order.
+ *
+ * NOTE: this code ignores any changes anyone might have made
+ * to the sibling and stack_mode field of the window's attributes,
+ * so it really isn't safe for these to be manipulated except
+ * by calling Tk_RestackWindow.
+ */
+
+ for (winPtr2 = winPtr->nextPtr; winPtr2 != NULL;
+ winPtr2 = winPtr2->nextPtr) {
+ if ((winPtr2->window != None)
+ && !(winPtr2->flags & (TK_TOP_LEVEL|TK_REPARENTED))) {
+ XWindowChanges changes;
+ changes.sibling = winPtr2->window;
+ changes.stack_mode = Below;
+ XConfigureWindow(winPtr->display, winPtr->window,
+ CWSibling|CWStackMode, &changes);
+ break;
+ }
+ }
+
+ /*
+ * If this window has a different colormap than its parent, add
+ * the window to the WM_COLORMAP_WINDOWS property for its top-level.
+ */
+
+ if ((winPtr->parentPtr != NULL) &&
+ (winPtr->atts.colormap != winPtr->parentPtr->atts.colormap)) {
+ TkWmAddToColormapWindows(winPtr);
+ winPtr->flags |= TK_WM_COLORMAP_WINDOW;
+ }
+ }
+
+ /*
+ * Issue a ConfigureNotify event if there were deferred configuration
+ * changes (but skip it if the window is being deleted; the
+ * ConfigureNotify event could cause problems if we're being called
+ * from Tk_DestroyWindow under some conditions).
+ */
+
+ if ((winPtr->flags & TK_NEED_CONFIG_NOTIFY)
+ && !(winPtr->flags & TK_ALREADY_DEAD)){
+ winPtr->flags &= ~TK_NEED_CONFIG_NOTIFY;
+ TkDoConfigureNotify(winPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_UnmapWindow, etc. --
+ *
+ * There are several procedures under here, each of which
+ * mirrors an existing X procedure. In addition to performing
+ * the functions of the corresponding procedure, each
+ * procedure also updates the local window structure and
+ * synthesizes an X event (if the window's structure is being
+ * managed internally).
+ *
+ * Results:
+ * See the manual entries.
+ *
+ * Side effects:
+ * See the manual entries.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_UnmapWindow(tkwin)
+ Tk_Window tkwin; /* Token for window to unmap. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if (!(winPtr->flags & TK_MAPPED) || (winPtr->flags & TK_ALREADY_DEAD)) {
+ return;
+ }
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ /*
+ * Special processing has to be done for top-level windows. Let
+ * tkWm.c handle everything itself.
+ */
+
+ TkWmUnmapWindow(winPtr);
+ return;
+ }
+ winPtr->flags &= ~TK_MAPPED;
+ XUnmapWindow(winPtr->display, winPtr->window);
+ if (!(winPtr->flags & TK_TOP_LEVEL)) {
+ XEvent event;
+
+ event.type = UnmapNotify;
+ event.xunmap.serial = LastKnownRequestProcessed(winPtr->display);
+ event.xunmap.send_event = False;
+ event.xunmap.display = winPtr->display;
+ event.xunmap.event = winPtr->window;
+ event.xunmap.window = winPtr->window;
+ event.xunmap.from_configure = False;
+ Tk_HandleEvent(&event);
+ }
+}
+
+void
+Tk_ConfigureWindow(tkwin, valueMask, valuePtr)
+ Tk_Window tkwin; /* Window to re-configure. */
+ unsigned int valueMask; /* Mask indicating which parts of
+ * *valuePtr are to be used. */
+ XWindowChanges *valuePtr; /* New values. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if (valueMask & CWX) {
+ winPtr->changes.x = valuePtr->x;
+ }
+ if (valueMask & CWY) {
+ winPtr->changes.y = valuePtr->y;
+ }
+ if (valueMask & CWWidth) {
+ winPtr->changes.width = valuePtr->width;
+ }
+ if (valueMask & CWHeight) {
+ winPtr->changes.height = valuePtr->height;
+ }
+ if (valueMask & CWBorderWidth) {
+ winPtr->changes.border_width = valuePtr->border_width;
+ }
+ if (valueMask & (CWSibling|CWStackMode)) {
+ panic("Can't set sibling or stack mode from Tk_ConfigureWindow.");
+ }
+
+ if (winPtr->window != None) {
+ XConfigureWindow(winPtr->display, winPtr->window,
+ valueMask, valuePtr);
+ TkDoConfigureNotify(winPtr);
+ } else {
+ winPtr->dirtyChanges |= valueMask;
+ winPtr->flags |= TK_NEED_CONFIG_NOTIFY;
+ }
+}
+
+void
+Tk_MoveWindow(tkwin, x, y)
+ Tk_Window tkwin; /* Window to move. */
+ int x, y; /* New location for window (within
+ * parent). */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->changes.x = x;
+ winPtr->changes.y = y;
+ if (winPtr->window != None) {
+ XMoveWindow(winPtr->display, winPtr->window, x, y);
+ TkDoConfigureNotify(winPtr);
+ } else {
+ winPtr->dirtyChanges |= CWX|CWY;
+ winPtr->flags |= TK_NEED_CONFIG_NOTIFY;
+ }
+}
+
+void
+Tk_ResizeWindow(tkwin, width, height)
+ Tk_Window tkwin; /* Window to resize. */
+ int width, height; /* New dimensions for window. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->changes.width = (unsigned) width;
+ winPtr->changes.height = (unsigned) height;
+ if (winPtr->window != None) {
+ XResizeWindow(winPtr->display, winPtr->window, (unsigned) width,
+ (unsigned) height);
+ TkDoConfigureNotify(winPtr);
+ } else {
+ winPtr->dirtyChanges |= CWWidth|CWHeight;
+ winPtr->flags |= TK_NEED_CONFIG_NOTIFY;
+ }
+}
+
+void
+Tk_MoveResizeWindow(tkwin, x, y, width, height)
+ Tk_Window tkwin; /* Window to move and resize. */
+ int x, y; /* New location for window (within
+ * parent). */
+ int width, height; /* New dimensions for window. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->changes.x = x;
+ winPtr->changes.y = y;
+ winPtr->changes.width = (unsigned) width;
+ winPtr->changes.height = (unsigned) height;
+ if (winPtr->window != None) {
+ XMoveResizeWindow(winPtr->display, winPtr->window, x, y,
+ (unsigned) width, (unsigned) height);
+ TkDoConfigureNotify(winPtr);
+ } else {
+ winPtr->dirtyChanges |= CWX|CWY|CWWidth|CWHeight;
+ winPtr->flags |= TK_NEED_CONFIG_NOTIFY;
+ }
+}
+
+void
+Tk_SetWindowBorderWidth(tkwin, width)
+ Tk_Window tkwin; /* Window to modify. */
+ int width; /* New border width for window. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->changes.border_width = width;
+ if (winPtr->window != None) {
+ XSetWindowBorderWidth(winPtr->display, winPtr->window,
+ (unsigned) width);
+ TkDoConfigureNotify(winPtr);
+ } else {
+ winPtr->dirtyChanges |= CWBorderWidth;
+ winPtr->flags |= TK_NEED_CONFIG_NOTIFY;
+ }
+}
+
+void
+Tk_ChangeWindowAttributes(tkwin, valueMask, attsPtr)
+ Tk_Window tkwin; /* Window to manipulate. */
+ unsigned long valueMask; /* OR'ed combination of bits,
+ * indicating which fields of
+ * *attsPtr are to be used. */
+ register XSetWindowAttributes *attsPtr;
+ /* New values for some attributes. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if (valueMask & CWBackPixmap) {
+ winPtr->atts.background_pixmap = attsPtr->background_pixmap;
+ }
+ if (valueMask & CWBackPixel) {
+ winPtr->atts.background_pixel = attsPtr->background_pixel;
+ }
+ if (valueMask & CWBorderPixmap) {
+ winPtr->atts.border_pixmap = attsPtr->border_pixmap;
+ }
+ if (valueMask & CWBorderPixel) {
+ winPtr->atts.border_pixel = attsPtr->border_pixel;
+ }
+ if (valueMask & CWBitGravity) {
+ winPtr->atts.bit_gravity = attsPtr->bit_gravity;
+ }
+ if (valueMask & CWWinGravity) {
+ winPtr->atts.win_gravity = attsPtr->win_gravity;
+ }
+ if (valueMask & CWBackingStore) {
+ winPtr->atts.backing_store = attsPtr->backing_store;
+ }
+ if (valueMask & CWBackingPlanes) {
+ winPtr->atts.backing_planes = attsPtr->backing_planes;
+ }
+ if (valueMask & CWBackingPixel) {
+ winPtr->atts.backing_pixel = attsPtr->backing_pixel;
+ }
+ if (valueMask & CWOverrideRedirect) {
+ winPtr->atts.override_redirect = attsPtr->override_redirect;
+ }
+ if (valueMask & CWSaveUnder) {
+ winPtr->atts.save_under = attsPtr->save_under;
+ }
+ if (valueMask & CWEventMask) {
+ winPtr->atts.event_mask = attsPtr->event_mask;
+ }
+ if (valueMask & CWDontPropagate) {
+ winPtr->atts.do_not_propagate_mask
+ = attsPtr->do_not_propagate_mask;
+ }
+ if (valueMask & CWColormap) {
+ winPtr->atts.colormap = attsPtr->colormap;
+ }
+ if (valueMask & CWCursor) {
+ winPtr->atts.cursor = attsPtr->cursor;
+ }
+
+ if (winPtr->window != None) {
+ XChangeWindowAttributes(winPtr->display, winPtr->window,
+ valueMask, attsPtr);
+ } else {
+ winPtr->dirtyAtts |= valueMask;
+ }
+}
+
+void
+Tk_SetWindowBackground(tkwin, pixel)
+ Tk_Window tkwin; /* Window to manipulate. */
+ unsigned long pixel; /* Pixel value to use for
+ * window's background. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->atts.background_pixel = pixel;
+
+ if (winPtr->window != None) {
+ XSetWindowBackground(winPtr->display, winPtr->window, pixel);
+ } else {
+ winPtr->dirtyAtts = (winPtr->dirtyAtts & (unsigned) ~CWBackPixmap)
+ | CWBackPixel;
+ }
+}
+
+void
+Tk_SetWindowBackgroundPixmap(tkwin, pixmap)
+ Tk_Window tkwin; /* Window to manipulate. */
+ Pixmap pixmap; /* Pixmap to use for window's
+ * background. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->atts.background_pixmap = pixmap;
+
+ if (winPtr->window != None) {
+ XSetWindowBackgroundPixmap(winPtr->display,
+ winPtr->window, pixmap);
+ } else {
+ winPtr->dirtyAtts = (winPtr->dirtyAtts & (unsigned) ~CWBackPixel)
+ | CWBackPixmap;
+ }
+}
+
+void
+Tk_SetWindowBorder(tkwin, pixel)
+ Tk_Window tkwin; /* Window to manipulate. */
+ unsigned long pixel; /* Pixel value to use for
+ * window's border. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->atts.border_pixel = pixel;
+
+ if (winPtr->window != None) {
+ XSetWindowBorder(winPtr->display, winPtr->window, pixel);
+ } else {
+ winPtr->dirtyAtts = (winPtr->dirtyAtts & (unsigned) ~CWBorderPixmap)
+ | CWBorderPixel;
+ }
+}
+
+void
+Tk_SetWindowBorderPixmap(tkwin, pixmap)
+ Tk_Window tkwin; /* Window to manipulate. */
+ Pixmap pixmap; /* Pixmap to use for window's
+ * border. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->atts.border_pixmap = pixmap;
+
+ if (winPtr->window != None) {
+ XSetWindowBorderPixmap(winPtr->display,
+ winPtr->window, pixmap);
+ } else {
+ winPtr->dirtyAtts = (winPtr->dirtyAtts & (unsigned) ~CWBorderPixel)
+ | CWBorderPixmap;
+ }
+}
+
+void
+Tk_DefineCursor(tkwin, cursor)
+ Tk_Window tkwin; /* Window to manipulate. */
+ Tk_Cursor cursor; /* Cursor to use for window (may be None). */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+#ifdef MAC_TCL
+ winPtr->atts.cursor = (XCursor) cursor;
+#else
+ winPtr->atts.cursor = (Cursor) cursor;
+#endif
+
+ if (winPtr->window != None) {
+ XDefineCursor(winPtr->display, winPtr->window, winPtr->atts.cursor);
+ } else {
+ winPtr->dirtyAtts = winPtr->dirtyAtts | CWCursor;
+ }
+}
+
+void
+Tk_UndefineCursor(tkwin)
+ Tk_Window tkwin; /* Window to manipulate. */
+{
+ Tk_DefineCursor(tkwin, None);
+}
+
+void
+Tk_SetWindowColormap(tkwin, colormap)
+ Tk_Window tkwin; /* Window to manipulate. */
+ Colormap colormap; /* Colormap to use for window. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->atts.colormap = colormap;
+
+ if (winPtr->window != None) {
+ XSetWindowColormap(winPtr->display, winPtr->window, colormap);
+ if (!(winPtr->flags & TK_TOP_LEVEL)) {
+ TkWmAddToColormapWindows(winPtr);
+ winPtr->flags |= TK_WM_COLORMAP_WINDOW;
+ }
+ } else {
+ winPtr->dirtyAtts |= CWColormap;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetWindowVisual --
+ *
+ * This procedure is called to specify a visual to be used
+ * for a Tk window when it is created. This procedure, if
+ * called at all, must be called before the X window is created
+ * (i.e. before Tk_MakeWindowExist is called).
+ *
+ * Results:
+ * The return value is 1 if successful, or 0 if the X window has
+ * been already created.
+ *
+ * Side effects:
+ * The information given is stored for when the window is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_SetWindowVisual(tkwin, visual, depth, colormap)
+ Tk_Window tkwin; /* Window to manipulate. */
+ Visual *visual; /* New visual for window. */
+ int depth; /* New depth for window. */
+ Colormap colormap; /* An appropriate colormap for the visual. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if( winPtr->window != None ){
+ /* Too late! */
+ return 0;
+ }
+
+ winPtr->visual = visual;
+ winPtr->depth = depth;
+ winPtr->atts.colormap = colormap;
+ winPtr->dirtyAtts |= CWColormap;
+
+ /*
+ * The following code is needed to make sure that the window doesn't
+ * inherit the parent's border pixmap, which would result in a BadMatch
+ * error.
+ */
+
+ if (!(winPtr->dirtyAtts & CWBorderPixmap)) {
+ winPtr->dirtyAtts |= CWBorderPixel;
+ }
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDoConfigureNotify --
+ *
+ * Generate a ConfigureNotify event describing the current
+ * configuration of a window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * An event is generated and processed by Tk_HandleEvent.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkDoConfigureNotify(winPtr)
+ register TkWindow *winPtr; /* Window whose configuration
+ * was just changed. */
+{
+ XEvent event;
+
+ event.type = ConfigureNotify;
+ event.xconfigure.serial = LastKnownRequestProcessed(winPtr->display);
+ event.xconfigure.send_event = False;
+ event.xconfigure.display = winPtr->display;
+ event.xconfigure.event = winPtr->window;
+ event.xconfigure.window = winPtr->window;
+ event.xconfigure.x = winPtr->changes.x;
+ event.xconfigure.y = winPtr->changes.y;
+ event.xconfigure.width = winPtr->changes.width;
+ event.xconfigure.height = winPtr->changes.height;
+ event.xconfigure.border_width = winPtr->changes.border_width;
+ if (winPtr->changes.stack_mode == Above) {
+ event.xconfigure.above = winPtr->changes.sibling;
+ } else {
+ event.xconfigure.above = None;
+ }
+ event.xconfigure.override_redirect = winPtr->atts.override_redirect;
+ Tk_HandleEvent(&event);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetClass --
+ *
+ * This procedure is used to give a window a class.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new class is stored for tkwin, replacing any existing
+ * class for it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetClass(tkwin, className)
+ Tk_Window tkwin; /* Token for window to assign class. */
+ char *className; /* New class for tkwin. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->classUid = Tk_GetUid(className);
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ TkWmSetClass(winPtr);
+ }
+ TkOptionClassChanged(winPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSetClassProcs --
+ *
+ * This procedure is used to set the class procedures and
+ * instance data for a window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new set of class procedures and instance data is stored
+ * for tkwin, replacing any existing values.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSetClassProcs(tkwin, procs, instanceData)
+ Tk_Window tkwin; /* Token for window to modify. */
+ TkClassProcs *procs; /* Class procs structure. */
+ ClientData instanceData; /* Data to be passed to class procedures. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->classProcsPtr = procs;
+ winPtr->instanceData = instanceData;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_NameToWindow --
+ *
+ * Given a string name for a window, this procedure
+ * returns the token for the window, if there exists a
+ * window corresponding to the given name.
+ *
+ * Results:
+ * The return result is either a token for the window corresponding
+ * to "name", or else NULL to indicate that there is no such
+ * window. In this case, an error message is left in interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_NameToWindow(interp, pathName, tkwin)
+ Tcl_Interp *interp; /* Where to report errors. */
+ char *pathName; /* Path name of window. */
+ Tk_Window tkwin; /* Token for window: name is assumed to
+ * belong to the same main window as tkwin. */
+{
+ Tcl_HashEntry *hPtr;
+
+ hPtr = Tcl_FindHashEntry(&((TkWindow *) tkwin)->mainPtr->nameTable,
+ pathName);
+ if (hPtr == NULL) {
+ Tcl_AppendResult(interp, "bad window path name \"",
+ pathName, "\"", (char *) NULL);
+ return NULL;
+ }
+ return (Tk_Window) Tcl_GetHashValue(hPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_IdToWindow --
+ *
+ * Given an X display and window ID, this procedure returns the
+ * Tk token for the window, if there exists a Tk window corresponding
+ * to the given ID.
+ *
+ * Results:
+ * The return result is either a token for the window corresponding
+ * to the given X id, or else NULL to indicate that there is no such
+ * window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_IdToWindow(display, window)
+ Display *display; /* X display containing the window. */
+ Window window; /* X window window id. */
+{
+ TkDisplay *dispPtr;
+ Tcl_HashEntry *hPtr;
+
+ for (dispPtr = tkDisplayList; ; dispPtr = dispPtr->nextPtr) {
+ if (dispPtr == NULL) {
+ return NULL;
+ }
+ if (dispPtr->display == display) {
+ break;
+ }
+ }
+
+ hPtr = Tcl_FindHashEntry(&dispPtr->winTable, (char *) window);
+ if (hPtr == NULL) {
+ return NULL;
+ }
+ return (Tk_Window) Tcl_GetHashValue(hPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DisplayName --
+ *
+ * Return the textual name of a window's display.
+ *
+ * Results:
+ * The return value is the string name of the display associated
+ * with tkwin.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tk_DisplayName(tkwin)
+ Tk_Window tkwin; /* Window whose display name is desired. */
+{
+ return ((TkWindow *) tkwin)->dispPtr->name;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UnlinkWindow --
+ *
+ * This procedure removes a window from the childList of its
+ * parent.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is unlinked from its childList.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UnlinkWindow(winPtr)
+ TkWindow *winPtr; /* Child window to be unlinked. */
+{
+ TkWindow *prevPtr;
+
+ if (winPtr->parentPtr == NULL) {
+ return;
+ }
+ prevPtr = winPtr->parentPtr->childList;
+ if (prevPtr == winPtr) {
+ winPtr->parentPtr->childList = winPtr->nextPtr;
+ if (winPtr->nextPtr == NULL) {
+ winPtr->parentPtr->lastChildPtr = NULL;
+ }
+ } else {
+ while (prevPtr->nextPtr != winPtr) {
+ prevPtr = prevPtr->nextPtr;
+ if (prevPtr == NULL) {
+ panic("UnlinkWindow couldn't find child in parent");
+ }
+ }
+ prevPtr->nextPtr = winPtr->nextPtr;
+ if (winPtr->nextPtr == NULL) {
+ winPtr->parentPtr->lastChildPtr = prevPtr;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_RestackWindow --
+ *
+ * Change a window's position in the stacking order.
+ *
+ * Results:
+ * TCL_OK is normally returned. If other is not a descendant
+ * of tkwin's parent then TCL_ERROR is returned and tkwin is
+ * not repositioned.
+ *
+ * Side effects:
+ * Tkwin is repositioned in the stacking order.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_RestackWindow(tkwin, aboveBelow, other)
+ Tk_Window tkwin; /* Token for window whose position in
+ * the stacking order is to change. */
+ int aboveBelow; /* Indicates new position of tkwin relative
+ * to other; must be Above or Below. */
+ Tk_Window other; /* Tkwin will be moved to a position that
+ * puts it just above or below this window.
+ * If NULL then tkwin goes above or below
+ * all windows in the same parent. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkWindow *otherPtr = (TkWindow *) other;
+ XWindowChanges changes;
+ unsigned int mask;
+
+
+ /*
+ * Special case: if winPtr is a top-level window then just find
+ * the top-level ancestor of otherPtr and restack winPtr above
+ * otherPtr without changing any of Tk's childLists.
+ */
+
+ changes.stack_mode = aboveBelow;
+ mask = CWStackMode;
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ while ((otherPtr != NULL) && !(otherPtr->flags & TK_TOP_LEVEL)) {
+ otherPtr = otherPtr->parentPtr;
+ }
+ TkWmRestackToplevel(winPtr, aboveBelow, otherPtr);
+ return TCL_OK;
+ }
+
+ /*
+ * Find an ancestor of otherPtr that is a sibling of winPtr.
+ */
+
+ if (winPtr->parentPtr == NULL) {
+ /*
+ * Window is going to be deleted shortly; don't do anything.
+ */
+
+ return TCL_OK;
+ }
+ if (otherPtr == NULL) {
+ if (aboveBelow == Above) {
+ otherPtr = winPtr->parentPtr->lastChildPtr;
+ } else {
+ otherPtr = winPtr->parentPtr->childList;
+ }
+ } else {
+ while (winPtr->parentPtr != otherPtr->parentPtr) {
+ if ((otherPtr == NULL) || (otherPtr->flags & TK_TOP_LEVEL)) {
+ return TCL_ERROR;
+ }
+ otherPtr = otherPtr->parentPtr;
+ }
+ }
+ if (otherPtr == winPtr) {
+ return TCL_OK;
+ }
+
+ /*
+ * Reposition winPtr in the stacking order.
+ */
+
+ UnlinkWindow(winPtr);
+ if (aboveBelow == Above) {
+ winPtr->nextPtr = otherPtr->nextPtr;
+ if (winPtr->nextPtr == NULL) {
+ winPtr->parentPtr->lastChildPtr = winPtr;
+ }
+ otherPtr->nextPtr = winPtr;
+ } else {
+ TkWindow *prevPtr;
+
+ prevPtr = winPtr->parentPtr->childList;
+ if (prevPtr == otherPtr) {
+ winPtr->parentPtr->childList = winPtr;
+ } else {
+ while (prevPtr->nextPtr != otherPtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ prevPtr->nextPtr = winPtr;
+ }
+ winPtr->nextPtr = otherPtr;
+ }
+
+ /*
+ * Notify the X server of the change. If winPtr hasn't yet been
+ * created then there's no need to tell the X server now, since
+ * the stacking order will be handled properly when the window
+ * is finally created.
+ */
+
+ if (winPtr->window != None) {
+ changes.stack_mode = Above;
+ for (otherPtr = winPtr->nextPtr; otherPtr != NULL;
+ otherPtr = otherPtr->nextPtr) {
+ if ((otherPtr->window != None)
+ && !(otherPtr->flags & (TK_TOP_LEVEL|TK_REPARENTED))){
+ changes.sibling = otherPtr->window;
+ changes.stack_mode = Below;
+ mask = CWStackMode|CWSibling;
+ break;
+ }
+ }
+ XConfigureWindow(winPtr->display, winPtr->window, mask, &changes);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_MainWindow --
+ *
+ * Returns the main window for an application.
+ *
+ * Results:
+ * If interp has a Tk application associated with it, the main
+ * window for the application is returned. Otherwise NULL is
+ * returned and an error message is left in interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_MainWindow(interp)
+ Tcl_Interp *interp; /* Interpreter that embodies the
+ * application. Used for error
+ * reporting also. */
+{
+ TkMainInfo *mainPtr;
+
+ for (mainPtr = tkMainWindowList; mainPtr != NULL;
+ mainPtr = mainPtr->nextPtr) {
+ if (mainPtr->interp == interp) {
+ return (Tk_Window) mainPtr->winPtr;
+ }
+ }
+ interp->result = "this isn't a Tk application";
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_StrictMotif --
+ *
+ * Indicates whether strict Motif compliance has been specified
+ * for the given window.
+ *
+ * Results:
+ * The return value is 1 if strict Motif compliance has been
+ * requested for tkwin's application by setting the tk_strictMotif
+ * variable in its interpreter to a true value. 0 is returned
+ * if tk_strictMotif has a false value.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_StrictMotif(tkwin)
+ Tk_Window tkwin; /* Window whose application is
+ * to be checked. */
+{
+ return ((TkWindow *) tkwin)->mainPtr->strictMotif;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * OpenIM --
+ *
+ * Tries to open an X input method, associated with the
+ * given display. Right now we can only deal with a bare-bones
+ * input style: no preedit, and no status.
+ *
+ * Results:
+ * Stores the input method in dispPtr->inputMethod; if there isn't
+ * a suitable input method, then NULL is stored in dispPtr->inputMethod.
+ *
+ * Side effects:
+ * An input method gets opened.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+OpenIM(dispPtr)
+ TkDisplay *dispPtr; /* Tk's structure for the display. */
+{
+#ifndef TK_USE_INPUT_METHODS
+ return;
+#else
+ unsigned short i;
+ XIMStyles *stylePtr;
+
+ dispPtr->inputMethod = XOpenIM(dispPtr->display, NULL, NULL, NULL);
+ if (dispPtr->inputMethod == NULL) {
+ return;
+ }
+
+ if ((XGetIMValues(dispPtr->inputMethod, XNQueryInputStyle, &stylePtr,
+ NULL) != NULL) || (stylePtr == NULL)) {
+ goto error;
+ }
+ for (i = 0; i < stylePtr->count_styles; i++) {
+ if (stylePtr->supported_styles[i]
+ == (XIMPreeditNothing|XIMStatusNothing)) {
+ XFree(stylePtr);
+ return;
+ }
+ }
+ XFree(stylePtr);
+
+ error:
+
+ /*
+ * Should close the input method, but this causes core dumps on some
+ * systems (e.g. Solaris 2.3 as of 1/6/95).
+ * XCloseIM(dispPtr->inputMethod);
+ */
+ dispPtr->inputMethod = NULL;
+ return;
+#endif /* TK_USE_INPUT_METHODS */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetNumMainWindows --
+ *
+ * This procedure returns the number of main windows currently
+ * open in this process.
+ *
+ * Results:
+ * The number of main windows open in this process.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetNumMainWindows()
+{
+ return numMainWindows;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteWindowsExitProc --
+ *
+ * This procedure is invoked as an exit handler. It deletes all
+ * of the main windows in the process.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteWindowsExitProc(clientData)
+ ClientData clientData; /* Not used. */
+{
+ TkDisplay *displayPtr, *nextPtr;
+ Tcl_Interp *interp;
+
+ while (tkMainWindowList != NULL) {
+ /*
+ * We must protect the interpreter while deleting the window,
+ * because of <Destroy> bindings which could destroy the interpreter
+ * while the window is being deleted. This would leave frames on
+ * the call stack pointing at deleted memory, causing core dumps.
+ */
+
+ interp = tkMainWindowList->winPtr->mainPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ Tk_DestroyWindow((Tk_Window) tkMainWindowList->winPtr);
+ Tcl_Release((ClientData) interp);
+ }
+
+ displayPtr = tkDisplayList;
+ tkDisplayList = NULL;
+
+ /*
+ * Iterate destroying the displays until no more displays remain.
+ * It is possible for displays to get recreated during exit by any
+ * code that calls GetScreen, so we must destroy these new displays
+ * as well as the old ones.
+ */
+
+ for (displayPtr = tkDisplayList;
+ displayPtr != NULL;
+ displayPtr = tkDisplayList) {
+
+ /*
+ * Now iterate over the current list of open displays, and first
+ * set the global pointer to NULL so we will be able to notice if
+ * any new displays got created during deletion of the current set.
+ * We must also do this to ensure that Tk_IdToWindow does not find
+ * the old display as it is being destroyed, when it wants to see
+ * if it needs to dispatch a message.
+ */
+
+ for (tkDisplayList = NULL; displayPtr != NULL; displayPtr = nextPtr) {
+ nextPtr = displayPtr->nextPtr;
+ if (displayPtr->name != (char *) NULL) {
+ ckfree(displayPtr->name);
+ }
+ Tcl_DeleteHashTable(&(displayPtr->winTable));
+ TkpCloseDisplay(displayPtr);
+ }
+ }
+
+ numMainWindows = 0;
+ tkMainWindowList = NULL;
+ initialized = 0;
+ tkDisabledUid = NULL;
+ tkActiveUid = NULL;
+ tkNormalUid = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Init --
+ *
+ * This procedure is invoked to add Tk to an interpreter. It
+ * incorporates all of Tk's commands into the interpreter and
+ * creates the main window for a new Tk application. If the
+ * interpreter contains a variable "argv", this procedure
+ * extracts several arguments from that variable, uses them
+ * to configure the main window, and modifies argv to exclude
+ * the arguments (see the "wish" documentation for a list of
+ * the arguments that are extracted).
+ *
+ * Results:
+ * Returns a standard Tcl completion code and sets interp->result
+ * if there is an error.
+ *
+ * Side effects:
+ * Depends on various initialization scripts that get invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_Init(interp)
+ Tcl_Interp *interp; /* Interpreter to initialize. */
+{
+ return Initialize(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SafeInit --
+ *
+ * This procedure is invoked to add Tk to a safe interpreter. It
+ * invokes the internal procedure that does the real work.
+ *
+ * Results:
+ * Returns a standard Tcl completion code and sets interp->result
+ * if there is an error.
+ *
+ * Side effects:
+ * Depends on various initialization scripts that are invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_SafeInit(interp)
+ Tcl_Interp *interp; /* Interpreter to initialize. */
+{
+ /*
+ * Initialize the interpreter with Tk, safely. This removes
+ * all the Tk commands that are unsafe.
+ *
+ * Rationale:
+ *
+ * - Toplevel and menu are unsafe because they can be used to cover
+ * the entire screen and to steal input from the user.
+ * - Continuous ringing of the bell is a nuisance.
+ * - Cannot allow access to the clipboard because a malicious script
+ * can replace the contents with the string "rm -r *" and lead to
+ * surprises when the contents of the clipboard are pasted. We do
+ * not currently hide the selection command.. Should we?
+ * - Cannot allow send because it can be used to cause unsafe
+ * interpreters to execute commands. The tk command recreates the
+ * send command, so that too must be hidden.
+ * - Focus can be used to grab the focus away from another window,
+ * in effect stealing user input. Cannot allow that.
+ * NOTE: We currently do *not* hide focus as it would make it
+ * impossible to provide keyboard input to Tk in a safe interpreter.
+ * - Grab can be used to block the user from using any other apps
+ * on the screen.
+ * - Tkwait can block the containing process forever. Use bindings,
+ * fileevents and split the protocol into before-the-wait and
+ * after-the-wait parts. More work but necessary.
+ * - Wm is unsafe because (if toplevels are allowed, in the future)
+ * it can be used to remove decorations, move windows around, cover
+ * the entire screen etc etc.
+ *
+ * Current risks:
+ *
+ * - No CPU time limit, no memory allocation limits, no color limits.
+ *
+ * The actual code called is the same as Tk_Init but Tcl_IsSafe()
+ * is checked at several places to differentiate the two initialisations.
+ */
+
+ return Initialize(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Initialize --
+ *
+ *
+ * Results:
+ * A standard Tcl result. Also leaves an error message in interp->result
+ * if there was an error.
+ *
+ * Side effects:
+ * Depends on the initialization scripts that are invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Initialize(interp)
+ Tcl_Interp *interp; /* Interpreter to initialize. */
+{
+ char *p;
+ int argc, code;
+ char **argv, *args[20];
+ Tcl_DString class;
+ char buffer[30];
+
+ /*
+ * Start by initializing all the static variables to default acceptable
+ * values so that no information is leaked from a previous run of this
+ * code.
+ */
+
+ synchronize = 0;
+ name = NULL;
+ display = NULL;
+ geometry = NULL;
+ colormap = NULL;
+ use = NULL;
+ visual = NULL;
+ rest = 0;
+
+ /*
+ * If there is an "argv" variable, get its value, extract out
+ * relevant arguments from it, and rewrite the variable without
+ * the arguments that we used.
+ */
+
+ p = Tcl_GetVar2(interp, "argv", (char *) NULL, TCL_GLOBAL_ONLY);
+ argv = NULL;
+ if (p != NULL) {
+ if (Tcl_SplitList(interp, p, &argc, &argv) != TCL_OK) {
+ argError:
+ Tcl_AddErrorInfo(interp,
+ "\n (processing arguments in argv variable)");
+ return TCL_ERROR;
+ }
+ if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv,
+ argTable, TK_ARGV_DONT_SKIP_FIRST_ARG|TK_ARGV_NO_DEFAULTS)
+ != TCL_OK) {
+ ckfree((char *) argv);
+ goto argError;
+ }
+ p = Tcl_Merge(argc, argv);
+ Tcl_SetVar2(interp, "argv", (char *) NULL, p, TCL_GLOBAL_ONLY);
+ sprintf(buffer, "%d", argc);
+ Tcl_SetVar2(interp, "argc", (char *) NULL, buffer, TCL_GLOBAL_ONLY);
+ ckfree(p);
+ }
+
+ /*
+ * Figure out the application's name and class.
+ */
+
+ Tcl_DStringInit(&class);
+ if (name == NULL) {
+ int offset;
+ TkpGetAppName(interp, &class);
+ offset = Tcl_DStringLength(&class)+1;
+ Tcl_DStringSetLength(&class, offset);
+ Tcl_DStringAppend(&class, Tcl_DStringValue(&class), offset-1);
+ name = Tcl_DStringValue(&class) + offset;
+ } else {
+ Tcl_DStringAppend(&class, name, -1);
+ }
+
+ p = Tcl_DStringValue(&class);
+ if (islower(UCHAR(*p))) {
+ *p = toupper(UCHAR(*p));
+ }
+
+ /*
+ * Create an argument list for creating the top-level window,
+ * using the information parsed from argv, if any.
+ */
+
+ args[0] = "toplevel";
+ args[1] = ".";
+ args[2] = "-class";
+ args[3] = Tcl_DStringValue(&class);
+ argc = 4;
+ if (display != NULL) {
+ args[argc] = "-screen";
+ args[argc+1] = display;
+ argc += 2;
+
+ /*
+ * If this is the first application for this process, save
+ * the display name in the DISPLAY environment variable so
+ * that it will be available to subprocesses created by us.
+ */
+
+ if (numMainWindows == 0) {
+ Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY);
+ }
+ }
+ if (colormap != NULL) {
+ args[argc] = "-colormap";
+ args[argc+1] = colormap;
+ argc += 2;
+ colormap = NULL;
+ }
+ if (use != NULL) {
+ args[argc] = "-use";
+ args[argc+1] = use;
+ argc += 2;
+ use = NULL;
+ }
+ if (visual != NULL) {
+ args[argc] = "-visual";
+ args[argc+1] = visual;
+ argc += 2;
+ visual = NULL;
+ }
+ args[argc] = NULL;
+ code = TkCreateFrame((ClientData) NULL, interp, argc, args, 1, name);
+
+ Tcl_DStringFree(&class);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ Tcl_ResetResult(interp);
+ if (synchronize) {
+ XSynchronize(Tk_Display(Tk_MainWindow(interp)), True);
+ }
+
+ /*
+ * Set the geometry of the main window, if requested. Put the
+ * requested geometry into the "geometry" variable.
+ */
+
+ if (geometry != NULL) {
+ Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
+ code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ geometry = NULL;
+ }
+ if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1) == NULL) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ code = Tcl_PkgProvide(interp, "Tk", TK_VERSION);
+ if (code != TCL_OK) {
+ goto done;
+ }
+
+ /*
+ * Invoke platform-specific initialization.
+ */
+
+ code = TkpInit(interp);
+
+ done:
+ if (argv != NULL) {
+ ckfree((char *) argv);
+ }
+ return code;
+}