summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2015-10-06 08:21:15 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2015-10-06 08:21:15 (GMT)
commit768f9f166d5d8e06b7215165580b9fab7e9925a3 (patch)
tree6bcd0cc0c55902d86ff831529af916a1ccbc053f /win
parentfb269f8f3fe5ffdafaae7c88c6957599cd99dd00 (diff)
parent5580f4a403b6c1487e27c93960c07cab1691d8f3 (diff)
downloadtcl-768f9f166d5d8e06b7215165580b9fab7e9925a3.zip
tcl-768f9f166d5d8e06b7215165580b9fab7e9925a3.tar.gz
tcl-768f9f166d5d8e06b7215165580b9fab7e9925a3.tar.bz2
Double '[' and ']', otherwise re-generating "configure" doesn't give the expected result.
Diffstat (limited to 'win')
-rw-r--r--win/tcl.m44
1 files changed, 2 insertions, 2 deletions
diff --git a/win/tcl.m4 b/win/tcl.m4
index eecc01c..80a5086 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -792,7 +792,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
LIBRARIES="\${SHARED_LIBRARIES}"
EXESUFFIX="\${DBGX}.exe"
case "x`echo \${VisualStudioVersion}`" in
- x1[4-9]*)
+ x1[[4-9]]*)
lflags="${lflags} -nodefaultlib:libucrt.lib"
;;
*)
@@ -837,7 +837,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib ws2_32.lib"
case "x`echo \${VisualStudioVersion}`" in
- x1[4-9]*)
+ x1[[4-9]]*)
LIBS="$LIBS ucrt.lib"
;;
*)
N32__) || 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 +#endif +#ifndef _XLIB_H +# ifdef MAC_TCL +# include +# include +# else +# include +# endif +#endif +#ifdef __STDC__ +# include +#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 + +/* + * 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 + +/* + * 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 <>, + * <>, or <>. + * + * 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, ). + * 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., 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 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 +#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 +#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 +#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 +#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 +#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 +#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 +#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 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 + +/* + * 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 + +/* + * 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 + +/* + * 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 + +/* + * 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 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 + +/* + * 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; ifilters; + 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; ipatterns = 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; ipattern = (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; itype, 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 +#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). */ + TkWi