freebsd-skq/contrib/nvi/tcl_api/tcl.c

/*-
 * Copyright (c) 1992, 1993, 1994
 *	The Regents of the University of California.  All rights reserved.
 * Copyright (c) 1992, 1993, 1994, 1995
 *	Keith Bostic.  All rights reserved.
 * Copyright (c) 1995
 *	George V. Neville-Neil. All rights reserved.
 *
 * See the LICENSE file for redistribution information.
 */

#include "config.h"

#ifndef lint
static const char sccsid[] = "@(#)tcl.c	8.16 (Berkeley) 10/16/96";
#endif /* not lint */

#include <sys/types.h>
#include <sys/queue.h>
#include <sys/time.h>

#include <bitstring.h>
#include <errno.h>
#include <limits.h>
#include <signal.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <tcl.h>
#include <termios.h>
#include <unistd.h>

#include "../common/common.h"
#include "tcl_extern.h"

static int  getint __P((Tcl_Interp *, char *, char *, int *));
static int  getscreenid __P((Tcl_Interp *, SCR **, char *, char *));
static void msghandler __P((SCR *, mtype_t, char *, size_t));

extern GS *__global_list;			/* XXX */

/*
 * INITMESSAGE --
 *	Macros to point messages at the Tcl message handler.
 */
#define	INITMESSAGE							\
	scr_msg = __global_list->scr_msg;				\
	__global_list->scr_msg = msghandler;
#define	ENDMESSAGE							\
	__global_list->scr_msg = scr_msg;

/*
 * tcl_fscreen --
 *	Return the screen id associated with file name.
 *
 * Tcl Command: viFindScreen
 * Usage: viFindScreen file
 */
static int
tcl_fscreen(clientData, interp, argc, argv)
	ClientData clientData;
	Tcl_Interp *interp;
	int argc;
	char **argv;
{
	SCR *sp;

	if (argc != 2) {
		Tcl_SetResult(interp, "Usage: viFindScreen file", TCL_STATIC);
		return (TCL_ERROR);
	}

	if (getscreenid(interp, &sp, NULL, argv[1]))
		return (TCL_ERROR);

	(void)sprintf(interp->result, "%d", sp->id);
	return (TCL_OK);
}

/*
 * tcl_aline --
 *	-- Append the string text after the line in lineNumber.
 *
 * Tcl Command: viAppendLine
 * Usage: viAppendLine screenId lineNumber text
 */
static int
tcl_aline(clientData, interp, argc, argv)
	ClientData clientData;
	Tcl_Interp *interp;
	int argc;
	char **argv;
{
	SCR *sp;
	void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
	int lno, rval;

	if (argc != 4) {
		Tcl_SetResult(interp,
		    "Usage: viAppendLine screenId lineNumber text", TCL_STATIC);
		return (TCL_ERROR);
	}

	if (getscreenid(interp, &sp, argv[1], NULL) ||
	    getint(interp, "line number", argv[2], &lno))
		return (TCL_ERROR);
	INITMESSAGE;
	rval = api_aline(sp, (recno_t)lno, argv[3], strlen(argv[3]));
	ENDMESSAGE;

	return (rval ? TCL_ERROR : TCL_OK);
}

/*
 * tcl_dline --
 *	Delete lineNum.
 *
 * Tcl Command: viDelLine
 * Usage: viDelLine screenId lineNum
 */
static int
tcl_dline(clientData, interp, argc, argv)
	ClientData clientData;
	Tcl_Interp *interp;
	int argc;
	char **argv;
{
	SCR *sp;
	void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
	int lno, rval;

	if (argc != 3) {
		Tcl_SetResult(interp,
		    "Usage: viDelLine screenId lineNumber", TCL_STATIC);
		return (TCL_ERROR);
	}

	if (getscreenid(interp, &sp, argv[1], NULL) ||
	    getint(interp, "line number", argv[2], &lno))
		return (TCL_ERROR);
	INITMESSAGE;
	rval = api_dline(sp, (recno_t)lno);
	ENDMESSAGE;

	return (rval ? TCL_ERROR : TCL_OK);
}

/*
 * tcl_gline --
 *	Return lineNumber.
 *
 * Tcl Command: viGetLine
 * Usage: viGetLine screenId lineNumber
 */
static int
tcl_gline(clientData, interp, argc, argv)
	ClientData clientData;
	Tcl_Interp *interp;
	int argc;
	char **argv;
{
	SCR *sp;
	size_t len;
	void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
	int lno, rval;
	char *line, *p;

	if (argc != 3) {
		Tcl_SetResult(interp,
		    "Usage: viGetLine screenId lineNumber", TCL_STATIC);
		return (TCL_ERROR);
	}
	if (getscreenid(interp, &sp, argv[1], NULL) ||
	    getint(interp, "line number", argv[2], &lno))
		return (TCL_ERROR);
	INITMESSAGE;
	rval = api_gline(sp, (recno_t)lno, &p, &len);
	ENDMESSAGE;

	if (rval)
		return (TCL_ERROR);

	if ((line = malloc(len + 1)) == NULL)
		exit(1);				/* XXX */
	memmove(line, p, len);
	line[len] = '\0';
	Tcl_SetResult(interp, line, TCL_DYNAMIC);
	return (TCL_OK);
}

/*
 * tcl_iline --
 *	Insert the string text after the line in lineNumber.
 *
 * Tcl Command: viInsertLine
 * Usage: viInsertLine screenId lineNumber text
 */
static int
tcl_iline(clientData, interp, argc, argv)
	ClientData clientData;
	Tcl_Interp *interp;
	int argc;
	char **argv;
{
	SCR *sp;
	void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
	int lno, rval;

	if (argc != 4) {
		Tcl_SetResult(interp,
		    "Usage: viInsertLine screenId lineNumber text", TCL_STATIC);
		return (TCL_ERROR);
	}

	if (getscreenid(interp, &sp, argv[1], NULL) ||
	    getint(interp, "line number", argv[2], &lno))
		return (TCL_ERROR);
	INITMESSAGE;
	rval = api_iline(sp, (recno_t)lno, argv[3], strlen(argv[3]));
	ENDMESSAGE;

	return (rval ? TCL_ERROR : TCL_OK);
}

/*
 * tcl_lline --
 *	Return the last line in the screen.
 *
 * Tcl Command: viLastLine
 * Usage: viLastLine screenId
 */
static int
tcl_lline(clientData, interp, argc, argv)
	ClientData clientData;
	Tcl_Interp *interp;
	int argc;
	char **argv;
{
	SCR *sp;
	recno_t last;
	void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
	int rval;

	if (argc != 2) {
		Tcl_SetResult(interp, "Usage: viLastLine screenId", TCL_STATIC);
		return (TCL_ERROR);
	}

	if (getscreenid(interp, &sp, argv[1], NULL))
		return (TCL_ERROR);
	INITMESSAGE;
	rval = api_lline(sp, &last);
	ENDMESSAGE;
	if (rval)
		return (TCL_ERROR);

	(void)sprintf(interp->result, "%lu", (unsigned long)last);
	return (TCL_OK);
}

/*
 * tcl_sline --
 *	Set lineNumber to the text supplied.
 *
 * Tcl Command: viSetLine
 * Usage: viSetLine screenId lineNumber text
 */
static int
tcl_sline(clientData, interp, argc, argv)
	ClientData clientData;
	Tcl_Interp *interp;
	int argc;
	char **argv;
{
	SCR *sp;
	void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
	int lno, rval;

	if (argc != 4) {
		Tcl_SetResult(interp,
		    "Usage: viSetLine screenId lineNumber text", TCL_STATIC);
		return (TCL_ERROR);
	}

	if (getscreenid(interp, &sp, argv[1], NULL) ||
	    getint(interp, "line number", argv[2], &lno))
		return (TCL_ERROR);
	INITMESSAGE;
	rval = api_sline(sp, (recno_t)lno, argv[3], strlen(argv[3]));
	ENDMESSAGE;

	return (rval ? TCL_ERROR : TCL_OK);
}

/*
 * tcl_getmark --
 *	Return the mark's cursor position as a list with two elements.
 *	{line, column}.
 *
 * Tcl Command: viGetMark
 * Usage: viGetMark screenId mark
 */
static int
tcl_getmark(clientData, interp, argc, argv)
	ClientData clientData;
	Tcl_Interp *interp;
	int argc;
	char **argv;
{
	MARK cursor;
	SCR *sp;
	void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
	int rval;
	char buf[20];

	if (argc != 3) {
		Tcl_SetResult(interp,
		    "Usage: viGetMark screenId mark", TCL_STATIC);
		return (TCL_ERROR);
	}

	if (getscreenid(interp, &sp, argv[1], NULL))
		return (TCL_ERROR);
	INITMESSAGE;
	rval = api_getmark(sp, (int)argv[2][0], &cursor);
	ENDMESSAGE;

	if (rval)
		return (TCL_ERROR);

	(void)snprintf(buf, sizeof(buf), "%lu", (u_long)cursor.lno);
	Tcl_AppendElement(interp, buf);
	(void)snprintf(buf, sizeof(buf), "%lu", (u_long)cursor.cno);
	Tcl_AppendElement(interp, buf);
	return (TCL_OK);
}

/*
 * tcl_setmark --
 *	Set the mark to the line and column numbers supplied.
 *
 * Tcl Command: viSetMark
 * Usage: viSetMark screenId mark line column
 */
static int
tcl_setmark(clientData, interp, argc, argv)
	ClientData clientData;
	Tcl_Interp *interp;
	int argc;
	char **argv;
{
	MARK cursor;
	SCR *sp;
	void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
	int i, rval;

	if (argc != 5) {
		Tcl_SetResult(interp,
		    "Usage: viSetMark screenId mark line column", TCL_STATIC);
		return (TCL_ERROR);
	}

	if (getscreenid(interp, &sp, argv[1], NULL))
		return (TCL_ERROR);
	if (getint(interp, "line number", argv[3], &i))
		return (TCL_ERROR);
	cursor.lno = i;
	if (getint(interp, "column number", argv[4], &i))
		return (TCL_ERROR);
	cursor.cno = i;
	INITMESSAGE;
	rval = api_setmark(sp, (int)argv[2][0], &cursor);
	ENDMESSAGE;

	return (rval ? TCL_ERROR : TCL_OK);
}

/*
 * tcl_getcursor --
 *	Return the current cursor position as a list with two elements.
 *	{line, column}.
 *
 * Tcl Command: viGetCursor
 * Usage: viGetCursor screenId
 */
static int
tcl_getcursor(clientData, interp, argc, argv)
	ClientData clientData;
	Tcl_Interp *interp;
	int argc;
	char **argv;
{
	MARK cursor;
	SCR *sp;
	void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
	int rval;
	char buf[20];

	if (argc != 2) {
		Tcl_SetResult(interp,
		    "Usage: viGetCursor screenId", TCL_STATIC);
		return (TCL_ERROR);
	}

	if (getscreenid(interp, &sp, argv[1], NULL))
		return (TCL_ERROR);
	INITMESSAGE;
	rval = api_getcursor(sp, &cursor);
	ENDMESSAGE;

	if (rval)
		return (TCL_ERROR);

	(void)snprintf(buf, sizeof(buf), "%lu", (u_long)cursor.lno);
	Tcl_AppendElement(interp, buf);
	(void)snprintf(buf, sizeof(buf), "%lu", (u_long)cursor.cno);
	Tcl_AppendElement(interp, buf);
	return (TCL_OK);
}

/*
 * tcl_setcursor --
 *	Set the cursor to the line and column numbers supplied.
 *
 * Tcl Command: viSetCursor
 * Usage: viSetCursor screenId line column
 */
static int
tcl_setcursor(clientData, interp, argc, argv)
	ClientData clientData;
	Tcl_Interp *interp;
	int argc;
	char **argv;
{
	MARK cursor;
	SCR *sp;
	void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
	int i, rval;

	if (argc != 4) {
		Tcl_SetResult(interp,
		    "Usage: viSetCursor screenId line column", TCL_STATIC);
		return (TCL_ERROR);
	}

	if (getscreenid(interp, &sp, argv[1], NULL))
		return (TCL_ERROR);
	if (getint(interp, "screen id", argv[2], &i))
		return (TCL_ERROR);
	cursor.lno = i;
	if (getint(interp, "screen id", argv[3], &i))
		return (TCL_ERROR);
	cursor.cno = i;
	INITMESSAGE;
	rval = api_setcursor(sp, &cursor);
	ENDMESSAGE;

	return (rval ? TCL_ERROR : TCL_OK);
}

/*
 * tcl_msg --
 *	Set the message line to text.
 *
 * Tcl Command: viMsg
 * Usage: viMsg screenId text
 */
static int
tcl_msg(clientData, interp, argc, argv)
	ClientData clientData;
	Tcl_Interp *interp;
	int argc;
	char **argv;
{
	SCR *sp;

	if (argc != 3) {
		Tcl_SetResult(interp, "Usage: viMsg screenId text", TCL_STATIC);
		return (TCL_ERROR);
	}

	if (getscreenid(interp, &sp, argv[1], NULL))
		return (TCL_ERROR);
	api_imessage(sp, argv[2]);

	return (TCL_OK);
}

/*
 * tcl_iscreen --
 *	Create a new screen.  If a filename is specified then the screen
 *	is opened with that file.
 *
 * Tcl Command: viNewScreen
 * Usage: viNewScreen screenId [file]
 */
static int
tcl_iscreen(clientData, interp, argc, argv)
	ClientData clientData;
	Tcl_Interp *interp;
	int argc;
	char **argv;
{
	SCR *sp, *nsp;
	void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
	int rval;

	if (argc != 2 && argc != 3) {
		Tcl_SetResult(interp,
		    "Usage: viNewScreen screenId [file]", TCL_STATIC);
		return (TCL_ERROR);
	}

	if (getscreenid(interp, &sp, argv[1], NULL))
		return (TCL_ERROR);
	INITMESSAGE;
	rval = api_edit(sp, argv[2], &nsp, 1);
	ENDMESSAGE;

	if (rval)
		return (TCL_ERROR);

	(void)sprintf(interp->result, "%d", nsp->id);
	return (TCL_OK);
}

/*
 * tcl_escreen --
 *	End a screen.
 *
 * Tcl Command: viEndScreen
 * Usage: viEndScreen screenId
 */
static int
tcl_escreen(clientData, interp, argc, argv)
	ClientData clientData;
	Tcl_Interp *interp;
	int argc;
	char **argv;
{
	SCR *sp;
	void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
	int rval;

	if (argc != 2) {
		Tcl_SetResult(interp,
		     "Usage: viEndScreen screenId", TCL_STATIC);
		return (TCL_ERROR);
	}

	if (getscreenid(interp, &sp, argv[1], NULL))
		return (TCL_ERROR);
	INITMESSAGE;
	rval = api_escreen(sp);
	ENDMESSAGE;

	return (rval ? TCL_ERROR : TCL_OK);
}

/*
 * tcl_swscreen --
 *	Change the current focus to screen.
 *
 * Tcl Command: viSwitchScreen
 * Usage: viSwitchScreen screenId screenId
 */
static int
tcl_swscreen(clientData, interp, argc, argv)
	ClientData clientData;
	Tcl_Interp *interp;
	int argc;
	char **argv;
{
	SCR *sp, *new;
	void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
	int rval;

	if (argc != 3) {
		Tcl_SetResult(interp,
		    "Usage: viSwitchScreen cur_screenId new_screenId",
		    TCL_STATIC);
		return (TCL_ERROR);
	}

	if (getscreenid(interp, &sp, argv[1], NULL))
		return (TCL_ERROR);
	if (getscreenid(interp, &new, argv[2], NULL))
		return (TCL_ERROR);
	INITMESSAGE;
	rval = api_swscreen(sp, new);
	ENDMESSAGE;

	return (rval ? TCL_ERROR : TCL_OK);
}

/*
 * tcl_map --
 *	Associate a key with a tcl procedure.
 *
 * Tcl Command: viMapKey
 * Usage: viMapKey screenId key tclproc
 */
static int
tcl_map(clientData, interp, argc, argv)
	ClientData clientData;
	Tcl_Interp *interp;
	int argc;
	char **argv;
{
	SCR *sp;
	void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
	int rval;
	char command[256];

	if (argc != 4) {
		Tcl_SetResult(interp,
		    "Usage: viMapKey screenId key tclproc", TCL_STATIC);
		return (TCL_ERROR);
	}

	if (getscreenid(interp, &sp, argv[1], NULL))
		return (TCL_ERROR);
	INITMESSAGE;
	(void)snprintf(command, sizeof(command), ":tcl %s\n", argv[3]);
	rval = api_map(sp, argv[2], command, strlen(command));
	ENDMESSAGE;

	return (rval ? TCL_ERROR : TCL_OK);
}

/*
 * tcl_unmap --
 *	Unmap a key.
 *
 * Tcl Command: viUnmapKey
 * Usage: viUnmMapKey screenId key
 */
static int
tcl_unmap(clientData, interp, argc, argv)
	ClientData clientData;
	Tcl_Interp *interp;
	int argc;
	char **argv;
{
	SCR *sp;
	void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
	int rval;

	if (argc != 3) {
		Tcl_SetResult(interp,
		    "Usage: viUnmapKey screenId key", TCL_STATIC);
		return (TCL_ERROR);
	}

	if (getscreenid(interp, &sp, argv[1], NULL))
		return (TCL_ERROR);
	INITMESSAGE;
	rval = api_unmap(sp, argv[2]);
	ENDMESSAGE;

	return (rval ? TCL_ERROR : TCL_OK);
}

/*
 * tcl_opts_set --
 *	Set an option.
 *
 * Tcl Command: viSetOpt
 * Usage: viSetOpt screenId command
 */
static int
tcl_opts_set(clientData, interp, argc, argv)
	ClientData clientData;
	Tcl_Interp *interp;
	int argc;
	char **argv;
{
	SCR *sp;
	void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
	int rval;
	char *setting;

	if (argc != 3) {
		Tcl_SetResult(interp,
		    "Usage: viSetOpt screenId command", TCL_STATIC);
		return (TCL_ERROR);
	}

	if (getscreenid(interp, &sp, argv[1], NULL))
		return (TCL_ERROR);
	INITMESSAGE;
	/*rval = api_opts_set(sp, argv[2]);*/
	MALLOC(sp, setting, char *, strlen(argv[2])+6);
	strcpy(setting, ":set ");
	strcpy(setting+5, argv[2]);
	rval=api_run_str(sp, setting);
	free(setting);
	ENDMESSAGE;

	return (rval ? TCL_ERROR : TCL_OK);
}

/*
 * tcl_opts_get --
 	Return the value of an option.
 *	
 * Tcl Command: viGetOpt
 * Usage: viGetOpt screenId option
 */
static int
tcl_opts_get(clientData, interp, argc, argv)
	ClientData clientData;
	Tcl_Interp *interp;
	int argc;
	char **argv;
{
	SCR *sp;
	void (*scr_msg) __P((SCR *, mtype_t, char *, size_t));
	int rval;
	char *value;

	if (argc != 3) {
		Tcl_SetResult(interp,
		    "Usage: viGetOpt screenId option", TCL_STATIC);
		return (TCL_ERROR);
	}

	if (getscreenid(interp, &sp, argv[1], NULL))
		return (TCL_ERROR);
	INITMESSAGE;
	rval = api_opts_get(sp, argv[2], &value, NULL);
	ENDMESSAGE;
	if (rval)
		return (TCL_ERROR);

	Tcl_SetResult(interp, value, TCL_DYNAMIC);
	return (TCL_OK);
}

/*
 * tcl_init --
 *	Create the TCL commands used by nvi.
 *
 * PUBLIC: int tcl_init __P((GS *));
 */
int
tcl_init(gp)
	GS *gp;
{
	gp->tcl_interp = Tcl_CreateInterp();
	if (Tcl_Init(gp->tcl_interp) == TCL_ERROR)
		return (1);

#define	TCC(name, function) {						\
	Tcl_CreateCommand(gp->tcl_interp, name, function,		\
	    (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);		\
}
	TCC("viAppendLine", tcl_aline);
	TCC("viDelLine", tcl_dline);
	TCC("viEndScreen", tcl_escreen);
	TCC("viFindScreen", tcl_fscreen);
	TCC("viGetCursor", tcl_getcursor);
	TCC("viGetLine", tcl_gline);
	TCC("viGetMark", tcl_getmark);
	TCC("viGetOpt", tcl_opts_get);
	TCC("viInsertLine", tcl_iline);
	TCC("viLastLine", tcl_lline);
	TCC("viMapKey", tcl_map);
	TCC("viMsg", tcl_msg);
	TCC("viNewScreen", tcl_iscreen);
	TCC("viSetCursor", tcl_setcursor);
	TCC("viSetLine", tcl_sline);
	TCC("viSetMark", tcl_setmark);
	TCC("viSetOpt", tcl_opts_set);
	TCC("viSwitchScreen", tcl_swscreen);
	TCC("viUnmapKey", tcl_unmap);

	return (0);
}

/*
 * getscreenid --
 *	Get the specified screen pointer.
 *
 * XXX
 * This is fatal.  We can't post a message into vi that we're unable to find
 * the screen without first finding the screen... So, this must be the first
 * thing a Tcl routine does, and, if it fails, the last as well.
 */
static int 
getscreenid(interp, spp, id, name)
	Tcl_Interp *interp;
	SCR **spp;
	char *id, *name;
{
	int scr_no;
	char buf[64];

	if (id != NULL && getint(interp, "screen id", id, &scr_no))
		return (1);
	if ((*spp = api_fscreen(scr_no, name)) == NULL) {
		(void)snprintf(buf, sizeof(buf),
		    "unknown screen id: %s", name == NULL ? id : name);
		Tcl_SetResult(interp, buf, TCL_VOLATILE);
		return (1);
	}
	return (0);
}

/*
 * getint --
 *	Get a Tcl integer.
 *
 * XXX
 * This code assumes that both recno_t and size_t are larger than ints.
 */
static int
getint(interp, msg, s, intp)
	Tcl_Interp *interp;
	char *msg, *s;
	int *intp;
{
	char buf[64];

	if (Tcl_GetInt(interp, s, intp) == TCL_ERROR)
		return (1);
	if (*intp < 0) {
		(void)snprintf(buf, sizeof(buf),
		    "illegal %s %s: may not be negative", msg, s);
		Tcl_SetResult(interp, buf, TCL_VOLATILE);
		return (1);
	}
	return (0);
}

/*
 * msghandler --
 *	Tcl message routine so that error messages are processed in
 *	Tcl, not in nvi.
 */
static void
msghandler(sp, mtype, msg, len)
	SCR *sp;
	mtype_t mtype;
	char *msg;
	size_t len;
{
	/* Replace the trailing <newline> with an EOS. */
	msg[len - 1] = '\0';

	Tcl_SetResult(sp->gp->tcl_interp, msg, TCL_VOLATILE);
}