tcl.c revision 1.2 1 1.1 christos /*-
2 1.1 christos * Copyright (c) 1992, 1993, 1994
3 1.1 christos * The Regents of the University of California. All rights reserved.
4 1.1 christos * Copyright (c) 1992, 1993, 1994, 1995
5 1.1 christos * Keith Bostic. All rights reserved.
6 1.1 christos * Copyright (c) 1995
7 1.1 christos * George V. Neville-Neil. All rights reserved.
8 1.1 christos *
9 1.1 christos * See the LICENSE file for redistribution information.
10 1.1 christos */
11 1.1 christos
12 1.1 christos #include "config.h"
13 1.1 christos
14 1.1 christos #ifndef lint
15 1.1 christos static const char sccsid[] = "Id: tcl.c,v 8.19 2001/08/24 12:17:27 skimo Exp (Berkeley) Date: 2001/08/24 12:17:27 ";
16 1.1 christos #endif /* not lint */
17 1.1 christos
18 1.1 christos #include <sys/types.h>
19 1.1 christos #include <sys/queue.h>
20 1.1 christos #include <sys/time.h>
21 1.1 christos
22 1.1 christos #include <bitstring.h>
23 1.1 christos #include <errno.h>
24 1.1 christos #include <limits.h>
25 1.1 christos #include <signal.h>
26 1.1 christos #include <stdio.h>
27 1.1 christos #include <stdlib.h>
28 1.1 christos #include <string.h>
29 1.1 christos #include <tcl.h>
30 1.1 christos #include <termios.h>
31 1.1 christos #include <unistd.h>
32 1.1 christos
33 1.1 christos #include "../common/common.h"
34 1.2 christos #include "tcl_api_extern.h"
35 1.1 christos
36 1.1 christos static int getint __P((Tcl_Interp *, char *, char *, int *));
37 1.1 christos static int getscreenid __P((Tcl_Interp *, SCR **, char *, char *));
38 1.1 christos static void msghandler __P((SCR *, mtype_t, char *, size_t));
39 1.1 christos
40 1.1 christos extern GS *__global_list; /* XXX */
41 1.1 christos
42 1.1 christos /*
43 1.1 christos * INITMESSAGE --
44 1.1 christos * Macros to point messages at the Tcl message handler.
45 1.1 christos */
46 1.1 christos #define INITMESSAGE(sp) \
47 1.1 christos scr_msg = sp->wp->scr_msg; \
48 1.1 christos sp->wp->scr_msg = msghandler;
49 1.1 christos #define ENDMESSAGE(sp) \
50 1.1 christos sp->wp->scr_msg = scr_msg;
51 1.1 christos
52 1.1 christos /*
53 1.1 christos * tcl_fscreen --
54 1.1 christos * Return the screen id associated with file name.
55 1.1 christos *
56 1.1 christos * Tcl Command: viFindScreen
57 1.1 christos * Usage: viFindScreen file
58 1.1 christos */
59 1.1 christos static int
60 1.1 christos tcl_fscreen(clientData, interp, argc, argv)
61 1.1 christos ClientData clientData;
62 1.1 christos Tcl_Interp *interp;
63 1.1 christos int argc;
64 1.1 christos char **argv;
65 1.1 christos {
66 1.1 christos SCR *sp;
67 1.1 christos
68 1.1 christos if (argc != 2) {
69 1.1 christos Tcl_SetResult(interp, "Usage: viFindScreen file", TCL_STATIC);
70 1.1 christos return (TCL_ERROR);
71 1.1 christos }
72 1.1 christos
73 1.1 christos if (getscreenid(interp, &sp, NULL, argv[1]))
74 1.1 christos return (TCL_ERROR);
75 1.1 christos
76 1.1 christos (void)sprintf(interp->result, "%d", sp->id);
77 1.1 christos return (TCL_OK);
78 1.1 christos }
79 1.1 christos
80 1.1 christos /*
81 1.1 christos * tcl_aline --
82 1.1 christos * -- Append the string text after the line in lineNumber.
83 1.1 christos *
84 1.1 christos * Tcl Command: viAppendLine
85 1.1 christos * Usage: viAppendLine screenId lineNumber text
86 1.1 christos */
87 1.1 christos static int
88 1.1 christos tcl_aline(clientData, interp, argc, argv)
89 1.1 christos ClientData clientData;
90 1.1 christos Tcl_Interp *interp;
91 1.1 christos int argc;
92 1.1 christos char **argv;
93 1.1 christos {
94 1.1 christos SCR *sp;
95 1.1 christos void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
96 1.1 christos int lno, rval;
97 1.1 christos
98 1.1 christos if (argc != 4) {
99 1.1 christos Tcl_SetResult(interp,
100 1.1 christos "Usage: viAppendLine screenId lineNumber text", TCL_STATIC);
101 1.1 christos return (TCL_ERROR);
102 1.1 christos }
103 1.1 christos
104 1.1 christos if (getscreenid(interp, &sp, argv[1], NULL) ||
105 1.1 christos getint(interp, "line number", argv[2], &lno))
106 1.1 christos return (TCL_ERROR);
107 1.1 christos INITMESSAGE(sp);
108 1.1 christos rval = api_aline(sp, (db_recno_t)lno, argv[3], strlen(argv[3]));
109 1.1 christos ENDMESSAGE(sp);
110 1.1 christos
111 1.1 christos return (rval ? TCL_ERROR : TCL_OK);
112 1.1 christos }
113 1.1 christos
114 1.1 christos /*
115 1.1 christos * tcl_dline --
116 1.1 christos * Delete lineNum.
117 1.1 christos *
118 1.1 christos * Tcl Command: viDelLine
119 1.1 christos * Usage: viDelLine screenId lineNum
120 1.1 christos */
121 1.1 christos static int
122 1.1 christos tcl_dline(clientData, interp, argc, argv)
123 1.1 christos ClientData clientData;
124 1.1 christos Tcl_Interp *interp;
125 1.1 christos int argc;
126 1.1 christos char **argv;
127 1.1 christos {
128 1.1 christos SCR *sp;
129 1.1 christos void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
130 1.1 christos int lno, rval;
131 1.1 christos
132 1.1 christos if (argc != 3) {
133 1.1 christos Tcl_SetResult(interp,
134 1.1 christos "Usage: viDelLine screenId lineNumber", TCL_STATIC);
135 1.1 christos return (TCL_ERROR);
136 1.1 christos }
137 1.1 christos
138 1.1 christos if (getscreenid(interp, &sp, argv[1], NULL) ||
139 1.1 christos getint(interp, "line number", argv[2], &lno))
140 1.1 christos return (TCL_ERROR);
141 1.1 christos INITMESSAGE(sp);
142 1.1 christos rval = api_dline(sp, (db_recno_t)lno);
143 1.1 christos ENDMESSAGE(sp);
144 1.1 christos
145 1.1 christos return (rval ? TCL_ERROR : TCL_OK);
146 1.1 christos }
147 1.1 christos
148 1.1 christos /*
149 1.1 christos * tcl_gline --
150 1.1 christos * Return lineNumber.
151 1.1 christos *
152 1.1 christos * Tcl Command: viGetLine
153 1.1 christos * Usage: viGetLine screenId lineNumber
154 1.1 christos */
155 1.1 christos static int
156 1.1 christos tcl_gline(clientData, interp, argc, argv)
157 1.1 christos ClientData clientData;
158 1.1 christos Tcl_Interp *interp;
159 1.1 christos int argc;
160 1.1 christos char **argv;
161 1.1 christos {
162 1.1 christos SCR *sp;
163 1.1 christos size_t len;
164 1.1 christos void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
165 1.1 christos int lno, rval;
166 1.1 christos char *line, *p;
167 1.1 christos
168 1.1 christos if (argc != 3) {
169 1.1 christos Tcl_SetResult(interp,
170 1.1 christos "Usage: viGetLine screenId lineNumber", TCL_STATIC);
171 1.1 christos return (TCL_ERROR);
172 1.1 christos }
173 1.1 christos if (getscreenid(interp, &sp, argv[1], NULL) ||
174 1.1 christos getint(interp, "line number", argv[2], &lno))
175 1.1 christos return (TCL_ERROR);
176 1.1 christos INITMESSAGE(sp);
177 1.1 christos rval = api_gline(sp, (db_recno_t)lno, &p, &len);
178 1.1 christos ENDMESSAGE(sp);
179 1.1 christos
180 1.1 christos if (rval)
181 1.1 christos return (TCL_ERROR);
182 1.1 christos
183 1.1 christos if ((line = malloc(len + 1)) == NULL)
184 1.1 christos exit(1); /* XXX */
185 1.1 christos memmove(line, p, len);
186 1.1 christos line[len] = '\0';
187 1.1 christos Tcl_SetResult(interp, line, TCL_DYNAMIC);
188 1.1 christos return (TCL_OK);
189 1.1 christos }
190 1.1 christos
191 1.1 christos /*
192 1.1 christos * tcl_iline --
193 1.1 christos * Insert the string text after the line in lineNumber.
194 1.1 christos *
195 1.1 christos * Tcl Command: viInsertLine
196 1.1 christos * Usage: viInsertLine screenId lineNumber text
197 1.1 christos */
198 1.1 christos static int
199 1.1 christos tcl_iline(clientData, interp, argc, argv)
200 1.1 christos ClientData clientData;
201 1.1 christos Tcl_Interp *interp;
202 1.1 christos int argc;
203 1.1 christos char **argv;
204 1.1 christos {
205 1.1 christos SCR *sp;
206 1.1 christos void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
207 1.1 christos int lno, rval;
208 1.1 christos
209 1.1 christos if (argc != 4) {
210 1.1 christos Tcl_SetResult(interp,
211 1.1 christos "Usage: viInsertLine screenId lineNumber text", TCL_STATIC);
212 1.1 christos return (TCL_ERROR);
213 1.1 christos }
214 1.1 christos
215 1.1 christos if (getscreenid(interp, &sp, argv[1], NULL) ||
216 1.1 christos getint(interp, "line number", argv[2], &lno))
217 1.1 christos return (TCL_ERROR);
218 1.1 christos INITMESSAGE(sp);
219 1.1 christos rval = api_iline(sp, (db_recno_t)lno, argv[3], strlen(argv[3]));
220 1.1 christos ENDMESSAGE(sp);
221 1.1 christos
222 1.1 christos return (rval ? TCL_ERROR : TCL_OK);
223 1.1 christos }
224 1.1 christos
225 1.1 christos /*
226 1.1 christos * tcl_lline --
227 1.1 christos * Return the last line in the screen.
228 1.1 christos *
229 1.1 christos * Tcl Command: viLastLine
230 1.1 christos * Usage: viLastLine screenId
231 1.1 christos */
232 1.1 christos static int
233 1.1 christos tcl_lline(clientData, interp, argc, argv)
234 1.1 christos ClientData clientData;
235 1.1 christos Tcl_Interp *interp;
236 1.1 christos int argc;
237 1.1 christos char **argv;
238 1.1 christos {
239 1.1 christos SCR *sp;
240 1.1 christos db_recno_t last;
241 1.1 christos void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
242 1.1 christos int rval;
243 1.1 christos
244 1.1 christos if (argc != 2) {
245 1.1 christos Tcl_SetResult(interp, "Usage: viLastLine screenId", TCL_STATIC);
246 1.1 christos return (TCL_ERROR);
247 1.1 christos }
248 1.1 christos
249 1.1 christos if (getscreenid(interp, &sp, argv[1], NULL))
250 1.1 christos return (TCL_ERROR);
251 1.1 christos INITMESSAGE(sp);
252 1.1 christos rval = api_lline(sp, &last);
253 1.1 christos ENDMESSAGE(sp);
254 1.1 christos if (rval)
255 1.1 christos return (TCL_ERROR);
256 1.1 christos
257 1.1 christos (void)sprintf(interp->result, "%lu", (unsigned long)last);
258 1.1 christos return (TCL_OK);
259 1.1 christos }
260 1.1 christos
261 1.1 christos /*
262 1.1 christos * tcl_sline --
263 1.1 christos * Set lineNumber to the text supplied.
264 1.1 christos *
265 1.1 christos * Tcl Command: viSetLine
266 1.1 christos * Usage: viSetLine screenId lineNumber text
267 1.1 christos */
268 1.1 christos static int
269 1.1 christos tcl_sline(clientData, interp, argc, argv)
270 1.1 christos ClientData clientData;
271 1.1 christos Tcl_Interp *interp;
272 1.1 christos int argc;
273 1.1 christos char **argv;
274 1.1 christos {
275 1.1 christos SCR *sp;
276 1.1 christos void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
277 1.1 christos int lno, rval;
278 1.1 christos
279 1.1 christos if (argc != 4) {
280 1.1 christos Tcl_SetResult(interp,
281 1.1 christos "Usage: viSetLine screenId lineNumber text", TCL_STATIC);
282 1.1 christos return (TCL_ERROR);
283 1.1 christos }
284 1.1 christos
285 1.1 christos if (getscreenid(interp, &sp, argv[1], NULL) ||
286 1.1 christos getint(interp, "line number", argv[2], &lno))
287 1.1 christos return (TCL_ERROR);
288 1.1 christos INITMESSAGE(sp);
289 1.1 christos rval = api_sline(sp, (db_recno_t)lno, argv[3], strlen(argv[3]));
290 1.1 christos ENDMESSAGE(sp);
291 1.1 christos
292 1.1 christos return (rval ? TCL_ERROR : TCL_OK);
293 1.1 christos }
294 1.1 christos
295 1.1 christos /*
296 1.1 christos * tcl_getmark --
297 1.1 christos * Return the mark's cursor position as a list with two elements.
298 1.1 christos * {line, column}.
299 1.1 christos *
300 1.1 christos * Tcl Command: viGetMark
301 1.1 christos * Usage: viGetMark screenId mark
302 1.1 christos */
303 1.1 christos static int
304 1.1 christos tcl_getmark(clientData, interp, argc, argv)
305 1.1 christos ClientData clientData;
306 1.1 christos Tcl_Interp *interp;
307 1.1 christos int argc;
308 1.1 christos char **argv;
309 1.1 christos {
310 1.1 christos MARK cursor;
311 1.1 christos SCR *sp;
312 1.1 christos void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
313 1.1 christos int rval;
314 1.1 christos char buf[20];
315 1.1 christos
316 1.1 christos if (argc != 3) {
317 1.1 christos Tcl_SetResult(interp,
318 1.1 christos "Usage: viGetMark screenId mark", TCL_STATIC);
319 1.1 christos return (TCL_ERROR);
320 1.1 christos }
321 1.1 christos
322 1.1 christos if (getscreenid(interp, &sp, argv[1], NULL))
323 1.1 christos return (TCL_ERROR);
324 1.1 christos INITMESSAGE(sp);
325 1.1 christos rval = api_getmark(sp, (int)argv[2][0], &cursor);
326 1.1 christos ENDMESSAGE(sp);
327 1.1 christos
328 1.1 christos if (rval)
329 1.1 christos return (TCL_ERROR);
330 1.1 christos
331 1.1 christos (void)snprintf(buf, sizeof(buf), "%lu", (u_long)cursor.lno);
332 1.1 christos Tcl_AppendElement(interp, buf);
333 1.1 christos (void)snprintf(buf, sizeof(buf), "%lu", (u_long)cursor.cno);
334 1.1 christos Tcl_AppendElement(interp, buf);
335 1.1 christos return (TCL_OK);
336 1.1 christos }
337 1.1 christos
338 1.1 christos /*
339 1.1 christos * tcl_setmark --
340 1.1 christos * Set the mark to the line and column numbers supplied.
341 1.1 christos *
342 1.1 christos * Tcl Command: viSetMark
343 1.1 christos * Usage: viSetMark screenId mark line column
344 1.1 christos */
345 1.1 christos static int
346 1.1 christos tcl_setmark(clientData, interp, argc, argv)
347 1.1 christos ClientData clientData;
348 1.1 christos Tcl_Interp *interp;
349 1.1 christos int argc;
350 1.1 christos char **argv;
351 1.1 christos {
352 1.1 christos MARK cursor;
353 1.1 christos SCR *sp;
354 1.1 christos void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
355 1.1 christos int i, rval;
356 1.1 christos
357 1.1 christos if (argc != 5) {
358 1.1 christos Tcl_SetResult(interp,
359 1.1 christos "Usage: viSetMark screenId mark line column", TCL_STATIC);
360 1.1 christos return (TCL_ERROR);
361 1.1 christos }
362 1.1 christos
363 1.1 christos if (getscreenid(interp, &sp, argv[1], NULL))
364 1.1 christos return (TCL_ERROR);
365 1.1 christos if (getint(interp, "line number", argv[3], &i))
366 1.1 christos return (TCL_ERROR);
367 1.1 christos cursor.lno = i;
368 1.1 christos if (getint(interp, "column number", argv[4], &i))
369 1.1 christos return (TCL_ERROR);
370 1.1 christos cursor.cno = i;
371 1.1 christos INITMESSAGE(sp);
372 1.1 christos rval = api_setmark(sp, (int)argv[2][0], &cursor);
373 1.1 christos ENDMESSAGE(sp);
374 1.1 christos
375 1.1 christos return (rval ? TCL_ERROR : TCL_OK);
376 1.1 christos }
377 1.1 christos
378 1.1 christos /*
379 1.1 christos * tcl_getcursor --
380 1.1 christos * Return the current cursor position as a list with two elements.
381 1.1 christos * {line, column}.
382 1.1 christos *
383 1.1 christos * Tcl Command: viGetCursor
384 1.1 christos * Usage: viGetCursor screenId
385 1.1 christos */
386 1.1 christos static int
387 1.1 christos tcl_getcursor(clientData, interp, argc, argv)
388 1.1 christos ClientData clientData;
389 1.1 christos Tcl_Interp *interp;
390 1.1 christos int argc;
391 1.1 christos char **argv;
392 1.1 christos {
393 1.1 christos MARK cursor;
394 1.1 christos SCR *sp;
395 1.1 christos void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
396 1.1 christos int rval;
397 1.1 christos char buf[20];
398 1.1 christos
399 1.1 christos if (argc != 2) {
400 1.1 christos Tcl_SetResult(interp,
401 1.1 christos "Usage: viGetCursor screenId", TCL_STATIC);
402 1.1 christos return (TCL_ERROR);
403 1.1 christos }
404 1.1 christos
405 1.1 christos if (getscreenid(interp, &sp, argv[1], NULL))
406 1.1 christos return (TCL_ERROR);
407 1.1 christos INITMESSAGE(sp);
408 1.1 christos rval = api_getcursor(sp, &cursor);
409 1.1 christos ENDMESSAGE(sp);
410 1.1 christos
411 1.1 christos if (rval)
412 1.1 christos return (TCL_ERROR);
413 1.1 christos
414 1.1 christos (void)snprintf(buf, sizeof(buf), "%lu", (u_long)cursor.lno);
415 1.1 christos Tcl_AppendElement(interp, buf);
416 1.1 christos (void)snprintf(buf, sizeof(buf), "%lu", (u_long)cursor.cno);
417 1.1 christos Tcl_AppendElement(interp, buf);
418 1.1 christos return (TCL_OK);
419 1.1 christos }
420 1.1 christos
421 1.1 christos /*
422 1.1 christos * tcl_setcursor --
423 1.1 christos * Set the cursor to the line and column numbers supplied.
424 1.1 christos *
425 1.1 christos * Tcl Command: viSetCursor
426 1.1 christos * Usage: viSetCursor screenId line column
427 1.1 christos */
428 1.1 christos static int
429 1.1 christos tcl_setcursor(clientData, interp, argc, argv)
430 1.1 christos ClientData clientData;
431 1.1 christos Tcl_Interp *interp;
432 1.1 christos int argc;
433 1.1 christos char **argv;
434 1.1 christos {
435 1.1 christos MARK cursor;
436 1.1 christos SCR *sp;
437 1.1 christos void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
438 1.1 christos int i, rval;
439 1.1 christos
440 1.1 christos if (argc != 4) {
441 1.1 christos Tcl_SetResult(interp,
442 1.1 christos "Usage: viSetCursor screenId line column", TCL_STATIC);
443 1.1 christos return (TCL_ERROR);
444 1.1 christos }
445 1.1 christos
446 1.1 christos if (getscreenid(interp, &sp, argv[1], NULL))
447 1.1 christos return (TCL_ERROR);
448 1.1 christos if (getint(interp, "screen id", argv[2], &i))
449 1.1 christos return (TCL_ERROR);
450 1.1 christos cursor.lno = i;
451 1.1 christos if (getint(interp, "screen id", argv[3], &i))
452 1.1 christos return (TCL_ERROR);
453 1.1 christos cursor.cno = i;
454 1.1 christos INITMESSAGE(sp);
455 1.1 christos rval = api_setcursor(sp, &cursor);
456 1.1 christos ENDMESSAGE(sp);
457 1.1 christos
458 1.1 christos return (rval ? TCL_ERROR : TCL_OK);
459 1.1 christos }
460 1.1 christos
461 1.1 christos /*
462 1.1 christos * tcl_msg --
463 1.1 christos * Set the message line to text.
464 1.1 christos *
465 1.1 christos * Tcl Command: viMsg
466 1.1 christos * Usage: viMsg screenId text
467 1.1 christos */
468 1.1 christos static int
469 1.1 christos tcl_msg(clientData, interp, argc, argv)
470 1.1 christos ClientData clientData;
471 1.1 christos Tcl_Interp *interp;
472 1.1 christos int argc;
473 1.1 christos char **argv;
474 1.1 christos {
475 1.1 christos SCR *sp;
476 1.1 christos
477 1.1 christos if (argc != 3) {
478 1.1 christos Tcl_SetResult(interp, "Usage: viMsg screenId text", TCL_STATIC);
479 1.1 christos return (TCL_ERROR);
480 1.1 christos }
481 1.1 christos
482 1.1 christos if (getscreenid(interp, &sp, argv[1], NULL))
483 1.1 christos return (TCL_ERROR);
484 1.1 christos api_imessage(sp, argv[2]);
485 1.1 christos
486 1.1 christos return (TCL_OK);
487 1.1 christos }
488 1.1 christos
489 1.1 christos /*
490 1.1 christos * tcl_iscreen --
491 1.1 christos * Create a new screen. If a filename is specified then the screen
492 1.1 christos * is opened with that file.
493 1.1 christos *
494 1.1 christos * Tcl Command: viNewScreen
495 1.1 christos * Usage: viNewScreen screenId [file]
496 1.1 christos */
497 1.1 christos static int
498 1.1 christos tcl_iscreen(clientData, interp, argc, argv)
499 1.1 christos ClientData clientData;
500 1.1 christos Tcl_Interp *interp;
501 1.1 christos int argc;
502 1.1 christos char **argv;
503 1.1 christos {
504 1.1 christos SCR *sp, *nsp;
505 1.1 christos void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
506 1.1 christos int rval;
507 1.1 christos
508 1.1 christos if (argc != 2 && argc != 3) {
509 1.1 christos Tcl_SetResult(interp,
510 1.1 christos "Usage: viNewScreen screenId [file]", TCL_STATIC);
511 1.1 christos return (TCL_ERROR);
512 1.1 christos }
513 1.1 christos
514 1.1 christos if (getscreenid(interp, &sp, argv[1], NULL))
515 1.1 christos return (TCL_ERROR);
516 1.1 christos INITMESSAGE(sp);
517 1.1 christos rval = api_edit(sp, argv[2], &nsp, 1);
518 1.1 christos ENDMESSAGE(sp);
519 1.1 christos
520 1.1 christos if (rval)
521 1.1 christos return (TCL_ERROR);
522 1.1 christos
523 1.1 christos (void)sprintf(interp->result, "%d", nsp->id);
524 1.1 christos return (TCL_OK);
525 1.1 christos }
526 1.1 christos
527 1.1 christos /*
528 1.1 christos * tcl_escreen --
529 1.1 christos * End a screen.
530 1.1 christos *
531 1.1 christos * Tcl Command: viEndScreen
532 1.1 christos * Usage: viEndScreen screenId
533 1.1 christos */
534 1.1 christos static int
535 1.1 christos tcl_escreen(clientData, interp, argc, argv)
536 1.1 christos ClientData clientData;
537 1.1 christos Tcl_Interp *interp;
538 1.1 christos int argc;
539 1.1 christos char **argv;
540 1.1 christos {
541 1.1 christos SCR *sp;
542 1.1 christos void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
543 1.1 christos int rval;
544 1.1 christos
545 1.1 christos if (argc != 2) {
546 1.1 christos Tcl_SetResult(interp,
547 1.1 christos "Usage: viEndScreen screenId", TCL_STATIC);
548 1.1 christos return (TCL_ERROR);
549 1.1 christos }
550 1.1 christos
551 1.1 christos if (getscreenid(interp, &sp, argv[1], NULL))
552 1.1 christos return (TCL_ERROR);
553 1.1 christos INITMESSAGE(sp);
554 1.1 christos rval = api_escreen(sp);
555 1.1 christos ENDMESSAGE(sp);
556 1.1 christos
557 1.1 christos return (rval ? TCL_ERROR : TCL_OK);
558 1.1 christos }
559 1.1 christos
560 1.1 christos /*
561 1.1 christos * tcl_swscreen --
562 1.1 christos * Change the current focus to screen.
563 1.1 christos *
564 1.1 christos * Tcl Command: viSwitchScreen
565 1.1 christos * Usage: viSwitchScreen screenId screenId
566 1.1 christos */
567 1.1 christos static int
568 1.1 christos tcl_swscreen(clientData, interp, argc, argv)
569 1.1 christos ClientData clientData;
570 1.1 christos Tcl_Interp *interp;
571 1.1 christos int argc;
572 1.1 christos char **argv;
573 1.1 christos {
574 1.1 christos SCR *sp, *new;
575 1.1 christos void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
576 1.1 christos int rval;
577 1.1 christos
578 1.1 christos if (argc != 3) {
579 1.1 christos Tcl_SetResult(interp,
580 1.1 christos "Usage: viSwitchScreen cur_screenId new_screenId",
581 1.1 christos TCL_STATIC);
582 1.1 christos return (TCL_ERROR);
583 1.1 christos }
584 1.1 christos
585 1.1 christos if (getscreenid(interp, &sp, argv[1], NULL))
586 1.1 christos return (TCL_ERROR);
587 1.1 christos if (getscreenid(interp, &new, argv[2], NULL))
588 1.1 christos return (TCL_ERROR);
589 1.1 christos INITMESSAGE(sp);
590 1.1 christos rval = api_swscreen(sp, new);
591 1.1 christos ENDMESSAGE(sp);
592 1.1 christos
593 1.1 christos return (rval ? TCL_ERROR : TCL_OK);
594 1.1 christos }
595 1.1 christos
596 1.1 christos /*
597 1.1 christos * tcl_map --
598 1.1 christos * Associate a key with a tcl procedure.
599 1.1 christos *
600 1.1 christos * Tcl Command: viMapKey
601 1.1 christos * Usage: viMapKey screenId key tclproc
602 1.1 christos */
603 1.1 christos static int
604 1.1 christos tcl_map(clientData, interp, argc, argv)
605 1.1 christos ClientData clientData;
606 1.1 christos Tcl_Interp *interp;
607 1.1 christos int argc;
608 1.1 christos char **argv;
609 1.1 christos {
610 1.1 christos SCR *sp;
611 1.1 christos void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
612 1.1 christos int rval;
613 1.1 christos char command[256];
614 1.1 christos
615 1.1 christos if (argc != 4) {
616 1.1 christos Tcl_SetResult(interp,
617 1.1 christos "Usage: viMapKey screenId key tclproc", TCL_STATIC);
618 1.1 christos return (TCL_ERROR);
619 1.1 christos }
620 1.1 christos
621 1.1 christos if (getscreenid(interp, &sp, argv[1], NULL))
622 1.1 christos return (TCL_ERROR);
623 1.1 christos INITMESSAGE(sp);
624 1.1 christos (void)snprintf(command, sizeof(command), ":tcl %s\n", argv[3]);
625 1.1 christos rval = api_map(sp, argv[2], command, strlen(command));
626 1.1 christos ENDMESSAGE(sp);
627 1.1 christos
628 1.1 christos return (rval ? TCL_ERROR : TCL_OK);
629 1.1 christos }
630 1.1 christos
631 1.1 christos /*
632 1.1 christos * tcl_unmap --
633 1.1 christos * Unmap a key.
634 1.1 christos *
635 1.1 christos * Tcl Command: viUnmapKey
636 1.1 christos * Usage: viUnmMapKey screenId key
637 1.1 christos */
638 1.1 christos static int
639 1.1 christos tcl_unmap(clientData, interp, argc, argv)
640 1.1 christos ClientData clientData;
641 1.1 christos Tcl_Interp *interp;
642 1.1 christos int argc;
643 1.1 christos char **argv;
644 1.1 christos {
645 1.1 christos SCR *sp;
646 1.1 christos void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
647 1.1 christos int rval;
648 1.1 christos
649 1.1 christos if (argc != 3) {
650 1.1 christos Tcl_SetResult(interp,
651 1.1 christos "Usage: viUnmapKey screenId key", TCL_STATIC);
652 1.1 christos return (TCL_ERROR);
653 1.1 christos }
654 1.1 christos
655 1.1 christos if (getscreenid(interp, &sp, argv[1], NULL))
656 1.1 christos return (TCL_ERROR);
657 1.1 christos INITMESSAGE(sp);
658 1.1 christos rval = api_unmap(sp, argv[2]);
659 1.1 christos ENDMESSAGE(sp);
660 1.1 christos
661 1.1 christos return (rval ? TCL_ERROR : TCL_OK);
662 1.1 christos }
663 1.1 christos
664 1.1 christos /*
665 1.1 christos * tcl_opts_set --
666 1.1 christos * Set an option.
667 1.1 christos *
668 1.1 christos * Tcl Command: viSetOpt
669 1.1 christos * Usage: viSetOpt screenId command
670 1.1 christos */
671 1.1 christos static int
672 1.1 christos tcl_opts_set(clientData, interp, argc, argv)
673 1.1 christos ClientData clientData;
674 1.1 christos Tcl_Interp *interp;
675 1.1 christos int argc;
676 1.1 christos char **argv;
677 1.1 christos {
678 1.1 christos SCR *sp;
679 1.1 christos void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
680 1.1 christos int rval;
681 1.1 christos char *setting;
682 1.1 christos
683 1.1 christos if (argc != 3) {
684 1.1 christos Tcl_SetResult(interp,
685 1.1 christos "Usage: viSetOpt screenId command", TCL_STATIC);
686 1.1 christos return (TCL_ERROR);
687 1.1 christos }
688 1.1 christos
689 1.1 christos if (getscreenid(interp, &sp, argv[1], NULL))
690 1.1 christos return (TCL_ERROR);
691 1.1 christos INITMESSAGE(sp);
692 1.1 christos /*rval = api_opts_set(sp, argv[2]);*/
693 1.1 christos MALLOC(sp, setting, char *, strlen(argv[2])+6);
694 1.1 christos strcpy(setting, ":set ");
695 1.1 christos strcpy(setting+5, argv[2]);
696 1.1 christos rval=api_run_str(sp, setting);
697 1.1 christos free(setting);
698 1.1 christos ENDMESSAGE(sp);
699 1.1 christos
700 1.1 christos return (rval ? TCL_ERROR : TCL_OK);
701 1.1 christos }
702 1.1 christos
703 1.1 christos /*
704 1.1 christos * tcl_opts_get --
705 1.1 christos Return the value of an option.
706 1.1 christos *
707 1.1 christos * Tcl Command: viGetOpt
708 1.1 christos * Usage: viGetOpt screenId option
709 1.1 christos */
710 1.1 christos static int
711 1.1 christos tcl_opts_get(clientData, interp, argc, argv)
712 1.1 christos ClientData clientData;
713 1.1 christos Tcl_Interp *interp;
714 1.1 christos int argc;
715 1.1 christos char **argv;
716 1.1 christos {
717 1.1 christos SCR *sp;
718 1.1 christos void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
719 1.1 christos int rval;
720 1.1 christos char *value;
721 1.1 christos
722 1.1 christos if (argc != 3) {
723 1.1 christos Tcl_SetResult(interp,
724 1.1 christos "Usage: viGetOpt screenId option", TCL_STATIC);
725 1.1 christos return (TCL_ERROR);
726 1.1 christos }
727 1.1 christos
728 1.1 christos if (getscreenid(interp, &sp, argv[1], NULL))
729 1.1 christos return (TCL_ERROR);
730 1.1 christos INITMESSAGE(sp);
731 1.1 christos rval = api_opts_get(sp, argv[2], &value, NULL);
732 1.1 christos ENDMESSAGE(sp);
733 1.1 christos if (rval)
734 1.1 christos return (TCL_ERROR);
735 1.1 christos
736 1.1 christos Tcl_SetResult(interp, value, TCL_DYNAMIC);
737 1.1 christos return (TCL_OK);
738 1.1 christos }
739 1.1 christos
740 1.1 christos /*
741 1.1 christos * tcl_init --
742 1.1 christos * Create the TCL commands used by nvi.
743 1.1 christos *
744 1.1 christos * PUBLIC: int tcl_init __P((GS *));
745 1.1 christos */
746 1.1 christos int
747 1.1 christos tcl_init(gp)
748 1.1 christos GS *gp;
749 1.1 christos {
750 1.1 christos gp->tcl_interp = Tcl_CreateInterp();
751 1.1 christos if (Tcl_Init(gp->tcl_interp) == TCL_ERROR)
752 1.1 christos return (1);
753 1.1 christos
754 1.1 christos #define TCC(name, function) { \
755 1.1 christos Tcl_CreateCommand(gp->tcl_interp, name, function, \
756 1.1 christos (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); \
757 1.1 christos }
758 1.1 christos TCC("viAppendLine", tcl_aline);
759 1.1 christos TCC("viDelLine", tcl_dline);
760 1.1 christos TCC("viEndScreen", tcl_escreen);
761 1.1 christos TCC("viFindScreen", tcl_fscreen);
762 1.1 christos TCC("viGetCursor", tcl_getcursor);
763 1.1 christos TCC("viGetLine", tcl_gline);
764 1.1 christos TCC("viGetMark", tcl_getmark);
765 1.1 christos TCC("viGetOpt", tcl_opts_get);
766 1.1 christos TCC("viInsertLine", tcl_iline);
767 1.1 christos TCC("viLastLine", tcl_lline);
768 1.1 christos TCC("viMapKey", tcl_map);
769 1.1 christos TCC("viMsg", tcl_msg);
770 1.1 christos TCC("viNewScreen", tcl_iscreen);
771 1.1 christos TCC("viSetCursor", tcl_setcursor);
772 1.1 christos TCC("viSetLine", tcl_sline);
773 1.1 christos TCC("viSetMark", tcl_setmark);
774 1.1 christos TCC("viSetOpt", tcl_opts_set);
775 1.1 christos TCC("viSwitchScreen", tcl_swscreen);
776 1.1 christos TCC("viUnmapKey", tcl_unmap);
777 1.1 christos
778 1.1 christos return (0);
779 1.1 christos }
780 1.1 christos
781 1.1 christos /*
782 1.1 christos * getscreenid --
783 1.1 christos * Get the specified screen pointer.
784 1.1 christos *
785 1.1 christos * XXX
786 1.1 christos * This is fatal. We can't post a message into vi that we're unable to find
787 1.1 christos * the screen without first finding the screen... So, this must be the first
788 1.1 christos * thing a Tcl routine does, and, if it fails, the last as well.
789 1.1 christos */
790 1.1 christos static int
791 1.1 christos getscreenid(interp, spp, id, name)
792 1.1 christos Tcl_Interp *interp;
793 1.1 christos SCR **spp;
794 1.1 christos char *id, *name;
795 1.1 christos {
796 1.1 christos int scr_no;
797 1.1 christos char buf[64];
798 1.1 christos
799 1.1 christos if (id != NULL && getint(interp, "screen id", id, &scr_no))
800 1.1 christos return (1);
801 1.1 christos if ((*spp = api_fscreen(scr_no, name)) == NULL) {
802 1.1 christos (void)snprintf(buf, sizeof(buf),
803 1.1 christos "unknown screen id: %s", name == NULL ? id : name);
804 1.1 christos Tcl_SetResult(interp, buf, TCL_VOLATILE);
805 1.1 christos return (1);
806 1.1 christos }
807 1.1 christos return (0);
808 1.1 christos }
809 1.1 christos
810 1.1 christos /*
811 1.1 christos * getint --
812 1.1 christos * Get a Tcl integer.
813 1.1 christos *
814 1.1 christos * XXX
815 1.1 christos * This code assumes that both db_recno_t and size_t are larger than ints.
816 1.1 christos */
817 1.1 christos static int
818 1.1 christos getint(interp, msg, s, intp)
819 1.1 christos Tcl_Interp *interp;
820 1.1 christos char *msg, *s;
821 1.1 christos int *intp;
822 1.1 christos {
823 1.1 christos char buf[64];
824 1.1 christos
825 1.1 christos if (Tcl_GetInt(interp, s, intp) == TCL_ERROR)
826 1.1 christos return (1);
827 1.1 christos if (*intp < 0) {
828 1.1 christos (void)snprintf(buf, sizeof(buf),
829 1.1 christos "illegal %s %s: may not be negative", msg, s);
830 1.1 christos Tcl_SetResult(interp, buf, TCL_VOLATILE);
831 1.1 christos return (1);
832 1.1 christos }
833 1.1 christos return (0);
834 1.1 christos }
835 1.1 christos
836 1.1 christos /*
837 1.1 christos * msghandler --
838 1.1 christos * Tcl message routine so that error messages are processed in
839 1.1 christos * Tcl, not in nvi.
840 1.1 christos */
841 1.1 christos static void
842 1.1 christos msghandler(sp, mtype, msg, len)
843 1.1 christos SCR *sp;
844 1.1 christos mtype_t mtype;
845 1.1 christos char *msg;
846 1.1 christos size_t len;
847 1.1 christos {
848 1.1 christos /* Replace the trailing <newline> with an EOS. */
849 1.1 christos msg[len - 1] = '\0';
850 1.1 christos
851 1.1 christos Tcl_SetResult(sp->gp->tcl_interp, msg, TCL_VOLATILE);
852 1.1 christos }
853