tclcmdmz.c

来自「tcl是工具命令语言」· C语言 代码 · 共 2,428 行 · 第 1/5 页

		 */
		mapStrings = (Tcl_UniChar **) ckalloc((mapElemc * 2)
			* sizeof(Tcl_UniChar *));
		mapLens = (int *) ckalloc((mapElemc * 2) * sizeof(int));
		if (nocase) {
		    u2lc = (Tcl_UniChar *)
			ckalloc((mapElemc) * sizeof(Tcl_UniChar));
		}
		for (index = 0; index < mapElemc; index++) {
		    mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index],
			    &(mapLens[index]));
		    if (nocase && ((index % 2) == 0)) {
			u2lc[index/2] = Tcl_UniCharToLower(*mapStrings[index]);
		    }
		}
		for (p = ustring1; ustring1 < end; ustring1++) {
		    for (index = 0; index < mapElemc; index += 2) {
			/*
			 * Get the key string to match on.
			 */
			ustring2 = mapStrings[index];
			length2  = mapLens[index];
			if ((length2 > 0) && ((*ustring1 == *ustring2) ||
				(nocase && (Tcl_UniCharToLower(*ustring1) ==
					u2lc[index/2]))) &&
				((length2 == 1) || strCmpFn(ustring2, ustring1,
					(unsigned long) length2) == 0)) {
			    if (p != ustring1) {
				/*
				 * Put the skipped chars onto the result first
				 */
				Tcl_AppendUnicodeToObj(resultPtr, p,
					ustring1 - p);
				p = ustring1 + length2;
			    } else {
				p += length2;
			    }
			    /*
			     * Adjust len to be full length of matched string
			     */
			    ustring1 = p - 1;

			    /*
			     * Append the map value to the unicode string
			     */
			    Tcl_AppendUnicodeToObj(resultPtr,
				    mapStrings[index+1], mapLens[index+1]);
			    break;
			}
		    }
		}
		ckfree((char *) mapStrings);
		ckfree((char *) mapLens);
		if (nocase) {
		    ckfree((char *) u2lc);
		}
	    }
	    if (p != ustring1) {
		/*
		 * Put the rest of the unmapped chars onto result
		 */
		Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p);
	    }
	    break;
	}
	case STR_MATCH: {
	    Tcl_UniChar *ustring1, *ustring2;
	    int nocase = 0;

	    if (objc < 4 || objc > 5) {
	        Tcl_WrongNumArgs(interp, 2, objv, "?-nocase? pattern string");
		return TCL_ERROR;
	    }

	    if (objc == 5) {
		string2 = Tcl_GetStringFromObj(objv[2], &length2);
		if ((length2 > 1) &&
		    strncmp(string2, "-nocase", (size_t) length2) == 0) {
		    nocase = 1;
		} else {
		    Tcl_AppendStringsToObj(resultPtr, "bad option \"",
					   string2, "\": must be -nocase",
					   (char *) NULL);
		    return TCL_ERROR;
		}
	    }
	    ustring1 = Tcl_GetUnicodeFromObj(objv[objc-1], &length1);
	    ustring2 = Tcl_GetUnicodeFromObj(objv[objc-2], &length2);
	    Tcl_SetBooleanObj(resultPtr, TclUniCharMatch(ustring1, length1,
		    ustring2, length2, nocase));
	    break;
	}
	case STR_RANGE: {
	    int first, last;

	    if (objc != 5) {
	        Tcl_WrongNumArgs(interp, 2, objv, "string first last");
		return TCL_ERROR;
	    }

	    /*
	     * If we have a ByteArray object, avoid indexing in the
	     * Utf string since the byte array contains one byte per
	     * character.  Otherwise, use the Unicode string rep to
	     * get the range.
	     */

	    if (objv[2]->typePtr == &tclByteArrayType) {
		string1 = (char *)Tcl_GetByteArrayFromObj(objv[2], &length1);
		length1--;
	    } else {
		/*
		 * Get the length in actual characters.
		 */
		string1 = NULL;
		length1 = Tcl_GetCharLength(objv[2]) - 1;
	    }

	    if ((TclGetIntForIndex(interp, objv[3], length1, &first) != TCL_OK)
		    || (TclGetIntForIndex(interp, objv[4], length1,
			    &last) != TCL_OK)) {
		return TCL_ERROR;
	    }

	    if (first < 0) {
		first = 0;
	    }
	    if (last >= length1) {
		last = length1;
	    }
	    if (last >= first) {
		if (string1 != NULL) {
		    int numBytes = last - first + 1;
		    resultPtr = Tcl_NewByteArrayObj(
			(unsigned char *) &string1[first], numBytes);
		    Tcl_SetObjResult(interp, resultPtr);
		} else {
		    Tcl_SetObjResult(interp,
			    Tcl_GetRange(objv[2], first, last));
		}
	    }
	    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;
	    }

	    if (count == 1) {
		Tcl_SetObjResult(interp, objv[2]);
	    } else if (count > 1) {
		string1 = Tcl_GetStringFromObj(objv[2], &length1);
		if (length1 > 0) {
		    /*
		     * Only build up a string that has data.  Instead of
		     * building it up with repeated appends, we just allocate
		     * the necessary space once and copy the string value in.
		     */
		    length2		= length1 * count;
		    /*
		     * Include space for the NULL
		     */
		    string2		= (char *) ckalloc((size_t) length2+1);
		    for (index = 0; index < count; index++) {
			memcpy(string2 + (length1 * index), string1,
				(size_t) length1);
		    }
		    string2[length2]	= '\0';
		    /*
		     * We have to directly assign this instead of using
		     * Tcl_SetStringObj (and indirectly TclInitStringRep)
		     * because that makes another copy of the data.
		     */
		    resultPtr		= Tcl_NewObj();
		    resultPtr->bytes	= string2;
		    resultPtr->length	= length2;
		    Tcl_SetObjResult(interp, resultPtr);
		}
	    }
	    break;
	}
	case STR_REPLACE: {
	    Tcl_UniChar *ustring1;
	    int first, last;

	    if (objc < 5 || objc > 6) {
	        Tcl_WrongNumArgs(interp, 2, objv,
				 "string first last ?string?");
		return TCL_ERROR;
	    }

	    ustring1 = Tcl_GetUnicodeFromObj(objv[2], &length1);
	    length1--;

	    if ((TclGetIntForIndex(interp, objv[3], length1, &first) != TCL_OK)
		    || (TclGetIntForIndex(interp, objv[4], length1,
			    &last) != TCL_OK)) {
		return TCL_ERROR;
	    }

	    if ((last < first) || (last < 0) || (first > length1)) {
		Tcl_SetObjResult(interp, objv[2]);
	    } else {
		if (first < 0) {
		    first = 0;
		}

		Tcl_SetUnicodeObj(resultPtr, ustring1, first);
		if (objc == 6) {
		    Tcl_AppendObjToObj(resultPtr, objv[5]);
		}
		if (last < length1) {
		    Tcl_AppendUnicodeToObj(resultPtr, ustring1 + last + 1,
			    length1 - last);
		}
	    }
	    break;
	}
	case STR_TOLOWER:
	case STR_TOUPPER:
	case STR_TOTITLE:
	    if (objc < 3 || objc > 5) {
	        Tcl_WrongNumArgs(interp, 2, objv, "string ?first? ?last?");
		return TCL_ERROR;
	    }

	    string1 = Tcl_GetStringFromObj(objv[2], &length1);

	    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_GetString(resultPtr));
		} else if ((enum options) index == STR_TOUPPER) {
		    length1 = Tcl_UtfToUpper(Tcl_GetString(resultPtr));
		} else {
		    length1 = Tcl_UtfToTitle(Tcl_GetString(resultPtr));
		}
		Tcl_SetObjLength(resultPtr, length1);
	    } else {
		int first, last;
		CONST 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((size_t) length2+1);
		memcpy(string2, start, (size_t) 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);
		ckfree(string2);
	    }
	    break;

	case STR_TRIM: {
	    Tcl_UniChar ch, trim;
	    register CONST char *p, *end;
	    char *check, *checkEnd;
	    int offset;

	    left = 1;
	    right = 1;

	    dotrim:
	    if (objc == 4) {
		string2 = Tcl_GetStringFromObj(objv[3], &length2);
	    } else if (objc == 3) {
		string2 = " \t\n\r";
		length2 = strlen(string2);
	    } else {
	        Tcl_WrongNumArgs(interp, 2, objv, "string ?chars?");
		return TCL_ERROR;
	    }
	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
	    checkEnd = string2 + length2;

	    if (left) {
		end = string1 + length1;
		/*
		 * The outer loop iterates over the string.  The inner
		 * loop iterates over the trim characters.  The loops
		 * terminate as soon as a non-trim character is discovered
		 * and string1 is left pointing at the first non-trim
		 * character.
		 */

		for (p = string1; p < end; p += offset) {
		    offset = TclUtfToUniChar(p, &ch);
		    
		    for (check = string2; ; ) {
			if (check >= checkEnd) {
			    p = end;
			    break;
			}
			check += TclUtfToUniChar(check, &trim);
			if (ch == trim) {
			    length1 -= offset;
			    string1 += offset;
			    break;
			}
		    }
		}
	    }
	    if (right) {
	        end = string1;

		/*
		 * The outer loop iterates over the string.  The inner
		 * loop iterates over the trim characters.  The loops
		 * terminate as soon as a non-trim character is discovered
		 * and length1 marks the last non-trim character.
		 */

		for (p = string1 + length1; p > end; ) {
		    p = Tcl_UtfPrev(p, string1);
		    offset = TclUtfToUniChar(p, &ch);
		    for (check = string2; ; ) {
		        if (check >= checkEnd) {
			    p = end;
			    break;
			}
			check += TclUtfToUniChar(check, &trim);
			if (ch == trim) {
			    length1 -= offset;
			    break;
			}
		    }
		}
	    }
	    Tcl_SetStringObj(resultPtr, string1, length1);
	    break;
	}
	case STR_TRIMLEFT: {
	    left = 1;
	    right = 0;
	    goto dotrim;
	}
	case STR_TRIMRIGHT: {
	    left = 0;
	    right = 1;
	    goto dotrim;
	}
	case STR_WORDEND: {
	    int cur;
	    Tcl_UniChar ch;
	    CONST char *p, *end;
	    int numChars;
	    
	    if (objc != 4) {
	        Tcl_WrongNumArgs(interp, 2, objv, "string index");
		return TCL_ERROR;
	    }

	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
	    numChars = Tcl_NumUtfChars(string1, length1);
	    if (TclGetIntForIndex(interp, objv[3], numChars-1,
				  &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (index < 0) {
		index = 0;
	    }
	    if (index < numChars) {
		p = Tcl_UtfAtIndex(string1, index);
		end = string1+length1;
		for (cur = index; p < end; cur++) {
		    p += TclUtfToUniChar(p, &ch);
		    if (!Tcl_UniCharIsWordChar(ch)) {
			break;
		    }
		}
		if (cur == index) {
		    cur++;
		}
	    } else {
		cur = numChars;
	    }
	    Tcl_SetIntObj(resultPtr, cur);
	    break;
	}
	case STR_WORDSTART: {
	    int cur;
	    Tcl_UniChar ch;
	    CONST char *p;
	    int numChars;
	    
	    if (objc != 4) {
	        Tcl_WrongNumArgs(interp, 2, objv, "string index");
		return TCL_ERROR;
	    }

	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
	    numChars = Tcl_NumUtfChars(string1, length1);
	    if (TclGetIntForIndex(interp, objv[3], numChars-1,
				  &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (index >= numChars) {
		index = numChars - 1;
	    }
	    cur = 0;
	    if (index > 0) {
		p = Tcl_UtfAtIndex(string1, index);
	        for (cur = index; cur >= 0; cur--) {
		    TclUtfToUniChar(p, &ch);
		    if (!Tcl_UniCharIsWordChar(ch)) {
			break;
		    }
		    p = Tcl_UtfPrev(p, string1);
		}
		if (cur != index) {
		    cur += 1;
		}
	    }
	    Tcl_SetIntObj(resultPtr, cur);
	    break;
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SubstObjCmd --
 *
 *	This procedure is invoked to process the "subst" Tcl command.
 *	See the user documentation for details on what it does.  This
 *	command relies on Tcl_SubstObj() for its implementation.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_SubstObjCmd(dummy, inte