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