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