MFC:
[dragonfly.git] / contrib / nvi / tcl_api / tcl.c
blob8f4a430bac4cfbdad15d83638adfcd91946d953a
1 /*-
2 * Copyright (c) 1992, 1993, 1994
3 * The Regents of the University of California. All rights reserved.
4 * Copyright (c) 1992, 1993, 1994, 1995
5 * Keith Bostic. All rights reserved.
6 * Copyright (c) 1995
7 * George V. Neville-Neil. All rights reserved.
9 * See the LICENSE file for redistribution information.
12 #include "config.h"
14 #ifndef lint
15 static const char sccsid[] = "@(#)tcl.c 8.16 (Berkeley) 10/16/96";
16 #endif /* not lint */
18 #include <sys/types.h>
19 #include <sys/queue.h>
20 #include <sys/time.h>
22 #include <bitstring.h>
23 #include <errno.h>
24 #include <limits.h>
25 #include <signal.h>
26 #include <stdio.h>
27 #include <stdlib.h>
28 #include <string.h>
29 #include <tcl.h>
30 #include <termios.h>
31 #include <unistd.h>
33 #include "../common/common.h"
34 #include "tcl_extern.h"
36 static int getint __P((Tcl_Interp *, char *, char *, int *));
37 static int getscreenid __P((Tcl_Interp *, SCR **, char *, char *));
38 static void msghandler __P((SCR *, mtype_t, char *, size_t));
40 extern GS *__global_list; /* XXX */
43 * INITMESSAGE --
44 * Macros to point messages at the Tcl message handler.
46 #define INITMESSAGE \
47 scr_msg = __global_list->scr_msg; \
48 __global_list->scr_msg = msghandler;
49 #define ENDMESSAGE \
50 __global_list->scr_msg = scr_msg;
53 * tcl_fscreen --
54 * Return the screen id associated with file name.
56 * Tcl Command: viFindScreen
57 * Usage: viFindScreen file
59 static int
60 tcl_fscreen(clientData, interp, argc, argv)
61 ClientData clientData;
62 Tcl_Interp *interp;
63 int argc;
64 char **argv;
66 SCR *sp;
68 if (argc != 2) {
69 Tcl_SetResult(interp, "Usage: viFindScreen file", TCL_STATIC);
70 return (TCL_ERROR);
73 if (getscreenid(interp, &sp, NULL, argv[1]))
74 return (TCL_ERROR);
76 (void)sprintf(interp->result, "%d", sp->id);
77 return (TCL_OK);
81 * tcl_aline --
82 * -- Append the string text after the line in lineNumber.
84 * Tcl Command: viAppendLine
85 * Usage: viAppendLine screenId lineNumber text
87 static int
88 tcl_aline(clientData, interp, argc, argv)
89 ClientData clientData;
90 Tcl_Interp *interp;
91 int argc;
92 char **argv;
94 SCR *sp;
95 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
96 int lno, rval;
98 if (argc != 4) {
99 Tcl_SetResult(interp,
100 "Usage: viAppendLine screenId lineNumber text", TCL_STATIC);
101 return (TCL_ERROR);
104 if (getscreenid(interp, &sp, argv[1], NULL) ||
105 getint(interp, "line number", argv[2], &lno))
106 return (TCL_ERROR);
107 INITMESSAGE;
108 rval = api_aline(sp, (recno_t)lno, argv[3], strlen(argv[3]));
109 ENDMESSAGE;
111 return (rval ? TCL_ERROR : TCL_OK);
115 * tcl_dline --
116 * Delete lineNum.
118 * Tcl Command: viDelLine
119 * Usage: viDelLine screenId lineNum
121 static int
122 tcl_dline(clientData, interp, argc, argv)
123 ClientData clientData;
124 Tcl_Interp *interp;
125 int argc;
126 char **argv;
128 SCR *sp;
129 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
130 int lno, rval;
132 if (argc != 3) {
133 Tcl_SetResult(interp,
134 "Usage: viDelLine screenId lineNumber", TCL_STATIC);
135 return (TCL_ERROR);
138 if (getscreenid(interp, &sp, argv[1], NULL) ||
139 getint(interp, "line number", argv[2], &lno))
140 return (TCL_ERROR);
141 INITMESSAGE;
142 rval = api_dline(sp, (recno_t)lno);
143 ENDMESSAGE;
145 return (rval ? TCL_ERROR : TCL_OK);
149 * tcl_gline --
150 * Return lineNumber.
152 * Tcl Command: viGetLine
153 * Usage: viGetLine screenId lineNumber
155 static int
156 tcl_gline(clientData, interp, argc, argv)
157 ClientData clientData;
158 Tcl_Interp *interp;
159 int argc;
160 char **argv;
162 SCR *sp;
163 size_t len;
164 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
165 int lno, rval;
166 char *line, *p;
168 if (argc != 3) {
169 Tcl_SetResult(interp,
170 "Usage: viGetLine screenId lineNumber", TCL_STATIC);
171 return (TCL_ERROR);
173 if (getscreenid(interp, &sp, argv[1], NULL) ||
174 getint(interp, "line number", argv[2], &lno))
175 return (TCL_ERROR);
176 INITMESSAGE;
177 rval = api_gline(sp, (recno_t)lno, &p, &len);
178 ENDMESSAGE;
180 if (rval)
181 return (TCL_ERROR);
183 if ((line = malloc(len + 1)) == NULL)
184 exit(1); /* XXX */
185 memmove(line, p, len);
186 line[len] = '\0';
187 Tcl_SetResult(interp, line, TCL_DYNAMIC);
188 return (TCL_OK);
192 * tcl_iline --
193 * Insert the string text after the line in lineNumber.
195 * Tcl Command: viInsertLine
196 * Usage: viInsertLine screenId lineNumber text
198 static int
199 tcl_iline(clientData, interp, argc, argv)
200 ClientData clientData;
201 Tcl_Interp *interp;
202 int argc;
203 char **argv;
205 SCR *sp;
206 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
207 int lno, rval;
209 if (argc != 4) {
210 Tcl_SetResult(interp,
211 "Usage: viInsertLine screenId lineNumber text", TCL_STATIC);
212 return (TCL_ERROR);
215 if (getscreenid(interp, &sp, argv[1], NULL) ||
216 getint(interp, "line number", argv[2], &lno))
217 return (TCL_ERROR);
218 INITMESSAGE;
219 rval = api_iline(sp, (recno_t)lno, argv[3], strlen(argv[3]));
220 ENDMESSAGE;
222 return (rval ? TCL_ERROR : TCL_OK);
226 * tcl_lline --
227 * Return the last line in the screen.
229 * Tcl Command: viLastLine
230 * Usage: viLastLine screenId
232 static int
233 tcl_lline(clientData, interp, argc, argv)
234 ClientData clientData;
235 Tcl_Interp *interp;
236 int argc;
237 char **argv;
239 SCR *sp;
240 recno_t last;
241 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
242 int rval;
244 if (argc != 2) {
245 Tcl_SetResult(interp, "Usage: viLastLine screenId", TCL_STATIC);
246 return (TCL_ERROR);
249 if (getscreenid(interp, &sp, argv[1], NULL))
250 return (TCL_ERROR);
251 INITMESSAGE;
252 rval = api_lline(sp, &last);
253 ENDMESSAGE;
254 if (rval)
255 return (TCL_ERROR);
257 (void)sprintf(interp->result, "%lu", (unsigned long)last);
258 return (TCL_OK);
262 * tcl_sline --
263 * Set lineNumber to the text supplied.
265 * Tcl Command: viSetLine
266 * Usage: viSetLine screenId lineNumber text
268 static int
269 tcl_sline(clientData, interp, argc, argv)
270 ClientData clientData;
271 Tcl_Interp *interp;
272 int argc;
273 char **argv;
275 SCR *sp;
276 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
277 int lno, rval;
279 if (argc != 4) {
280 Tcl_SetResult(interp,
281 "Usage: viSetLine screenId lineNumber text", TCL_STATIC);
282 return (TCL_ERROR);
285 if (getscreenid(interp, &sp, argv[1], NULL) ||
286 getint(interp, "line number", argv[2], &lno))
287 return (TCL_ERROR);
288 INITMESSAGE;
289 rval = api_sline(sp, (recno_t)lno, argv[3], strlen(argv[3]));
290 ENDMESSAGE;
292 return (rval ? TCL_ERROR : TCL_OK);
296 * tcl_getmark --
297 * Return the mark's cursor position as a list with two elements.
298 * {line, column}.
300 * Tcl Command: viGetMark
301 * Usage: viGetMark screenId mark
303 static int
304 tcl_getmark(clientData, interp, argc, argv)
305 ClientData clientData;
306 Tcl_Interp *interp;
307 int argc;
308 char **argv;
310 MARK cursor;
311 SCR *sp;
312 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
313 int rval;
314 char buf[20];
316 if (argc != 3) {
317 Tcl_SetResult(interp,
318 "Usage: viGetMark screenId mark", TCL_STATIC);
319 return (TCL_ERROR);
322 if (getscreenid(interp, &sp, argv[1], NULL))
323 return (TCL_ERROR);
324 INITMESSAGE;
325 rval = api_getmark(sp, (int)argv[2][0], &cursor);
326 ENDMESSAGE;
328 if (rval)
329 return (TCL_ERROR);
331 (void)snprintf(buf, sizeof(buf), "%lu", (u_long)cursor.lno);
332 Tcl_AppendElement(interp, buf);
333 (void)snprintf(buf, sizeof(buf), "%lu", (u_long)cursor.cno);
334 Tcl_AppendElement(interp, buf);
335 return (TCL_OK);
339 * tcl_setmark --
340 * Set the mark to the line and column numbers supplied.
342 * Tcl Command: viSetMark
343 * Usage: viSetMark screenId mark line column
345 static int
346 tcl_setmark(clientData, interp, argc, argv)
347 ClientData clientData;
348 Tcl_Interp *interp;
349 int argc;
350 char **argv;
352 MARK cursor;
353 SCR *sp;
354 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
355 int i, rval;
357 if (argc != 5) {
358 Tcl_SetResult(interp,
359 "Usage: viSetMark screenId mark line column", TCL_STATIC);
360 return (TCL_ERROR);
363 if (getscreenid(interp, &sp, argv[1], NULL))
364 return (TCL_ERROR);
365 if (getint(interp, "line number", argv[3], &i))
366 return (TCL_ERROR);
367 cursor.lno = i;
368 if (getint(interp, "column number", argv[4], &i))
369 return (TCL_ERROR);
370 cursor.cno = i;
371 INITMESSAGE;
372 rval = api_setmark(sp, (int)argv[2][0], &cursor);
373 ENDMESSAGE;
375 return (rval ? TCL_ERROR : TCL_OK);
379 * tcl_getcursor --
380 * Return the current cursor position as a list with two elements.
381 * {line, column}.
383 * Tcl Command: viGetCursor
384 * Usage: viGetCursor screenId
386 static int
387 tcl_getcursor(clientData, interp, argc, argv)
388 ClientData clientData;
389 Tcl_Interp *interp;
390 int argc;
391 char **argv;
393 MARK cursor;
394 SCR *sp;
395 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
396 int rval;
397 char buf[20];
399 if (argc != 2) {
400 Tcl_SetResult(interp,
401 "Usage: viGetCursor screenId", TCL_STATIC);
402 return (TCL_ERROR);
405 if (getscreenid(interp, &sp, argv[1], NULL))
406 return (TCL_ERROR);
407 INITMESSAGE;
408 rval = api_getcursor(sp, &cursor);
409 ENDMESSAGE;
411 if (rval)
412 return (TCL_ERROR);
414 (void)snprintf(buf, sizeof(buf), "%lu", (u_long)cursor.lno);
415 Tcl_AppendElement(interp, buf);
416 (void)snprintf(buf, sizeof(buf), "%lu", (u_long)cursor.cno);
417 Tcl_AppendElement(interp, buf);
418 return (TCL_OK);
422 * tcl_setcursor --
423 * Set the cursor to the line and column numbers supplied.
425 * Tcl Command: viSetCursor
426 * Usage: viSetCursor screenId line column
428 static int
429 tcl_setcursor(clientData, interp, argc, argv)
430 ClientData clientData;
431 Tcl_Interp *interp;
432 int argc;
433 char **argv;
435 MARK cursor;
436 SCR *sp;
437 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
438 int i, rval;
440 if (argc != 4) {
441 Tcl_SetResult(interp,
442 "Usage: viSetCursor screenId line column", TCL_STATIC);
443 return (TCL_ERROR);
446 if (getscreenid(interp, &sp, argv[1], NULL))
447 return (TCL_ERROR);
448 if (getint(interp, "screen id", argv[2], &i))
449 return (TCL_ERROR);
450 cursor.lno = i;
451 if (getint(interp, "screen id", argv[3], &i))
452 return (TCL_ERROR);
453 cursor.cno = i;
454 INITMESSAGE;
455 rval = api_setcursor(sp, &cursor);
456 ENDMESSAGE;
458 return (rval ? TCL_ERROR : TCL_OK);
462 * tcl_msg --
463 * Set the message line to text.
465 * Tcl Command: viMsg
466 * Usage: viMsg screenId text
468 static int
469 tcl_msg(clientData, interp, argc, argv)
470 ClientData clientData;
471 Tcl_Interp *interp;
472 int argc;
473 char **argv;
475 SCR *sp;
477 if (argc != 3) {
478 Tcl_SetResult(interp, "Usage: viMsg screenId text", TCL_STATIC);
479 return (TCL_ERROR);
482 if (getscreenid(interp, &sp, argv[1], NULL))
483 return (TCL_ERROR);
484 api_imessage(sp, argv[2]);
486 return (TCL_OK);
490 * tcl_iscreen --
491 * Create a new screen. If a filename is specified then the screen
492 * is opened with that file.
494 * Tcl Command: viNewScreen
495 * Usage: viNewScreen screenId [file]
497 static int
498 tcl_iscreen(clientData, interp, argc, argv)
499 ClientData clientData;
500 Tcl_Interp *interp;
501 int argc;
502 char **argv;
504 SCR *sp, *nsp;
505 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
506 int rval;
508 if (argc != 2 && argc != 3) {
509 Tcl_SetResult(interp,
510 "Usage: viNewScreen screenId [file]", TCL_STATIC);
511 return (TCL_ERROR);
514 if (getscreenid(interp, &sp, argv[1], NULL))
515 return (TCL_ERROR);
516 INITMESSAGE;
517 rval = api_edit(sp, argv[2], &nsp, 1);
518 ENDMESSAGE;
520 if (rval)
521 return (TCL_ERROR);
523 (void)sprintf(interp->result, "%d", nsp->id);
524 return (TCL_OK);
528 * tcl_escreen --
529 * End a screen.
531 * Tcl Command: viEndScreen
532 * Usage: viEndScreen screenId
534 static int
535 tcl_escreen(clientData, interp, argc, argv)
536 ClientData clientData;
537 Tcl_Interp *interp;
538 int argc;
539 char **argv;
541 SCR *sp;
542 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
543 int rval;
545 if (argc != 2) {
546 Tcl_SetResult(interp,
547 "Usage: viEndScreen screenId", TCL_STATIC);
548 return (TCL_ERROR);
551 if (getscreenid(interp, &sp, argv[1], NULL))
552 return (TCL_ERROR);
553 INITMESSAGE;
554 rval = api_escreen(sp);
555 ENDMESSAGE;
557 return (rval ? TCL_ERROR : TCL_OK);
561 * tcl_swscreen --
562 * Change the current focus to screen.
564 * Tcl Command: viSwitchScreen
565 * Usage: viSwitchScreen screenId screenId
567 static int
568 tcl_swscreen(clientData, interp, argc, argv)
569 ClientData clientData;
570 Tcl_Interp *interp;
571 int argc;
572 char **argv;
574 SCR *sp, *new;
575 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
576 int rval;
578 if (argc != 3) {
579 Tcl_SetResult(interp,
580 "Usage: viSwitchScreen cur_screenId new_screenId",
581 TCL_STATIC);
582 return (TCL_ERROR);
585 if (getscreenid(interp, &sp, argv[1], NULL))
586 return (TCL_ERROR);
587 if (getscreenid(interp, &new, argv[2], NULL))
588 return (TCL_ERROR);
589 INITMESSAGE;
590 rval = api_swscreen(sp, new);
591 ENDMESSAGE;
593 return (rval ? TCL_ERROR : TCL_OK);
597 * tcl_map --
598 * Associate a key with a tcl procedure.
600 * Tcl Command: viMapKey
601 * Usage: viMapKey screenId key tclproc
603 static int
604 tcl_map(clientData, interp, argc, argv)
605 ClientData clientData;
606 Tcl_Interp *interp;
607 int argc;
608 char **argv;
610 SCR *sp;
611 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
612 int rval;
613 char command[256];
615 if (argc != 4) {
616 Tcl_SetResult(interp,
617 "Usage: viMapKey screenId key tclproc", TCL_STATIC);
618 return (TCL_ERROR);
621 if (getscreenid(interp, &sp, argv[1], NULL))
622 return (TCL_ERROR);
623 INITMESSAGE;
624 (void)snprintf(command, sizeof(command), ":tcl %s\n", argv[3]);
625 rval = api_map(sp, argv[2], command, strlen(command));
626 ENDMESSAGE;
628 return (rval ? TCL_ERROR : TCL_OK);
632 * tcl_unmap --
633 * Unmap a key.
635 * Tcl Command: viUnmapKey
636 * Usage: viUnmMapKey screenId key
638 static int
639 tcl_unmap(clientData, interp, argc, argv)
640 ClientData clientData;
641 Tcl_Interp *interp;
642 int argc;
643 char **argv;
645 SCR *sp;
646 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
647 int rval;
649 if (argc != 3) {
650 Tcl_SetResult(interp,
651 "Usage: viUnmapKey screenId key", TCL_STATIC);
652 return (TCL_ERROR);
655 if (getscreenid(interp, &sp, argv[1], NULL))
656 return (TCL_ERROR);
657 INITMESSAGE;
658 rval = api_unmap(sp, argv[2]);
659 ENDMESSAGE;
661 return (rval ? TCL_ERROR : TCL_OK);
665 * tcl_opts_set --
666 * Set an option.
668 * Tcl Command: viSetOpt
669 * Usage: viSetOpt screenId command
671 static int
672 tcl_opts_set(clientData, interp, argc, argv)
673 ClientData clientData;
674 Tcl_Interp *interp;
675 int argc;
676 char **argv;
678 SCR *sp;
679 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
680 int rval;
681 char *setting;
683 if (argc != 3) {
684 Tcl_SetResult(interp,
685 "Usage: viSetOpt screenId command", TCL_STATIC);
686 return (TCL_ERROR);
689 if (getscreenid(interp, &sp, argv[1], NULL))
690 return (TCL_ERROR);
691 INITMESSAGE;
692 /*rval = api_opts_set(sp, argv[2]);*/
693 MALLOC(sp, setting, char *, strlen(argv[2])+6);
694 strcpy(setting, ":set ");
695 strcpy(setting+5, argv[2]);
696 rval=api_run_str(sp, setting);
697 free(setting);
698 ENDMESSAGE;
700 return (rval ? TCL_ERROR : TCL_OK);
704 * tcl_opts_get --
705 Return the value of an option.
707 * Tcl Command: viGetOpt
708 * Usage: viGetOpt screenId option
710 static int
711 tcl_opts_get(clientData, interp, argc, argv)
712 ClientData clientData;
713 Tcl_Interp *interp;
714 int argc;
715 char **argv;
717 SCR *sp;
718 void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
719 int rval;
720 char *value;
722 if (argc != 3) {
723 Tcl_SetResult(interp,
724 "Usage: viGetOpt screenId option", TCL_STATIC);
725 return (TCL_ERROR);
728 if (getscreenid(interp, &sp, argv[1], NULL))
729 return (TCL_ERROR);
730 INITMESSAGE;
731 rval = api_opts_get(sp, argv[2], &value, NULL);
732 ENDMESSAGE;
733 if (rval)
734 return (TCL_ERROR);
736 Tcl_SetResult(interp, value, TCL_DYNAMIC);
737 return (TCL_OK);
741 * tcl_init --
742 * Create the TCL commands used by nvi.
744 * PUBLIC: int tcl_init __P((GS *));
747 tcl_init(gp)
748 GS *gp;
750 gp->tcl_interp = Tcl_CreateInterp();
751 if (Tcl_Init(gp->tcl_interp) == TCL_ERROR)
752 return (1);
754 #define TCC(name, function) { \
755 Tcl_CreateCommand(gp->tcl_interp, name, function, \
756 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); \
758 TCC("viAppendLine", tcl_aline);
759 TCC("viDelLine", tcl_dline);
760 TCC("viEndScreen", tcl_escreen);
761 TCC("viFindScreen", tcl_fscreen);
762 TCC("viGetCursor", tcl_getcursor);
763 TCC("viGetLine", tcl_gline);
764 TCC("viGetMark", tcl_getmark);
765 TCC("viGetOpt", tcl_opts_get);
766 TCC("viInsertLine", tcl_iline);
767 TCC("viLastLine", tcl_lline);
768 TCC("viMapKey", tcl_map);
769 TCC("viMsg", tcl_msg);
770 TCC("viNewScreen", tcl_iscreen);
771 TCC("viSetCursor", tcl_setcursor);
772 TCC("viSetLine", tcl_sline);
773 TCC("viSetMark", tcl_setmark);
774 TCC("viSetOpt", tcl_opts_set);
775 TCC("viSwitchScreen", tcl_swscreen);
776 TCC("viUnmapKey", tcl_unmap);
778 return (0);
782 * getscreenid --
783 * Get the specified screen pointer.
785 * XXX
786 * This is fatal. We can't post a message into vi that we're unable to find
787 * the screen without first finding the screen... So, this must be the first
788 * thing a Tcl routine does, and, if it fails, the last as well.
790 static int
791 getscreenid(interp, spp, id, name)
792 Tcl_Interp *interp;
793 SCR **spp;
794 char *id, *name;
796 int scr_no;
797 char buf[64];
799 if (id != NULL && getint(interp, "screen id", id, &scr_no))
800 return (1);
801 if ((*spp = api_fscreen(scr_no, name)) == NULL) {
802 (void)snprintf(buf, sizeof(buf),
803 "unknown screen id: %s", name == NULL ? id : name);
804 Tcl_SetResult(interp, buf, TCL_VOLATILE);
805 return (1);
807 return (0);
811 * getint --
812 * Get a Tcl integer.
814 * XXX
815 * This code assumes that both recno_t and size_t are larger than ints.
817 static int
818 getint(interp, msg, s, intp)
819 Tcl_Interp *interp;
820 char *msg, *s;
821 int *intp;
823 char buf[64];
825 if (Tcl_GetInt(interp, s, intp) == TCL_ERROR)
826 return (1);
827 if (*intp < 0) {
828 (void)snprintf(buf, sizeof(buf),
829 "illegal %s %s: may not be negative", msg, s);
830 Tcl_SetResult(interp, buf, TCL_VOLATILE);
831 return (1);
833 return (0);
837 * msghandler --
838 * Tcl message routine so that error messages are processed in
839 * Tcl, not in nvi.
841 static void
842 msghandler(sp, mtype, msg, len)
843 SCR *sp;
844 mtype_t mtype;
845 char *msg;
846 size_t len;
848 /* Replace the trailing <newline> with an EOS. */
849 msg[len - 1] = '\0';
851 Tcl_SetResult(sp->gp->tcl_interp, msg, TCL_VOLATILE);