Tcl Source Code

.SH NAME
encoding \- Manipulate encodings
.SH SYNOPSIS
\fBencoding \fIoption\fR ?\fIarg arg ...\fR?
.BE
.SH INTRODUCTION
.PP
Strings in Tcl are logically a sequence of Unicode characters.
These strings are represented in memory as a sequence of bytes that
may be in one of several encodings: modified UTF\-8 (which uses 1 to 4
bytes per character), or a custom encoding start as 8 bit binary data.






.PP
Different operating system interfaces or applications may generate
strings in other encodings such as Shift\-JIS.  The \fBencoding\fR
command helps to bridge the gap between Unicode and these other
formats.
.SH DESCRIPTION
.PP
Performs one of several encoding related operations, depending on
\fIoption\fR.  The legal \fIoption\fRs are:
.TP
\fBencoding convertfrom\fR ?\fB-nocomplain\fR? ?\fB-failindex var\fR?
?\fIencoding\fR? \fIdata\fR
.
Convert \fIdata\fR to a Unicode string from the specified \fIencoding\fR.  The
characters in \fIdata\fR are 8 bit binary data.  The resulting

sequence of bytes is a string created by applying the given \fIencoding\fR
to the data. If \fIencoding\fR is not specified, the current
system encoding is used.
.
The call fails on convertion errors, like an incomplete utf-8 sequence.
The option \fB-failindex\fR is followed by a variable name. The variable
is set to \fI-1\fR if no conversion error occured. It is set to the
first error location in \fIdata\fR in case of a conversion error. All data
until this error location is transformed and retured. This option may not
be used together with \fB-nocomplain\fR.
.
The call does not fail on conversion errors, if the option
\fB-nocomplain\fR is given. In this case, any error locations are replaced
by \fB?\fR. Incomplete sequences are written verbatim to the output string.
The purpose of this switch is to gain compatibility to prior versions of TCL.
It is not recommended for any other usage.
.TP
\fBencoding convertto\fR ?\fB-nocomplain\fR? ?\fB-failindex var\fR?
?\fIencoding\fR? \fIstring\fR
.
Convert \fIstring\fR from Unicode to the specified \fIencoding\fR.
The result is a sequence of bytes that represents the converted
string.  Each byte is stored in the lower 8-bits of a Unicode
character (indeed, the resulting string is a binary string as far as
Tcl is concerned, at least initially).  If \fIencoding\fR is not
specified, the current system encoding is used.
.
The call fails on convertion errors, like a Unicode character not representable
in the given \fIencoding\fR.
.
The option \fB-failindex\fR is followed by a variable name. The variable
is set to \fI-1\fR if no conversion error occured. It is set to the
first error location in \fIdata\fR in case of a conversion error. All data
until this error location is transformed and retured. This option may not
be used together with \fB-nocomplain\fR.
.
The call does not fail on conversion errors, if the option
\fB-nocomplain\fR is given. In this case, any error locations are replaced
by \fB?\fR. Incomplete sequences are written verbatim to the output string.
The purpose of this switch is to gain compatibility to prior versions of TCL.
It is not recommended for any other usage.
.TP
\fBencoding dirs\fR ?\fIdirectoryList\fR?
.
Tcl can load encoding data files from the file system that describe
additional encodings for it to work with. This command sets the search
path for \fB*.enc\fR encoding data files to the list of directories
\fIdirectoryList\fR. If \fIdirectoryList\fR is omitted then the

.CS
set s [\fBencoding convertfrom\fR euc-jp "\exA4\exCF"]
.CE
.PP
The result is the unicode codepoint:
.QW "\eu306F" ,
which is the Hiragana letter HA.
.PP
The following example detects the error location in an incomplete UTF-8 sequence:
.PP
.CS
% set s [\fBencoding convertfrom\fR -failindex i utf-8 "A\xc3"]
A
% set i
1
.CE
.PP
The following example detects the error location while transforming to ISO8859-1
(ISO-Latin 1):
.PP
.CS
% set s [\fBencoding convertto\fR -failindex i utf-8 "A\u0141"]
A
% set i
1
.CE
.PP
.SH "SEE ALSO"
Tcl_GetEncoding(3)
.SH KEYWORDS
encoding, unicode
.\" Local Variables:
.\" mode: nroff
.\" End:

    const char *bytesPtr;	/* Pointer to the first byte of the array */
#if TCL_MAJOR_VERSION > 8 || defined(TCL_NO_DEPRECATED)
    int flags = TCL_ENCODING_STOPONERROR;
#else
    int flags = TCL_ENCODING_NOCOMPLAIN;
#endif
    int result;
    Tcl_Obj *failVarObj = NULL;
    /*
     * Decode parameters:
     * Possible combinations:
     * 1) data						-> objc = 2
     * 2) encoding data					-> objc = 3
     * 3) -nocomplain data				-> objc = 3
     * 4) -nocomplain encoding data			-> objc = 4
     * 5) -failindex val data				-> objc = 4
     * 6) -failindex val encoding data			-> objc = 5
     */

    if (objc == 2) {
	encoding = Tcl_GetEncoding(interp, NULL);
	data = objv[1];
    } else if (objc > 2 && objc < 6) {
	int objcUnprocessed = objc;
	data = objv[objc - 1];
	bytesPtr = Tcl_GetString(objv[1]);
	if (bytesPtr[0] == '-' && bytesPtr[1] == 'n'
		&& !strncmp(bytesPtr, "-nocomplain", strlen(bytesPtr))) {
	    flags = TCL_ENCODING_NOCOMPLAIN;
	    objcUnprocessed--;
	} else if (bytesPtr[0] == '-' && bytesPtr[1] == 'f'
		&& !strncmp(bytesPtr, "-failindex", strlen(bytesPtr))) {
	    /* at least two additional arguments needed */
	    if (objc < 4) {
		goto encConvFromError;
	    }
	    failVarObj = objv[2];
	    flags = TCL_ENCODING_STOPONERROR;
	    objcUnprocessed -= 2;
	}
	switch (objcUnprocessed) {
	    case 3:
		if (Tcl_GetEncodingFromObj(interp, objv[objc - 2], &encoding) != TCL_OK) {
		    return TCL_ERROR;
		}

		break;
	    case 2:



		encoding = Tcl_GetEncoding(interp, NULL);

		break;
	    default:
		goto encConvFromError;
	}
    } else {
    encConvFromError:
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain? ?-failindex var? ?encoding? data");
	return TCL_ERROR;
    }


    /*
     * Convert the string into a byte array in 'ds'
     */
#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9)
    if (!(flags & TCL_ENCODING_STOPONERROR)) {
	bytesPtr = (char *) Tcl_GetByteArrayFromObj(data, &length);
    } else
#endif
    bytesPtr = (char *) TclGetBytesFromObj(interp, data, &length);
    if (bytesPtr == NULL) {
	return TCL_ERROR;
    }
    result = Tcl_ExternalToUtfDStringEx(encoding, bytesPtr, length,
	    flags, &ds);
    if (!(flags & TCL_ENCODING_NOCOMPLAIN) && (result != TCL_INDEX_NONE)) {
	if (failVarObj != NULL) {
	    if (Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewWideIntObj(result), TCL_LEAVE_ERR_MSG) == NULL) {
		return TCL_ERROR;
	    }
	} else {
	    char buf[TCL_INTEGER_SPACE];
	    sprintf(buf, "%u", result);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("unexpected byte sequence starting at index %"
		    "u: '\\x%X'", result, UCHAR(bytesPtr[result])));
	    Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALSEQUENCE",
		    buf, NULL);
	    Tcl_DStringFree(&ds);
	    return TCL_ERROR;
	}
    } else if (failVarObj != NULL) {
	if (Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewIntObj(-1), TCL_LEAVE_ERR_MSG) == NULL) {
	    return TCL_ERROR;
	}
    }

    /*
     * Note that we cannot use Tcl_DStringResult here because it will
     * truncate the string at the first null byte.
     */

    const char *stringPtr;	/* Pointer to the first byte of the string */
    int result;
#if TCL_MAJOR_VERSION > 8 || defined(TCL_NO_DEPRECATED)
    int flags = TCL_ENCODING_STOPONERROR;
#else
    int flags = TCL_ENCODING_NOCOMPLAIN;
#endif
    Tcl_Obj *failVarObj = NULL;

    /*
     * Decode parameters:
     * Possible combinations:
     * 1) data						-> objc = 2
     * 2) encoding data					-> objc = 3
     * 3) -nocomplain data				-> objc = 3
     * 4) -nocomplain encoding data			-> objc = 4
     * 5) -failindex val data				-> objc = 4
     * 6) -failindex val encoding data			-> objc = 5
     */

    if (objc == 2) {
	encoding = Tcl_GetEncoding(interp, NULL);
	data = objv[1];
    } else if (objc > 2 && objc < 6) {
	int objcUnprocessed = objc;
	data = objv[objc - 1];
	stringPtr = Tcl_GetString(objv[1]);
	if (stringPtr[0] == '-' && stringPtr[1] == 'n'
		&& !strncmp(stringPtr, "-nocomplain", strlen(stringPtr))) {
	    flags = TCL_ENCODING_NOCOMPLAIN;
	    objcUnprocessed--;
	} else if (stringPtr[0] == '-' && stringPtr[1] == 'f'
		&& !strncmp(stringPtr, "-failindex", strlen(stringPtr))) {
	    /* at least two additional arguments needed */
	    if (objc < 4) {
		goto encConvToError;
	    }
	    failVarObj = objv[2];
	    flags = TCL_ENCODING_STOPONERROR;
	    objcUnprocessed -= 2;
	}
	switch (objcUnprocessed) {
	    case 3:
		if (Tcl_GetEncodingFromObj(interp, objv[objc - 2], &encoding) != TCL_OK) {
		    return TCL_ERROR;
		}

		break;
	    case 2:



		encoding = Tcl_GetEncoding(interp, NULL);

		break;
	    default:
		goto encConvToError;
	}
    } else {
    encConvToError:
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain? ?-failindex var? ?encoding? data");
	return TCL_ERROR;
    }


    /*
     * Convert the string to a byte array in 'ds'
     */

    stringPtr = TclGetStringFromObj(data, &length);
    result = Tcl_UtfToExternalDStringEx(encoding, stringPtr, length,
	    flags, &ds);
    if (!(flags & TCL_ENCODING_NOCOMPLAIN) && (result != TCL_INDEX_NONE)) {
	if (failVarObj != NULL) {
	    /* I hope, wide int will cover size_t data type */
	    if (Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewWideIntObj(result), TCL_LEAVE_ERR_MSG) == NULL) {
		return TCL_ERROR;
	    }
	} else {
	    size_t pos = Tcl_NumUtfChars(stringPtr, result);
	    int ucs4;
	    char buf[TCL_INTEGER_SPACE];
	    TclUtfToUCS4(&stringPtr[result], &ucs4);
	    sprintf(buf, "%u", result);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("unexpected character at index %"
		    TCL_Z_MODIFIER "u: 'U+%06X'", pos, ucs4));
	    Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALSEQUENCE",
		    buf, NULL);
	    Tcl_DStringFree(&ds);
	    return TCL_ERROR;
	}
    } else if (failVarObj != NULL) {
	if (Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewIntObj(-1), TCL_LEAVE_ERR_MSG) == NULL) {
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp,
		     Tcl_NewByteArrayObj((unsigned char*) Tcl_DStringValue(&ds),
					 Tcl_DStringLength(&ds)));
    Tcl_DStringFree(&ds);

    /*

    encoding
} -result {wrong # args: should be "encoding subcommand ?arg ...?"}
test cmdAH-4.2 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding foo
} -result {unknown or ambiguous subcommand "foo": must be convertfrom, convertto, dirs, names, or system}
test cmdAH-4.3 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding convertto
} -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-failindex var? ?encoding? data"}
test cmdAH-4.4 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding convertto foo bar
} -result {unknown encoding "foo"}
test cmdAH-4.5 {Tcl_EncodingObjCmd} -setup {
    set system [encoding system]
} -body {
    encoding system jis0208

    encoding system iso8859-1
    encoding convertto jis0208 乎
} -cleanup {
    encoding system $system
} -result 8C
test cmdAH-4.7 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding convertfrom
} -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"}
test cmdAH-4.8 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding convertfrom foo bar
} -result {unknown encoding "foo"}
test cmdAH-4.9 {Tcl_EncodingObjCmd} -setup {
    set system [encoding system]
} -body {
    encoding system jis0208

    set system [encoding system]
} -body {
    encoding system iso8859-1
    encoding system
} -cleanup {
    encoding system $system
} -result iso8859-1

test cmdAH-4.14.1 {Syntax error, -nocomplain and -failindex, no encoding} -body {
    encoding convertfrom -nocomplain -failindex 2 ABC
} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"}
test cmdAH-4.14.2 {Syntax error, -nocomplain and -failindex, no encoding} -body {
    encoding convertto -nocomplain -failindex 2 ABC
} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-failindex var? ?encoding? data"}
test cmdAH-4.15.1 {Syntax error, -failindex and -nocomplain, no encoding} -body {
    encoding convertfrom -failindex 2 -nocomplain ABC
} -returnCodes 1 -result {unknown encoding "-nocomplain"}
test cmdAH-4.15.2 {Syntax error, -failindex and -nocomplain, no encoding} -body {
    encoding convertto -failindex 2 -nocomplain ABC
} -returnCodes 1 -result {unknown encoding "-nocomplain"}
test cmdAH-4.16.1 {Syntax error, -nocomplain and -failindex, encoding} -body {
    encoding convertfrom -nocomplain -failindex 2 utf-8 ABC
} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"}
test cmdAH-4.16.2 {Syntax error, -nocomplain and -failindex, encoding} -body {
    encoding convertto -nocomplain -failindex 2 utf-8 ABC
} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-failindex var? ?encoding? data"}
test cmdAH-4.17.1 {Syntax error, -failindex and -nocomplain, encoding} -body {
    encoding convertfrom -failindex 2 -nocomplain utf-8 ABC
} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"}
test cmdAH-4.17.2 {Syntax error, -failindex and -nocomplain, encoding} -body {
    encoding convertto -failindex 2 -nocomplain utf-8 ABC
} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-failindex var? ?encoding? data"}
test cmdAH-4.18.1 {Syntax error, -failindex with no var, no encoding} -body {
    encoding convertfrom -failindex ABC
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"}
test cmdAH-4.18.2 {Syntax error, -failindex with no var, no encoding (byte compiled)} -setup {
    proc encoding_test {} {
        encoding convertfrom -failindex ABC
    }
} -body {
    # Compile and execute
    encoding_test
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"} -cleanup {
    rename encoding_test ""
}
test cmdAH-4.18.3 {Syntax error, -failindex with no var, no encoding} -body {
    encoding convertto -failindex ABC
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-nocomplain? ?-failindex var? ?encoding? data"}
test cmdAH-4.18.4 {Syntax error, -failindex with no var, no encoding (byte compiled)} -setup {
    proc encoding_test {} {
        encoding convertto -failindex ABC
    }
} -body {
    # Compile and execute
    encoding_test
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-nocomplain? ?-failindex var? ?encoding? data"} -cleanup {
    rename encoding_test ""
}
test cmdAH-4.19.1 {convertrom -failindex with correct data} -body {
    encoding convertfrom -failindex test ABC
    set test
} -returnCodes 0 -result -1
test cmdAH-4.19.2 {convertrom -failindex with correct data (byt compiled)} -setup {
    proc encoding_test {} {
	encoding convertfrom -failindex test ABC
	set test
    }
} -body {
    # Compile and execute
    encoding_test
} -returnCodes 0 -result -1 -cleanup {
    rename encoding_test ""
}
test cmdAH-4.19.3 {convertrom -failindex with correct data} -body {
    encoding convertto -failindex test ABC
    set test
} -returnCodes 0 -result -1
test cmdAH-4.19.4 {convertrom -failindex with correct data (byt compiled)} -setup {
    proc encoding_test {} {
	encoding convertto -failindex test ABC
	set test
    }
} -body {
    # Compile and execute
    encoding_test
} -returnCodes 0 -result -1 -cleanup {
    rename encoding_test ""
}
test cmdAH-4.20.1 {convertrom -failindex with incomplete utf8} -body {
    set x [encoding convertfrom -failindex i utf-8 A\xc3]
    binary scan $x H* y
    list $y $i
} -returnCodes 0 -result {41c3 -1}
test cmdAH-4.20.2 {convertrom -failindex with incomplete utf8 (byte compiled)} -setup {
    proc encoding_test {} {
	set x [encoding convertfrom -failindex i utf-8 A\xc3]
	binary scan $x H* y
	list $y $i
    }
} -body {
    # Compile and execute
    encoding_test
} -returnCodes 0 -result {41c3 -1} -cleanup {
    rename encoding_test ""
}
test cmdAH-4.21.1 {convertto -failindex with wrong character} -body {
    set x [encoding convertto -failindex i iso8859-1 A\u0141]
    binary scan $x H* y
    list $y $i
} -returnCodes 0 -result {41 1}
test cmdAH-4.21.2 {convertto -failindex with wrong character (byte compiled)} -setup {
    proc encoding_test {} {
    set x [encoding convertto -failindex i iso8859-1 A\u0141]
	binary scan $x H* y
	list $y $i
    }
} -body {
    # Compile and execute
    encoding_test
} -returnCodes 0 -result {41 1} -cleanup {
    rename encoding_test ""
}

test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body {
    file
} -result {wrong # args: should be "file subcommand ?arg ...?"}
test cmdAH-5.2 {Tcl_FileObjCmd} -returnCodes error -body {
    file x
} -result {unknown or ambiguous subcommand "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempdir, tempfile, type, volumes, or writable}

    string length [encoding convertfrom -nocomplain "\x20"]
} 1
test encoding-24.21 {Parse with -nocomplain but without providing encoding} {
    string length [encoding convertto -nocomplain "\x20"]
} 1
test encoding-24.22 {Syntax error, two encodings} -body {
    encoding convertfrom iso8859-1 utf-8 "ZX\uD800"
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"}
test encoding-24.23 {Syntax error, two encodings} -body {
    encoding convertto iso8859-1 utf-8 "ZX\uD800"
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-nocomplain? ?-failindex var? ?encoding? data"}

file delete [file join [temporaryDirectory] iso2022.txt]

#
# Begin jajp encoding round-trip conformity tests
#
proc foreach-jisx0208 {varName command} {

} -result foobar
test safe-11.7 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding convertfrom
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"}
test safe-11.7.1 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    catch {interp eval $i encoding convertfrom} m o
    dict get $o -errorinfo
} -returnCodes ok -match glob -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"
    while executing
"encoding convertfrom"
    invoked from within
"encoding convertfrom"
    invoked from within
"interp eval $i encoding convertfrom"}
test safe-11.8 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding convertto
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-failindex var? ?encoding? data"}
test safe-11.8.1 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    catch {interp eval $i encoding convertto} m o
    dict get $o -errorinfo
} -returnCodes ok -match glob -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-failindex var? ?encoding? data"
    while executing
"encoding convertto"
    invoked from within
"encoding convertto"
    invoked from within
"interp eval $i encoding convertto"}