Attachment "regsub-code.patch" to
ticket [652953ffff]
added by
nobody
2002-12-13 04:51:56.
--- generic/tclCmdMZ.c Tue Oct 15 13:49:07 2002
+++ generic/tclCmdMZ_regsub-code.c Thu Dec 12 16:24:07 2002
@@ -525,7 +525,7 @@
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int idx, result, cflags, all, wlen, wsublen, numMatches, offset;
+ int idx, result, cflags, all, code, wlen, wsublen, numMatches, offset;
int start, end, subStart, subEnd, match;
Tcl_RegExp regExpr;
Tcl_RegExpInfo info;
@@ -533,18 +533,19 @@
Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend;
static CONST char *options[] = {
- "-all", "-nocase", "-expanded",
+ "-all", "-nocase", "-expanded", "-code",
"-line", "-linestop", "-lineanchor", "-start",
"--", NULL
};
enum options {
- REGSUB_ALL, REGSUB_NOCASE, REGSUB_EXPANDED,
+ REGSUB_ALL, REGSUB_NOCASE, REGSUB_EXPANDED, REGSUB_CODE,
REGSUB_LINE, REGSUB_LINESTOP, REGSUB_LINEANCHOR, REGSUB_START,
REGSUB_LAST
};
cflags = TCL_REG_ADVANCED;
all = 0;
+ code = 0;
offset = 0;
resultPtr = NULL;
@@ -565,6 +566,10 @@
all = 1;
break;
}
+ case REGSUB_CODE: {
+ code = 1;
+ break;
+ }
case REGSUB_NOCASE: {
cflags |= TCL_REG_NOCASE;
break;
@@ -758,55 +763,129 @@
end = info.matches[0].end;
Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, start);
- /*
- * Append the subSpec argument to the variable, making appropriate
- * substitutions. This code is a bit hairy because of the backslash
- * conventions and because the code saves up ranges of characters in
- * subSpec to reduce the number of calls to Tcl_SetVar.
- */
+ if (code) {
+ Tcl_Obj *varname, **preserved;
+ varname = Tcl_NewObj();
+ Tcl_IncrRefCount(varname);
+
+ /* Set variables from 0-n and preserve the old values */
+ preserved = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) *
+ (info.nsubs + 1));
+ for (idx = 0; idx <= info.nsubs; idx++) {
+ Tcl_SetIntObj(varname, idx);
- wsrc = wfirstChar = wsubspec;
- wend = wsubspec + wsublen;
- for (ch = *wsrc; wsrc != wend; wsrc++, ch = *wsrc) {
- if (ch == '&') {
- idx = 0;
- } else if (ch == '\\') {
- ch = wsrc[1];
- if ((ch >= '0') && (ch <= '9')) {
- idx = ch - '0';
- } else if ((ch == '\\') || (ch == '&')) {
- *wsrc = ch;
- Tcl_AppendUnicodeToObj(resultPtr, wfirstChar,
- wsrc - wfirstChar + 1);
- *wsrc = '\\';
- wfirstChar = wsrc + 2;
- wsrc++;
- continue;
+ subStart = info.matches[idx].start;
+ subEnd = info.matches[idx].end;
+
+ preserved[idx] = Tcl_ObjGetVar2(interp, varname, NULL, 0);
+ if (preserved[idx]) {
+ Tcl_IncrRefCount(preserved[idx]);
+ }
+
+ if ((subStart >= 0) && (subEnd >= 0)) {
+ Tcl_ObjSetVar2(interp, varname, NULL,
+ Tcl_NewUnicodeObj(wstring + offset + subStart,
+ subEnd - subStart), 0);
+ } else {
+ Tcl_ObjSetVar2(interp, varname, NULL, Tcl_NewObj(), 0);
+ }
+ }
+
+ /* Run the code */
+ switch (Tcl_EvalObjEx(interp, subPtr, 0)) {
+ case TCL_OK:
+ case TCL_RETURN: {
+ Tcl_AppendObjToObj(resultPtr, Tcl_GetObjResult(interp));
+ break;
+ }
+ case TCL_BREAK: {
+ /* Replace nothing, and halt -all */
+ Tcl_AppendUnicodeToObj(resultPtr, wstring + offset + start,
+ end - start);
+ all = 0;
+ break;
+ }
+ case TCL_CONTINUE: {
+ Tcl_AddErrorInfo(interp,
+ "\"continue\" cannot be invoked from \"regsub\"");
+ result = TCL_ERROR;
+ break;
+ }
+ default: {
+ result = TCL_ERROR;
+ break;
+ }
+ }
+
+ /* Restore the numeric vars */
+ for (idx = 0; idx <= info.nsubs; idx++) {
+ Tcl_SetIntObj(varname, idx);
+ if (preserved[idx]) {
+ Tcl_ObjSetVar2(interp, varname, NULL, preserved[idx], 0);
+ Tcl_DecrRefCount(preserved[idx]);
+ } else {
+ Tcl_UnsetVar(interp, Tcl_GetString(varname), 0);
+ }
+ }
+ ckfree((char *)preserved);
+
+ Tcl_DecrRefCount(varname);
+
+ if (result == TCL_ERROR) {
+ goto done;
+ }
+ } else {
+ /*
+ * Append the subSpec argument to the variable, making appropriate
+ * substitutions. This code is a bit hairy because of the backslash
+ * conventions and because the code saves up ranges of characters in
+ * subSpec to reduce the number of calls to Tcl_SetVar.
+ */
+
+ wsrc = wfirstChar = wsubspec;
+ wend = wsubspec + wsublen;
+ for (ch = *wsrc; wsrc != wend; wsrc++, ch = *wsrc) {
+ if (ch == '&') {
+ idx = 0;
+ } else if (ch == '\\') {
+ ch = wsrc[1];
+ if ((ch >= '0') && (ch <= '9')) {
+ idx = ch - '0';
+ } else if ((ch == '\\') || (ch == '&')) {
+ *wsrc = ch;
+ Tcl_AppendUnicodeToObj(resultPtr, wfirstChar,
+ wsrc - wfirstChar + 1);
+ *wsrc = '\\';
+ wfirstChar = wsrc + 2;
+ wsrc++;
+ continue;
+ } else {
+ continue;
+ }
} else {
continue;
}
- } else {
- continue;
+ if (wfirstChar != wsrc) {
+ Tcl_AppendUnicodeToObj(resultPtr, wfirstChar,
+ wsrc - wfirstChar);
+ }
+ if (idx <= info.nsubs) {
+ subStart = info.matches[idx].start;
+ subEnd = info.matches[idx].end;
+ if ((subStart >= 0) && (subEnd >= 0)) {
+ Tcl_AppendUnicodeToObj(resultPtr,
+ wstring + offset + subStart, subEnd - subStart);
+ }
+ }
+ if (*wsrc == '\\') {
+ wsrc++;
+ }
+ wfirstChar = wsrc + 1;
}
if (wfirstChar != wsrc) {
Tcl_AppendUnicodeToObj(resultPtr, wfirstChar,
wsrc - wfirstChar);
}
- if (idx <= info.nsubs) {
- subStart = info.matches[idx].start;
- subEnd = info.matches[idx].end;
- if ((subStart >= 0) && (subEnd >= 0)) {
- Tcl_AppendUnicodeToObj(resultPtr,
- wstring + offset + subStart, subEnd - subStart);
- }
- }
- if (*wsrc == '\\') {
- wsrc++;
- }
- wfirstChar = wsrc + 1;
- }
- if (wfirstChar != wsrc) {
- Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar);
}
if (end == 0) {
/*
@@ -850,7 +929,7 @@
* holding the number of matches.
*/
- Tcl_SetIntObj(Tcl_GetObjResult(interp), numMatches);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(numMatches));
}
} else {
/*
