1 #pragma prototyped
2 /*
3 * tkMain.c --
4 *
5 * This file contains a generic main program for Tk-based applications.
6 * It can be used as-is for many applications, just by supplying a
7 * different appInitProc procedure for each specific application.
8 * Or, it can be used as a template for creating new main programs
9 * for Tk applications.
10 *
11 * Copyright (c) 1990-1994 The Regents of the University of California.
12 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
13 *
14 * See the file "license.terms" for information on usage and redistribution
15 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
16 *
17 * SCCS: @(#) tkMain.c 1.148 96/03/25 18:08:43
18 */
19
20 #include "tksh.h"
21 #include <ctype.h>
22 #include <stdio.h>
23 #include <string.h>
24 #include <tcl.h>
25 #include <tk.h>
26 #if 0
27 #ifdef NO_STDLIB_H
28 # include "../compat/stdlib.h"
29 #else
30 # include <stdlib.h>
31 #endif
32 #endif
33
34 /*
35 * Declarations for various library procedures and variables (don't want
36 * to include tkInt.h or tkPort.h here, because people might copy this
37 * file out of the Tk source directory to make their own modified versions).
38 * Note: don't declare "exit" here even though a declaration is really
39 * needed, because it will conflict with a declaration elsewhere on
40 * some systems.
41 */
42
43 extern int isatty _ANSI_ARGS_((int fd));
44 #if 0
45 extern int read _ANSI_ARGS_((int fd, char *buf, size_t size));
46 extern char * strrchr _ANSI_ARGS_((CONST char *string, int c));
47 #endif
48
49 /*
50 * Global variables used by the main program:
51 */
52
53 static Tcl_Interp *interp; /* Interpreter for this application. */
54 static Tcl_DString command; /* Used to assemble lines of terminal input
55 * into Tcl commands. */
56 static Tcl_DString line; /* Used to read the next line from the
57 * terminal input. */
58 static int tty; /* Non-zero means standard input is a
59 * terminal-like device. Zero means it's
60 * a file. */
61
62 /*
63 * Forward declarations for procedures defined later in this file.
64 */
65
66 static void Prompt _ANSI_ARGS_((Tcl_Interp *interp, int partial));
67 static void StdinProc _ANSI_ARGS_((ClientData clientData,
68 int mask));
69
70 /*
71 *----------------------------------------------------------------------
72 *
73 * Tk_Main --
74 *
75 * Main program for Wish and most other Tk-based applications.
76 *
77 * Results:
78 * None. This procedure never returns (it exits the process when
79 * it's done.
80 *
81 * Side effects:
82 * This procedure initializes the Tk world and then starts
83 * interpreting commands; almost anything could happen, depending
84 * on the script being interpreted.
85 *
86 *----------------------------------------------------------------------
87 */
88
89 void
Tksh_TkMain(argc,argv,appInitProc)90 Tksh_TkMain(argc, argv, appInitProc)
91 int argc; /* Number of arguments. */
92 char **argv; /* Array of argument strings. */
93 Tcl_AppInitProc *appInitProc; /* Application-specific initialization
94 * procedure to call after most
95 * initialization but before starting
96 * to execute commands. */
97 {
98 char *args, *fileName;
99 char buf[20];
100 int code;
101 size_t length;
102 #if 0
103 Tcl_Channel inChannel, outChannel;
104 #endif
105 Tcl_Channel errChannel, chan;
106
107 Tcl_FindExecutable(argv[0]);
108 interp = Tcl_CreateInterp();
109 #ifdef TCL_MEM_DEBUG
110 Tcl_InitMemory(interp);
111 #endif
112
113 /*
114 * Parse command-line arguments. A leading "-file" argument is
115 * ignored (a historical relic from the distant past). If the
116 * next argument doesn't start with a "-" then strip it off and
117 * use it as the name of a script file to process.
118 */
119
120 fileName = NULL;
121 if (argc > 1) {
122 length = strlen(argv[1]);
123 if ((length >= 2) && (strncmp(argv[1], "-file", length) == 0)) {
124 argc--;
125 argv++;
126 }
127 }
128 if ((argc > 1) && (argv[1][0] != '-')) {
129 fileName = argv[1];
130 argc--;
131 argv++;
132 }
133
134 /*
135 * Make command-line arguments available in the Tcl variables "argc"
136 * and "argv".
137 */
138
139 args = Tcl_Merge(argc-1, argv+1);
140 Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
141 ckfree(args);
142 sprintf(buf, "%d", argc-1);
143 Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
144 Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
145 TCL_GLOBAL_ONLY);
146
147 /*
148 * Set the "tcl_interactive" variable.
149 */
150
151 /*
152 * For now, under Windows, we assume we are not running as a console mode
153 * app, so we need to use the GUI console. In order to enable this, we
154 * always claim to be running on a tty. This probably isn't the right
155 * way to do it.
156 */
157
158 #ifdef __WIN32__
159 tty = 1;
160 #else
161 tty = isatty(0);
162 #endif
163 Tcl_SetVar(interp, "tcl_interactive",
164 ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
165
166 /*
167 * Invoke application-specific initialization.
168 */
169
170 if ((*appInitProc)(interp) != TCL_OK) {
171 errChannel = Tcl_GetStdChannel(TCL_STDERR);
172 if (errChannel) {
173 Tcl_Write(errChannel,
174 "application-specific initialization failed: ", -1);
175 Tcl_Write(errChannel, interp->result, -1);
176 Tcl_Write(errChannel, "\n", 1);
177 }
178 Tcl_DeleteInterp(interp);
179 Tcl_Exit(1); /* added so tksh will exit here */
180 }
181
182 /*
183 * Invoke the script specified on the command line, if any.
184 */
185
186 if (fileName != NULL) {
187 code = Tcl_EvalFile(interp, fileName);
188 if (code != TCL_OK) {
189 goto error;
190 }
191 tty = 0;
192 } else {
193
194 /*
195 * Commands will come from standard input, so set up an event
196 * handler for standard input. Evaluate the .rc file, if one
197 * has been specified, set up an event handler for standard
198 * input, and print a prompt if the input device is a terminal.
199 */
200
201 fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
202
203 if (fileName != NULL) {
204 Tcl_DString buffer;
205 char *fullName;
206
207 fullName = Tcl_TranslateFileName(interp, fileName, &buffer);
208 if (fullName == NULL) {
209 errChannel = Tcl_GetStdChannel(TCL_STDERR);
210 if (errChannel) {
211 Tcl_Write(errChannel, interp->result, -1);
212 Tcl_Write(errChannel, "\n", 1);
213 }
214 } else {
215
216 /*
217 * NOTE: The following relies on O_RDONLY==0.
218 */
219
220 chan = Tcl_OpenFileChannel(interp, fullName, "r", 0);
221 if (chan != (Tcl_Channel) NULL) {
222 Tcl_Close(NULL, chan);
223 if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
224 errChannel = Tcl_GetStdChannel(TCL_STDERR);
225 if (errChannel) {
226 Tcl_Write(errChannel, interp->result, -1);
227 Tcl_Write(errChannel, "\n", 1);
228 }
229 }
230 }
231 }
232
233 Tcl_DStringFree(&buffer);
234 }
235
236 #if 0
237 /*
238 * Establish a channel handler for stdin.
239 */
240
241 inChannel = Tcl_GetStdChannel(TCL_STDIN);
242 if (inChannel) {
243 Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
244 (ClientData) inChannel);
245 }
246 if (tty) {
247 Prompt(interp, 0);
248 }
249 #endif
250 }
251
252 #if 0
253 outChannel = Tcl_GetStdChannel(TCL_STDOUT);
254 if (outChannel) {
255 Tcl_Flush(outChannel);
256 }
257 Tcl_DStringInit(&command);
258 Tcl_DStringInit(&line);
259 #endif
260 Tcl_ResetResult(interp);
261
262 /*
263 * Loop infinitely, waiting for commands to execute. When there
264 * are no windows left, Tk_MainLoop returns and we exit.
265 */
266
267 #if 0
268 Tk_MainLoop();
269 Tcl_DeleteInterp(interp);
270 Tcl_Exit(0);
271 #else
272 return;
273 #endif
274
275 error:
276 /*
277 * The following statement guarantees that the errorInfo
278 * variable is set properly.
279 */
280
281 Tcl_AddErrorInfo(interp, "");
282 errChannel = Tcl_GetStdChannel(TCL_STDERR);
283 if (errChannel) {
284 Tcl_Write(errChannel, Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY),
285 -1);
286 Tcl_Write(errChannel, "\n", 1);
287 }
288 Tcl_DeleteInterp(interp);
289 Tcl_Exit(1);
290 }
291
292 #if 0
293 /*
294 *----------------------------------------------------------------------
295 *
296 * StdinProc --
297 *
298 * This procedure is invoked by the event dispatcher whenever
299 * standard input becomes readable. It grabs the next line of
300 * input characters, adds them to a command being assembled, and
301 * executes the command if it's complete.
302 *
303 * Results:
304 * None.
305 *
306 * Side effects:
307 * Could be almost arbitrary, depending on the command that's
308 * typed.
309 *
310 *----------------------------------------------------------------------
311 */
312
313 /* ARGSUSED */
314 static void
315 StdinProc(clientData, mask)
316 ClientData clientData; /* Not used. */
317 int mask; /* Not used. */
318 {
319 static int gotPartial = 0;
320 char *cmd;
321 int code, count;
322 Tcl_Channel chan = (Tcl_Channel) clientData;
323
324 count = Tcl_Gets(chan, &line);
325
326 if (count < 0) {
327 if (!gotPartial) {
328 if (tty) {
329 Tcl_Exit(0);
330 } else {
331 Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
332 }
333 return;
334 } else {
335 count = 0;
336 }
337 }
338
339 (void) Tcl_DStringAppend(&command, Tcl_DStringValue(&line), -1);
340 cmd = Tcl_DStringAppend(&command, "\n", -1);
341 Tcl_DStringFree(&line);
342
343 if (!Tcl_CommandComplete(cmd)) {
344 gotPartial = 1;
345 goto prompt;
346 }
347 gotPartial = 0;
348
349 /*
350 * Disable the stdin channel handler while evaluating the command;
351 * otherwise if the command re-enters the event loop we might
352 * process commands from stdin before the current command is
353 * finished. Among other things, this will trash the text of the
354 * command being evaluated.
355 */
356
357 Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan);
358 code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
359 Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
360 (ClientData) chan);
361 Tcl_DStringFree(&command);
362 if (*interp->result != 0) {
363 if ((code != TCL_OK) || (tty)) {
364 /*
365 * The statement below used to call "printf", but that resulted
366 * in core dumps under Solaris 2.3 if the result was very long.
367 *
368 * NOTE: This probably will not work under Windows either.
369 */
370
371 puts(interp->result);
372 }
373 }
374
375 /*
376 * Output a prompt.
377 */
378
379 prompt:
380 if (tty) {
381 Prompt(interp, gotPartial);
382 }
383 Tcl_ResetResult(interp);
384 }
385
386 /*
387 *----------------------------------------------------------------------
388 *
389 * Prompt --
390 *
391 * Issue a prompt on standard output, or invoke a script
392 * to issue the prompt.
393 *
394 * Results:
395 * None.
396 *
397 * Side effects:
398 * A prompt gets output, and a Tcl script may be evaluated
399 * in interp.
400 *
401 *----------------------------------------------------------------------
402 */
403
404 static void
405 Prompt(interp, partial)
406 Tcl_Interp *interp; /* Interpreter to use for prompting. */
407 int partial; /* Non-zero means there already
408 * exists a partial command, so use
409 * the secondary prompt. */
410 {
411 char *promptCmd;
412 int code;
413 Tcl_Channel outChannel, errChannel;
414
415 errChannel = Tcl_GetChannel(interp, "stderr", NULL);
416
417 promptCmd = Tcl_GetVar(interp,
418 partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY);
419 if (promptCmd == NULL) {
420 defaultPrompt:
421 if (!partial) {
422
423 /*
424 * We must check that outChannel is a real channel - it
425 * is possible that someone has transferred stdout out of
426 * this interpreter with "interp transfer".
427 */
428
429 outChannel = Tcl_GetChannel(interp, "stdout", NULL);
430 if (outChannel != (Tcl_Channel) NULL) {
431 Tcl_Write(outChannel, "% ", 2);
432 }
433 }
434 } else {
435 code = Tcl_Eval(interp, promptCmd);
436 if (code != TCL_OK) {
437 Tcl_AddErrorInfo(interp,
438 "\n (script that generates prompt)");
439 /*
440 * We must check that errChannel is a real channel - it
441 * is possible that someone has transferred stderr out of
442 * this interpreter with "interp transfer".
443 */
444
445 errChannel = Tcl_GetChannel(interp, "stderr", NULL);
446 if (errChannel != (Tcl_Channel) NULL) {
447 Tcl_Write(errChannel, interp->result, -1);
448 Tcl_Write(errChannel, "\n", 1);
449 }
450 goto defaultPrompt;
451 }
452 }
453 outChannel = Tcl_GetChannel(interp, "stdout", NULL);
454 if (outChannel != (Tcl_Channel) NULL) {
455 Tcl_Flush(outChannel);
456 }
457 }
458 #endif
459
460
461 /*********************************************************************/
462
Tksh_BindCmd(clientData,interp,argc,argv)463 static int Tksh_BindCmd(clientData, interp, argc, argv)
464 ClientData clientData; /* Main window associated with
465 * interpreter. */
466 Tcl_Interp *interp; /* Current interpreter. */
467 int argc; /* Number of arguments. */
468 char **argv; /* Argument strings. */
469 {
470 char *bindscript, *script = NULL, *oldarg;
471 int result;
472
473 if ((argc == 4) && (argv[3][0] != '+'))
474 {
475 static char *bindprefixksh = "#!ksh\n";
476 static char *bindprefixtcl = "#!tcl\n";
477 # define BINDPRELEN 6
478
479 bindscript = argv[3];
480 if ((bindscript[0] == '#') && (bindscript[1] == '!' ))
481 {
482 if ((strcmp(bindscript, bindprefixksh) == 0) ||
483 (strcmp(bindscript, bindprefixtcl) == 0))
484 return Tk_BindCmd(clientData,interp,argc,argv);
485 }
486 script = (char *) malloc(strlen(bindscript) + BINDPRELEN +1);
487 strcpy(script, (((Interp *) interp)->interpType == INTERP_TCL)?
488 bindprefixtcl : bindprefixksh);
489 strcpy(script + BINDPRELEN, bindscript);
490 oldarg = argv[3];
491 argv[3] = script;
492 result = Tk_BindCmd(clientData, interp, argc, argv);
493 argv[3] = oldarg;
494 free(script);
495 return result;
496 }
497 return Tk_BindCmd(clientData, interp, argc, argv);
498 }
bindsetup(Tcl_Interp * interp)499 static void bindsetup(Tcl_Interp *interp)
500 {
501 Tcl_CmdInfo bindInfo;
502 if (Tcl_GetCommandInfo(interp, "bind", & bindInfo))
503 {
504 bindInfo.proc = Tksh_BindCmd;
505 /* Tcl_SetCommandInfo(interp, "bind", &bindInfo); */
506 Tcl_CreateCommand(interp, "bind", bindInfo.proc,
507 bindInfo.clientData, bindInfo.deleteProc);
508 Tksh_SetCommandType(interp, "bind", INTERP_CURRENT);
509 }
510 }
b_tkloop(int argc,char ** argv,Shbltin_t * context)511 static int b_tkloop(int argc, char **argv, Shbltin_t *context)
512 {
513 Tcl_Interp *interp = (Tcl_Interp *)context->ptr;
514 Tksh_BeginBlock(interp, INTERP_TCL);
515 Tk_MainLoop();
516 Tksh_EndBlock(interp);
517 return 0;
518 }
Tksh_Init(interp)519 int Tksh_Init(interp)
520 Tcl_Interp *interp; /* Interpreter to initialize. */
521 {
522 #if 0
523 static char initCmd[] =
524 "if [[ -f $tk_library/tk.ksh ]] ; then \n\
525 . $tk_library/tk.ksh\n\
526 else \n\
527 msg=\"can't find $tk_library/tk.ksh; perhaps you \"\n\
528 msg=\"$msg need to\\ninstall Tk or set your TK_LIBRARY \"\n\
529 msg=\"$msg environment variable?\"\n\
530 print -u2 $msg\n\
531 fi\n";
532 #endif
533 bindsetup(interp);
534 sh_addbuiltin("tkloop", b_tkloop, (void *) interp);
535 return TCL_OK;
536 }
537
538 static int
Tksh_AppInit(interp)539 Tksh_AppInit(interp)
540 Tcl_Interp *interp; /* Interpreter for application. */
541 {
542 if (Tcl_Init(interp) == TCL_ERROR) {
543 return TCL_ERROR;
544 }
545 Tksh_BeginBlock(interp, INTERP_TCL);
546 /* Should be current, but Tk_Init evals a script. */
547 if (Tk_Init(interp) == TCL_ERROR) {
548 return TCL_ERROR;
549 }
550 if (Tksh_Init(interp) == TCL_ERROR) {
551 return TCL_ERROR;
552 }
553 Tksh_SetCommandType(interp, "button", INTERP_CURRENT); /* Why do this? */
554 Tksh_EndBlock(interp);
555 Tcl_StaticPackage(interp, "Tk", Tk_Init, (Tcl_PackageInitProc *) NULL);
556 #ifdef TK_TEST
557 if (Tktest_Init(interp) == TCL_ERROR) {
558 return TCL_ERROR;
559 }
560 Tcl_StaticPackage(interp, "Tktest", Tktest_Init,
561 (Tcl_PackageInitProc *) NULL);
562 #endif /* TK_TEST */
563
564
565 /*
566 * Call the init procedures for included packages. Each call should
567 * look like this:
568 *
569 * if (Mod_Init(interp) == TCL_ERROR) {
570 * return TCL_ERROR;
571 * }
572 *
573 * where "Mod" is the name of the module.
574 */
575
576 /*
577 * Call Tcl_CreateCommand for application-specific commands, if
578 * they weren't already created by the init procedures called above.
579 */
580
581 /*
582 * Specify a user-specific startup file to invoke if the application
583 * is run interactively. Typically the startup file is "~/.apprc"
584 * where "app" is the name of the application. If this line is deleted
585 * then no user-specific startup file will be run under any conditions.
586 */
587
588 Tcl_SetVar(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY);
589 return TCL_OK;
590 }
591 #include <signal.h>
592 static int gotIntr;
593 extern int Tcl_NumEventsFound(void);
SigEventSetup(ClientData clientData,int flags)594 static void SigEventSetup(ClientData clientData, int flags)
595 {
596 }
SigEventProcess(Tcl_Event * evPtr,int flags)597 static int SigEventProcess(Tcl_Event *evPtr, int flags)
598 {
599 return 1;
600 }
SigEventCheck(ClientData clientData,int flags)601 static void SigEventCheck(ClientData clientData, int flags)
602 {
603 Tcl_Event *evPtr;
604 if (Tcl_NumEventsFound() < 0)
605 {
606 evPtr = (Tcl_Event *) malloc(sizeof(Tcl_Event));
607 evPtr->proc = SigEventProcess;
608 gotIntr = 1;;
609 Tcl_QueueEvent(evPtr, TCL_QUEUE_TAIL);
610 }
611 }
TmoutProc(ClientData clientData)612 static void TmoutProc(ClientData clientData)
613 {
614 *((int *)clientData) = 1;
615 }
fileReady(ClientData clientData,int mask)616 static void fileReady(ClientData clientData, int mask)
617 {
618 Tcl_File *filePtr = (Tcl_File *) clientData;
619 /* Tcl_DeleteFileHandler(*filePtr); */
620 Tcl_CreateFileHandler(*filePtr, 0, fileReady, (ClientData) 0);
621 *filePtr = NULL;
622 }
623 #include <wait.h>
tksh_waitevent(int fd,long tmout,int rw)624 int tksh_waitevent(int fd, long tmout, int rw)
625 {
626 int tFlag = 0, result = 1;
627 Tcl_TimerToken token;
628 Tcl_File file = NULL;
629 gotIntr = 0;
630
631 if (fd >= 0)
632 {
633 file = Tcl_GetFile((ClientData)fd ,TCL_UNIX_FD);
634 Tcl_CreateFileHandler(file, TCL_READABLE, fileReady, &file);
635 }
636
637 if (tmout> 0)
638 token = Tcl_CreateTimerHandler((int)tmout,TmoutProc,&(tFlag));
639
640 Tksh_BeginBlock(interp, INTERP_TCL); /* Best Guess */
641 while ((!gotIntr) && (!tFlag) && ((fd<0)||file) && result && (fd>=0 || !sh_waitsafe()))
642 result = Tcl_DoOneEvent(0);
643 Tksh_EndBlock(interp);
644
645 if (gotIntr)
646 {
647 result = -1;
648 errno = EINTR;
649 } else
650 {
651 result = 1;
652 }
653
654 if (tmout > 0)
655 Tcl_DeleteTimerHandler(token);
656 if (file)
657 Tcl_CreateFileHandler(file, 0, fileReady, (ClientData) 0);
658
659 return result;
660 }
661 #if 0
662 static void stoptk(void)
663 {
664 Tcl_Exit(0);
665 }
666 #endif
b_tkinit(int argc,char * argv[],Shbltin_t * context)667 int b_tkinit(int argc, char *argv[], Shbltin_t *context)
668 {
669 static char *av[] = { "tkinit", 0 };
670
671 if (argc == 0)
672 {
673 argc = 1;
674 argv = av;
675 }
676 Tksh_TkMain(argc,argv,context ? (Tcl_AppInitProc*)context->ptr : Tksh_AppInit);
677 Tcl_CreateEventSource(SigEventSetup,SigEventCheck,NULL);
678 sh_waitnotify(tksh_waitevent);
679 /* atexit(stoptk); */
680 return 0;
681 }
682