summaryrefslogtreecommitdiffstats
path: root/generic/tclCmdMZ.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCmdMZ.c')
-rw-r--r--generic/tclCmdMZ.c155
1 files changed, 93 insertions, 62 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 7e94d9f..95debf8 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -34,12 +34,35 @@ static int UniCharIsHexDigit(int character);
/*
* Default set of characters to trim in [string trim] and friends. This is a
- * UTF-8 literal string containing space, tab, newline, carriage return,
- * ethiopic wordspace (U+1361), ogham space mark (U+1680), and ideographic
- * space (U+3000). [TIP #318]
+ * UTF-8 literal string containing all Unicode space characters [TIP #413]
*/
-#define DEFAULT_TRIM_SET " \t\n\r\xe1\x8d\xa1\xe1\x9a\x80\xe3\x80\x80"
+#define DEFAULT_TRIM_SET \
+ "\x09\x0a\x0b\x0c\x0d " /* ASCII */\
+ "\xc0\x80" /* nul (U+0000) */\
+ "\xc2\x85" /* next line (U+0085) */\
+ "\xc2\xa0" /* non-breaking space (U+00a0) */\
+ "\xe1\x9a\x80" /* ogham space mark (U+1680) */ \
+ "\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */\
+ "\xe2\x80\x80" /* en quad (U+2000) */\
+ "\xe2\x80\x81" /* em quad (U+2001) */\
+ "\xe2\x80\x82" /* en space (U+2002) */\
+ "\xe2\x80\x83" /* em space (U+2003) */\
+ "\xe2\x80\x84" /* three-per-em space (U+2004) */\
+ "\xe2\x80\x85" /* four-per-em space (U+2005) */\
+ "\xe2\x80\x86" /* six-per-em space (U+2006) */\
+ "\xe2\x80\x87" /* figure space (U+2007) */\
+ "\xe2\x80\x88" /* punctuation space (U+2008) */\
+ "\xe2\x80\x89" /* thin space (U+2009) */\
+ "\xe2\x80\x8a" /* hair space (U+200a) */\
+ "\xe2\x80\x8b" /* zero width space (U+200b) */\
+ "\xe2\x80\xa8" /* line separator (U+2028) */\
+ "\xe2\x80\xa9" /* paragraph separator (U+2029) */\
+ "\xe2\x80\xaf" /* narrow no-break space (U+202f) */\
+ "\xe2\x81\x9f" /* medium mathematical space (U+205f) */\
+ "\xe2\x81\xa0" /* word joiner (U+2060) */\
+ "\xe3\x80\x80" /* ideographic space (U+3000) */\
+ "\xef\xbb\xbf" /* zero width no-break space (U+feff) */
/*
*----------------------------------------------------------------------
@@ -204,8 +227,8 @@ Tcl_RegexpObjCmd(
*/
if (doinline && ((objc - 2) != 0)) {
- Tcl_AppendResult(interp, "regexp match variables not allowed"
- " when using -inline", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "regexp match variables not allowed when using -inline", -1));
goto optionError;
}
@@ -1839,8 +1862,8 @@ StringMapCmd(
strncmp(string, "-nocase", (size_t) length2) == 0) {
nocase = 1;
} else {
- Tcl_AppendResult(interp, "bad option \"", string,
- "\": must be -nocase", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": must be -nocase", string));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
string, NULL);
return TCL_ERROR;
@@ -2106,8 +2129,8 @@ StringMatchCmd(
strncmp(string, "-nocase", (size_t) length) == 0) {
nocase = TCL_MATCH_NOCASE;
} else {
- Tcl_AppendResult(interp, "bad option \"", string,
- "\": must be -nocase", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": must be -nocase", string));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
string, NULL);
return TCL_ERROR;
@@ -2567,8 +2590,9 @@ StringEqualCmd(
return TCL_ERROR;
}
} else {
- Tcl_AppendResult(interp, "bad option \"", string2,
- "\": must be -nocase or -length", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": must be -nocase or -length",
+ string2));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
string2, NULL);
return TCL_ERROR;
@@ -2716,8 +2740,9 @@ StringCmpCmd(
return TCL_ERROR;
}
} else {
- Tcl_AppendResult(interp, "bad option \"", string2,
- "\": must be -nocase or -length", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": must be -nocase or -length",
+ string2));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
string2, NULL);
return TCL_ERROR;
@@ -3299,28 +3324,28 @@ TclInitStringCmd(
Tcl_Interp *interp) /* Current interpreter. */
{
static const EnsembleImplMap stringImplMap[] = {
- {"bytelength", StringBytesCmd, NULL, NULL, NULL, 0},
+ {"bytelength", StringBytesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0},
{"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0},
- {"first", StringFirstCmd, NULL, NULL, NULL, 0},
+ {"first", StringFirstCmd, TclCompileStringFirstCmd, NULL, NULL, 0},
{"index", StringIndexCmd, TclCompileStringIndexCmd, NULL, NULL, 0},
{"is", StringIsCmd, NULL, NULL, NULL, 0},
- {"last", StringLastCmd, NULL, NULL, NULL, 0},
+ {"last", StringLastCmd, TclCompileStringLastCmd, NULL, NULL, 0},
{"length", StringLenCmd, TclCompileStringLenCmd, NULL, NULL, 0},
- {"map", StringMapCmd, NULL, NULL, NULL, 0},
+ {"map", StringMapCmd, TclCompileStringMapCmd, NULL, NULL, 0},
{"match", StringMatchCmd, TclCompileStringMatchCmd, NULL, NULL, 0},
- {"range", StringRangeCmd, NULL, NULL, NULL, 0},
- {"repeat", StringReptCmd, NULL, NULL, NULL, 0},
+ {"range", StringRangeCmd, TclCompileStringRangeCmd, NULL, NULL, 0},
+ {"repeat", StringReptCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"replace", StringRplcCmd, NULL, NULL, NULL, 0},
- {"reverse", StringRevCmd, NULL, NULL, NULL, 0},
- {"tolower", StringLowerCmd, NULL, NULL, NULL, 0},
- {"toupper", StringUpperCmd, NULL, NULL, NULL, 0},
- {"totitle", StringTitleCmd, NULL, NULL, NULL, 0},
- {"trim", StringTrimCmd, NULL, NULL, NULL, 0},
- {"trimleft", StringTrimLCmd, NULL, NULL, NULL, 0},
- {"trimright", StringTrimRCmd, NULL, NULL, NULL, 0},
- {"wordend", StringEndCmd, NULL, NULL, NULL, 0},
- {"wordstart", StringStartCmd, NULL, NULL, NULL, 0},
+ {"reverse", StringRevCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"tolower", StringLowerCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
+ {"toupper", StringUpperCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
+ {"totitle", StringTitleCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
+ {"trim", StringTrimCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+ {"trimleft", StringTrimLCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+ {"trimright", StringTrimRCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+ {"wordend", StringEndCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"wordstart", StringStartCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{NULL, NULL, NULL, NULL, NULL, 0}
};
@@ -3515,9 +3540,9 @@ TclNRSwitchObjCmd(
* Mode already set via -exact, -glob, or -regexp.
*/
- Tcl_AppendResult(interp, "bad option \"",
- TclGetString(objv[i]), "\": ", options[mode],
- " option already found", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": %s option already found",
+ TclGetString(objv[i]), options[mode]));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
"DOUBLEOPT", NULL);
return TCL_ERROR;
@@ -3534,8 +3559,9 @@ TclNRSwitchObjCmd(
case OPT_INDEXV:
i++;
if (i >= objc-2) {
- Tcl_AppendResult(interp, "missing variable name argument to ",
- "-indexvar", " option", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "missing variable name argument to %s option",
+ "-indexvar"));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
"NOVAR", NULL);
return TCL_ERROR;
@@ -3546,8 +3572,9 @@ TclNRSwitchObjCmd(
case OPT_MATCHV:
i++;
if (i >= objc-2) {
- Tcl_AppendResult(interp, "missing variable name argument to ",
- "-matchvar", " option", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "missing variable name argument to %s option",
+ "-matchvar"));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
"NOVAR", NULL);
return TCL_ERROR;
@@ -3565,15 +3592,15 @@ TclNRSwitchObjCmd(
return TCL_ERROR;
}
if (indexVarObj != NULL && mode != OPT_REGEXP) {
- Tcl_AppendResult(interp,
- "-indexvar option requires -regexp option", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s option requires -regexp option", "-indexvar"));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
"MODERESTRICTION", NULL);
return TCL_ERROR;
}
if (matchVarObj != NULL && mode != OPT_REGEXP) {
- Tcl_AppendResult(interp,
- "-matchvar option requires -regexp option", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s option requires -regexp option", "-matchvar"));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
"MODERESTRICTION", NULL);
return TCL_ERROR;
@@ -3622,7 +3649,8 @@ TclNRSwitchObjCmd(
if (objc % 2) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "extra switch pattern with no body", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "extra switch pattern with no body", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM",
NULL);
@@ -3637,10 +3665,10 @@ TclNRSwitchObjCmd(
if (splitObjs) {
for (i=0 ; i<objc ; i+=2) {
if (TclGetString(objv[i])[0] == '#') {
- Tcl_AppendResult(interp, ", this may be due to a "
- "comment incorrectly placed outside of a "
- "switch body - see the \"switch\" "
- "documentation", NULL);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ ", this may be due to a comment incorrectly"
+ " placed outside of a switch body - see the"
+ " \"switch\" documentation", -1);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
"BADARM", "COMMENT?", NULL);
break;
@@ -3657,9 +3685,9 @@ TclNRSwitchObjCmd(
*/
if (strcmp(TclGetString(objv[objc-1]), "-") == 0) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "no body specified for pattern \"",
- TclGetString(objv[objc-2]), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no body specified for pattern \"%s\"",
+ TclGetString(objv[objc-2])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM",
"FALLTHROUGH", NULL);
return TCL_ERROR;
@@ -3985,7 +4013,8 @@ Tcl_ThrowObjCmd(
if (Tcl_ListObjLength(interp, objv[1], &len) != TCL_OK) {
return TCL_ERROR;
} else if (len < 1) {
- Tcl_AppendResult(interp, "type must be non-empty list", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "type must be non-empty list", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "THROW", "BADEXCEPTION",
NULL);
return TCL_ERROR;
@@ -4169,15 +4198,16 @@ TclNRTryObjCmd(
switch ((enum Handlers) type) {
case TryFinally: /* finally script */
if (i < objc-2) {
- Tcl_AppendResult(interp, "finally clause must be last", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "finally clause must be last", -1));
Tcl_DecrRefCount(handlersObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY",
"NONTERMINAL", NULL);
return TCL_ERROR;
} else if (i == objc-1) {
- Tcl_AppendResult(interp, "wrong # args to finally clause: ",
- "must be \"", TclGetString(objv[0]),
- " ... finally script\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "wrong # args to finally clause: must be"
+ " \"... finally script\"", -1));
Tcl_DecrRefCount(handlersObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY",
"ARGUMENT", NULL);
@@ -4188,15 +4218,16 @@ TclNRTryObjCmd(
case TryOn: /* on code variableList script */
if (i > objc-4) {
- Tcl_AppendResult(interp, "wrong # args to on clause: ",
- "must be \"", TclGetString(objv[0]),
- " ... on code variableList script\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "wrong # args to on clause: must be \"... on code"
+ " variableList script\"", -1));
Tcl_DecrRefCount(handlersObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "ON",
"ARGUMENT", NULL);
return TCL_ERROR;
}
- if (TCL_ERROR == TclGetCompletionCodeFromObj(interp, objv[i+1], &code)) {
+ if (TclGetCompletionCodeFromObj(interp, objv[i+1],
+ &code) != TCL_OK) {
Tcl_DecrRefCount(handlersObj);
return TCL_ERROR;
}
@@ -4205,9 +4236,10 @@ TclNRTryObjCmd(
case TryTrap: /* trap pattern variableList script */
if (i > objc-4) {
- Tcl_AppendResult(interp, "wrong # args to trap clause: ",
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "wrong # args to trap clause: "
"must be \"... trap pattern variableList script\"",
- NULL);
+ -1));
Tcl_DecrRefCount(handlersObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP",
"ARGUMENT", NULL);
@@ -4248,9 +4280,8 @@ TclNRTryObjCmd(
}
}
if (bodyShared) {
- Tcl_AppendResult(interp,
- "last non-finally clause must not have a body of \"-\"",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "last non-finally clause must not have a body of \"-\"", -1));
Tcl_DecrRefCount(handlersObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "BADFALLTHROUGH",
NULL);
generated by cgit v0.12 at 2024-10-02 16:25:56 (GMT)