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