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.
7 * George V. Neville-Neil. All rights reserved.
9 * See the LICENSE file for redistribution information.
15 static const char sccsid
[] = "@(#)tcl.c 8.16 (Berkeley) 10/16/96";
18 #include <sys/types.h>
19 #include <sys/queue.h>
22 #include <bitstring.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 */
44 * Macros to point messages at the Tcl message handler.
47 scr_msg = __global_list->scr_msg; \
48 __global_list->scr_msg = msghandler;
50 __global_list->scr_msg = scr_msg;
54 * Return the screen id associated with file name.
56 * Tcl Command: viFindScreen
57 * Usage: viFindScreen file
60 tcl_fscreen(clientData
, interp
, argc
, argv
)
61 ClientData clientData
;
69 Tcl_SetResult(interp
, "Usage: viFindScreen file", TCL_STATIC
);
73 if (getscreenid(interp
, &sp
, NULL
, argv
[1]))
76 (void)sprintf(interp
->result
, "%d", sp
->id
);
82 * -- Append the string text after the line in lineNumber.
84 * Tcl Command: viAppendLine
85 * Usage: viAppendLine screenId lineNumber text
88 tcl_aline(clientData
, interp
, argc
, argv
)
89 ClientData clientData
;
95 void (*scr_msg
) __P((SCR
*, mtype_t
, char *, size_t));
100 "Usage: viAppendLine screenId lineNumber text", TCL_STATIC
);
104 if (getscreenid(interp
, &sp
, argv
[1], NULL
) ||
105 getint(interp
, "line number", argv
[2], &lno
))
108 rval
= api_aline(sp
, (recno_t
)lno
, argv
[3], strlen(argv
[3]));
111 return (rval
? TCL_ERROR
: TCL_OK
);
118 * Tcl Command: viDelLine
119 * Usage: viDelLine screenId lineNum
122 tcl_dline(clientData
, interp
, argc
, argv
)
123 ClientData clientData
;
129 void (*scr_msg
) __P((SCR
*, mtype_t
, char *, size_t));
133 Tcl_SetResult(interp
,
134 "Usage: viDelLine screenId lineNumber", TCL_STATIC
);
138 if (getscreenid(interp
, &sp
, argv
[1], NULL
) ||
139 getint(interp
, "line number", argv
[2], &lno
))
142 rval
= api_dline(sp
, (recno_t
)lno
);
145 return (rval
? TCL_ERROR
: TCL_OK
);
152 * Tcl Command: viGetLine
153 * Usage: viGetLine screenId lineNumber
156 tcl_gline(clientData
, interp
, argc
, argv
)
157 ClientData clientData
;
164 void (*scr_msg
) __P((SCR
*, mtype_t
, char *, size_t));
169 Tcl_SetResult(interp
,
170 "Usage: viGetLine screenId lineNumber", TCL_STATIC
);
173 if (getscreenid(interp
, &sp
, argv
[1], NULL
) ||
174 getint(interp
, "line number", argv
[2], &lno
))
177 rval
= api_gline(sp
, (recno_t
)lno
, &p
, &len
);
183 if ((line
= malloc(len
+ 1)) == NULL
)
185 memmove(line
, p
, len
);
187 Tcl_SetResult(interp
, line
, TCL_DYNAMIC
);
193 * Insert the string text after the line in lineNumber.
195 * Tcl Command: viInsertLine
196 * Usage: viInsertLine screenId lineNumber text
199 tcl_iline(clientData
, interp
, argc
, argv
)
200 ClientData clientData
;
206 void (*scr_msg
) __P((SCR
*, mtype_t
, char *, size_t));
210 Tcl_SetResult(interp
,
211 "Usage: viInsertLine screenId lineNumber text", TCL_STATIC
);
215 if (getscreenid(interp
, &sp
, argv
[1], NULL
) ||
216 getint(interp
, "line number", argv
[2], &lno
))
219 rval
= api_iline(sp
, (recno_t
)lno
, argv
[3], strlen(argv
[3]));
222 return (rval
? TCL_ERROR
: TCL_OK
);
227 * Return the last line in the screen.
229 * Tcl Command: viLastLine
230 * Usage: viLastLine screenId
233 tcl_lline(clientData
, interp
, argc
, argv
)
234 ClientData clientData
;
241 void (*scr_msg
) __P((SCR
*, mtype_t
, char *, size_t));
245 Tcl_SetResult(interp
, "Usage: viLastLine screenId", TCL_STATIC
);
249 if (getscreenid(interp
, &sp
, argv
[1], NULL
))
252 rval
= api_lline(sp
, &last
);
257 (void)sprintf(interp
->result
, "%lu", (unsigned long)last
);
263 * Set lineNumber to the text supplied.
265 * Tcl Command: viSetLine
266 * Usage: viSetLine screenId lineNumber text
269 tcl_sline(clientData
, interp
, argc
, argv
)
270 ClientData clientData
;
276 void (*scr_msg
) __P((SCR
*, mtype_t
, char *, size_t));
280 Tcl_SetResult(interp
,
281 "Usage: viSetLine screenId lineNumber text", TCL_STATIC
);
285 if (getscreenid(interp
, &sp
, argv
[1], NULL
) ||
286 getint(interp
, "line number", argv
[2], &lno
))
289 rval
= api_sline(sp
, (recno_t
)lno
, argv
[3], strlen(argv
[3]));
292 return (rval
? TCL_ERROR
: TCL_OK
);
297 * Return the mark's cursor position as a list with two elements.
300 * Tcl Command: viGetMark
301 * Usage: viGetMark screenId mark
304 tcl_getmark(clientData
, interp
, argc
, argv
)
305 ClientData clientData
;
312 void (*scr_msg
) __P((SCR
*, mtype_t
, char *, size_t));
317 Tcl_SetResult(interp
,
318 "Usage: viGetMark screenId mark", TCL_STATIC
);
322 if (getscreenid(interp
, &sp
, argv
[1], NULL
))
325 rval
= api_getmark(sp
, (int)argv
[2][0], &cursor
);
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
);
340 * Set the mark to the line and column numbers supplied.
342 * Tcl Command: viSetMark
343 * Usage: viSetMark screenId mark line column
346 tcl_setmark(clientData
, interp
, argc
, argv
)
347 ClientData clientData
;
354 void (*scr_msg
) __P((SCR
*, mtype_t
, char *, size_t));
358 Tcl_SetResult(interp
,
359 "Usage: viSetMark screenId mark line column", TCL_STATIC
);
363 if (getscreenid(interp
, &sp
, argv
[1], NULL
))
365 if (getint(interp
, "line number", argv
[3], &i
))
368 if (getint(interp
, "column number", argv
[4], &i
))
372 rval
= api_setmark(sp
, (int)argv
[2][0], &cursor
);
375 return (rval
? TCL_ERROR
: TCL_OK
);
380 * Return the current cursor position as a list with two elements.
383 * Tcl Command: viGetCursor
384 * Usage: viGetCursor screenId
387 tcl_getcursor(clientData
, interp
, argc
, argv
)
388 ClientData clientData
;
395 void (*scr_msg
) __P((SCR
*, mtype_t
, char *, size_t));
400 Tcl_SetResult(interp
,
401 "Usage: viGetCursor screenId", TCL_STATIC
);
405 if (getscreenid(interp
, &sp
, argv
[1], NULL
))
408 rval
= api_getcursor(sp
, &cursor
);
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
);
423 * Set the cursor to the line and column numbers supplied.
425 * Tcl Command: viSetCursor
426 * Usage: viSetCursor screenId line column
429 tcl_setcursor(clientData
, interp
, argc
, argv
)
430 ClientData clientData
;
437 void (*scr_msg
) __P((SCR
*, mtype_t
, char *, size_t));
441 Tcl_SetResult(interp
,
442 "Usage: viSetCursor screenId line column", TCL_STATIC
);
446 if (getscreenid(interp
, &sp
, argv
[1], NULL
))
448 if (getint(interp
, "screen id", argv
[2], &i
))
451 if (getint(interp
, "screen id", argv
[3], &i
))
455 rval
= api_setcursor(sp
, &cursor
);
458 return (rval
? TCL_ERROR
: TCL_OK
);
463 * Set the message line to text.
466 * Usage: viMsg screenId text
469 tcl_msg(clientData
, interp
, argc
, argv
)
470 ClientData clientData
;
478 Tcl_SetResult(interp
, "Usage: viMsg screenId text", TCL_STATIC
);
482 if (getscreenid(interp
, &sp
, argv
[1], NULL
))
484 api_imessage(sp
, argv
[2]);
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]
498 tcl_iscreen(clientData
, interp
, argc
, argv
)
499 ClientData clientData
;
505 void (*scr_msg
) __P((SCR
*, mtype_t
, char *, size_t));
508 if (argc
!= 2 && argc
!= 3) {
509 Tcl_SetResult(interp
,
510 "Usage: viNewScreen screenId [file]", TCL_STATIC
);
514 if (getscreenid(interp
, &sp
, argv
[1], NULL
))
517 rval
= api_edit(sp
, argv
[2], &nsp
, 1);
523 (void)sprintf(interp
->result
, "%d", nsp
->id
);
531 * Tcl Command: viEndScreen
532 * Usage: viEndScreen screenId
535 tcl_escreen(clientData
, interp
, argc
, argv
)
536 ClientData clientData
;
542 void (*scr_msg
) __P((SCR
*, mtype_t
, char *, size_t));
546 Tcl_SetResult(interp
,
547 "Usage: viEndScreen screenId", TCL_STATIC
);
551 if (getscreenid(interp
, &sp
, argv
[1], NULL
))
554 rval
= api_escreen(sp
);
557 return (rval
? TCL_ERROR
: TCL_OK
);
562 * Change the current focus to screen.
564 * Tcl Command: viSwitchScreen
565 * Usage: viSwitchScreen screenId screenId
568 tcl_swscreen(clientData
, interp
, argc
, argv
)
569 ClientData clientData
;
575 void (*scr_msg
) __P((SCR
*, mtype_t
, char *, size_t));
579 Tcl_SetResult(interp
,
580 "Usage: viSwitchScreen cur_screenId new_screenId",
585 if (getscreenid(interp
, &sp
, argv
[1], NULL
))
587 if (getscreenid(interp
, &new, argv
[2], NULL
))
590 rval
= api_swscreen(sp
, new);
593 return (rval
? TCL_ERROR
: TCL_OK
);
598 * Associate a key with a tcl procedure.
600 * Tcl Command: viMapKey
601 * Usage: viMapKey screenId key tclproc
604 tcl_map(clientData
, interp
, argc
, argv
)
605 ClientData clientData
;
611 void (*scr_msg
) __P((SCR
*, mtype_t
, char *, size_t));
616 Tcl_SetResult(interp
,
617 "Usage: viMapKey screenId key tclproc", TCL_STATIC
);
621 if (getscreenid(interp
, &sp
, argv
[1], NULL
))
624 (void)snprintf(command
, sizeof(command
), ":tcl %s\n", argv
[3]);
625 rval
= api_map(sp
, argv
[2], command
, strlen(command
));
628 return (rval
? TCL_ERROR
: TCL_OK
);
635 * Tcl Command: viUnmapKey
636 * Usage: viUnmMapKey screenId key
639 tcl_unmap(clientData
, interp
, argc
, argv
)
640 ClientData clientData
;
646 void (*scr_msg
) __P((SCR
*, mtype_t
, char *, size_t));
650 Tcl_SetResult(interp
,
651 "Usage: viUnmapKey screenId key", TCL_STATIC
);
655 if (getscreenid(interp
, &sp
, argv
[1], NULL
))
658 rval
= api_unmap(sp
, argv
[2]);
661 return (rval
? TCL_ERROR
: TCL_OK
);
668 * Tcl Command: viSetOpt
669 * Usage: viSetOpt screenId command
672 tcl_opts_set(clientData
, interp
, argc
, argv
)
673 ClientData clientData
;
679 void (*scr_msg
) __P((SCR
*, mtype_t
, char *, size_t));
684 Tcl_SetResult(interp
,
685 "Usage: viSetOpt screenId command", TCL_STATIC
);
689 if (getscreenid(interp
, &sp
, argv
[1], NULL
))
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
);
700 return (rval
? TCL_ERROR
: TCL_OK
);
705 Return the value of an option.
707 * Tcl Command: viGetOpt
708 * Usage: viGetOpt screenId option
711 tcl_opts_get(clientData
, interp
, argc
, argv
)
712 ClientData clientData
;
718 void (*scr_msg
) __P((SCR
*, mtype_t
, char *, size_t));
723 Tcl_SetResult(interp
,
724 "Usage: viGetOpt screenId option", TCL_STATIC
);
728 if (getscreenid(interp
, &sp
, argv
[1], NULL
))
731 rval
= api_opts_get(sp
, argv
[2], &value
, NULL
);
736 Tcl_SetResult(interp
, value
, TCL_DYNAMIC
);
742 * Create the TCL commands used by nvi.
744 * PUBLIC: int tcl_init __P((GS *));
750 gp
->tcl_interp
= Tcl_CreateInterp();
751 if (Tcl_Init(gp
->tcl_interp
) == TCL_ERROR
)
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
);
783 * Get the specified screen pointer.
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.
791 getscreenid(interp
, spp
, id
, name
)
799 if (id
!= NULL
&& getint(interp
, "screen id", id
, &scr_no
))
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
);
815 * This code assumes that both recno_t and size_t are larger than ints.
818 getint(interp
, msg
, s
, intp
)
825 if (Tcl_GetInt(interp
, s
, intp
) == TCL_ERROR
)
828 (void)snprintf(buf
, sizeof(buf
),
829 "illegal %s %s: may not be negative", msg
, s
);
830 Tcl_SetResult(interp
, buf
, TCL_VOLATILE
);
838 * Tcl message routine so that error messages are processed in
842 msghandler(sp
, mtype
, msg
, len
)
848 /* Replace the trailing <newline> with an EOS. */
851 Tcl_SetResult(sp
->gp
->tcl_interp
, msg
, TCL_VOLATILE
);