← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to gcl-tk/tktst.c

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
gcl-tk/tktst.c
 
1
/*-*-c++-*-*/
 
2
 
 
3
#include <stdio.h>
 
4
#include <setjmp.h>
 
5
#include <tclExtend.h>
 
6
#include <tk.h>
 
7
 
 
8
Tcl_Interp *tcliMain;           /* Main and only tcl interpreter instance */
 
9
 
 
10
static Tk_Window mainWindow;    /* The main window for the application.  If
 
11
                                 * NULL then the application no longer
 
12
                                 * exists. */
 
13
 
 
14
static int tty;                 /* Non-zero means standard input is a
 
15
                                 * terminal-like device.  Zero means it's
 
16
                                 * a file. */
 
17
 
 
18
static int synchronize = 1;
 
19
static char *szname = "TCL/TK-Scheme";
 
20
static char *szdisplay = NULL;  /* "unix:0.0"; */
 
21
 
 
22
static Tcl_DString command;     /* Used to assemble lines of terminal input
 
23
                                 * into Tcl commands. */
 
24
static int gotPartial = 0;      /* Partial command in buffer. */
 
25
 
 
26
static char exitCmd[] = "exit";
 
27
static char errorExitCmd[] = "destroy .";
 
28
 
 
29
extern int isatty _ANSI_ARGS_((int fd));
 
30
/*
 
31
int __TclX_AppInit(Tcl_Interp *interp) { return TCL_OK; }
 
32
*/
 
33
/*
 
34
 *----------------------------------------------------------------------
 
35
 *
 
36
 * StdinProc --
 
37
 *
 
38
 *      This procedure is invoked by the event dispatcher whenever
 
39
 *      standard input becomes readable.  It grabs the next line of
 
40
 *      input characters, adds them to a command being assembled, and
 
41
 *      executes the command if it's complete.
 
42
 *
 
43
 * Results:
 
44
 *      None.
 
45
 *
 
46
 * Side effects:
 
47
 *      Could be almost arbitrary, depending on the command that's
 
48
 *      typed.
 
49
 *
 
50
 *----------------------------------------------------------------------
 
51
 */
 
52
 
 
53
static void
 
54
StdinProc(ClientData clientData, int mask)
 
55
{
 
56
#define BUFFER_SIZE 4000
 
57
  char input[BUFFER_SIZE+1];
 
58
  char *cmd;
 
59
  int code, count;
 
60
 
 
61
  count = read(fileno(stdin), input, BUFFER_SIZE);
 
62
  if (count <= 0) {
 
63
    if (!gotPartial) {
 
64
      if (tty) {
 
65
        Tcl_VarEval(tcliMain, "exit", (char *) NULL);
 
66
        exit(1);
 
67
      }
 
68
      else {
 
69
        Tk_DeleteFileHandler(0);
 
70
      }
 
71
      return;
 
72
    }
 
73
    else {
 
74
      count = 0;
 
75
    }
 
76
  }
 
77
  cmd = Tcl_DStringAppend(&command, input, count);
 
78
  if (count != 0) {
 
79
    if ((input[count-1] != '\n') && (input[count-1] != ';')) {
 
80
      gotPartial = 1;
 
81
      goto exitPoint;
 
82
    }
 
83
    if (!Tcl_CommandComplete(cmd)) {
 
84
      gotPartial = 1;
 
85
      goto exitPoint;
 
86
    }
 
87
  }
 
88
  gotPartial = 0;
 
89
 
 
90
  /*
 
91
   * Disable the stdin file handler;  otherwise if the command
 
92
   * re-enters the event loop we might process commands from
 
93
   * stdin before the current command is finished.  Among other
 
94
   * things, this will trash the text of the command being evaluated.
 
95
   */
 
96
 
 
97
  Tk_CreateFileHandler(0, 0, StdinProc, (ClientData) 0);
 
98
  code = Tcl_RecordAndEval(tcliMain, cmd, 0);
 
99
  Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
 
100
  if (tty)
 
101
    TclX_PrintResult (tcliMain, code, cmd);
 
102
  Tcl_DStringFree(&command);
 
103
 
 
104
 exitPoint:
 
105
  if (tty) {
 
106
    TclX_OutputPrompt (tcliMain, !gotPartial);
 
107
  }
 
108
}
 
109
 
 
110
/*
 
111
 *----------------------------------------------------------------------
 
112
 *
 
113
 * SignalProc --
 
114
 *
 
115
 *      Function called on a signal generating an error to clear the stdin
 
116
 *      buffer.
 
117
 *----------------------------------------------------------------------
 
118
 */
 
119
static void
 
120
SignalProc (int signalNum)
 
121
{
 
122
  tclGotErrorSignal = 0;
 
123
  Tcl_DStringFree (&command);
 
124
  gotPartial = 0;
 
125
  if (tty) {
 
126
    fputc ('\n', stdout);
 
127
    TclX_OutputPrompt (tcliMain, !gotPartial);
 
128
  }
 
129
}
 
130
 
 
131
char *TclTkInit()
 
132
{
 
133
  tcliMain = Tcl_CreateInterp();
 
134
 
 
135
  mainWindow = Tk_CreateMainWindow(tcliMain, szdisplay, szname, "Tk");
 
136
  if (mainWindow == NULL)
 
137
    fprintf(stderr, "Unable to create mainWindow : %s\n", tcliMain->result);
 
138
 
 
139
  Tk_SetClass(mainWindow, "Tk");
 
140
  if (synchronize)
 
141
    XSynchronize(Tk_Display(mainWindow), True);
 
142
 
 
143
  Tk_GeometryRequest(mainWindow, 200, 200);
 
144
  /*
 
145
     if (__TclX_AppInit(tcliMain) != TCL_OK)
 
146
     TclX_ErrorExit (tcliMain, 255);
 
147
     */
 
148
  Tcl_AppInit(tcliMain);
 
149
 
 
150
  return ".";
 
151
}
 
152
 
 
153
void TclTkMainLoop()
 
154
{
 
155
  /*
 
156
   * Set the "tcl_interactive" variable.
 
157
   */
 
158
  tty = isatty(0);
 
159
  Tcl_SetVar(tcliMain, "tcl_interactive",
 
160
             tty ? "1" : "0", TCL_GLOBAL_ONLY);
 
161
/*
 
162
  TclX_EvalRCFile (tcliMain);
 
163
*/
 
164
  /*
 
165
   * Commands will come from standard input.  Set up a handler
 
166
   * to receive those characters and print a prompt if the input
 
167
   * device is a terminal.
 
168
   */
 
169
  tclErrorSignalProc = SignalProc;
 
170
  Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
 
171
  if (tty)
 
172
    TclX_OutputPrompt (tcliMain, 1);
 
173
 
 
174
  Tk_MainLoop();
 
175
  Tcl_GlobalEval(tcliMain, exitCmd);
 
176
 
 
177
}
 
178
 
 
179
main()
 
180
{
 
181
  TclTkInit();
 
182
  TclTkMainLoop();
 
183
}
 
184
 
 
185
int
 
186
Tcl_AppInit(interp)
 
187
    Tcl_Interp *interp;         /* Interpreter for application. */
 
188
{
 
189
    Tk_Window main;
 
190
 
 
191
    main = Tk_MainWindow(interp);
 
192
 
 
193
    /*
 
194
     * Call the init procedures for included packages.  Each call should
 
195
     * look like this:
 
196
     *
 
197
     * if (Mod_Init(interp) == TCL_ERROR) {
 
198
     *     return TCL_ERROR;
 
199
     * }
 
200
     *
 
201
     * where "Mod" is the name of the module.
 
202
     */
 
203
 
 
204
    if (Tcl_Init(interp) == TCL_ERROR) {
 
205
        return TCL_ERROR;
 
206
    }
 
207
    if (Tk_Init(interp) == TCL_ERROR) {
 
208
        return TCL_ERROR;
 
209
    }
 
210
 
 
211
    if (TclX_Init(interp) == TCL_ERROR)
 
212
      return TCL_ERROR;
 
213
 
 
214
    if (TkX_Init(interp) == TCL_ERROR)
 
215
      return TCL_ERROR;
 
216
 
 
217
    /*
 
218
     * Call Tcl_CreateCommand for application-specific commands, if
 
219
     * they weren't already created by the init procedures called above.
 
220
     */
 
221
 
 
222
    /*
 
223
     * Specify a user-specific startup file to invoke if the application
 
224
     * is run interactively.  Typically the startup file is "~/.apprc"
 
225
     * where "app" is the name of the application.  If this line is deleted
 
226
     * then no user-specific startup file will be run under any conditions.
 
227
     */
 
228
 
 
229
    tcl_RcFileName = "~/.wishrc";
 
230
    return TCL_OK;
 
231
}