/* $NetBSD: tcl.c,v 1.1.1.2 2008/05/18 14:31:39 aymeric Exp $ */ /*- * 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[] = "Id: tcl.c,v 8.19 2001/08/24 12:17:27 skimo Exp (Berkeley) Date: 2001/08/24 12:17:27"; #endif /* not lint */ #include #include #include #include #include #include #include #include #include #include #include #include #include #include "../common/common.h" #include "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(sp) \ scr_msg = sp->wp->scr_msg; \ sp->wp->scr_msg = msghandler; #define ENDMESSAGE(sp) \ sp->wp->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(sp); rval = api_aline(sp, (db_recno_t)lno, argv[3], strlen(argv[3])); ENDMESSAGE(sp); 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(sp); rval = api_dline(sp, (db_recno_t)lno); ENDMESSAGE(sp); 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(sp); rval = api_gline(sp, (db_recno_t)lno, &p, &len); ENDMESSAGE(sp); 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(sp); rval = api_iline(sp, (db_recno_t)lno, argv[3], strlen(argv[3])); ENDMESSAGE(sp); 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; db_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(sp); rval = api_lline(sp, &last); ENDMESSAGE(sp); 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(sp); rval = api_sline(sp, (db_recno_t)lno, argv[3], strlen(argv[3])); ENDMESSAGE(sp); 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(sp); rval = api_getmark(sp, (int)argv[2][0], &cursor); ENDMESSAGE(sp); 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(sp); rval = api_setmark(sp, (int)argv[2][0], &cursor); ENDMESSAGE(sp); 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(sp); rval = api_getcursor(sp, &cursor); ENDMESSAGE(sp); 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(sp); rval = api_setcursor(sp, &cursor); ENDMESSAGE(sp); 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(sp); rval = api_edit(sp, argv[2], &nsp, 1); ENDMESSAGE(sp); 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(sp); rval = api_escreen(sp); ENDMESSAGE(sp); 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(sp); rval = api_swscreen(sp, new); ENDMESSAGE(sp); 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(sp); (void)snprintf(command, sizeof(command), ":tcl %s\n", argv[3]); rval = api_map(sp, argv[2], command, strlen(command)); ENDMESSAGE(sp); 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(sp); rval = api_unmap(sp, argv[2]); ENDMESSAGE(sp); 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(sp); /*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(sp); 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(sp); rval = api_opts_get(sp, argv[2], &value, NULL); ENDMESSAGE(sp); 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 db_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 with an EOS. */ msg[len - 1] = '\0'; Tcl_SetResult(sp->gp->tcl_interp, msg, TCL_VOLATILE); }