summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCmdMZ.c354
-rw-r--r--generic/tclUtil.c48
2 files changed, 331 insertions, 71 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 38a3f8d..52cdf10 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.3 1999/04/16 00:46:43 stanton Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.4 1999/05/04 01:33:10 stanton Exp $
*/
#include "tclInt.h"
@@ -806,16 +806,22 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
char *string1, *string2;
int length1, length2;
static char *options[] = {
- "compare", "first", "index", "last",
- "length", "match", "range", "tolower",
- "toupper", "totitle", "trim", "trimleft",
- "trimright", "wordend", "wordstart", (char *) NULL
+ "bytes", "compare", "equal", "first",
+ "icompare", "iequal", "index",
+ "last", "length", "map",
+ "match", "range", "repeat", "replace",
+ "tolower", "toupper", "totitle",
+ "trim", "trimleft", "trimright",
+ "wordend", "wordstart", (char *) NULL
};
enum options {
- STR_COMPARE, STR_FIRST, STR_INDEX, STR_LAST,
- STR_LENGTH, STR_MATCH, STR_RANGE, STR_TOLOWER,
- STR_TOUPPER, STR_TOTITLE, STR_TRIM, STR_TRIMLEFT,
- STR_TRIMRIGHT, STR_WORDEND, STR_WORDSTART
+ STR_BYTES, STR_COMPARE, STR_EQUAL, STR_FIRST,
+ STR_ICOMPARE, STR_IEQUAL, STR_INDEX,
+ STR_LAST, STR_LENGTH, STR_MAP,
+ STR_MATCH, STR_RANGE, STR_REPEAT, STR_REPLACE,
+ STR_TOLOWER, STR_TOUPPER, STR_TOTITLE,
+ STR_TRIM, STR_TRIMLEFT, STR_TRIMRIGHT,
+ STR_WORDEND, STR_WORDSTART
};
if (objc < 2) {
@@ -830,11 +836,65 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
resultPtr = Tcl_GetObjResult(interp);
switch ((enum options) index) {
+ case STR_EQUAL:
case STR_COMPARE: {
- int match, length;
+ int match, length, reqlength = -1;
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "string1 string2");
+ if (!(objc == 4 || objc == 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "string1 string2 ?length?");
+ return TCL_ERROR;
+ }
+ if ((objc == 5) &&
+ Tcl_GetIntFromObj(interp, objv[4], &reqlength) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ string1 = Tcl_GetStringFromObj(objv[2], &length1);
+ string2 = Tcl_GetStringFromObj(objv[3], &length2);
+
+ length = (length1 < length2) ? length1 : length2;
+ if ((reqlength >= 0) && (reqlength < length)) {
+ Tcl_UniChar ch1, ch2;
+
+ /*
+ * reqlength must be interpreted as chars, not bytes
+ * we will only enter here when both strings are of
+ * at least reqlength chars long (no need for \0 check)
+ */
+ match = 0;
+ while (reqlength-- > 0) {
+ string1 += Tcl_UtfToUniChar(string1, &ch1);
+ string2 += Tcl_UtfToUniChar(string2, &ch2);
+ if (ch1 != ch2) {
+ match = ch1 - ch2;
+ break;
+ }
+ }
+ } else {
+ match = memcmp(string1, string2, (unsigned) length);
+ if (match == 0) {
+ match = length1 - length2;
+ }
+ }
+ if ((enum options) index == STR_EQUAL) {
+ Tcl_SetIntObj(resultPtr, (match) ? 0 : 1);
+ } else {
+ Tcl_SetIntObj(resultPtr, ((match > 0) ? 1 :
+ (match < 0) ? -1 : 0));
+ }
+ break;
+ }
+ case STR_IEQUAL:
+ case STR_ICOMPARE: {
+ int match, length, reqlength = -1;
+ Tcl_UniChar ch1, ch2;
+
+ if (objc < 4 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "string1 string2 ?length?");
+ return TCL_ERROR;
+ }
+ if ((objc == 5) &&
+ Tcl_GetIntFromObj(interp, objv[4], &reqlength) != TCL_OK) {
return TCL_ERROR;
}
@@ -842,11 +902,34 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
string2 = Tcl_GetStringFromObj(objv[3], &length2);
length = (length1 < length2) ? length1 : length2;
- match = memcmp(string1, string2, (unsigned) length);
- if (match == 0) {
- match = length1 - length2;
+ if ((reqlength >= 0) && (reqlength < length)) {
+ length = reqlength;
+ }
+ /*
+ * length must be interpreted as chars, not bytes
+ * we will only enter here when both strings are of
+ * at least length chars long (no need for \0 check)
+ */
+ match = 0;
+ while (length-- > 0) {
+ string1 += Tcl_UtfToUniChar(string1, &ch1);
+ string2 += Tcl_UtfToUniChar(string2, &ch2);
+ if ((ch1 != ch2) &&
+ (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2))) {
+ match = ch1 - ch2;
+ break;
+ }
+ }
+ if ((match == 0) && (reqlength >= length)) {
+ match = length1 - length2;
+ }
+
+ if ((enum options) index == STR_IEQUAL) {
+ Tcl_SetIntObj(resultPtr, (match) ? 0 : 1);
+ } else {
+ Tcl_SetIntObj(resultPtr, ((match > 0) ? 1 :
+ (match < 0) ? -1 : 0));
}
- Tcl_SetIntObj(resultPtr, (match > 0) ? 1 : (match < 0) ? -1 : 0);
break;
}
case STR_FIRST: {
@@ -897,29 +980,25 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
}
case STR_INDEX: {
int index;
- Tcl_UniChar ch;
char buf[TCL_UTF_MAX];
- char *start, *end;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "string charIndex");
return TCL_ERROR;
}
-
- if (Tcl_GetIntFromObj(interp, objv[3], &index) != TCL_OK) {
- return TCL_ERROR;
+ string1 = Tcl_GetStringFromObj(objv[2], &length1);
+ /*
+ * establish what 'end' really means
+ */
+ length2 = Tcl_NumUtfChars(string1, length1) - 1;
+ if (TclGetIntForIndex(interp, objv[3], length2,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
}
- if (index >= 0) {
- start = Tcl_GetStringFromObj(objv[2], &length1);
- end = start + length1;
- for ( ; start < end; index--) {
- start += Tcl_UtfToUniChar(start, &ch);
- if (index == 0) {
- Tcl_SetStringObj(resultPtr, buf,
- Tcl_UniCharToUtf(ch, buf));
- break;
- }
- }
+ if ((index >= 0) && (index < length1)) {
+ length2 = Tcl_UniCharToUtf(Tcl_UniCharAtIndex(string1,
+ index), buf);
+ Tcl_SetStringObj(resultPtr, buf, length2);
}
break;
}
@@ -965,6 +1044,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
Tcl_SetIntObj(resultPtr, match);
break;
}
+ case STR_BYTES:
case STR_LENGTH: {
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "string");
@@ -972,7 +1052,70 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
}
string1 = Tcl_GetStringFromObj(objv[2], &length1);
- Tcl_SetIntObj(resultPtr, Tcl_NumUtfChars(string1, length1));
+ if ((enum options) index == STR_BYTES) {
+ Tcl_SetIntObj(resultPtr, length1);
+ } else {
+ Tcl_SetIntObj(resultPtr, Tcl_NumUtfChars(string1, length1));
+ }
+ break;
+ }
+ case STR_MAP: {
+ int mapElemc, len;
+ Tcl_Obj **mapElemv;
+ char *end;
+ Tcl_UniChar ch;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "charMap string");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_ListObjGetElements(interp, objv[objc-2], &mapElemc,
+ &mapElemv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (mapElemc & 1) {
+ /*
+ * The charMap must be an even number of key/value items
+ */
+ Tcl_SetStringObj(resultPtr, "char map list unbalanced", -1);
+ return TCL_ERROR;
+ }
+ string1 = Tcl_GetStringFromObj(objv[objc-1], &length1);
+ if (length1 == 0) {
+ break;
+ }
+ end = string1 + length1;
+
+ for ( ; string1 < end; string1 += len) {
+ len = Tcl_UtfToUniChar(string1, &ch);
+ for (index = 0; index < mapElemc; index +=2) {
+ /*
+ * Get the key string to match on
+ */
+ string2 = Tcl_GetStringFromObj(mapElemv[index], &length2);
+ if ((*string2 == *string1) &&
+ (memcmp(string2, string1, length2) == 0)) {
+ /*
+ * Adjust len to be full length of matched string
+ */
+ len = length2;
+ /*
+ * Change string2 and length2 to the replacement value
+ */
+ string2 = Tcl_GetStringFromObj(mapElemv[index+1],
+ &length2);
+ Tcl_AppendToObj(resultPtr, string2, length2);
+ break;
+ }
+ }
+ if (index == mapElemc) {
+ /*
+ * No match was found, put the char onto result
+ */
+ Tcl_AppendToObj(resultPtr, string1, len);
+ }
+ }
break;
}
case STR_MATCH: {
@@ -1019,32 +1162,133 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
}
break;
}
+ case STR_REPEAT: {
+ int count;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "string count");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIntFromObj(interp, objv[3], &count) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ string1 = Tcl_GetStringFromObj(objv[2], &length1);
+ if (length1 > 0) {
+ for (index = 0; index < count; index++) {
+ Tcl_AppendToObj(resultPtr, string1, length1);
+ }
+ }
+ break;
+ }
+ case STR_REPLACE: {
+ int first, last;
+
+ if (!(objc == 5 || objc == 6)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "string first last ?string?");
+ return TCL_ERROR;
+ }
+
+ string1 = Tcl_GetStringFromObj(objv[2], &length1);
+ length1 = Tcl_NumUtfChars(string1, length1) - 1;
+ if (TclGetIntForIndex(interp, objv[3], length1,
+ &first) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (TclGetIntForIndex(interp, objv[4], length1,
+ &last) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((last < first) || (first > length1) || (last < 0)) {
+ Tcl_SetObjResult(interp, objv[2]);
+ } else {
+ char *start, *end;
+
+ if (first < 0) {
+ first = 0;
+ }
+ start = Tcl_UtfAtIndex(string1, first);
+ end = Tcl_UtfAtIndex(start, ((last > length1) ? length1 : last)
+ - first + 1);
+ Tcl_SetStringObj(resultPtr, string1, start - string1);
+ if (objc == 6) {
+ Tcl_AppendObjToObj(resultPtr, objv[5]);
+ }
+ if (last < length1) {
+ Tcl_AppendToObj(resultPtr, end, -1);
+ }
+ }
+ break;
+ }
case STR_TOLOWER:
case STR_TOUPPER:
case STR_TOTITLE:
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "string");
+ if (objc < 3 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "string ?first? ?last?");
return TCL_ERROR;
}
string1 = Tcl_GetStringFromObj(objv[2], &length1);
- /*
- * Since the result object is not a shared object, it is
- * safe to copy the string into the result and do the
- * conversion in place. The conversion may change the length
- * of the string, so reset the length after conversion.
- */
-
- Tcl_SetStringObj(resultPtr, string1, length1);
- if ((enum options) index == STR_TOLOWER) {
- length1 = Tcl_UtfToLower(Tcl_GetStringFromObj(resultPtr, NULL));
- } else if ((enum options) index == STR_TOUPPER) {
- length1 = Tcl_UtfToUpper(Tcl_GetStringFromObj(resultPtr, NULL));
+ if (objc == 3) {
+ /*
+ * Since the result object is not a shared object, it is
+ * safe to copy the string into the result and do the
+ * conversion in place. The conversion may change the length
+ * of the string, so reset the length after conversion.
+ */
+
+ Tcl_SetStringObj(resultPtr, string1, length1);
+ if ((enum options) index == STR_TOLOWER) {
+ length1 = Tcl_UtfToLower(Tcl_GetStringFromObj(resultPtr, NULL));
+ } else if ((enum options) index == STR_TOUPPER) {
+ length1 = Tcl_UtfToUpper(Tcl_GetStringFromObj(resultPtr, NULL));
+ } else {
+ length1 = Tcl_UtfToTitle(Tcl_GetStringFromObj(resultPtr, NULL));
+ }
+ Tcl_SetObjLength(resultPtr, length1);
} else {
- length1 = Tcl_UtfToTitle(Tcl_GetStringFromObj(resultPtr, NULL));
+ int first, last;
+ char *start, *end;
+
+ length1 = Tcl_NumUtfChars(string1, length1) - 1;
+ if (TclGetIntForIndex(interp, objv[3], length1,
+ &first) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (first < 0) {
+ first = 0;
+ }
+ last = first;
+ if ((objc == 5) && (TclGetIntForIndex(interp, objv[4], length1,
+ &last) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if (last >= length1) {
+ last = length1;
+ }
+ if (last < first) {
+ Tcl_SetObjResult(interp, objv[2]);
+ break;
+ }
+ start = Tcl_UtfAtIndex(string1, first);
+ end = Tcl_UtfAtIndex(start, last - first + 1);
+ length2 = end-start;
+ string2 = ckalloc(length2+1);
+ memcpy(string2, start, length2);
+ string2[length2] = '\0';
+ if ((enum options) index == STR_TOLOWER) {
+ length2 = Tcl_UtfToLower(string2);
+ } else if ((enum options) index == STR_TOUPPER) {
+ length2 = Tcl_UtfToUpper(string2);
+ } else {
+ length2 = Tcl_UtfToTitle(string2);
+ }
+ Tcl_SetStringObj(resultPtr, string1, start - string1);
+ Tcl_AppendToObj(resultPtr, string2, length2);
+ Tcl_AppendToObj(resultPtr, end, -1);
}
- Tcl_SetObjLength(resultPtr, length1);
break;
case STR_TRIM: {
@@ -1147,13 +1391,14 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
}
string1 = Tcl_GetStringFromObj(objv[2], &length1);
- if (Tcl_GetIntFromObj(interp, objv[3], &index) != TCL_OK) {
- return TCL_ERROR;
+ numChars = Tcl_NumUtfChars(string1, length1);
+ if (TclGetIntForIndex(interp, objv[3], numChars-1,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
}
if (index < 0) {
index = 0;
}
- numChars = Tcl_NumUtfChars(string1, length1);
if (index < numChars) {
p = Tcl_UtfAtIndex(string1, index);
end = string1+length1;
@@ -1184,10 +1429,11 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
}
string1 = Tcl_GetStringFromObj(objv[2], &length1);
- if (Tcl_GetIntFromObj(interp, objv[3], &index) != TCL_OK) {
+ numChars = Tcl_NumUtfChars(string1, length1);
+ if (TclGetIntForIndex(interp, objv[3], numChars-1,
+ &index) != TCL_OK) {
return TCL_ERROR;
}
- numChars = Tcl_NumUtfChars(string1, length1);
if (index >= numChars) {
index = numChars - 1;
}
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 095100f..2031ccd 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclUtil.c,v 1.8 1999/04/21 21:50:29 rjohnson Exp $
+ * RCS: @(#) $Id: tclUtil.c,v 1.9 1999/05/04 01:33:11 stanton Exp $
*/
#include "tclInt.h"
@@ -2051,31 +2051,45 @@ TclGetIntForIndex(interp, objPtr, endValue, indexPtr)
int *indexPtr; /* Location filled in with an integer
* representing an index. */
{
- Interp *iPtr = (Interp *) interp;
char *bytes;
- int index, length, result;
+ long longResult;
+ int length;
if (objPtr->typePtr == &tclIntType) {
*indexPtr = (int)objPtr->internalRep.longValue;
return TCL_OK;
}
-
+
bytes = Tcl_GetStringFromObj(objPtr, &length);
- if ((*bytes == 'e')
- && (strncmp(bytes, "end", (unsigned) length) == 0)) {
- index = endValue;
+
+ if ((*bytes != 'e') ||
+ (strncmp(bytes, "end", (length > 3) ? 3 : length) != 0)) {
+ if (Tcl_ExprLongObj(interp, objPtr, &longResult) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ *indexPtr = longResult;
+ return TCL_OK;
+ }
+
+ if (length <= 3) {
+ *indexPtr = endValue;
+ } else if ((bytes[3] == '+') || (bytes[3] == '-')) {
+ /*
+ * This is our limited string expression evaluator
+ */
+ if (Tcl_ExprLong(interp, bytes+3, &longResult) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ *indexPtr = endValue + longResult;
} else {
- result = Tcl_GetIntFromObj((Tcl_Interp *) NULL, objPtr, &index);
- if (result != TCL_OK) {
- if (iPtr != NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "bad index \"", bytes,
- "\": must be integer or \"end\"", (char *) NULL);
- }
- return result;
- }
+ if (interp != NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "invalid index \"", bytes,
+ "\": must be integer or ?end[+-]?expression",
+ (char *) NULL);
+ }
+ return TCL_ERROR;
}
- *indexPtr = index;
return TCL_OK;
}