![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to tclhist.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Micropolis - Activity] / micropolis / src / tcl|
Return to tclhist.c CVS log | Up to [Micropolis - Activity] / micropolis / src / tcl |
1.1 ! root 1: /* ! 2: * tclHistory.c -- ! 3: * ! 4: * This module implements history as an optional addition to Tcl. ! 5: * It can be called to record commands ("events") before they are ! 6: * executed, and it provides a command that may be used to perform ! 7: * history substitutions. ! 8: * ! 9: * Copyright 1990-1991 Regents of the University of California ! 10: * Permission to use, copy, modify, and distribute this ! 11: * software and its documentation for any purpose and without ! 12: * fee is hereby granted, provided that the above copyright ! 13: * notice appear in all copies. The University of California ! 14: * makes no representations about the suitability of this ! 15: * software for any purpose. It is provided "as is" without ! 16: * express or implied warranty. ! 17: */ ! 18: ! 19: #ifndef lint ! 20: static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclHistory.c,v 1.23 91/10/28 09:11:16 ouster Exp $ SPRITE (Berkeley)"; ! 21: #endif /* not lint */ ! 22: ! 23: #include "tclint.h" ! 24: ! 25: /* ! 26: * This history stuff is mostly straightforward, except for one thing ! 27: * that makes everything very complicated. Suppose that the following ! 28: * commands get executed: ! 29: * echo foo ! 30: * history redo ! 31: * It's important that the history event recorded for the second command ! 32: * be "echo foo", not "history redo". Otherwise, if another "history redo" ! 33: * command is typed, it will result in infinite recursions on the ! 34: * "history redo" command. Thus, the actual recorded history must be ! 35: * echo foo ! 36: * echo foo ! 37: * To do this, the history command revises recorded history as part of ! 38: * its execution. In the example above, when "history redo" starts ! 39: * execution, the current event is "history redo", but the history ! 40: * command arranges for the current event to be changed to "echo foo". ! 41: * ! 42: * There are three additional complications. The first is that history ! 43: * substitution may only be part of a command, as in the following ! 44: * command sequence: ! 45: * echo foo bar ! 46: * echo [history word 3] ! 47: * In this case, the second event should be recorded as "echo bar". Only ! 48: * part of the recorded event is to be modified. Fortunately, Tcl_Eval ! 49: * helps with this by recording (in the evalFirst and evalLast fields of ! 50: * the intepreter) the location of the command being executed, so the ! 51: * history module can replace exactly the range of bytes corresponding ! 52: * to the history substitution command. ! 53: * ! 54: * The second complication is that there are two ways to revise history: ! 55: * replace a command, and replace the result of a command. Consider the ! 56: * two examples below: ! 57: * format {result is %d} $num | format {result is %d} $num ! 58: * print [history redo] | print [history word 3] ! 59: * Recorded history for these two cases should be as follows: ! 60: * format {result is %d} $num | format {result is %d} $num ! 61: * print [format {result is %d} $num] | print $num ! 62: * In the left case, the history command was replaced with another command ! 63: * to be executed (the brackets were retained), but in the case on the ! 64: * right the result of executing the history command was replaced (i.e. ! 65: * brackets were replaced too). ! 66: * ! 67: * The third complication is that there could potentially be many ! 68: * history substitutions within a single command, as in: ! 69: * echo [history word 3] [history word 2] ! 70: * There could even be nested history substitutions, as in: ! 71: * history subs abc [history word 2] ! 72: * If history revisions were made immediately during each "history" command ! 73: * invocations, it would be very difficult to produce the correct cumulative ! 74: * effect from several substitutions in the same command. To get around ! 75: * this problem, the actual history revision isn't made during the execution ! 76: * of the "history" command. Information about the changes is just recorded, ! 77: * in xxx records, and the actual changes are made during the next call to ! 78: * Tcl_RecordHistory (when we know that execution of the previous command ! 79: * has finished). ! 80: */ ! 81: ! 82: /* ! 83: * Default space allocation for command strings: ! 84: */ ! 85: ! 86: #define INITIAL_CMD_SIZE 40 ! 87: ! 88: /* ! 89: * Forward declarations for procedures defined later in this file: ! 90: */ ! 91: ! 92: static void DoRevs _ANSI_ARGS_((Interp *iPtr)); ! 93: static HistoryEvent * GetEvent _ANSI_ARGS_((Interp *iPtr, char *string)); ! 94: static char * GetWords _ANSI_ARGS_((Interp *iPtr, char *command, ! 95: char *words)); ! 96: static void InsertRev _ANSI_ARGS_((Interp *iPtr, ! 97: HistoryRev *revPtr)); ! 98: static void MakeSpace _ANSI_ARGS_((HistoryEvent *hPtr, int size)); ! 99: static void RevCommand _ANSI_ARGS_((Interp *iPtr, char *string)); ! 100: static void RevResult _ANSI_ARGS_((Interp *iPtr, char *string)); ! 101: static int SubsAndEval _ANSI_ARGS_((Interp *iPtr, char *cmd, ! 102: char *old, char *new)); ! 103: ! 104: /* ! 105: *---------------------------------------------------------------------- ! 106: * ! 107: * Tcl_InitHistory -- ! 108: * ! 109: * Initialize history-related state in an interpreter. ! 110: * ! 111: * Results: ! 112: * None. ! 113: * ! 114: * Side effects: ! 115: * History info is initialized in iPtr. ! 116: * ! 117: *---------------------------------------------------------------------- ! 118: */ ! 119: ! 120: void ! 121: Tcl_InitHistory(interp) ! 122: Tcl_Interp *interp; /* Interpreter to initialize. */ ! 123: { ! 124: register Interp *iPtr = (Interp *) interp; ! 125: int i; ! 126: ! 127: if (iPtr->numEvents != 0) { ! 128: return; ! 129: } ! 130: iPtr->numEvents = 20; ! 131: iPtr->events = (HistoryEvent *) ! 132: ckalloc((unsigned) (iPtr->numEvents * sizeof(HistoryEvent))); ! 133: for (i = 0; i < iPtr->numEvents; i++) { ! 134: iPtr->events[i].command = (char *) ckalloc(INITIAL_CMD_SIZE); ! 135: *iPtr->events[i].command = 0; ! 136: iPtr->events[i].bytesAvl = INITIAL_CMD_SIZE; ! 137: } ! 138: iPtr->curEvent = 0; ! 139: iPtr->curEventNum = 0; ! 140: Tcl_CreateCommand((Tcl_Interp *) iPtr, "history", Tcl_HistoryCmd, ! 141: (ClientData) NULL, (void (*)()) NULL); ! 142: } ! 143: ! 144: /* ! 145: *---------------------------------------------------------------------- ! 146: * ! 147: * Tcl_RecordAndEval -- ! 148: * ! 149: * This procedure adds its command argument to the current list of ! 150: * recorded events and then executes the command by calling Tcl_Eval. ! 151: * ! 152: * Results: ! 153: * The return value is a standard Tcl return value, the result of ! 154: * executing cmd. ! 155: * ! 156: * Side effects: ! 157: * The command is recorded and executed. In addition, pending history ! 158: * revisions are carried out, and information is set up to enable ! 159: * Tcl_Eval to identify history command ranges. This procedure also ! 160: * initializes history information for the interpreter, if it hasn't ! 161: * already been initialized. ! 162: * ! 163: *---------------------------------------------------------------------- ! 164: */ ! 165: ! 166: int ! 167: Tcl_RecordAndEval(interp, cmd, flags) ! 168: Tcl_Interp *interp; /* Token for interpreter in which command ! 169: * will be executed. */ ! 170: char *cmd; /* Command to record. */ ! 171: int flags; /* Additional flags to pass to Tcl_Eval. ! 172: * TCL_NO_EVAL means only record: don't ! 173: * execute command. */ ! 174: { ! 175: register Interp *iPtr = (Interp *) interp; ! 176: register HistoryEvent *eventPtr; ! 177: int length, result; ! 178: ! 179: if (iPtr->numEvents == 0) { ! 180: Tcl_InitHistory(interp); ! 181: } ! 182: DoRevs(iPtr); ! 183: ! 184: /* ! 185: * Don't record empty commands. ! 186: */ ! 187: ! 188: while (isspace(*cmd)) { ! 189: cmd++; ! 190: } ! 191: if (*cmd == '\0') { ! 192: Tcl_ResetResult(interp); ! 193: return TCL_OK; ! 194: } ! 195: ! 196: iPtr->curEventNum++; ! 197: iPtr->curEvent++; ! 198: if (iPtr->curEvent >= iPtr->numEvents) { ! 199: iPtr->curEvent = 0; ! 200: } ! 201: eventPtr = &iPtr->events[iPtr->curEvent]; ! 202: ! 203: /* ! 204: * Chop off trailing newlines before recording the command. ! 205: */ ! 206: ! 207: length = strlen(cmd); ! 208: while (cmd[length-1] == '\n') { ! 209: length--; ! 210: } ! 211: MakeSpace(eventPtr, length + 1); ! 212: strncpy(eventPtr->command, cmd, length); ! 213: eventPtr->command[length] = 0; ! 214: ! 215: /* ! 216: * Execute the command. Note: history revision isn't possible after ! 217: * a nested call to this procedure, because the event at the top of ! 218: * the history list no longer corresponds to what's going on when ! 219: * a nested call here returns. Thus, must leave history revision ! 220: * disabled when we return. ! 221: */ ! 222: ! 223: result = TCL_OK; ! 224: if (flags != TCL_NO_EVAL) { ! 225: iPtr->historyFirst = cmd; ! 226: iPtr->revDisables = 0; ! 227: result = Tcl_Eval(interp, cmd, flags | TCL_RECORD_BOUNDS, ! 228: (char **) NULL); ! 229: } ! 230: iPtr->revDisables = 1; ! 231: return result; ! 232: } ! 233: ! 234: /* ! 235: *---------------------------------------------------------------------- ! 236: * ! 237: * Tcl_HistoryCmd -- ! 238: * ! 239: * This procedure is invoked to process the "history" Tcl command. ! 240: * See the user documentation for details on what it does. ! 241: * ! 242: * Results: ! 243: * A standard Tcl result. ! 244: * ! 245: * Side effects: ! 246: * See the user documentation. ! 247: * ! 248: *---------------------------------------------------------------------- ! 249: */ ! 250: ! 251: /* ARGSUSED */ ! 252: int ! 253: Tcl_HistoryCmd(dummy, interp, argc, argv) ! 254: ClientData dummy; /* Not used. */ ! 255: Tcl_Interp *interp; /* Current interpreter. */ ! 256: int argc; /* Number of arguments. */ ! 257: char **argv; /* Argument strings. */ ! 258: { ! 259: register Interp *iPtr = (Interp *) interp; ! 260: register HistoryEvent *eventPtr; ! 261: int length; ! 262: char c; ! 263: ! 264: /* ! 265: * If no arguments, treat the same as "history info". ! 266: */ ! 267: ! 268: if (argc == 1) { ! 269: goto infoCmd; ! 270: } ! 271: ! 272: c = argv[1][0]; ! 273: length = strlen(argv[1]); ! 274: ! 275: if ((c == 'a') && (strncmp(argv[1], "add", length)) == 0) { ! 276: if ((argc != 3) && (argc != 4)) { ! 277: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], ! 278: " add event ?exec?\"", (char *) NULL); ! 279: return TCL_ERROR; ! 280: } ! 281: if (argc == 4) { ! 282: if (strncmp(argv[3], "exec", strlen(argv[3])) != 0) { ! 283: Tcl_AppendResult(interp, "bad argument \"", argv[3], ! 284: "\": should be \"exec\"", (char *) NULL); ! 285: return TCL_ERROR; ! 286: } ! 287: return Tcl_RecordAndEval(interp, argv[2], 0); ! 288: } ! 289: return Tcl_RecordAndEval(interp, argv[2], TCL_NO_EVAL); ! 290: } else if ((c == 'c') && (strncmp(argv[1], "change", length)) == 0) { ! 291: if ((argc != 3) && (argc != 4)) { ! 292: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], ! 293: " change newValue ?event?\"", (char *) NULL); ! 294: return TCL_ERROR; ! 295: } ! 296: if (argc == 3) { ! 297: eventPtr = &iPtr->events[iPtr->curEvent]; ! 298: iPtr->revDisables += 1; ! 299: while (iPtr->revPtr != NULL) { ! 300: HistoryRev *nextPtr; ! 301: ! 302: ckfree(iPtr->revPtr->newBytes); ! 303: nextPtr = iPtr->revPtr->nextPtr; ! 304: ckfree((char *) iPtr->revPtr); ! 305: iPtr->revPtr = nextPtr; ! 306: } ! 307: } else { ! 308: eventPtr = GetEvent(iPtr, argv[3]); ! 309: if (eventPtr == NULL) { ! 310: return TCL_ERROR; ! 311: } ! 312: } ! 313: MakeSpace(eventPtr, strlen(argv[2]) + 1); ! 314: strcpy(eventPtr->command, argv[2]); ! 315: return TCL_OK; ! 316: } else if ((c == 'e') && (strncmp(argv[1], "event", length)) == 0) { ! 317: if (argc > 3) { ! 318: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], ! 319: " event ?event?\"", (char *) NULL); ! 320: return TCL_ERROR; ! 321: } ! 322: eventPtr = GetEvent(iPtr, argc==2 ? "-1" : argv[2]); ! 323: if (eventPtr == NULL) { ! 324: return TCL_ERROR; ! 325: } ! 326: RevResult(iPtr, eventPtr->command); ! 327: Tcl_SetResult(interp, eventPtr->command, TCL_VOLATILE); ! 328: return TCL_OK; ! 329: } else if ((c == 'i') && (strncmp(argv[1], "info", length)) == 0) { ! 330: int count, indx, i; ! 331: char *newline; ! 332: ! 333: if ((argc != 2) && (argc != 3)) { ! 334: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], ! 335: " info ?count?\"", (char *) NULL); ! 336: return TCL_ERROR; ! 337: } ! 338: infoCmd: ! 339: if (argc == 3) { ! 340: if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) { ! 341: return TCL_ERROR; ! 342: } ! 343: if (count > iPtr->numEvents) { ! 344: count = iPtr->numEvents; ! 345: } ! 346: } else { ! 347: count = iPtr->numEvents; ! 348: } ! 349: newline = ""; ! 350: for (i = 0, indx = iPtr->curEvent + 1 + iPtr->numEvents - count; ! 351: i < count; i++, indx++) { ! 352: char *cur, *next, savedChar; ! 353: char serial[20]; ! 354: ! 355: if (indx >= iPtr->numEvents) { ! 356: indx -= iPtr->numEvents; ! 357: } ! 358: cur = iPtr->events[indx].command; ! 359: if (*cur == '\0') { ! 360: continue; /* No command recorded here. */ ! 361: } ! 362: sprintf(serial, "%6d ", iPtr->curEventNum + 1 - (count - i)); ! 363: Tcl_AppendResult(interp, newline, serial, (char *) NULL); ! 364: newline = "\n"; ! 365: ! 366: /* ! 367: * Tricky formatting here: for multi-line commands, indent ! 368: * the continuation lines. ! 369: */ ! 370: ! 371: while (1) { ! 372: next = strchr(cur, '\n'); ! 373: if (next == NULL) { ! 374: break; ! 375: } ! 376: next++; ! 377: savedChar = *next; ! 378: *next = 0; ! 379: Tcl_AppendResult(interp, cur, "\t", (char *) NULL); ! 380: *next = savedChar; ! 381: cur = next; ! 382: } ! 383: Tcl_AppendResult(interp, cur, (char *) NULL); ! 384: } ! 385: return TCL_OK; ! 386: } else if ((c == 'k') && (strncmp(argv[1], "keep", length)) == 0) { ! 387: int count, i, src; ! 388: HistoryEvent *events; ! 389: ! 390: if (argc != 3) { ! 391: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], ! 392: " keep number\"", (char *) NULL); ! 393: return TCL_ERROR; ! 394: } ! 395: if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) { ! 396: return TCL_ERROR; ! 397: } ! 398: if ((count <= 0) || (count > 1000)) { ! 399: Tcl_AppendResult(interp, "illegal keep count \"", argv[2], ! 400: "\"", (char *) NULL); ! 401: return TCL_ERROR; ! 402: } ! 403: ! 404: /* ! 405: * Create a new history array and copy as much existing history ! 406: * as possible from the old array. ! 407: */ ! 408: ! 409: events = (HistoryEvent *) ! 410: ckalloc((unsigned) (count * sizeof(HistoryEvent))); ! 411: if (count < iPtr->numEvents) { ! 412: src = iPtr->curEvent + 1 - count; ! 413: if (src < 0) { ! 414: src += iPtr->numEvents; ! 415: } ! 416: } else { ! 417: src = iPtr->curEvent + 1; ! 418: } ! 419: for (i = 0; i < count; i++, src++) { ! 420: if (src >= iPtr->numEvents) { ! 421: src = 0; ! 422: } ! 423: if (i < iPtr->numEvents) { ! 424: events[i] = iPtr->events[src]; ! 425: iPtr->events[src].command = NULL; ! 426: } else { ! 427: events[i].command = (char *) ckalloc(INITIAL_CMD_SIZE); ! 428: events[i].command[0] = 0; ! 429: events[i].bytesAvl = INITIAL_CMD_SIZE; ! 430: } ! 431: } ! 432: ! 433: /* ! 434: * Throw away everything left in the old history array, and ! 435: * substitute the new one for the old one. ! 436: */ ! 437: ! 438: for (i = 0; i < iPtr->numEvents; i++) { ! 439: if (iPtr->events[i].command != NULL) { ! 440: ckfree(iPtr->events[i].command); ! 441: } ! 442: } ! 443: ckfree((char *) iPtr->events); ! 444: iPtr->events = events; ! 445: if (count < iPtr->numEvents) { ! 446: iPtr->curEvent = count-1; ! 447: } else { ! 448: iPtr->curEvent = iPtr->numEvents-1; ! 449: } ! 450: iPtr->numEvents = count; ! 451: return TCL_OK; ! 452: } else if ((c == 'n') && (strncmp(argv[1], "nextid", length)) == 0) { ! 453: if (argc != 2) { ! 454: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], ! 455: " nextid\"", (char *) NULL); ! 456: return TCL_ERROR; ! 457: } ! 458: sprintf(iPtr->result, "%d", iPtr->curEventNum+1); ! 459: return TCL_OK; ! 460: } else if ((c == 'r') && (strncmp(argv[1], "redo", length)) == 0) { ! 461: if (argc > 3) { ! 462: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], ! 463: " redo ?event?\"", (char *) NULL); ! 464: return TCL_ERROR; ! 465: } ! 466: eventPtr = GetEvent(iPtr, argc==2 ? "-1" : argv[2]); ! 467: if (eventPtr == NULL) { ! 468: return TCL_ERROR; ! 469: } ! 470: RevCommand(iPtr, eventPtr->command); ! 471: return Tcl_Eval(interp, eventPtr->command, 0, (char **) NULL); ! 472: } else if ((c == 's') && (strncmp(argv[1], "substitute", length)) == 0) { ! 473: if ((argc > 5) || (argc < 4)) { ! 474: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], ! 475: " substitute old new ?event?\"", (char *) NULL); ! 476: return TCL_ERROR; ! 477: } ! 478: eventPtr = GetEvent(iPtr, argc==4 ? "-1" : argv[4]); ! 479: if (eventPtr == NULL) { ! 480: return TCL_ERROR; ! 481: } ! 482: return SubsAndEval(iPtr, eventPtr->command, argv[2], argv[3]); ! 483: } else if ((c == 'w') && (strncmp(argv[1], "words", length)) == 0) { ! 484: char *words; ! 485: ! 486: if ((argc != 3) && (argc != 4)) { ! 487: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], ! 488: " words num-num/pat ?event?\"", (char *) NULL); ! 489: return TCL_ERROR; ! 490: } ! 491: eventPtr = GetEvent(iPtr, argc==3 ? "-1" : argv[3]); ! 492: if (eventPtr == NULL) { ! 493: return TCL_ERROR; ! 494: } ! 495: words = GetWords(iPtr, eventPtr->command, argv[2]); ! 496: if (words == NULL) { ! 497: return TCL_ERROR; ! 498: } ! 499: RevResult(iPtr, words); ! 500: iPtr->result = words; ! 501: iPtr->freeProc = (Tcl_FreeProc *) free; ! 502: return TCL_OK; ! 503: } ! 504: ! 505: Tcl_AppendResult(interp, "bad option \"", argv[1], ! 506: "\": must be add, change, event, info, keep, nextid, ", ! 507: "redo, substitute, or words", (char *) NULL); ! 508: return TCL_ERROR; ! 509: } ! 510: ! 511: /* ! 512: *---------------------------------------------------------------------- ! 513: * ! 514: * MakeSpace -- ! 515: * ! 516: * Given a history event, make sure it has enough space for ! 517: * a string of a given length (enlarge the string area if ! 518: * necessary). ! 519: * ! 520: * Results: ! 521: * None. ! 522: * ! 523: * Side effects: ! 524: * More memory may get allocated. ! 525: * ! 526: *---------------------------------------------------------------------- ! 527: */ ! 528: ! 529: static void ! 530: MakeSpace(hPtr, size) ! 531: HistoryEvent *hPtr; ! 532: int size; /* # of bytes needed in hPtr. */ ! 533: { ! 534: if (hPtr->bytesAvl < size) { ! 535: ckfree(hPtr->command); ! 536: hPtr->command = (char *) ckalloc((unsigned) size); ! 537: hPtr->bytesAvl = size; ! 538: } ! 539: } ! 540: ! 541: /* ! 542: *---------------------------------------------------------------------- ! 543: * ! 544: * InsertRev -- ! 545: * ! 546: * Add a new revision to the list of those pending for iPtr. ! 547: * Do it in a way that keeps the revision list sorted in ! 548: * increasing order of firstIndex. Also, eliminate revisions ! 549: * that are subsets of other revisions. ! 550: * ! 551: * Results: ! 552: * None. ! 553: * ! 554: * Side effects: ! 555: * RevPtr is added to iPtr's revision list. ! 556: * ! 557: *---------------------------------------------------------------------- ! 558: */ ! 559: ! 560: static void ! 561: InsertRev(iPtr, revPtr) ! 562: Interp *iPtr; /* Interpreter to use. */ ! 563: register HistoryRev *revPtr; /* Revision to add to iPtr's list. */ ! 564: { ! 565: register HistoryRev *curPtr; ! 566: register HistoryRev *prevPtr; ! 567: ! 568: for (curPtr = iPtr->revPtr, prevPtr = NULL; curPtr != NULL; ! 569: prevPtr = curPtr, curPtr = curPtr->nextPtr) { ! 570: /* ! 571: * If this revision includes the new one (or vice versa) then ! 572: * just eliminate the one that is a subset of the other. ! 573: */ ! 574: ! 575: if ((revPtr->firstIndex <= curPtr->firstIndex) ! 576: && (revPtr->lastIndex >= curPtr->firstIndex)) { ! 577: curPtr->firstIndex = revPtr->firstIndex; ! 578: curPtr->lastIndex = revPtr->lastIndex; ! 579: curPtr->newSize = revPtr->newSize; ! 580: ckfree(curPtr->newBytes); ! 581: curPtr->newBytes = revPtr->newBytes; ! 582: ckfree((char *) revPtr); ! 583: return; ! 584: } ! 585: if ((revPtr->firstIndex >= curPtr->firstIndex) ! 586: && (revPtr->lastIndex <= curPtr->lastIndex)) { ! 587: ckfree(revPtr->newBytes); ! 588: ckfree((char *) revPtr); ! 589: return; ! 590: } ! 591: ! 592: if (revPtr->firstIndex < curPtr->firstIndex) { ! 593: break; ! 594: } ! 595: } ! 596: ! 597: /* ! 598: * Insert revPtr just after prevPtr. ! 599: */ ! 600: ! 601: if (prevPtr == NULL) { ! 602: revPtr->nextPtr = iPtr->revPtr; ! 603: iPtr->revPtr = revPtr; ! 604: } else { ! 605: revPtr->nextPtr = prevPtr->nextPtr; ! 606: prevPtr->nextPtr = revPtr; ! 607: } ! 608: } ! 609: ! 610: /* ! 611: *---------------------------------------------------------------------- ! 612: * ! 613: * RevCommand -- ! 614: * ! 615: * This procedure is invoked by the "history" command to record ! 616: * a command revision. See the comments at the beginning of the ! 617: * file for more information about revisions. ! 618: * ! 619: * Results: ! 620: * None. ! 621: * ! 622: * Side effects: ! 623: * Revision information is recorded. ! 624: * ! 625: *---------------------------------------------------------------------- ! 626: */ ! 627: ! 628: static void ! 629: RevCommand(iPtr, string) ! 630: register Interp *iPtr; /* Interpreter in which to perform the ! 631: * substitution. */ ! 632: char *string; /* String to substitute. */ ! 633: { ! 634: register HistoryRev *revPtr; ! 635: ! 636: if ((iPtr->evalFirst == NULL) || (iPtr->revDisables > 0)) { ! 637: return; ! 638: } ! 639: revPtr = (HistoryRev *) ckalloc(sizeof(HistoryRev)); ! 640: revPtr->firstIndex = iPtr->evalFirst - iPtr->historyFirst; ! 641: revPtr->lastIndex = iPtr->evalLast - iPtr->historyFirst; ! 642: revPtr->newSize = strlen(string); ! 643: revPtr->newBytes = (char *) ckalloc((unsigned) (revPtr->newSize+1)); ! 644: strcpy(revPtr->newBytes, string); ! 645: InsertRev(iPtr, revPtr); ! 646: } ! 647: ! 648: /* ! 649: *---------------------------------------------------------------------- ! 650: * ! 651: * RevResult -- ! 652: * ! 653: * This procedure is invoked by the "history" command to record ! 654: * a result revision. See the comments at the beginning of the ! 655: * file for more information about revisions. ! 656: * ! 657: * Results: ! 658: * None. ! 659: * ! 660: * Side effects: ! 661: * Revision information is recorded. ! 662: * ! 663: *---------------------------------------------------------------------- ! 664: */ ! 665: ! 666: static void ! 667: RevResult(iPtr, string) ! 668: register Interp *iPtr; /* Interpreter in which to perform the ! 669: * substitution. */ ! 670: char *string; /* String to substitute. */ ! 671: { ! 672: register HistoryRev *revPtr; ! 673: char *evalFirst, *evalLast; ! 674: char *argv[2]; ! 675: ! 676: if ((iPtr->evalFirst == NULL) || (iPtr->revDisables > 0)) { ! 677: return; ! 678: } ! 679: ! 680: /* ! 681: * Expand the replacement range to include the brackets that surround ! 682: * the command. If there aren't any brackets (i.e. this command was ! 683: * invoked at top-level) then don't do any revision. Also, if there ! 684: * are several commands in brackets, of which this is just one, ! 685: * then don't do any revision. ! 686: */ ! 687: ! 688: evalFirst = iPtr->evalFirst; ! 689: evalLast = iPtr->evalLast + 1; ! 690: while (1) { ! 691: if (evalFirst == iPtr->historyFirst) { ! 692: return; ! 693: } ! 694: evalFirst--; ! 695: if (*evalFirst == '[') { ! 696: break; ! 697: } ! 698: if (!isspace(*evalFirst)) { ! 699: return; ! 700: } ! 701: } ! 702: if (*evalLast != ']') { ! 703: return; ! 704: } ! 705: ! 706: revPtr = (HistoryRev *) ckalloc(sizeof(HistoryRev)); ! 707: revPtr->firstIndex = evalFirst - iPtr->historyFirst; ! 708: revPtr->lastIndex = evalLast - iPtr->historyFirst; ! 709: argv[0] = string; ! 710: revPtr->newBytes = Tcl_Merge(1, argv); ! 711: revPtr->newSize = strlen(revPtr->newBytes); ! 712: InsertRev(iPtr, revPtr); ! 713: } ! 714: ! 715: /* ! 716: *---------------------------------------------------------------------- ! 717: * ! 718: * DoRevs -- ! 719: * ! 720: * This procedure is called to apply the history revisions that ! 721: * have been recorded in iPtr. ! 722: * ! 723: * Results: ! 724: * None. ! 725: * ! 726: * Side effects: ! 727: * The most recent entry in the history for iPtr may be modified. ! 728: * ! 729: *---------------------------------------------------------------------- ! 730: */ ! 731: ! 732: static void ! 733: DoRevs(iPtr) ! 734: register Interp *iPtr; /* Interpreter whose history is to ! 735: * be modified. */ ! 736: { ! 737: register HistoryRev *revPtr; ! 738: register HistoryEvent *eventPtr; ! 739: char *newCommand, *p; ! 740: unsigned int size; ! 741: int bytesSeen, count; ! 742: ! 743: if (iPtr->revPtr == NULL) { ! 744: return; ! 745: } ! 746: ! 747: /* ! 748: * The revision is done in two passes. The first pass computes the ! 749: * amount of space needed for the revised event, and the second pass ! 750: * pieces together the new event and frees up the revisions. ! 751: */ ! 752: ! 753: eventPtr = &iPtr->events[iPtr->curEvent]; ! 754: size = strlen(eventPtr->command) + 1; ! 755: for (revPtr = iPtr->revPtr; revPtr != NULL; revPtr = revPtr->nextPtr) { ! 756: size -= revPtr->lastIndex + 1 - revPtr->firstIndex; ! 757: size += revPtr->newSize; ! 758: } ! 759: ! 760: newCommand = (char *) ckalloc(size); ! 761: p = newCommand; ! 762: bytesSeen = 0; ! 763: for (revPtr = iPtr->revPtr; revPtr != NULL; ) { ! 764: HistoryRev *nextPtr = revPtr->nextPtr; ! 765: ! 766: count = revPtr->firstIndex - bytesSeen; ! 767: if (count > 0) { ! 768: strncpy(p, eventPtr->command + bytesSeen, count); ! 769: p += count; ! 770: } ! 771: strncpy(p, revPtr->newBytes, revPtr->newSize); ! 772: p += revPtr->newSize; ! 773: bytesSeen = revPtr->lastIndex+1; ! 774: ckfree(revPtr->newBytes); ! 775: ckfree((char *) revPtr); ! 776: revPtr = nextPtr; ! 777: } ! 778: if (&p[strlen(&eventPtr->command[bytesSeen]) + 1] > ! 779: &newCommand[size]) { ! 780: printf("Assertion failed!\n"); ! 781: } ! 782: strcpy(p, eventPtr->command + bytesSeen); ! 783: ! 784: /* ! 785: * Replace the command in the event. ! 786: */ ! 787: ! 788: ckfree(eventPtr->command); ! 789: eventPtr->command = newCommand; ! 790: eventPtr->bytesAvl = size; ! 791: iPtr->revPtr = NULL; ! 792: } ! 793: ! 794: /* ! 795: *---------------------------------------------------------------------- ! 796: * ! 797: * GetEvent -- ! 798: * ! 799: * Given a textual description of an event (see the manual page ! 800: * for legal values) find the corresponding event and return its ! 801: * command string. ! 802: * ! 803: * Results: ! 804: * The return value is a pointer to the event named by "string". ! 805: * If no such event exists, then NULL is returned and an error ! 806: * message is left in iPtr. ! 807: * ! 808: * Side effects: ! 809: * None. ! 810: * ! 811: *---------------------------------------------------------------------- ! 812: */ ! 813: ! 814: static HistoryEvent * ! 815: GetEvent(iPtr, string) ! 816: register Interp *iPtr; /* Interpreter in which to look. */ ! 817: char *string; /* Description of event. */ ! 818: { ! 819: int eventNum, index; ! 820: register HistoryEvent *eventPtr; ! 821: int length; ! 822: ! 823: /* ! 824: * First check for a numeric specification of an event. ! 825: */ ! 826: ! 827: if (isdigit(*string) || (*string == '-')) { ! 828: if (Tcl_GetInt((Tcl_Interp *) iPtr, string, &eventNum) != TCL_OK) { ! 829: return NULL; ! 830: } ! 831: if (eventNum < 0) { ! 832: eventNum += iPtr->curEventNum; ! 833: } ! 834: if (eventNum > iPtr->curEventNum) { ! 835: Tcl_AppendResult((Tcl_Interp *) iPtr, "event \"", string, ! 836: "\" hasn't occurred yet", (char *) NULL); ! 837: return NULL; ! 838: } ! 839: if ((eventNum <= iPtr->curEventNum-iPtr->numEvents) ! 840: || (eventNum <= 0)) { ! 841: Tcl_AppendResult((Tcl_Interp *) iPtr, "event \"", string, ! 842: "\" is too far in the past", (char *) NULL); ! 843: return NULL; ! 844: } ! 845: index = iPtr->curEvent + (eventNum - iPtr->curEventNum); ! 846: if (index < 0) { ! 847: index += iPtr->numEvents; ! 848: } ! 849: return &iPtr->events[index]; ! 850: } ! 851: ! 852: /* ! 853: * Next, check for an event that contains the string as a prefix or ! 854: * that matches the string in the sense of Tcl_StringMatch. ! 855: */ ! 856: ! 857: length = strlen(string); ! 858: for (index = iPtr->curEvent - 1; ; index--) { ! 859: if (index < 0) { ! 860: index += iPtr->numEvents; ! 861: } ! 862: if (index == iPtr->curEvent) { ! 863: break; ! 864: } ! 865: eventPtr = &iPtr->events[index]; ! 866: if ((strncmp(eventPtr->command, string, length) == 0) ! 867: || Tcl_StringMatch(eventPtr->command, string)) { ! 868: return eventPtr; ! 869: } ! 870: } ! 871: ! 872: Tcl_AppendResult((Tcl_Interp *) iPtr, "no event matches \"", string, ! 873: "\"", (char *) NULL); ! 874: return NULL; ! 875: } ! 876: ! 877: /* ! 878: *---------------------------------------------------------------------- ! 879: * ! 880: * SubsAndEval -- ! 881: * ! 882: * Generate a new command by making a textual substitution in ! 883: * the "cmd" argument. Then execute the new command. ! 884: * ! 885: * Results: ! 886: * The return value is a standard Tcl error. ! 887: * ! 888: * Side effects: ! 889: * History gets revised if the substitution is occurring on ! 890: * a recorded command line. Also, the re-executed command ! 891: * may produce side-effects. ! 892: * ! 893: *---------------------------------------------------------------------- ! 894: */ ! 895: ! 896: static int ! 897: SubsAndEval(iPtr, cmd, old, new) ! 898: register Interp *iPtr; /* Interpreter in which to execute ! 899: * new command. */ ! 900: char *cmd; /* Command in which to substitute. */ ! 901: char *old; /* String to search for in command. */ ! 902: char *new; /* Replacement string for "old". */ ! 903: { ! 904: char *src, *dst, *newCmd; ! 905: int count, oldLength, newLength, length, result; ! 906: ! 907: /* ! 908: * Figure out how much space it will take to hold the ! 909: * substituted command (and complain if the old string ! 910: * doesn't appear in the original command). ! 911: */ ! 912: ! 913: oldLength = strlen(old); ! 914: newLength = strlen(new); ! 915: src = cmd; ! 916: count = 0; ! 917: while (1) { ! 918: src = strstr(src, old); ! 919: if (src == NULL) { ! 920: break; ! 921: } ! 922: src += oldLength; ! 923: count++; ! 924: } ! 925: if (count == 0) { ! 926: Tcl_AppendResult((Tcl_Interp *) iPtr, "\"", old, ! 927: "\" doesn't appear in event", (char *) NULL); ! 928: return TCL_ERROR; ! 929: } ! 930: length = strlen(cmd) + count*(newLength - oldLength); ! 931: ! 932: /* ! 933: * Generate a substituted command. ! 934: */ ! 935: ! 936: newCmd = (char *) ckalloc((unsigned) (length + 1)); ! 937: dst = newCmd; ! 938: while (1) { ! 939: src = strstr(cmd, old); ! 940: if (src == NULL) { ! 941: strcpy(dst, cmd); ! 942: break; ! 943: } ! 944: strncpy(dst, cmd, src-cmd); ! 945: dst += src-cmd; ! 946: strcpy(dst, new); ! 947: dst += newLength; ! 948: cmd = src + oldLength; ! 949: } ! 950: ! 951: RevCommand(iPtr, newCmd); ! 952: result = Tcl_Eval((Tcl_Interp *) iPtr, newCmd, 0, (char **) NULL); ! 953: ckfree(newCmd); ! 954: return result; ! 955: } ! 956: ! 957: /* ! 958: *---------------------------------------------------------------------- ! 959: * ! 960: * GetWords -- ! 961: * ! 962: * Given a command string, return one or more words from the ! 963: * command string. ! 964: * ! 965: * Results: ! 966: * The return value is a pointer to a dynamically-allocated ! 967: * string containing the words of command specified by "words". ! 968: * If the word specifier has improper syntax then an error ! 969: * message is placed in iPtr->result and NULL is returned. ! 970: * ! 971: * Side effects: ! 972: * Memory is allocated. It is the caller's responsibilty to ! 973: * free the returned string.. ! 974: * ! 975: *---------------------------------------------------------------------- ! 976: */ ! 977: ! 978: static char * ! 979: GetWords(iPtr, command, words) ! 980: register Interp *iPtr; /* Tcl interpreter in which to place ! 981: * an error message if needed. */ ! 982: char *command; /* Command string. */ ! 983: char *words; /* Description of which words to extract ! 984: * from the command. Either num[-num] or ! 985: * a pattern. */ ! 986: { ! 987: char *result; ! 988: char *start, *end, *dst; ! 989: register char *next; ! 990: int first; /* First word desired. -1 means last word ! 991: * only. */ ! 992: int last; /* Last word desired. -1 means use everything ! 993: * up to the end. */ ! 994: int index; /* Index of current word. */ ! 995: char *pattern; ! 996: ! 997: /* ! 998: * Figure out whether we're looking for a numerical range or for ! 999: * a pattern. ! 1000: */ ! 1001: ! 1002: pattern = NULL; ! 1003: first = 0; ! 1004: last = -1; ! 1005: if (*words == '$') { ! 1006: if (words[1] != '\0') { ! 1007: goto error; ! 1008: } ! 1009: first = -1; ! 1010: } else if (isdigit(*words)) { ! 1011: first = strtoul(words, &start, 0); ! 1012: if (*start == 0) { ! 1013: last = first; ! 1014: } else if (*start == '-') { ! 1015: start++; ! 1016: if (*start == '$') { ! 1017: start++; ! 1018: } else if (isdigit(*start)) { ! 1019: last = strtoul(start, &start, 0); ! 1020: } else { ! 1021: goto error; ! 1022: } ! 1023: if (*start != 0) { ! 1024: goto error; ! 1025: } ! 1026: } ! 1027: if ((first > last) && (last != -1)) { ! 1028: goto error; ! 1029: } ! 1030: } else { ! 1031: pattern = words; ! 1032: } ! 1033: ! 1034: /* ! 1035: * Scan through the words one at a time, copying those that are ! 1036: * relevant into the result string. Allocate a result area large ! 1037: * enough to hold all the words if necessary. ! 1038: */ ! 1039: ! 1040: result = (char *) ckalloc((unsigned) (strlen(command) + 1)); ! 1041: dst = result; ! 1042: for (next = command; isspace(*next); next++) { ! 1043: /* Empty loop body: just find start of first word. */ ! 1044: } ! 1045: for (index = 0; *next != 0; index++) { ! 1046: start = next; ! 1047: end = TclWordEnd(next, 0); ! 1048: for (next = end; isspace(*next); next++) { ! 1049: /* Empty loop body: just find start of next word. */ ! 1050: } ! 1051: if ((first > index) || ((first == -1) && (*next != 0))) { ! 1052: continue; ! 1053: } ! 1054: if ((last != -1) && (last < index)) { ! 1055: continue; ! 1056: } ! 1057: if (pattern != NULL) { ! 1058: int match; ! 1059: char savedChar = *end; ! 1060: ! 1061: *end = 0; ! 1062: match = Tcl_StringMatch(start, pattern); ! 1063: *end = savedChar; ! 1064: if (!match) { ! 1065: continue; ! 1066: } ! 1067: } ! 1068: if (dst != result) { ! 1069: *dst = ' '; ! 1070: dst++; ! 1071: } ! 1072: strncpy(dst, start, (end-start)); ! 1073: dst += end-start; ! 1074: } ! 1075: *dst = 0; ! 1076: ! 1077: /* ! 1078: * Check for an out-of-range argument index. ! 1079: */ ! 1080: ! 1081: if ((last >= index) || (first >= index)) { ! 1082: ckfree(result); ! 1083: Tcl_AppendResult((Tcl_Interp *) iPtr, "word selector \"", words, ! 1084: "\" specified non-existent words", (char *) NULL); ! 1085: return NULL; ! 1086: } ! 1087: return result; ! 1088: ! 1089: error: ! 1090: Tcl_AppendResult((Tcl_Interp *) iPtr, "bad word selector \"", words, ! 1091: "\": should be num-num or pattern", (char *) NULL); ! 1092: return NULL; ! 1093: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.