Home | History | Annotate | Line # | Download | only in tcl_api
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