1 /* File: TclTk.c */
2
3 /* Purpose: embedded Tcl */
4
5 /*
6 * Copyright (c) 1997-2001 Tim Baker
7 *
8 * This software may be copied and distributed for educational, research, and
9 * not for profit purposes provided that this copyright and statement are
10 * included in all such copies.
11 */
12
13 #include "tnb.h"
14
15 #ifdef PLATFORM_WIN
16 #include <windows.h>
17
TCL_VARARGS_DEF(char *,arg1)18 static void WishPanic TCL_VARARGS_DEF(char *,arg1)
19 {
20 va_list argList;
21 char buf[1024];
22 char *format;
23
24 format = TCL_VARARGS_START(char *, arg1, argList);
25 vstrnfmt(buf, 1024, format, &argList);
26
27 MessageBeep(MB_ICONEXCLAMATION);
28 MessageBox(NULL, buf, "Fatal Error in Angband",
29 MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
30 #ifdef _MSC_VER
31 _asm {
32 int 3
33 }
34 #endif
35 ExitProcess(1);
36 }
37
CloseStdHandle(DWORD nStdHandle)38 static void CloseStdHandle(DWORD nStdHandle)
39 {
40 HANDLE handle;
41
42 handle = GetStdHandle(nStdHandle);
43 if ((handle == INVALID_HANDLE_VALUE) ||
44 (handle == 0) ||
45 (GetFileType(handle) == FILE_TYPE_UNKNOWN))
46 {
47 return;
48 }
49
50 CloseHandle(handle);
51 }
52
TclTk_Init(char ** argv)53 Tcl_Interp *TclTk_Init(char **argv)
54 {
55 char *p;
56 char buffer[MAX_PATH], *t;
57 size_t length;
58 Tcl_Interp *interp;
59
60 /*** From tk80/win/winMain.c ***/
61
62 Tcl_SetPanicProc(WishPanic);
63
64 /* This call does nothing on Win32 systems */
65 SetMessageQueue(64);
66
67 GetModuleFileName(NULL, buffer, sizeof(buffer));
68 for (p = buffer; *p != '\0'; p++)
69 {
70 if (*p == '\\')
71 {
72 *p = '/';
73 }
74 }
75
76 /*** From tk80/generic/TkMain.c ***/
77
78 Tcl_FindExecutable(buffer);
79
80 /* According to Hobbs, this should come after Tcl_FindExecutable() */
81 interp = Tcl_CreateInterp();
82
83 /* XXX Hack -- When run from a BAT file, the input/output doesn't
84 * go to the Tk Console. */
85 CloseStdHandle(STD_INPUT_HANDLE);
86 CloseStdHandle(STD_OUTPUT_HANDLE);
87 CloseStdHandle(STD_ERROR_HANDLE);
88
89 Tcl_SetVar(interp, "tcl_interactive", "1", TCL_GLOBAL_ONLY);
90
91 /*** from tk80/win/winMain.c (Tcl_AppInit) ***/
92
93 if (Tcl_Init(interp) != TCL_OK)
94 {
95 goto error;
96 }
97 if (Tk_Init(interp) != TCL_OK)
98 {
99 goto error;
100 }
101 Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
102
103 /* Require the same Tcl version */
104 t = Tcl_GetVar(interp, "tcl_patchLevel", TCL_GLOBAL_ONLY);
105 if (!t || strcmp(t, TCL_PATCH_LEVEL))
106 {
107 WishPanic("This version of Angband was compiled for use\nwith "
108 "Tcl version %s, not %s.", TCL_PATCH_LEVEL, t);
109 }
110
111 /* Require the same Tk version */
112 t = Tcl_GetVar(interp, "tk_patchLevel", TCL_GLOBAL_ONLY);
113 if (!t || strcmp(t, TK_PATCH_LEVEL))
114 {
115 WishPanic("This version of Angband was compiled for use\nwith "
116 "Tk version %s, not %s.", TK_PATCH_LEVEL, t);
117 }
118
119 Tcl_ResetResult(interp);
120
121 return interp;
122
123 error:
124 WishPanic(interp->result);
125 return NULL;
126 }
127
128 #endif /* PLATFORM_WIN */
129
130 #ifdef PLATFORM_X11
131 #include <unistd.h>
132
133 typedef struct ThreadSpecificData {
134 Tcl_Interp *interp; /* Interpreter for this thread. */
135 Tcl_DString command; /* Used to assemble lines of terminal input
136 * into Tcl commands. */
137 Tcl_DString line; /* Used to read the next line from the
138 * terminal input. */
139 int tty; /* Non-zero means standard input is a
140 * terminal-like device. Zero means it's
141 * a file. */
142 } ThreadSpecificData;
143 Tcl_ThreadDataKey dataKey;
144
145
146 /*
147 *----------------------------------------------------------------------
148 *
149 * Prompt --
150 *
151 * Issue a prompt on standard output, or invoke a script
152 * to issue the prompt.
153 *
154 * Results:
155 * None.
156 *
157 * Side effects:
158 * A prompt gets output, and a Tcl script may be evaluated
159 * in interp.
160 *
161 *----------------------------------------------------------------------
162 */
163
164 /*
165 * Interpreter to use for prompting.
166 * Non-zero 'partial' means there already
167 * exists a partial command, so use
168 * the secondary prompt.
169 */
Prompt(Tcl_Interp * interp,int partial)170 static void Prompt(Tcl_Interp *interp, int partial)
171 {
172 cptr promptCmd;
173 int code;
174 Tcl_Channel outChannel, errChannel;
175
176 promptCmd = Tcl_GetVar(interp,
177 (partial ? "tcl_prompt2" : "tcl_prompt1"), TCL_GLOBAL_ONLY);
178 if (promptCmd == NULL) {
179 defaultPrompt:
180 if (!partial) {
181
182 /*
183 * We must check that outChannel is a real channel - it
184 * is possible that someone has transferred stdout out of
185 * this interpreter with "interp transfer".
186 */
187
188 outChannel = Tcl_GetChannel(interp, "stdout", NULL);
189 if (outChannel != (Tcl_Channel) NULL) {
190 Tcl_WriteChars(outChannel, "% ", 2);
191 }
192 }
193 } else {
194 code = Tcl_Eval(interp, promptCmd);
195 if (code != TCL_OK) {
196 Tcl_AddErrorInfo(interp,
197 "\n (script that generates prompt)");
198 /*
199 * We must check that errChannel is a real channel - it
200 * is possible that someone has transferred stderr out of
201 * this interpreter with "interp transfer".
202 */
203
204 errChannel = Tcl_GetChannel(interp, "stderr", NULL);
205 if (errChannel != (Tcl_Channel) NULL) {
206 Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
207 Tcl_WriteChars(errChannel, "\n", 1);
208 }
209 goto defaultPrompt;
210 }
211 }
212 outChannel = Tcl_GetChannel(interp, "stdout", NULL);
213 if (outChannel != (Tcl_Channel) NULL) {
214 Tcl_Flush(outChannel);
215 }
216 }
217
218
219 /*
220 *----------------------------------------------------------------------
221 *
222 * StdinProc --
223 *
224 * This procedure is invoked by the event dispatcher whenever
225 * standard input becomes readable. It grabs the next line of
226 * input characters, adds them to a command being assembled, and
227 * executes the command if it's complete.
228 *
229 * Results:
230 * None.
231 *
232 * Side effects:
233 * Could be almost arbitrary, depending on the command that's
234 * typed.
235 *
236 *----------------------------------------------------------------------
237 */
238
StdinProc(ClientData clientData,int mask)239 static void StdinProc(ClientData clientData, int mask)
240 {
241 static int gotPartial = 0;
242 char *cmd;
243 int code, count;
244 Tcl_Channel chan = (Tcl_Channel) clientData;
245 ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
246 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
247 Tcl_Interp *interp = tsdPtr->interp;
248
249 /* Hack - ignore parameter */
250 (void) mask;
251
252 count = Tcl_Gets(chan, &tsdPtr->line);
253
254 if (count < 0) {
255 if (!gotPartial) {
256 if (tsdPtr->tty) {
257 Tcl_Exit(0);
258 } else {
259 Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
260 }
261 return;
262 }
263 }
264
265 (void) Tcl_DStringAppend(&tsdPtr->command, Tcl_DStringValue(
266 &tsdPtr->line), -1);
267 cmd = Tcl_DStringAppend(&tsdPtr->command, "\n", -1);
268 Tcl_DStringFree(&tsdPtr->line);
269 if (!Tcl_CommandComplete(cmd)) {
270 gotPartial = 1;
271 goto prompt;
272 }
273 gotPartial = 0;
274
275 /*
276 * Disable the stdin channel handler while evaluating the command;
277 * otherwise if the command re-enters the event loop we might
278 * process commands from stdin before the current command is
279 * finished. Among other things, this will trash the text of the
280 * command being evaluated.
281 */
282
283 Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan);
284 code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
285
286 chan = Tcl_GetStdChannel(TCL_STDIN);
287 if (chan) {
288 Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
289 (ClientData) chan);
290 }
291 Tcl_DStringFree(&tsdPtr->command);
292 if (Tcl_GetStringResult(interp)[0] != '\0') {
293 if ((code != TCL_OK) || (tsdPtr->tty)) {
294 chan = Tcl_GetStdChannel(TCL_STDOUT);
295 if (chan) {
296 Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
297 Tcl_WriteChars(chan, "\n", 1);
298 }
299 }
300 }
301
302 /*
303 * Output a prompt.
304 */
305
306 prompt:
307 if (tsdPtr->tty) {
308 Prompt(interp, gotPartial);
309 }
310 Tcl_ResetResult(interp);
311 }
312
313 extern void TkpDisplayWarning(const char * msg, const char * title);
314
TclTk_Init(cptr * argv)315 Tcl_Interp *TclTk_Init(cptr *argv)
316 {
317 Tcl_Interp *interp;
318 Tcl_Channel inChannel, outChannel;
319 ThreadSpecificData *tsdPtr;
320
321 interp = Tcl_CreateInterp();
322
323 /*** From tk83/generic/TkMain.c ***/
324
325 tsdPtr = (ThreadSpecificData *)
326 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
327
328 Tcl_FindExecutable(argv[0]);
329 tsdPtr->interp = interp;
330
331 tsdPtr->tty = isatty(0);
332 Tcl_SetVar(interp, "tcl_interactive",
333 (tsdPtr->tty ? "1" : "0"), TCL_GLOBAL_ONLY);
334
335 /*** from tk83/unix/tkAppInit.c (Tcl_AppInit) ***/
336
337 if (Tcl_Init(interp) != TCL_OK)
338 {
339 goto error;
340 }
341 if (Tk_Init(interp) != TCL_OK)
342 {
343 goto error;
344 }
345 Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
346
347 /*** From tk83/generic/TkMain.c (again) ***/
348
349 /*
350 * Establish a channel handler for stdin.
351 */
352
353 inChannel = Tcl_GetStdChannel(TCL_STDIN);
354 if (inChannel)
355 {
356 Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
357 (ClientData) inChannel);
358 }
359 if (tsdPtr->tty)
360 {
361 Prompt(interp, 0);
362 }
363
364 outChannel = Tcl_GetStdChannel(TCL_STDOUT);
365 if (outChannel)
366 {
367 Tcl_Flush(outChannel);
368 }
369
370 Tcl_DStringInit(&tsdPtr->command);
371 Tcl_DStringInit(&tsdPtr->line);
372 Tcl_ResetResult(interp);
373
374 return interp;
375
376 error:
377 TkpDisplayWarning(Tcl_GetStringResult(interp), "TclTk_Init Failed!");
378 Tcl_DeleteInterp(interp);
379 Tcl_Exit(1);
380 return NULL;
381 }
382
383
384 #endif /* PLATFORM_X11 */
385