]> git.saurik.com Git - wxWidgets.git/blob - wxPython/wxSWIG/swig_lib/tcl/expectk.i
Updates for building wxSWIG on Linux
[wxWidgets.git] / wxPython / wxSWIG / swig_lib / tcl / expectk.i
1 //
2 // $Header$
3 //
4 // SWIG file for building expectk
5 // Dave Beazley
6 // March 18, 1996
7 //
8 /* Revision History
9 * $Log$
10 * Revision 1.1 2002/04/29 19:56:56 RD
11 * Since I have made several changes to SWIG over the years to accomodate
12 * special cases and other things in wxPython, and since I plan on making
13 * several more, I've decided to put the SWIG sources in wxPython's CVS
14 * instead of relying on maintaining patches. This effectivly becomes a
15 * fork of an obsolete version of SWIG, :-( but since SWIG 1.3 still
16 * doesn't have some things I rely on in 1.1, not to mention that my
17 * custom patches would all have to be redone, I felt that this is the
18 * easier road to take.
19 *
20 * Revision 1.2 1999/11/05 21:45:14 beazley
21 * Minor Changes
22 *
23 * Revision 1.1.1.1 1999/02/28 02:00:55 beazley
24 * Swig1.1
25 *
26 * Revision 1.1 1996/05/22 19:47:45 beazley
27 * Initial revision
28 *
29 */
30
31
32 #ifdef AUTODOC
33 %subsection "expectk.i"
34 %text %{
35 This module provides a main() function for building an extended version of
36 expectk. It has been tested with Expect 5.19, but may need modification
37 for newer versions.
38 %}
39 #endif
40
41 %{
42
43 /* exp_main_tk.c - main for expectk
44
45 This is "main.c" from the Tk distribution with some minor modifications to
46 support Expect.
47
48 Don Libes, NIST, 12/19/92
49
50 */
51
52
53 /*
54 * main.c --
55 *
56 * This file contains the main program for "wish", a windowing
57 * shell based on Tk and Tcl. It also provides a template that
58 * can be used as the basis for main programs for other Tk
59 * applications.
60 *
61 * Copyright (c) 1990-1993 The Regents of the University of California.
62 * All rights reserved.
63 *
64 * Permission is hereby granted, without written agreement and without
65 * license or royalty fees, to use, copy, modify, and distribute this
66 * software and its documentation for any purpose, provided that the
67 * above copyright notice and the following two paragraphs appear in
68 * all copies of this software.
69 *
70 * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
71 * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
72 * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
73 * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
74 *
75 * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
76 * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
77 * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
78 * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
79 * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
80 */
81
82 /*#include "tkConfig.h"*/
83 /*#include "tkInt.h"*/
84 #include <tk.h>
85 #include "expect_tcl.h"
86 #include "Dbg.h"
87 #include "string.h"
88
89 #ifdef TK_EXTENDED
90 # include "tclExtend.h"
91 #endif
92
93 /*
94 * Global variables used by the main program:
95 */
96
97 static Tk_Window mainWindow; /* The main window for the application. If
98 * NULL then the application no longer
99 * exists. */
100 static Tcl_Interp *interp; /* Interpreter for this application. */
101 #if 0
102 char *tcl_RcFileName = NULL; /* Name of a user-specific startup script
103 * to source if the application is being run
104 * interactively (e.g. "~/.wishrc"). Set
105 * by Tcl_AppInit. NULL means don't source
106 * anything ever. */
107 #endif
108 static Tcl_DString command; /* Used to assemble lines of terminal input
109 * into Tcl commands. */
110 static int tty; /* Non-zero means standard input is a
111 * terminal-like device. Zero means it's
112 * a file. */
113 static char normalExitCmd[] = "exit";
114 static char errorExitCmd[] = "exit 1";
115
116 /*
117 * Command-line options:
118 */
119
120 int synchronize = 0;
121 char *fileName = NULL;
122 char *name = NULL;
123 char *display = NULL;
124 char *geometry = NULL;
125
126 /* for Expect */
127 int my_rc = 1;
128 int sys_rc = 1;
129 int optcmd_eval();
130 int dashdash; /* not used, but Tk's arg parser requires a placeholder */
131 #ifdef TCL_DEBUGGER
132 int optcmd_debug();
133 #endif
134
135 Tk_ArgvInfo argTable[] = {
136 {"-file", TK_ARGV_STRING, (char *) NULL, (char *) &fileName,
137 "File from which to read commands"},
138 {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
139 "Initial geometry for window"},
140 {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
141 "Display to use"},
142 {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
143 "Name to use for application"},
144 {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
145 "Use synchronous mode for display server"},
146
147 /* for Expect */
148 {"-buffer", TK_ARGV_STRING, (char *) 1, (char *) &exp_buffer_command_input,
149 "Buffer command input"},
150 {"-command", TK_ARGV_GENFUNC, (char *) optcmd_eval, (char *)0,
151 "Command(s) to execute immediately"},
152 {"-diag", TK_ARGV_CONSTANT, (char *) 1, (char *) &exp_is_debugging,
153 "Enable diagnostics"},
154 {"--", TK_ARGV_REST, (char *)NULL, (char *)&dashdash,
155 "End of options"},
156 #if TCL_DEBUGGER
157 {"-Debug", TK_ARGV_GENFUNC, (char *) optcmd_debug, (char *)0,
158 "Enable debugger"},
159 #endif
160 {"-interactive", TK_ARGV_CONSTANT, (char *) 1, (char *) &exp_interactive,
161 "Interactive mode"},
162 {"-norc", TK_ARGV_CONSTANT, (char *) 0, (char *) &my_rc,
163 "Don't read ~/.expect.rc"},
164 {"-NORC", TK_ARGV_CONSTANT, (char *) 0, (char *) &sys_rc,
165 "Don't read system-wide expect.rc"},
166 {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
167 (char *) NULL}
168 };
169
170 #ifdef TCL_DEBUGGER
171 /*ARGSUSED*/
172 int
173 optcmd_debug(dst,interp,key,argc,argv)
174 char *dst;
175 Tcl_Interp *interp;
176 char *key;
177 int argc;
178 char **argv;
179 {
180 int i;
181
182 if (argc == 0) {
183 strcpy(interp->result,"-Debug flag needs 1 or 0 argument");
184 return -1;
185 }
186
187 if (Tcl_GetInt(interp,argv[0],&i) != TCL_OK) {
188 return -1;
189 }
190
191 if (i) {
192 Dbg_On(interp,0);
193 }
194
195 argc--;
196 for (i=0;i<argc;i++) {
197 argv[i] = argv[i+1];
198 }
199
200 return argc;
201 }
202 #endif /*TCL_DEBUGGER*/
203
204 /*ARGSUSED*/
205 int
206 optcmd_eval(dst,interp,key,argc,argv)
207 char *dst;
208 Tcl_Interp *interp;
209 char *key;
210 int argc;
211 char **argv;
212 {
213 int i;
214 int rc;
215
216 exp_cmdlinecmds = 1;
217
218 rc = Tcl_Eval(interp,argv[0]);
219 if (rc == TCL_ERROR) return -1;
220
221 argc--;
222 for (i=0;i<argc;i++) {
223 argv[i] = argv[i+1];
224 }
225
226 return argc;
227 }
228
229 /*
230 * Declaration for Tcl command procedure to create demo widget. This
231 * procedure is only invoked if SQUARE_DEMO is defined.
232 */
233
234 extern int SquareCmd _ANSI_ARGS_((ClientData clientData,
235 Tcl_Interp *interp, int argc, char *argv[]));
236
237 /*
238 * Forward declarations for procedures defined later in this file:
239 */
240
241 static void Prompt _ANSI_ARGS_((Tcl_Interp *interp, int partial));
242 static void StdinProc _ANSI_ARGS_((ClientData clientData,
243 int mask));
244 \f
245 /*
246 *----------------------------------------------------------------------
247 *
248 * main --
249 *
250 * Main program for Wish.
251 *
252 * Results:
253 * None. This procedure never returns (it exits the process when
254 * it's done
255 *
256 * Side effects:
257 * This procedure initializes the wish world and then starts
258 * interpreting commands; almost anything could happen, depending
259 * on the script being interpreted.
260 *
261 *----------------------------------------------------------------------
262 */
263
264 int
265 main(argc, argv)
266 int argc; /* Number of arguments. */
267 char **argv; /* Array of argument strings. */
268 {
269 char *args, *p, *msg, *class;
270 char buf[20];
271 int code;
272 int SWIG_init(Tcl_Interp *);
273 extern char *exp_argv0;
274 int used_argv1_for_filename = 0; /* added for Expect - DEL */
275
276 #ifdef TK_EXTENDED
277 tk_mainInterp = interp = Tcl_CreateExtendedInterp();
278 #else
279 interp = Tcl_CreateInterp();
280 #endif
281 #ifdef TCL_MEM_DEBUG
282 Tcl_InitMemory(interp);
283 #endif
284
285 if (Exp_Init(interp) == TCL_ERROR) {
286 fprintf(stderr,"Exp_Init failed: %s\n",interp->result);
287 return 1;
288 }
289
290 /* Add SWIG Extension */
291
292 if (SWIG_init(interp) == TCL_ERROR) {
293 fprintf(stderr,"Unable to initialize user-extensions : %s\n", interp->result);
294 return 1;
295 }
296 exp_argv0 = argv[0];
297
298 #ifdef TCL_DEBUGGER
299 Dbg_ArgcArgv(argc,argv,1);
300 #endif
301
302 /*
303 * Parse command-line arguments.
304 */
305
306 if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, argTable, 0)
307 != TCL_OK) {
308 fprintf(stderr, "%s\n", interp->result);
309 exit(1);
310 }
311
312 if (!fileName) { /* added for Expect - DEL */
313 fileName = argv[1];
314 used_argv1_for_filename = 1;
315 }
316
317 if (name == NULL) {
318 if (fileName != NULL) {
319 p = fileName;
320 } else {
321 p = argv[0];
322 }
323 name = strrchr(p, '/');
324 if (name != NULL) {
325 name++;
326 } else {
327 name = p;
328 }
329 }
330
331 /* if user hasn't explicitly requested we be interactive */
332 /* look for a file or some other source of commands */
333 if (fileName && !exp_interactive) {
334 if (0 == strcmp(fileName,"-")) {
335 exp_cmdfile = stdin;
336 } else if (exp_buffer_command_input) {
337 if (NULL == (exp_cmdfile = fopen(fileName,"r"))) {
338 perror(fileName);
339 exp_exit(interp,1);
340 } else {
341 exp_close_on_exec(fileno(exp_cmdfile));
342 }
343 } else {
344 exp_cmdfilename = fileName;
345 }
346 } else if (!exp_cmdlinecmds) {
347 /* no other source of commands, force interactive */
348 exp_interactive = 1;
349 }
350
351 /*
352 * If a display was specified, put it into the DISPLAY
353 * environment variable so that it will be available for
354 * any sub-processes created by us.
355 */
356
357 if (display != NULL) {
358 Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY);
359 }
360
361 /*
362 * Initialize the Tk application. If a -name option was provided,
363 * use it; otherwise, if a file name was provided, use the last
364 * element of its path as the name of the application; otherwise
365 * use the last element of the program name. For the application's
366 * class, capitalize the first letter of the name.
367 */
368
369 #if TK_MAJOR_VERSION >= 4
370 class = (char *) ckalloc((unsigned) (strlen(name) + 1));
371 strcpy(class, name);
372 class[0] = toupper((unsigned char) class[0]);
373 mainWindow = Tk_CreateMainWindow(interp, display, name, class);
374 #else
375 # if TK_MAJOR_VERSION == 3 && TK_MINOR_VERSION < 4
376 mainWindow = Tk_CreateMainWindow(interp, display, name);
377 # else
378 mainWindow = Tk_CreateMainWindow(interp, display, name, "Tk");
379 # endif
380 #endif
381
382 if (mainWindow == NULL) {
383 fprintf(stderr, "%s\n", interp->result);
384 exit(1);
385 }
386 #if TK_MAJOR_VERSION == 3 && TK_MINOR_VERSION < 4
387 Tk_SetClass(mainWindow, "Tk");
388 #endif
389 if (synchronize) {
390 XSynchronize(Tk_Display(mainWindow), True);
391 }
392
393 #if TK_MAJOR_VERSION < 4
394 Tk_GeometryRequest(mainWindow, 200, 200);
395 #endif
396
397 /*
398 * Make command-line arguments available in the Tcl variables "argc"
399 * and "argv". Also set the "geometry" variable from the geometry
400 * specified on the command line.
401 */
402
403 if (used_argv1_for_filename) { /* added for Expect - DEL */
404 argv++;
405 argc--;
406 /* if no script name, use interpreter name */
407 if (!argv[0] && !fileName) argv[0] = name;
408 }
409
410 args = Tcl_Merge(argc-1, argv+1);
411 Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
412 ckfree(args);
413 sprintf(buf, "%d", argc-1);
414 Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
415 Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
416 TCL_GLOBAL_ONLY);
417 if (geometry != NULL) {
418 #if TK_MAJOR_VERSION < 4
419 Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
420 #else
421 Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
422 code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL);
423 if (code != TCL_OK) {
424 fprintf(stderr, "%s\n", interp->result);
425 }
426 #endif
427 }
428
429 /*
430 * Set the "tcl_interactive" variable.
431 */
432
433 tty = isatty(0);
434 Tcl_SetVar(interp, "tcl_interactive",
435 ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
436
437 /*
438 * Add a few application-specific commands to the application's
439 * interpreter.
440 */
441
442 #ifdef SQUARE_DEMO
443 Tcl_CreateCommand(interp, "square", SquareCmd, (ClientData) mainWindow,
444 (void (*)()) NULL);
445 #endif
446
447 if (Tcl_Init(interp) == TCL_ERROR) {
448 fprintf(stderr,"Tcl_Init failed: %s\n",interp->result);
449 return 1;
450 }
451 if (Tk_Init(interp) == TCL_ERROR) {
452 fprintf(stderr,"Tk_Init failed: %s\n",interp->result);
453 return 1;
454 }
455
456 /* Call Exp_Init again because Tcl_Init resets auto_path, sigh. */
457 /* A better solution would be to execute Tcl/Tk_Init much earlier */
458 /* (before argc/argv is processed). */
459
460 if (Exp_Init(interp) == TCL_ERROR) {
461 fprintf(stderr,"Exp_Init failed: %s\n",interp->result);
462 return 1;
463 }
464
465 #if 0
466 tcl_RcFileName = "~/.wishrc";
467
468 /*
469 * Invoke application-specific initialization.
470 */
471
472 if (Tcl_AppInit(interp) != TCL_OK) {
473 fprintf(stderr, "Tcl_AppInit failed: %s\n", interp->result);
474 }
475 #endif
476
477 exp_interpret_rcfiles(interp,my_rc,sys_rc);
478
479 #ifdef TK_EXTENDED
480 tclAppName = "Wish";
481 tclAppLongname = "Wish - Tk Shell";
482 tclAppVersion = TK_VERSION;
483 Tcl_ShellEnvInit (interp, TCLSH_ABORT_STARTUP_ERR,
484 name,
485 0, NULL, /* argv var already set */
486 fileName == NULL, /* interactive? */
487 NULL); /* Standard default file */
488 #endif
489
490 /*
491 * Set the geometry of the main window, if requested.
492 */
493
494 if (geometry != NULL) {
495 code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL);
496 if (code != TCL_OK) {
497 fprintf(stderr, "%s\n", interp->result);
498 }
499 }
500
501 /*
502 * Invoke the script specified on the command line, if any.
503 */
504
505 /* become interactive if requested or "nothing to do" */
506 if (exp_interactive) {
507 (void) exp_interpreter(interp);
508 } else if (exp_cmdfile) {
509 int rc = exp_interpret_cmdfile(interp,exp_cmdfile);
510 if (rc != TCL_OK) exp_exit(interp,rc);
511 Tk_MainLoop();
512 } else if (exp_cmdfilename) {
513 int rc = exp_interpret_cmdfilename(interp,exp_cmdfilename);
514 if (rc != TCL_OK) exp_exit(interp,rc);
515 Tk_MainLoop();
516 }
517
518 /*
519 * Don't exit directly, but rather invoke the Tcl "exit" command.
520 * This gives the application the opportunity to redefine "exit"
521 * to do additional cleanup.
522 */
523
524 Tcl_Eval(interp,normalExitCmd);
525 exit(1);
526
527 #if 0
528 if (fileName != NULL) {
529 Dbg_On(interp,0);
530 code = Tcl_VarEval(interp, "source ", fileName, (char *) NULL);
531 if (code != TCL_OK) {
532 goto error;
533 }
534 tty = 0;
535 } else {
536 /*
537 * Commands will come from standard input, so set up an event
538 * handler for standard input. If the input device is aEvaluate the
539 * .rc file, if one has been specified, set up an event handler
540 * for standard input, and print a prompt if the input
541 * device is a terminal.
542 */
543
544 if (tcl_RcFileName != NULL) {
545 Tcl_DString buffer;
546 char *fullName;
547
548 fullName = Tcl_TildeSubst(interp, tcl_RcFileName, &buffer);
549 if (fullName == NULL) {
550 fprintf(stderr, "%s\n", interp->result);
551 } else {
552 if (access(fullName, R_OK) == 0) {
553 code = Tcl_EvalFile(interp, fullName);
554 if (code != TCL_OK) {
555 fprintf(stderr, "%s\n", interp->result);
556 }
557 }
558 }
559 Tcl_DStringFree(&buffer);
560 }
561 Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
562 if (tty) {
563 Prompt(interp, 0);
564 }
565 }
566 fflush(stdout);
567 Tcl_DStringInit(&command);
568
569 /*
570 * Loop infinitely, waiting for commands to execute. When there
571 * are no windows left, Tk_MainLoop returns and we exit.
572 */
573
574 Tk_MainLoop();
575
576 /*
577 * Don't exit directly, but rather invoke the Tcl "exit" command.
578 * This gives the application the opportunity to redefine "exit"
579 * to do additional cleanup.
580 */
581
582 Tcl_Eval(interp, "exit");
583 exit(1);
584
585 error:
586 msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
587 if (msg == NULL) {
588 msg = interp->result;
589 }
590 fprintf(stderr, "%s\n", msg);
591 Tcl_Eval(interp, errorExitCmd);
592 return 1; /* Needed only to prevent compiler warnings. */
593
594 #endif /*0*/
595 }
596 \f
597 #if 0
598 /*
599 *----------------------------------------------------------------------
600 *
601 * StdinProc --
602 *
603 * This procedure is invoked by the event dispatcher whenever
604 * standard input becomes readable. It grabs the next line of
605 * input characters, adds them to a command being assembled, and
606 * executes the command if it's complete.
607 *
608 * Results:
609 * None.
610 *
611 * Side effects:
612 * Could be almost arbitrary, depending on the command that's
613 * typed.
614 *
615 *----------------------------------------------------------------------
616 */
617
618 /* ARGSUSED */
619 static void
620 StdinProc(clientData, mask)
621 ClientData clientData; /* Not used. */
622 int mask; /* Not used. */
623 {
624 #define BUFFER_SIZE 4000
625 char input[BUFFER_SIZE+1];
626 static int gotPartial = 0;
627 char *cmd;
628 int code, count;
629
630 count = read(fileno(stdin), input, BUFFER_SIZE);
631 if (count <= 0) {
632 if (!gotPartial) {
633 if (tty) {
634 Tcl_Eval(interp, "exit");
635 exit(1);
636 } else {
637 Tk_DeleteFileHandler(0);
638 }
639 return;
640 } else {
641 count = 0;
642 }
643 }
644 cmd = Tcl_DStringAppend(&command, input, count);
645 if (count != 0) {
646 if ((input[count-1] != '\n') && (input[count-1] != ';')) {
647 gotPartial = 1;
648 goto prompt;
649 }
650 if (!Tcl_CommandComplete(cmd)) {
651 gotPartial = 1;
652 goto prompt;
653 }
654 }
655 gotPartial = 0;
656
657 /*
658 * Disable the stdin file handler while evaluating the command;
659 * otherwise if the command re-enters the event loop we might
660 * process commands from stdin before the current command is
661 * finished. Among other things, this will trash the text of the
662 * command being evaluated.
663 */
664
665 Tk_CreateFileHandler(0, 0, StdinProc, (ClientData) 0);
666 code = Tcl_RecordAndEval(interp, cmd, 0);
667 Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
668 Tcl_DStringFree(&command);
669 if (*interp->result != 0) {
670 if ((code != TCL_OK) || (tty)) {
671 printf("%s\n", interp->result);
672 }
673 }
674
675 /*
676 * Output a prompt.
677 */
678
679 prompt:
680 if (tty) {
681 Prompt(interp, gotPartial);
682 }
683 }
684 \f
685 /*
686 *----------------------------------------------------------------------
687 *
688 * Prompt --
689 *
690 * Issue a prompt on standard output, or invoke a script
691 * to issue the prompt.
692 *
693 * Results:
694 * None.
695 *
696 * Side effects:
697 * A prompt gets output, and a Tcl script may be evaluated
698 * in interp.
699 *
700 *----------------------------------------------------------------------
701 */
702
703 static void
704 Prompt(interp, partial)
705 Tcl_Interp *interp; /* Interpreter to use for prompting. */
706 int partial; /* Non-zero means there already
707 * exists a partial command, so use
708 * the secondary prompt. */
709 {
710 char *promptCmd;
711 int code;
712
713 promptCmd = Tcl_GetVar(interp,
714 partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY);
715 if (promptCmd == NULL) {
716 defaultPrompt:
717 if (!partial) {
718 fputs("% ", stdout);
719 }
720 } else {
721 code = Tcl_Eval(interp, promptCmd);
722 if (code != TCL_OK) {
723 Tcl_AddErrorInfo(interp,
724 "\n (script that generates prompt)");
725 fprintf(stderr, "%s\n", interp->result);
726 goto defaultPrompt;
727 }
728 }
729 fflush(stdout);
730 }
731 #endif /*0*/
732
733 %}