diff options
| author | rjohnson <rjohnson@noemail.net> | 1998-04-01 09:51:45 (GMT) |
|---|---|---|
| committer | rjohnson <rjohnson@noemail.net> | 1998-04-01 09:51:45 (GMT) |
| commit | 9c5b7f2b7e472536ed2e7c915ead05e2aa264182 (patch) | |
| tree | 8fb30cb152c4dc191be47fa043d2e6f5ea38c7ba /generic | |
| parent | 1d0efcbe267f2c0eb73869862522fb20fb2d63ca (diff) | |
| download | tk-9c5b7f2b7e472536ed2e7c915ead05e2aa264182.zip tk-9c5b7f2b7e472536ed2e7c915ead05e2aa264182.tar.gz tk-9c5b7f2b7e472536ed2e7c915ead05e2aa264182.tar.bz2 | |
Initial revision
FossilOrigin-Name: 2bf55ca9aa942b581137b9f474da5ad9c1480de4
Diffstat (limited to 'generic')
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 **) ®Prop); + + 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; +} |