tclEncoding.c
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:91k
源码类别:

通讯编程

开发平台:

Visual C++

  1. /*
  2.  * tclEncoding.c --
  3.  *
  4.  * Contains the implementation of the encoding conversion package.
  5.  *
  6.  * Copyright (c) 1996-1998 Sun Microsystems, Inc.
  7.  *
  8.  * See the file "license.terms" for information on usage and redistribution
  9.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10.  *
  11.  * RCS: @(#) $Id: tclEncoding.c,v 1.16.2.14 2007/02/12 19:25:42 andreas_kupries Exp $
  12.  */
  13. #include "tclInt.h"
  14. #include "tclPort.h"
  15. typedef size_t (LengthProc)_ANSI_ARGS_((CONST char *src));
  16. /*
  17.  * The following data structure represents an encoding, which describes how
  18.  * to convert between various character sets and UTF-8.
  19.  */
  20. typedef struct Encoding {
  21.     char *name; /* Name of encoding.  Malloced because (1)
  22.  * hash table entry that owns this encoding
  23.  * may be freed prior to this encoding being
  24.  * freed, (2) string passed in the
  25.  * Tcl_EncodingType structure may not be
  26.  * persistent. */
  27.     Tcl_EncodingConvertProc *toUtfProc;
  28. /* Procedure to convert from external
  29.  * encoding into UTF-8. */
  30.     Tcl_EncodingConvertProc *fromUtfProc;
  31. /* Procedure to convert from UTF-8 into
  32.  * external encoding. */
  33.     Tcl_EncodingFreeProc *freeProc;
  34. /* If non-NULL, procedure to call when this
  35.  * encoding is deleted. */
  36.     int nullSize; /* Number of 0x00 bytes that signify
  37.  * end-of-string in this encoding.  This
  38.  * number is used to determine the source
  39.  * string length when the srcLen argument is
  40.  * negative.  This number can be 1 or 2. */
  41.     ClientData clientData; /* Arbitrary value associated with encoding
  42.  * type.  Passed to conversion procedures. */
  43.     LengthProc *lengthProc; /* Function to compute length of
  44.  * null-terminated strings in this encoding.
  45.  * If nullSize is 1, this is strlen; if
  46.  * nullSize is 2, this is a function that
  47.  * returns the number of bytes in a 0x0000
  48.  * terminated string. */
  49.     int refCount; /* Number of uses of this structure. */
  50.     Tcl_HashEntry *hPtr; /* Hash table entry that owns this encoding. */
  51. } Encoding;
  52. /*
  53.  * The following structure is the clientData for a dynamically-loaded,
  54.  * table-driven encoding created by LoadTableEncoding().  It maps between
  55.  * Unicode and a single-byte, double-byte, or multibyte (1 or 2 bytes only)
  56.  * encoding.
  57.  */
  58. typedef struct TableEncodingData {
  59.     int fallback; /* Character (in this encoding) to
  60.  * substitute when this encoding cannot
  61.  * represent a UTF-8 character. */
  62.     char prefixBytes[256]; /* If a byte in the input stream is a lead
  63.  * byte for a 2-byte sequence, the
  64.  * corresponding entry in this array is 1,
  65.  * otherwise it is 0. */
  66.     unsigned short **toUnicode; /* Two dimensional sparse matrix to map
  67.  * characters from the encoding to Unicode.
  68.  * Each element of the toUnicode array points
  69.  * to an array of 256 shorts.  If there is no
  70.  * corresponding character in Unicode, the
  71.  * value in the matrix is 0x0000.  malloc'd. */
  72.     unsigned short **fromUnicode;
  73. /* Two dimensional sparse matrix to map
  74.  * characters from Unicode to the encoding.
  75.  * Each element of the fromUnicode array
  76.  * points to an array of 256 shorts.  If there
  77.  * is no corresponding character the encoding,
  78.  * the value in the matrix is 0x0000.
  79.  * malloc'd. */
  80. } TableEncodingData;
  81. /*
  82.  * The following structures is the clientData for a dynamically-loaded,
  83.  * escape-driven encoding that is itself comprised of other simpler
  84.  * encodings.  An example is "iso-2022-jp", which uses escape sequences to
  85.  * switch between ascii, jis0208, jis0212, gb2312, and ksc5601.  Note that
  86.  * "escape-driven" does not necessarily mean that the ESCAPE character is
  87.  * the character used for switching character sets.
  88.  */
  89. typedef struct EscapeSubTable {
  90.     unsigned int sequenceLen; /* Length of following string. */
  91.     char sequence[16]; /* Escape code that marks this encoding. */
  92.     char name[32]; /* Name for encoding. */
  93.     Encoding *encodingPtr; /* Encoding loaded using above name, or NULL
  94.  * if this sub-encoding has not been needed
  95.  * yet. */
  96. } EscapeSubTable;
  97. typedef struct EscapeEncodingData {
  98.     int fallback; /* Character (in this encoding) to
  99.  * substitute when this encoding cannot
  100.  * represent a UTF-8 character. */
  101.     unsigned int initLen; /* Length of following string. */
  102.     char init[16]; /* String to emit or expect before first char
  103.  * in conversion. */
  104.     unsigned int finalLen; /* Length of following string. */
  105.     char final[16]; /* String to emit or expect after last char
  106.  * in conversion. */
  107.     char prefixBytes[256]; /* If a byte in the input stream is the 
  108.  * first character of one of the escape 
  109.  * sequences in the following array, the 
  110.  * corresponding entry in this array is 1,
  111.  * otherwise it is 0. */
  112.     int numSubTables; /* Length of following array. */
  113.     EscapeSubTable subTables[1];/* Information about each EscapeSubTable
  114.  * used by this encoding type.  The actual 
  115.  * size will be as large as necessary to 
  116.  * hold all EscapeSubTables. */
  117. } EscapeEncodingData;
  118. /*
  119.  * Constants used when loading an encoding file to identify the type of the
  120.  * file.
  121.  */
  122. #define ENCODING_SINGLEBYTE 0
  123. #define ENCODING_DOUBLEBYTE 1
  124. #define ENCODING_MULTIBYTE 2
  125. #define ENCODING_ESCAPE 3
  126. /*
  127.  * Initialize the default encoding directory.  If this variable contains
  128.  * a non NULL value, it will be the first path used to locate the
  129.  * system encoding files.
  130.  */
  131. char *tclDefaultEncodingDir = NULL;
  132. static int encodingsInitialized  = 0;
  133. /*
  134.  * Hash table that keeps track of all loaded Encodings.  Keys are
  135.  * the string names that represent the encoding, values are (Encoding *).
  136.  */
  137.  
  138. static Tcl_HashTable encodingTable;
  139. TCL_DECLARE_MUTEX(encodingMutex)
  140. /*
  141.  * The following are used to hold the default and current system encodings.  
  142.  * If NULL is passed to one of the conversion routines, the current setting 
  143.  * of the system encoding will be used to perform the conversion.
  144.  */
  145. static Tcl_Encoding defaultEncoding;
  146. static Tcl_Encoding systemEncoding;
  147. /*
  148.  * The following variable is used in the sparse matrix code for a
  149.  * TableEncoding to represent a page in the table that has no entries.
  150.  */
  151. static unsigned short emptyPage[256];
  152. /*
  153.  * Procedures used only in this module.
  154.  */
  155. static int BinaryProc _ANSI_ARGS_((ClientData clientData,
  156.     CONST char *src, int srcLen, int flags,
  157.     Tcl_EncodingState *statePtr, char *dst, int dstLen,
  158.     int *srcReadPtr, int *dstWrotePtr,
  159.     int *dstCharsPtr));
  160. static void DupEncodingIntRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
  161.     Tcl_Obj *dupPtr));
  162. static void EscapeFreeProc _ANSI_ARGS_((ClientData clientData));
  163. static int EscapeFromUtfProc _ANSI_ARGS_((ClientData clientData,
  164.     CONST char *src, int srcLen, int flags,
  165.     Tcl_EncodingState *statePtr, char *dst, int dstLen,
  166.     int *srcReadPtr, int *dstWrotePtr,
  167.     int *dstCharsPtr));
  168. static int EscapeToUtfProc _ANSI_ARGS_((ClientData clientData,
  169.     CONST char *src, int srcLen, int flags,
  170.     Tcl_EncodingState *statePtr, char *dst, int dstLen,
  171.     int *srcReadPtr, int *dstWrotePtr,
  172.     int *dstCharsPtr));
  173. static void FreeEncoding _ANSI_ARGS_((Tcl_Encoding encoding));
  174. static void FreeEncodingIntRep _ANSI_ARGS_((Tcl_Obj *objPtr));
  175. static Encoding * GetTableEncoding _ANSI_ARGS_((
  176.     EscapeEncodingData *dataPtr, int state));
  177. static Tcl_Encoding LoadEncodingFile _ANSI_ARGS_((Tcl_Interp *interp,
  178.     CONST char *name));
  179. static Tcl_Encoding LoadTableEncoding _ANSI_ARGS_((Tcl_Interp *interp,
  180.     CONST char *name, int type, Tcl_Channel chan));
  181. static Tcl_Encoding LoadEscapeEncoding _ANSI_ARGS_((CONST char *name, 
  182.     Tcl_Channel chan));
  183. static Tcl_Channel OpenEncodingFile _ANSI_ARGS_((CONST char *dir,
  184.     CONST char *name));
  185. static void TableFreeProc _ANSI_ARGS_((ClientData clientData));
  186. static int TableFromUtfProc _ANSI_ARGS_((ClientData clientData,
  187.     CONST char *src, int srcLen, int flags,
  188.     Tcl_EncodingState *statePtr, char *dst, int dstLen,
  189.     int *srcReadPtr, int *dstWrotePtr,
  190.     int *dstCharsPtr));
  191. static int TableToUtfProc _ANSI_ARGS_((ClientData clientData,
  192.     CONST char *src, int srcLen, int flags,
  193.     Tcl_EncodingState *statePtr, char *dst, int dstLen,
  194.     int *srcReadPtr, int *dstWrotePtr,
  195.     int *dstCharsPtr));
  196. static size_t unilen _ANSI_ARGS_((CONST char *src));
  197. static int UnicodeToUtfProc _ANSI_ARGS_((ClientData clientData,
  198.     CONST char *src, int srcLen, int flags,
  199.     Tcl_EncodingState *statePtr, char *dst, int dstLen,
  200.     int *srcReadPtr, int *dstWrotePtr,
  201.     int *dstCharsPtr));
  202. static int UtfToUnicodeProc _ANSI_ARGS_((ClientData clientData,
  203.     CONST char *src, int srcLen, int flags,
  204.     Tcl_EncodingState *statePtr, char *dst, int dstLen,
  205.     int *srcReadPtr, int *dstWrotePtr,
  206.     int *dstCharsPtr));
  207. static int UtfToUtfProc _ANSI_ARGS_((ClientData clientData,
  208.     CONST char *src, int srcLen, int flags,
  209.     Tcl_EncodingState *statePtr, char *dst, int dstLen,
  210.     int *srcReadPtr, int *dstWrotePtr,
  211.     int *dstCharsPtr, int pureNullMode));
  212. static int UtfIntToUtfExtProc _ANSI_ARGS_((ClientData clientData,
  213.     CONST char *src, int srcLen, int flags,
  214.     Tcl_EncodingState *statePtr, char *dst, int dstLen,
  215.     int *srcReadPtr, int *dstWrotePtr,
  216.     int *dstCharsPtr));
  217. static int UtfExtToUtfIntProc _ANSI_ARGS_((ClientData clientData,
  218.     CONST char *src, int srcLen, int flags,
  219.     Tcl_EncodingState *statePtr, char *dst, int dstLen,
  220.     int *srcReadPtr, int *dstWrotePtr,
  221.     int *dstCharsPtr));
  222. static int TclFindEncodings _ANSI_ARGS_((CONST char *argv0));
  223. /*
  224.  * A Tcl_ObjType for holding a cached Tcl_Encoding as the intrep.
  225.  * This should help the lifetime of encodings be more useful.  
  226.  * See concerns raised in [Bug 1077262].
  227.  */
  228. static Tcl_ObjType EncodingType = {
  229.     "encoding", FreeEncodingIntRep, DupEncodingIntRep, NULL, NULL
  230. };
  231. /*
  232.  *----------------------------------------------------------------------
  233.  *
  234.  * TclGetEncodingFromObj --
  235.  *
  236.  *      Writes to (*encodingPtr) the Tcl_Encoding value of (*objPtr),
  237.  *      if possible, and returns TCL_OK.  If no such encoding exists,
  238.  *      TCL_ERROR is returned, and if interp is non-NULL, an error message
  239.  *      is written there.
  240.  *
  241.  * Results:
  242.  *      Standard Tcl return code.
  243.  *
  244.  * Side effects:
  245.  *  Caches the Tcl_Encoding value as the internal rep of (*objPtr).
  246.  *
  247.  *----------------------------------------------------------------------
  248.  */
  249. int 
  250. TclGetEncodingFromObj(interp, objPtr, encodingPtr)
  251.     Tcl_Interp *interp;
  252.     Tcl_Obj *objPtr;
  253.     Tcl_Encoding *encodingPtr;
  254. {
  255.     CONST char *name = Tcl_GetString(objPtr);
  256.     if (objPtr->typePtr != &EncodingType) {
  257. Tcl_Encoding encoding = Tcl_GetEncoding(interp, name);
  258. if (encoding == NULL) {
  259.     return TCL_ERROR;
  260. }
  261. if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc) {
  262.     objPtr->typePtr->freeIntRepProc(objPtr);
  263. }
  264. objPtr->internalRep.otherValuePtr = (VOID *) encoding;
  265. objPtr->typePtr = &EncodingType;
  266.     }
  267.     *encodingPtr = Tcl_GetEncoding(NULL, name);
  268.     return TCL_OK;
  269. }
  270. /*
  271.  *----------------------------------------------------------------------
  272.  *
  273.  * FreeEncodingIntRep --
  274.  *
  275.  *      The Tcl_FreeInternalRepProc for the "encoding" Tcl_ObjType.
  276.  *
  277.  *----------------------------------------------------------------------
  278.  */
  279. static void
  280. FreeEncodingIntRep(objPtr)
  281.     Tcl_Obj *objPtr;
  282. {
  283.     Tcl_FreeEncoding((Tcl_Encoding) objPtr->internalRep.otherValuePtr);
  284. }
  285. /*
  286.  *----------------------------------------------------------------------
  287.  *
  288.  * DupEncodingIntRep --
  289.  *
  290.  *      The Tcl_DupInternalRepProc for the "encoding" Tcl_ObjType.
  291.  *
  292.  *----------------------------------------------------------------------
  293.  */
  294. static void
  295. DupEncodingIntRep(srcPtr, dupPtr)
  296.     Tcl_Obj *srcPtr;
  297.     Tcl_Obj *dupPtr;
  298. {
  299.     dupPtr->internalRep.otherValuePtr = (VOID *)
  300.     Tcl_GetEncoding(NULL, srcPtr->bytes);
  301. }
  302. /*
  303.  *---------------------------------------------------------------------------
  304.  *
  305.  * TclInitEncodingSubsystem --
  306.  *
  307.  * Initialize all resources used by this subsystem on a per-process
  308.  * basis.  
  309.  *
  310.  * Results:
  311.  * None.
  312.  *
  313.  * Side effects:
  314.  * Depends on the memory, object, and IO subsystems.
  315.  *
  316.  *---------------------------------------------------------------------------
  317.  */
  318. void
  319. TclInitEncodingSubsystem()
  320. {
  321.     Tcl_EncodingType type;
  322.     Tcl_MutexLock(&encodingMutex);
  323.     Tcl_InitHashTable(&encodingTable, TCL_STRING_KEYS);
  324.     Tcl_MutexUnlock(&encodingMutex);
  325.     
  326.     /*
  327.      * Create a few initial encodings.  Note that the UTF-8 to UTF-8 
  328.      * translation is not a no-op, because it will turn a stream of
  329.      * improperly formed UTF-8 into a properly formed stream.
  330.      */
  331.     type.encodingName = "identity";
  332.     type.toUtfProc = BinaryProc;
  333.     type.fromUtfProc = BinaryProc;
  334.     type.freeProc = NULL;
  335.     type.nullSize = 1;
  336.     type.clientData = NULL;
  337.     defaultEncoding = Tcl_CreateEncoding(&type);
  338.     systemEncoding = Tcl_GetEncoding(NULL, type.encodingName);
  339.     type.encodingName = "utf-8";
  340.     type.toUtfProc = UtfExtToUtfIntProc;
  341.     type.fromUtfProc = UtfIntToUtfExtProc;
  342.     type.freeProc = NULL;
  343.     type.nullSize = 1;
  344.     type.clientData = NULL;
  345.     Tcl_CreateEncoding(&type);
  346.     type.encodingName   = "unicode";
  347.     type.toUtfProc = UnicodeToUtfProc;
  348.     type.fromUtfProc    = UtfToUnicodeProc;
  349.     type.freeProc = NULL;
  350.     type.nullSize = 2;
  351.     type.clientData = NULL;
  352.     Tcl_CreateEncoding(&type);
  353. }
  354. /*
  355.  *----------------------------------------------------------------------
  356.  *
  357.  * TclFinalizeEncodingSubsystem --
  358.  *
  359.  * Release the state associated with the encoding subsystem.
  360.  *
  361.  * Results:
  362.  * None.
  363.  *
  364.  * Side effects:
  365.  * Frees all of the encodings.
  366.  *
  367.  *----------------------------------------------------------------------
  368.  */
  369. void
  370. TclFinalizeEncodingSubsystem()
  371. {
  372.     Tcl_HashSearch search;
  373.     Tcl_HashEntry *hPtr;
  374.     Tcl_MutexLock(&encodingMutex);
  375.     encodingsInitialized  = 0;
  376.     FreeEncoding(systemEncoding);
  377.     hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
  378.     while (hPtr != NULL) {
  379. /*
  380.  * Call FreeEncoding instead of doing it directly to handle refcounts
  381.  * like escape encodings use.  [Bug #524674]
  382.  * Make sure to call Tcl_FirstHashEntry repeatedly so that all
  383.  * encodings are eventually cleaned up.
  384.  */
  385. FreeEncoding((Tcl_Encoding) Tcl_GetHashValue(hPtr));
  386. hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
  387.     }
  388.     Tcl_DeleteHashTable(&encodingTable);
  389.     Tcl_MutexUnlock(&encodingMutex);
  390. }
  391. /*
  392.  *-------------------------------------------------------------------------
  393.  *
  394.  * Tcl_GetDefaultEncodingDir --
  395.  *
  396.  *
  397.  * Results:
  398.  *
  399.  * Side effects:
  400.  *
  401.  *-------------------------------------------------------------------------
  402.  */
  403. CONST char *
  404. Tcl_GetDefaultEncodingDir()
  405. {
  406.     return tclDefaultEncodingDir;
  407. }
  408. /*
  409.  *-------------------------------------------------------------------------
  410.  *
  411.  * Tcl_SetDefaultEncodingDir --
  412.  *
  413.  *
  414.  * Results:
  415.  *
  416.  * Side effects:
  417.  *
  418.  *-------------------------------------------------------------------------
  419.  */
  420. void
  421. Tcl_SetDefaultEncodingDir(path)
  422.     CONST char *path;
  423. {
  424.     tclDefaultEncodingDir = (char *)ckalloc((unsigned) strlen(path) + 1);
  425.     strcpy(tclDefaultEncodingDir, path);
  426. }
  427. /*
  428.  *-------------------------------------------------------------------------
  429.  *
  430.  * Tcl_GetEncoding --
  431.  *
  432.  * Given the name of a encoding, find the corresponding Tcl_Encoding
  433.  * token.  If the encoding did not already exist, Tcl attempts to
  434.  * dynamically load an encoding by that name.
  435.  *
  436.  * Results:
  437.  * Returns a token that represents the encoding.  If the name didn't
  438.  * refer to any known or loadable encoding, NULL is returned.  If
  439.  * NULL was returned, an error message is left in interp's result
  440.  * object, unless interp was NULL.
  441.  *
  442.  * Side effects:
  443.  * The new encoding type is entered into a table visible to all
  444.  * interpreters, keyed off the encoding's name.  For each call to
  445.  * this procedure, there should eventually be a call to
  446.  * Tcl_FreeEncoding, so that the database can be cleaned up when
  447.  * encodings aren't needed anymore.
  448.  *
  449.  *-------------------------------------------------------------------------
  450.  */
  451. Tcl_Encoding
  452. Tcl_GetEncoding(interp, name)
  453.     Tcl_Interp *interp; /* Interp for error reporting, if not NULL. */
  454.     CONST char *name; /* The name of the desired encoding. */
  455. {
  456.     Tcl_HashEntry *hPtr;
  457.     Encoding *encodingPtr;
  458.     Tcl_MutexLock(&encodingMutex);
  459.     if (name == NULL) {
  460. encodingPtr = (Encoding *) systemEncoding;
  461. encodingPtr->refCount++;
  462. Tcl_MutexUnlock(&encodingMutex);
  463. return systemEncoding;
  464.     }
  465.     hPtr = Tcl_FindHashEntry(&encodingTable, name);
  466.     if (hPtr != NULL) {
  467. encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
  468. encodingPtr->refCount++;
  469. Tcl_MutexUnlock(&encodingMutex);
  470. return (Tcl_Encoding) encodingPtr;
  471.     }
  472.     Tcl_MutexUnlock(&encodingMutex);
  473.     return LoadEncodingFile(interp, name);
  474. }
  475. /*
  476.  *---------------------------------------------------------------------------
  477.  *
  478.  * Tcl_FreeEncoding --
  479.  *
  480.  * This procedure is called to release an encoding allocated by
  481.  * Tcl_CreateEncoding() or Tcl_GetEncoding().
  482.  *
  483.  * Results:
  484.  * None.
  485.  *
  486.  * Side effects:
  487.  * The reference count associated with the encoding is decremented
  488.  * and the encoding may be deleted if nothing is using it anymore.
  489.  *
  490.  *---------------------------------------------------------------------------
  491.  */
  492. void
  493. Tcl_FreeEncoding(encoding)
  494.     Tcl_Encoding encoding;
  495. {
  496.     Tcl_MutexLock(&encodingMutex);
  497.     FreeEncoding(encoding);
  498.     Tcl_MutexUnlock(&encodingMutex);
  499. }
  500. /*
  501.  *----------------------------------------------------------------------
  502.  *
  503.  * FreeEncoding --
  504.  *
  505.  * This procedure is called to release an encoding by procedures
  506.  * that already have the encodingMutex.
  507.  *
  508.  * Results:
  509.  * None.
  510.  *
  511.  * Side effects:
  512.  * The reference count associated with the encoding is decremented
  513.  * and the encoding may be deleted if nothing is using it anymore.
  514.  *
  515.  *----------------------------------------------------------------------
  516.  */
  517. static void
  518. FreeEncoding(encoding)
  519.     Tcl_Encoding encoding;
  520. {
  521.     Encoding *encodingPtr;
  522.     
  523.     encodingPtr = (Encoding *) encoding;
  524.     if (encodingPtr == NULL) {
  525. return;
  526.     }
  527.     encodingPtr->refCount--;
  528.     if (encodingPtr->refCount == 0) {
  529. if (encodingPtr->freeProc != NULL) {
  530.     (*encodingPtr->freeProc)(encodingPtr->clientData);
  531. }
  532. if (encodingPtr->hPtr != NULL) {
  533.     Tcl_DeleteHashEntry(encodingPtr->hPtr);
  534. }
  535. ckfree((char *) encodingPtr->name);
  536. ckfree((char *) encodingPtr);
  537.     }
  538. }
  539. /*
  540.  *-------------------------------------------------------------------------
  541.  *
  542.  * Tcl_GetEncodingName --
  543.  *
  544.  * Given an encoding, return the name that was used to constuct
  545.  * the encoding.
  546.  *
  547.  * Results:
  548.  * The name of the encoding.
  549.  *
  550.  * Side effects:
  551.  * None.
  552.  *
  553.  *---------------------------------------------------------------------------
  554.  */
  555. CONST char *
  556. Tcl_GetEncodingName(encoding)
  557.     Tcl_Encoding encoding; /* The encoding whose name to fetch. */
  558. {
  559.     Encoding *encodingPtr;
  560.     if (encoding == NULL) {
  561. encoding = systemEncoding;
  562.     }
  563.     encodingPtr = (Encoding *) encoding;
  564.     return encodingPtr->name;
  565. }
  566. /*
  567.  *-------------------------------------------------------------------------
  568.  *
  569.  * Tcl_GetEncodingNames --
  570.  *
  571.  * Get the list of all known encodings, including the ones stored
  572.  * as files on disk in the encoding path.
  573.  *
  574.  * Results:
  575.  * Modifies interp's result object to hold a list of all the available
  576.  * encodings.
  577.  *
  578.  * Side effects:
  579.  * None.
  580.  *
  581.  *-------------------------------------------------------------------------
  582.  */
  583. void
  584. Tcl_GetEncodingNames(interp)
  585.     Tcl_Interp *interp; /* Interp to hold result. */
  586. {
  587.     Tcl_HashSearch search;
  588.     Tcl_HashEntry *hPtr;
  589.     Tcl_Obj *pathPtr, *resultPtr;
  590.     int dummy;
  591.     Tcl_HashTable table;
  592.     Tcl_MutexLock(&encodingMutex);
  593.     Tcl_InitHashTable(&table, TCL_STRING_KEYS);
  594.     hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
  595.     while (hPtr != NULL) {
  596. Encoding *encodingPtr;
  597. encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
  598. Tcl_CreateHashEntry(&table, encodingPtr->name, &dummy);
  599. hPtr = Tcl_NextHashEntry(&search);
  600.     }
  601.     Tcl_MutexUnlock(&encodingMutex);
  602.     pathPtr = TclGetLibraryPath();
  603.     if (pathPtr != NULL) {
  604. int i, objc;
  605. Tcl_Obj **objv;
  606. char globArgString[10];
  607. Tcl_Obj* encodingObj = Tcl_NewStringObj("encoding",-1);
  608. Tcl_IncrRefCount(encodingObj);
  609. objc = 0;
  610. Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
  611. for (i = 0; i < objc; i++) {
  612.     Tcl_Obj *searchIn;
  613.     
  614.     /* 
  615.      * Construct the path from the element of pathPtr,
  616.      * joined with 'encoding'.
  617.      */
  618.     searchIn = Tcl_FSJoinToPath(objv[i],1,&encodingObj);
  619.     Tcl_IncrRefCount(searchIn);
  620.     Tcl_ResetResult(interp);
  621.     /*
  622.      * TclGlob() changes the contents of globArgString, which causes
  623.      * a segfault if we pass in a pointer to non-writeable memory.
  624.      * TclGlob() puts its results directly into interp.
  625.      */
  626.     strcpy(globArgString, "*.enc");
  627.     /* 
  628.      * The GLOBMODE_TAILS flag returns just the tail of each file
  629.      * which is the encoding name with a .enc extension 
  630.      */
  631.     if ((TclGlob(interp, globArgString, searchIn, 
  632.  TCL_GLOBMODE_TAILS, NULL) == TCL_OK)) {
  633. int objc2 = 0;
  634. Tcl_Obj **objv2;
  635. int j;
  636. Tcl_ListObjGetElements(NULL, Tcl_GetObjResult(interp), &objc2,
  637. &objv2);
  638. for (j = 0; j < objc2; j++) {
  639.     int length;
  640.     char *string;
  641.     string = Tcl_GetStringFromObj(objv2[j], &length);
  642.     length -= 4;
  643.     if (length > 0) {
  644. string[length] = '';
  645. Tcl_CreateHashEntry(&table, string, &dummy);
  646. string[length] = '.';
  647.     }
  648. }
  649.     }
  650.     Tcl_DecrRefCount(searchIn);
  651. }
  652. Tcl_DecrRefCount(encodingObj);
  653.     }
  654.     /*
  655.      * Clear any values placed in the result by globbing.
  656.      */
  657.     Tcl_ResetResult(interp);
  658.     resultPtr = Tcl_GetObjResult(interp);
  659.     hPtr = Tcl_FirstHashEntry(&table, &search);
  660.     while (hPtr != NULL) {
  661. Tcl_Obj *strPtr;
  662. strPtr = Tcl_NewStringObj(Tcl_GetHashKey(&table, hPtr), -1);
  663. Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
  664. hPtr = Tcl_NextHashEntry(&search);
  665.     }
  666.     Tcl_DeleteHashTable(&table);
  667. }
  668. /*
  669.  *------------------------------------------------------------------------
  670.  *
  671.  * Tcl_SetSystemEncoding --
  672.  *
  673.  * Sets the default encoding that should be used whenever the user
  674.  * passes a NULL value in to one of the conversion routines.
  675.  * If the supplied name is NULL, the system encoding is reset to the
  676.  * default system encoding.
  677.  *
  678.  * Results:
  679.  * The return value is TCL_OK if the system encoding was successfully
  680.  * set to the encoding specified by name, TCL_ERROR otherwise.  If
  681.  * TCL_ERROR is returned, an error message is left in interp's result
  682.  * object, unless interp was NULL.
  683.  *
  684.  * Side effects:
  685.  * The reference count of the new system encoding is incremented.
  686.  * The reference count of the old system encoding is decremented and 
  687.  * it may be freed.  
  688.  *
  689.  *------------------------------------------------------------------------
  690.  */
  691. int
  692. Tcl_SetSystemEncoding(interp, name)
  693.     Tcl_Interp *interp; /* Interp for error reporting, if not NULL. */
  694.     CONST char *name; /* The name of the desired encoding, or NULL
  695.  * to reset to default encoding. */
  696. {
  697.     Tcl_Encoding encoding;
  698.     Encoding *encodingPtr;
  699.     if (name == NULL) {
  700. Tcl_MutexLock(&encodingMutex);
  701. encoding = defaultEncoding;
  702. encodingPtr = (Encoding *) encoding;
  703. encodingPtr->refCount++;
  704. Tcl_MutexUnlock(&encodingMutex);
  705.     } else {
  706. encoding = Tcl_GetEncoding(interp, name);
  707. if (encoding == NULL) {
  708.     return TCL_ERROR;
  709. }
  710.     }
  711.     Tcl_MutexLock(&encodingMutex);
  712.     FreeEncoding(systemEncoding);
  713.     systemEncoding = encoding;
  714.     Tcl_MutexUnlock(&encodingMutex);
  715.     return TCL_OK;
  716. }
  717. /*
  718.  *---------------------------------------------------------------------------
  719.  *
  720.  * Tcl_CreateEncoding --
  721.  *
  722.  * This procedure is called to define a new encoding and the procedures
  723.  * that are used to convert between the specified encoding and Unicode.  
  724.  *
  725.  * Results:
  726.  * Returns a token that represents the encoding.  If an encoding with
  727.  * the same name already existed, the old encoding token remains
  728.  * valid and continues to behave as it used to, and will eventually
  729.  * be garbage collected when the last reference to it goes away.  Any
  730.  * subsequent calls to Tcl_GetEncoding with the specified name will
  731.  * retrieve the most recent encoding token.
  732.  *
  733.  * Side effects:
  734.  * The new encoding type is entered into a table visible to all
  735.  * interpreters, keyed off the encoding's name.  For each call to
  736.  * this procedure, there should eventually be a call to
  737.  * Tcl_FreeEncoding, so that the database can be cleaned up when
  738.  * encodings aren't needed anymore.
  739.  *
  740.  *---------------------------------------------------------------------------
  741.  */ 
  742. Tcl_Encoding
  743. Tcl_CreateEncoding(typePtr)
  744.     Tcl_EncodingType *typePtr; /* The encoding type. */
  745. {
  746.     Tcl_HashEntry *hPtr;
  747.     int new;
  748.     Encoding *encodingPtr;
  749.     char *name;
  750.     Tcl_MutexLock(&encodingMutex);
  751.     hPtr = Tcl_CreateHashEntry(&encodingTable, typePtr->encodingName, &new);
  752.     if (new == 0) {
  753. /*
  754.  * Remove old encoding from hash table, but don't delete it until
  755.  * last reference goes away.
  756.  */
  757.  
  758. encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
  759. encodingPtr->hPtr = NULL;
  760.     }
  761.     name = ckalloc((unsigned) strlen(typePtr->encodingName) + 1);
  762.     
  763.     encodingPtr = (Encoding *) ckalloc(sizeof(Encoding));
  764.     encodingPtr->name = strcpy(name, typePtr->encodingName);
  765.     encodingPtr->toUtfProc = typePtr->toUtfProc;
  766.     encodingPtr->fromUtfProc = typePtr->fromUtfProc;
  767.     encodingPtr->freeProc = typePtr->freeProc;
  768.     encodingPtr->nullSize = typePtr->nullSize;
  769.     encodingPtr->clientData = typePtr->clientData;
  770.     if (typePtr->nullSize == 1) {
  771. encodingPtr->lengthProc = (LengthProc *) strlen;
  772.     } else {
  773. encodingPtr->lengthProc = (LengthProc *) unilen;
  774.     }
  775.     encodingPtr->refCount = 1;
  776.     encodingPtr->hPtr = hPtr;
  777.     Tcl_SetHashValue(hPtr, encodingPtr);
  778.     Tcl_MutexUnlock(&encodingMutex);
  779.     return (Tcl_Encoding) encodingPtr;
  780. }
  781. /*
  782.  *-------------------------------------------------------------------------
  783.  *
  784.  * Tcl_ExternalToUtfDString --
  785.  *
  786.  * Convert a source buffer from the specified encoding into UTF-8.
  787.  * If any of the bytes in the source buffer are invalid or cannot
  788.  * be represented in the target encoding, a default fallback
  789.  * character will be substituted.
  790.  *
  791.  * Results:
  792.  * The converted bytes are stored in the DString, which is then NULL
  793.  * terminated.  The return value is a pointer to the value stored 
  794.  * in the DString.
  795.  *
  796.  * Side effects:
  797.  * None.
  798.  *
  799.  *-------------------------------------------------------------------------
  800.  */
  801. char * 
  802. Tcl_ExternalToUtfDString(encoding, src, srcLen, dstPtr)
  803.     Tcl_Encoding encoding; /* The encoding for the source string, or
  804.  * NULL for the default system encoding. */
  805.     CONST char *src; /* Source string in specified encoding. */
  806.     int srcLen; /* Source string length in bytes, or < 0 for
  807.  * encoding-specific string length. */
  808.     Tcl_DString *dstPtr; /* Uninitialized or free DString in which 
  809.  * the converted string is stored. */
  810. {
  811.     char *dst;
  812.     Tcl_EncodingState state;
  813.     Encoding *encodingPtr;
  814.     int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars;
  815.     Tcl_DStringInit(dstPtr);
  816.     dst = Tcl_DStringValue(dstPtr);
  817.     dstLen = dstPtr->spaceAvl - 1;
  818.     
  819.     if (encoding == NULL) {
  820. encoding = systemEncoding;
  821.     }
  822.     encodingPtr = (Encoding *) encoding;
  823.     if (src == NULL) {
  824. srcLen = 0;
  825.     } else if (srcLen < 0) {
  826. srcLen = (*encodingPtr->lengthProc)(src);
  827.     }
  828.     flags = TCL_ENCODING_START | TCL_ENCODING_END;
  829.     while (1) {
  830. result = (*encodingPtr->toUtfProc)(encodingPtr->clientData, src,
  831. srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote,
  832. &dstChars);
  833. soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
  834. if (result != TCL_CONVERT_NOSPACE) {
  835.     Tcl_DStringSetLength(dstPtr, soFar);
  836.     return Tcl_DStringValue(dstPtr);
  837. }
  838. flags &= ~TCL_ENCODING_START;
  839. src += srcRead;
  840. srcLen -= srcRead;
  841. if (Tcl_DStringLength(dstPtr) == 0) {
  842.     Tcl_DStringSetLength(dstPtr, dstLen);
  843. }
  844. Tcl_DStringSetLength(dstPtr, 2 * Tcl_DStringLength(dstPtr) + 1);
  845. dst = Tcl_DStringValue(dstPtr) + soFar;
  846. dstLen = Tcl_DStringLength(dstPtr) - soFar - 1;
  847.     }
  848. }
  849. /*
  850.  *-------------------------------------------------------------------------
  851.  *
  852.  * Tcl_ExternalToUtf --
  853.  *
  854.  * Convert a source buffer from the specified encoding into UTF-8.
  855.  *
  856.  * Results:
  857.  * The return value is one of TCL_OK, TCL_CONVERT_MULTIBYTE,
  858.  * TCL_CONVERT_SYNTAX, TCL_CONVERT_UNKNOWN, or TCL_CONVERT_NOSPACE,
  859.  * as documented in tcl.h.
  860.  *
  861.  * Side effects:
  862.  * The converted bytes are stored in the output buffer.  
  863.  *
  864.  *-------------------------------------------------------------------------
  865.  */
  866. int
  867. Tcl_ExternalToUtf(interp, encoding, src, srcLen, flags, statePtr, dst,
  868. dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr)
  869.     Tcl_Interp *interp; /* Interp for error return, if not NULL. */
  870.     Tcl_Encoding encoding; /* The encoding for the source string, or
  871.  * NULL for the default system encoding. */
  872.     CONST char *src; /* Source string in specified encoding. */
  873.     int srcLen; /* Source string length in bytes, or < 0 for
  874.  * encoding-specific string length. */
  875.     int flags; /* Conversion control flags. */
  876.     Tcl_EncodingState *statePtr;/* Place for conversion routine to store
  877.  * state information used during a piecewise
  878.  * conversion.  Contents of statePtr are
  879.  * initialized and/or reset by conversion
  880.  * routine under control of flags argument. */
  881.     char *dst; /* Output buffer in which converted string
  882.  * is stored. */
  883.     int dstLen; /* The maximum length of output buffer in
  884.  * bytes. */
  885.     int *srcReadPtr; /* Filled with the number of bytes from the
  886.  * source string that were converted.  This
  887.  * may be less than the original source length
  888.  * if there was a problem converting some
  889.  * source characters. */
  890.     int *dstWrotePtr; /* Filled with the number of bytes that were
  891.  * stored in the output buffer as a result of
  892.  * the conversion. */
  893.     int *dstCharsPtr; /* Filled with the number of characters that
  894.  * correspond to the bytes stored in the
  895.  * output buffer. */
  896. {
  897.     Encoding *encodingPtr;
  898.     int result, srcRead, dstWrote, dstChars;
  899.     Tcl_EncodingState state;
  900.     
  901.     if (encoding == NULL) {
  902. encoding = systemEncoding;
  903.     }
  904.     encodingPtr = (Encoding *) encoding;
  905.     if (src == NULL) {
  906. srcLen = 0;
  907.     } else if (srcLen < 0) {
  908. srcLen = (*encodingPtr->lengthProc)(src);
  909.     }
  910.     if (statePtr == NULL) {
  911. flags |= TCL_ENCODING_START | TCL_ENCODING_END;
  912. statePtr = &state;
  913.     }
  914.     if (srcReadPtr == NULL) {
  915. srcReadPtr = &srcRead;
  916.     }
  917.     if (dstWrotePtr == NULL) {
  918. dstWrotePtr = &dstWrote;
  919.     }
  920.     if (dstCharsPtr == NULL) {
  921. dstCharsPtr = &dstChars;
  922.     }
  923.     /*
  924.      * If there are any null characters in the middle of the buffer, they will
  925.      * converted to the UTF-8 null character (xC080).  To get the actual 
  926.      *  at the end of the destination buffer, we need to append it manually.
  927.      */
  928.     dstLen--;
  929.     result = (*encodingPtr->toUtfProc)(encodingPtr->clientData, src, srcLen,
  930.     flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
  931.     dstCharsPtr);
  932.     dst[*dstWrotePtr] = '';
  933.     return result;
  934. }
  935. /*
  936.  *-------------------------------------------------------------------------
  937.  *
  938.  * Tcl_UtfToExternalDString --
  939.  *
  940.  * Convert a source buffer from UTF-8 into the specified encoding.
  941.  * If any of the bytes in the source buffer are invalid or cannot
  942.  * be represented in the target encoding, a default fallback
  943.  * character will be substituted.
  944.  *
  945.  * Results:
  946.  * The converted bytes are stored in the DString, which is then
  947.  * NULL terminated in an encoding-specific manner.  The return value 
  948.  * is a pointer to the value stored in the DString.
  949.  *
  950.  * Side effects:
  951.  * None.
  952.  *
  953.  *-------------------------------------------------------------------------
  954.  */
  955. char *
  956. Tcl_UtfToExternalDString(encoding, src, srcLen, dstPtr)
  957.     Tcl_Encoding encoding; /* The encoding for the converted string,
  958.  * or NULL for the default system encoding. */
  959.     CONST char *src; /* Source string in UTF-8. */
  960.     int srcLen; /* Source string length in bytes, or < 0 for
  961.  * strlen(). */
  962.     Tcl_DString *dstPtr; /* Uninitialized or free DString in which 
  963.  * the converted string is stored. */
  964. {
  965.     char *dst;
  966.     Tcl_EncodingState state;
  967.     Encoding *encodingPtr;
  968.     int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars;
  969.     
  970.     Tcl_DStringInit(dstPtr);
  971.     dst = Tcl_DStringValue(dstPtr);
  972.     dstLen = dstPtr->spaceAvl - 1;
  973.     if (encoding == NULL) {
  974. encoding = systemEncoding;
  975.     }
  976.     encodingPtr = (Encoding *) encoding;
  977.     if (src == NULL) {
  978. srcLen = 0;
  979.     } else if (srcLen < 0) {
  980. srcLen = strlen(src);
  981.     }
  982.     flags = TCL_ENCODING_START | TCL_ENCODING_END;
  983.     while (1) {
  984. result = (*encodingPtr->fromUtfProc)(encodingPtr->clientData, src,
  985. srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote,
  986. &dstChars);
  987. soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
  988. if (result != TCL_CONVERT_NOSPACE) {
  989.     if (encodingPtr->nullSize == 2) {
  990.         Tcl_DStringSetLength(dstPtr, soFar + 1);
  991.     }
  992.     Tcl_DStringSetLength(dstPtr, soFar);
  993.     return Tcl_DStringValue(dstPtr);
  994. }
  995. flags &= ~TCL_ENCODING_START;
  996. src += srcRead;
  997. srcLen -= srcRead;
  998. if (Tcl_DStringLength(dstPtr) == 0) {
  999.     Tcl_DStringSetLength(dstPtr, dstLen);
  1000. }
  1001. Tcl_DStringSetLength(dstPtr, 2 * Tcl_DStringLength(dstPtr) + 1);
  1002. dst = Tcl_DStringValue(dstPtr) + soFar;
  1003. dstLen = Tcl_DStringLength(dstPtr) - soFar - 1;
  1004.     }
  1005. }
  1006. /*
  1007.  *-------------------------------------------------------------------------
  1008.  *
  1009.  * Tcl_UtfToExternal --
  1010.  *
  1011.  * Convert a buffer from UTF-8 into the specified encoding.
  1012.  *
  1013.  * Results:
  1014.  * The return value is one of TCL_OK, TCL_CONVERT_MULTIBYTE,
  1015.  * TCL_CONVERT_SYNTAX, TCL_CONVERT_UNKNOWN, or TCL_CONVERT_NOSPACE,
  1016.  * as documented in tcl.h.
  1017.  *
  1018.  * Side effects:
  1019.  * The converted bytes are stored in the output buffer.  
  1020.  *
  1021.  *-------------------------------------------------------------------------
  1022.  */
  1023. int
  1024. Tcl_UtfToExternal(interp, encoding, src, srcLen, flags, statePtr, dst,
  1025. dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr)
  1026.     Tcl_Interp *interp; /* Interp for error return, if not NULL. */
  1027.     Tcl_Encoding encoding; /* The encoding for the converted string,
  1028.  * or NULL for the default system encoding. */
  1029.     CONST char *src; /* Source string in UTF-8. */
  1030.     int srcLen; /* Source string length in bytes, or < 0 for
  1031.  * strlen(). */
  1032.     int flags; /* Conversion control flags. */
  1033.     Tcl_EncodingState *statePtr;/* Place for conversion routine to store
  1034.  * state information used during a piecewise
  1035.  * conversion.  Contents of statePtr are
  1036.  * initialized and/or reset by conversion
  1037.  * routine under control of flags argument. */
  1038.     char *dst; /* Output buffer in which converted string
  1039.  * is stored. */
  1040.     int dstLen; /* The maximum length of output buffer in
  1041.  * bytes. */
  1042.     int *srcReadPtr; /* Filled with the number of bytes from the
  1043.  * source string that were converted.  This
  1044.  * may be less than the original source length
  1045.  * if there was a problem converting some
  1046.  * source characters. */
  1047.     int *dstWrotePtr; /* Filled with the number of bytes that were
  1048.  * stored in the output buffer as a result of
  1049.  * the conversion. */
  1050.     int *dstCharsPtr; /* Filled with the number of characters that
  1051.  * correspond to the bytes stored in the
  1052.  * output buffer. */
  1053. {
  1054.     Encoding *encodingPtr;
  1055.     int result, srcRead, dstWrote, dstChars;
  1056.     Tcl_EncodingState state;
  1057.     
  1058.     if (encoding == NULL) {
  1059. encoding = systemEncoding;
  1060.     }
  1061.     encodingPtr = (Encoding *) encoding;
  1062.     if (src == NULL) {
  1063. srcLen = 0;
  1064.     } else if (srcLen < 0) {
  1065. srcLen = strlen(src);
  1066.     }
  1067.     if (statePtr == NULL) {
  1068. flags |= TCL_ENCODING_START | TCL_ENCODING_END;
  1069. statePtr = &state;
  1070.     }
  1071.     if (srcReadPtr == NULL) {
  1072. srcReadPtr = &srcRead;
  1073.     }
  1074.     if (dstWrotePtr == NULL) {
  1075. dstWrotePtr = &dstWrote;
  1076.     }
  1077.     if (dstCharsPtr == NULL) {
  1078. dstCharsPtr = &dstChars;
  1079.     }
  1080.     dstLen -= encodingPtr->nullSize;
  1081.     result = (*encodingPtr->fromUtfProc)(encodingPtr->clientData, src, srcLen,
  1082.     flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
  1083.     dstCharsPtr);
  1084.     if (encodingPtr->nullSize == 2) {
  1085. dst[*dstWrotePtr + 1] = '';
  1086.     }
  1087.     dst[*dstWrotePtr] = '';
  1088.     
  1089.     return result;
  1090. }
  1091. /*
  1092.  *---------------------------------------------------------------------------
  1093.  *
  1094.  * Tcl_FindExecutable --
  1095.  *
  1096.  * This procedure computes the absolute path name of the current
  1097.  * application, given its argv[0] value.
  1098.  *
  1099.  * Results:
  1100.  * None.
  1101.  *
  1102.  * Side effects:
  1103.  * The variable tclExecutableName gets filled in with the file
  1104.  * name for the application, if we figured it out.  If we couldn't
  1105.  * figure it out, tclExecutableName is set to NULL.
  1106.  *
  1107.  *---------------------------------------------------------------------------
  1108.  */
  1109. void
  1110. Tcl_FindExecutable(argv0)
  1111.     CONST char *argv0; /* The value of the application's argv[0]
  1112.  * (native). */
  1113. {
  1114.     int mustCleanUtf;
  1115.     CONST char *name;
  1116.     Tcl_DString buffer, nameString;
  1117.     TclInitSubsystems(argv0);
  1118.     if (argv0 == NULL) {
  1119. goto done;
  1120.     }
  1121.     if (tclExecutableName != NULL) {
  1122. ckfree(tclExecutableName);
  1123. tclExecutableName = NULL;
  1124.     }
  1125.     if ((name = TclpFindExecutable(argv0)) == NULL) {
  1126. goto done;
  1127.     }
  1128.     /*
  1129.      * The value returned from TclpNameOfExecutable is a UTF string that
  1130.      * is possibly dirty depending on when it was initialized.
  1131.      * TclFindEncodings will indicate whether we must "clean" the UTF (as
  1132.      * reported by the underlying system).  To assure that the UTF string
  1133.      * is a properly encoded native string for this system, convert the
  1134.      * UTF string to the default native encoding before the default
  1135.      * encoding is initialized.  Then, convert it back to UTF after the
  1136.      * system encoding is loaded.
  1137.      */
  1138.     
  1139.     Tcl_UtfToExternalDString(NULL, name, -1, &buffer);
  1140.     mustCleanUtf = TclFindEncodings(argv0);
  1141.     /*
  1142.      * Now it is OK to convert the native string back to UTF and set
  1143.      * the value of the tclExecutableName.
  1144.      */
  1145.     
  1146.     if (mustCleanUtf) {
  1147. Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&buffer), -1,
  1148. &nameString);
  1149. tclExecutableName = (char *)
  1150.     ckalloc((unsigned) (Tcl_DStringLength(&nameString) + 1));
  1151. strcpy(tclExecutableName, Tcl_DStringValue(&nameString));
  1152. Tcl_DStringFree(&nameString);
  1153.     } else {
  1154. tclExecutableName = (char *) ckalloc((unsigned) (strlen(name) + 1));
  1155. strcpy(tclExecutableName, name);
  1156.     }
  1157.     Tcl_DStringFree(&buffer);
  1158.     return;
  1159.     done:
  1160.     (void) TclFindEncodings(argv0);
  1161. }
  1162. /*
  1163.  *---------------------------------------------------------------------------
  1164.  *
  1165.  * LoadEncodingFile --
  1166.  *
  1167.  * Read a file that describes an encoding and create a new Encoding
  1168.  * from the data.  
  1169.  *
  1170.  * Results:
  1171.  * The return value is the newly loaded Encoding, or NULL if
  1172.  * the file didn't exist of was in the incorrect format.  If NULL was
  1173.  * returned, an error message is left in interp's result object,
  1174.  * unless interp was NULL.
  1175.  *
  1176.  * Side effects:
  1177.  * File read from disk.  
  1178.  *
  1179.  *---------------------------------------------------------------------------
  1180.  */
  1181. static Tcl_Encoding
  1182. LoadEncodingFile(interp, name)
  1183.     Tcl_Interp *interp; /* Interp for error reporting, if not NULL. */
  1184.     CONST char *name; /* The name of the encoding file on disk
  1185.  * and also the name for new encoding. */
  1186. {
  1187.     int objc, i, ch;
  1188.     Tcl_Obj **objv;
  1189.     Tcl_Obj *pathPtr;
  1190.     Tcl_Channel chan;
  1191.     Tcl_Encoding encoding;
  1192.     pathPtr = TclGetLibraryPath();
  1193.     if (pathPtr == NULL) {
  1194. goto unknown;
  1195.     }
  1196.     objc = 0;
  1197.     Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
  1198.     chan = NULL;
  1199.     for (i = 0; i < objc; i++) {
  1200. chan = OpenEncodingFile(Tcl_GetString(objv[i]), name);
  1201. if (chan != NULL) {
  1202.     break;
  1203. }
  1204.     }
  1205.     if (chan == NULL) {
  1206. goto unknown;
  1207.     }
  1208.     Tcl_SetChannelOption(NULL, chan, "-encoding", "utf-8");
  1209.     while (1) {
  1210. Tcl_DString ds;
  1211. Tcl_DStringInit(&ds);
  1212. Tcl_Gets(chan, &ds);
  1213. ch = Tcl_DStringValue(&ds)[0];
  1214. Tcl_DStringFree(&ds);
  1215. if (ch != '#') {
  1216.     break;
  1217. }
  1218.     }
  1219.     encoding = NULL;
  1220.     switch (ch) {
  1221. case 'S': {
  1222.     encoding = LoadTableEncoding(interp, name, ENCODING_SINGLEBYTE,
  1223.     chan);
  1224.     break;
  1225. }
  1226. case 'D': {
  1227.     encoding = LoadTableEncoding(interp, name, ENCODING_DOUBLEBYTE,
  1228.     chan);
  1229.     break;
  1230. }
  1231. case 'M': {
  1232.     encoding = LoadTableEncoding(interp, name, ENCODING_MULTIBYTE,
  1233.     chan);
  1234.     break;
  1235. }
  1236. case 'E': {
  1237.     encoding = LoadEscapeEncoding(name, chan);
  1238.     break;
  1239. }
  1240.     }
  1241.     if ((encoding == NULL) && (interp != NULL)) {
  1242. Tcl_AppendResult(interp, "invalid encoding file "", name, """, NULL);
  1243. if (ch == 'E') {
  1244.     Tcl_AppendResult(interp, " or missing sub-encoding", NULL);
  1245. }
  1246.     }
  1247.     Tcl_Close(NULL, chan);
  1248.     return encoding;
  1249.     unknown:
  1250.     if (interp != NULL) {
  1251. Tcl_AppendResult(interp, "unknown encoding "", name, """, NULL);
  1252.     }
  1253.     return NULL;
  1254. }
  1255. /*
  1256.  *----------------------------------------------------------------------
  1257.  *
  1258.  * OpenEncodingFile --
  1259.  *
  1260.  * Look for the file encoding/<name>.enc in the specified
  1261.  * directory.
  1262.  *
  1263.  * Results:
  1264.  * Returns an open file channel if the file exists.
  1265.  *
  1266.  * Side effects:
  1267.  * None.
  1268.  *
  1269.  *----------------------------------------------------------------------
  1270.  */
  1271. static Tcl_Channel
  1272. OpenEncodingFile(dir, name)
  1273.     CONST char *dir;
  1274.     CONST char *name;
  1275. {
  1276.     CONST char *argv[3];
  1277.     Tcl_DString pathString;
  1278.     CONST char *path;
  1279.     Tcl_Channel chan;
  1280.     Tcl_Obj *pathPtr;
  1281.     
  1282.     argv[0] = dir;
  1283.     argv[1] = "encoding";
  1284.     argv[2] = name;
  1285.     Tcl_DStringInit(&pathString);
  1286.     Tcl_JoinPath(3, argv, &pathString);
  1287.     path = Tcl_DStringAppend(&pathString, ".enc", -1);
  1288.     pathPtr = Tcl_NewStringObj(path,-1);
  1289.     Tcl_IncrRefCount(pathPtr);
  1290.     chan = Tcl_FSOpenFileChannel(NULL, pathPtr, "r", 0);
  1291.     Tcl_DecrRefCount(pathPtr);
  1292.     Tcl_DStringFree(&pathString);
  1293.     return chan;
  1294. }
  1295. /*
  1296.  *-------------------------------------------------------------------------
  1297.  *
  1298.  * LoadTableEncoding --
  1299.  *
  1300.  * Helper function for LoadEncodingTable().  Loads a table to that 
  1301.  * converts between Unicode and some other encoding and creates an 
  1302.  * encoding (using a TableEncoding structure) from that information.
  1303.  *
  1304.  * File contains binary data, but begins with a marker to indicate 
  1305.  * byte-ordering, so that same binary file can be read on either
  1306.  * endian platforms.
  1307.  *
  1308.  * Results:
  1309.  * The return value is the new encoding, or NULL if the encoding 
  1310.  * could not be created (because the file contained invalid data).
  1311.  *
  1312.  * Side effects:
  1313.  * None.
  1314.  *
  1315.  *-------------------------------------------------------------------------
  1316.  */
  1317. static Tcl_Encoding
  1318. LoadTableEncoding(interp, name, type, chan)
  1319.     Tcl_Interp *interp; /* Interp for temporary obj while reading. */
  1320.     CONST char *name; /* Name for new encoding. */
  1321.     int type; /* Type of encoding (ENCODING_?????). */
  1322.     Tcl_Channel chan; /* File containing new encoding. */
  1323. {
  1324.     Tcl_DString lineString;
  1325.     Tcl_Obj *objPtr;
  1326.     char *line;
  1327.     int i, hi, lo, numPages, symbol, fallback;
  1328.     unsigned char used[256];
  1329.     unsigned int size;
  1330.     TableEncodingData *dataPtr;
  1331.     unsigned short *pageMemPtr;
  1332.     Tcl_EncodingType encType;
  1333.     /*
  1334.      * Speed over memory. Use a full 256 character table to decode hex
  1335.      * sequences in the encoding files.
  1336.      */
  1337.     static char staticHex[] = {
  1338.       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*   0 ...  15 */
  1339.       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*  16 ...  31 */
  1340.       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*  32 ...  47 */
  1341.       0,  1,  2,  3,  4,  5,  6, 7, 8, 9, 0, 0, 0, 0, 0, 0, /*  48 ...  63 */
  1342.       0, 10, 11, 12, 13, 14, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*  64 ...  79 */
  1343.       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*  80 ...  95 */
  1344.       0, 10, 11, 12, 13, 14, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*  96 ... 111 */
  1345.       0,  1,  2,  3,  4,  5,  6, 7, 8, 9, 0, 0, 0, 0, 0, 0, /* 112 ... 127 */
  1346.       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 128 ... 143 */
  1347.       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 144 ... 159 */
  1348.       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 160 ... 175 */
  1349.       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 176 ... 191 */
  1350.       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 192 ... 207 */
  1351.       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 208 ... 223 */
  1352.       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 224 ... 239 */
  1353.       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 240 ... 255 */
  1354.     };
  1355.     Tcl_DStringInit(&lineString);
  1356.     Tcl_Gets(chan, &lineString);
  1357.     line = Tcl_DStringValue(&lineString);
  1358.     fallback = (int) strtol(line, &line, 16);
  1359.     symbol = (int) strtol(line, &line, 10);
  1360.     numPages = (int) strtol(line, &line, 10);
  1361.     Tcl_DStringFree(&lineString);
  1362.     if (numPages < 0) {
  1363. numPages = 0;
  1364.     } else if (numPages > 256) {
  1365. numPages = 256;
  1366.     }
  1367.     memset(used, 0, sizeof(used));
  1368. #undef PAGESIZE
  1369. #define PAGESIZE    (256 * sizeof(unsigned short))
  1370.     dataPtr = (TableEncodingData *) ckalloc(sizeof(TableEncodingData));
  1371.     memset(dataPtr, 0, sizeof(TableEncodingData));
  1372.     dataPtr->fallback = fallback;
  1373.     /*
  1374.      * Read the table that maps characters to Unicode.  Performs a single
  1375.      * malloc to get the memory for the array and all the pages needed by
  1376.      * the array.
  1377.      */
  1378.     size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE;
  1379.     dataPtr->toUnicode = (unsigned short **) ckalloc(size);
  1380.     memset(dataPtr->toUnicode, 0, size);
  1381.     pageMemPtr = (unsigned short *) (dataPtr->toUnicode + 256);
  1382.     if (interp == NULL) {
  1383. objPtr = Tcl_NewObj();
  1384.     } else {
  1385. objPtr = Tcl_GetObjResult(interp);
  1386.     }
  1387.     for (i = 0; i < numPages; i++) {
  1388. int ch;
  1389. char *p;
  1390. Tcl_ReadChars(chan, objPtr, 3 + 16 * (16 * 4 + 1), 0);
  1391. p = Tcl_GetString(objPtr);
  1392. hi = (staticHex[(unsigned int)p[0]] << 4) + staticHex[(unsigned int)p[1]];
  1393. dataPtr->toUnicode[hi] = pageMemPtr;
  1394. p += 2;
  1395. for (lo = 0; lo < 256; lo++) {
  1396.     if ((lo & 0x0f) == 0) {
  1397. p++;
  1398.     }
  1399.     ch = (staticHex[(unsigned int)p[0]] << 12) + (staticHex[(unsigned int)p[1]] << 8)
  1400. + (staticHex[(unsigned int)p[2]] << 4) + staticHex[(unsigned int)p[3]];
  1401.     if (ch != 0) {
  1402. used[ch >> 8] = 1;
  1403.     }
  1404.     *pageMemPtr = (unsigned short) ch;
  1405.     pageMemPtr++;
  1406.     p += 4;
  1407. }
  1408.     }
  1409.     if (interp == NULL) {
  1410. Tcl_DecrRefCount(objPtr);
  1411.     } else {
  1412. Tcl_ResetResult(interp);
  1413.     }
  1414.     if (type == ENCODING_DOUBLEBYTE) {
  1415. memset(dataPtr->prefixBytes, 1, sizeof(dataPtr->prefixBytes));
  1416.     } else {
  1417. for (hi = 1; hi < 256; hi++) {
  1418.     if (dataPtr->toUnicode[hi] != NULL) {
  1419. dataPtr->prefixBytes[hi] = 1;
  1420.     }
  1421. }
  1422.     }
  1423.     /*
  1424.      * Invert toUnicode array to produce the fromUnicode array.  Performs a
  1425.      * single malloc to get the memory for the array and all the pages
  1426.      * needed by the array.  While reading in the toUnicode array, we
  1427.      * remembered what pages that would be needed for the fromUnicode array.
  1428.      */
  1429.     if (symbol) {
  1430. used[0] = 1;
  1431.     }
  1432.     numPages = 0;
  1433.     for (hi = 0; hi < 256; hi++) {
  1434. if (used[hi]) {
  1435.     numPages++;
  1436. }
  1437.     }
  1438.     size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE;
  1439.     dataPtr->fromUnicode = (unsigned short **) ckalloc(size);
  1440.     memset(dataPtr->fromUnicode, 0, size);
  1441.     pageMemPtr = (unsigned short *) (dataPtr->fromUnicode + 256);
  1442.     for (hi = 0; hi < 256; hi++) {
  1443. if (dataPtr->toUnicode[hi] == NULL) {
  1444.     dataPtr->toUnicode[hi] = emptyPage;
  1445. } else {
  1446.     for (lo = 0; lo < 256; lo++) {
  1447. int ch;
  1448. ch = dataPtr->toUnicode[hi][lo];
  1449. if (ch != 0) {
  1450.     unsigned short *page;
  1451.     
  1452.     page = dataPtr->fromUnicode[ch >> 8];
  1453.     if (page == NULL) {
  1454. page = pageMemPtr;
  1455. pageMemPtr += 256;
  1456. dataPtr->fromUnicode[ch >> 8] = page;
  1457.     }
  1458.     page[ch & 0xff] = (unsigned short) ((hi << 8) + lo);
  1459. }
  1460.     }
  1461. }
  1462.     }
  1463.     if (type == ENCODING_MULTIBYTE) {
  1464. /*
  1465.  * If multibyte encodings don't have a backslash character, define
  1466.  * one.  Otherwise, on Windows, native file names won't work because
  1467.  * the backslash in the file name will map to the unknown character
  1468.  * (question mark) when converting from UTF-8 to external encoding.
  1469.  */
  1470. if (dataPtr->fromUnicode[0] != NULL) {
  1471.     if (dataPtr->fromUnicode[0]['\'] == '') {
  1472. dataPtr->fromUnicode[0]['\'] = '\';
  1473.     }
  1474. }
  1475.     }
  1476.     if (symbol) {
  1477. unsigned short *page;
  1478. /*
  1479.  * Make a special symbol encoding that not only maps the symbol
  1480.  * characters from their Unicode code points down into page 0, but
  1481.  * also ensure that the characters on page 0 map to themselves.
  1482.  * This is so that a symbol font can be used to display a simple
  1483.  * string like "abcd" and have alpha, beta, chi, delta show up,
  1484.  * rather than have "unknown" chars show up because strictly
  1485.  * speaking the symbol font doesn't have glyphs for those low ascii
  1486.  * chars.
  1487.  */
  1488. page = dataPtr->fromUnicode[0];
  1489. if (page == NULL) {
  1490.     page = pageMemPtr;
  1491.     dataPtr->fromUnicode[0] = page;
  1492. }
  1493. for (lo = 0; lo < 256; lo++) {
  1494.     if (dataPtr->toUnicode[0][lo] != 0) {
  1495. page[lo] = (unsigned short) lo;
  1496.     }
  1497. }
  1498.     }
  1499.     for (hi = 0; hi < 256; hi++) {
  1500. if (dataPtr->fromUnicode[hi] == NULL) {
  1501.     dataPtr->fromUnicode[hi] = emptyPage;
  1502. }
  1503.     }
  1504.     /*
  1505.      * For trailing 'R'everse encoding, see [Patch #689341]
  1506.      */
  1507.     Tcl_DStringInit(&lineString);
  1508.     do {
  1509. int len;
  1510. /* skip leading empty lines */
  1511. while ((len = Tcl_Gets(chan, &lineString)) == 0)
  1512.     ;
  1513. if (len < 0) {
  1514.     break;
  1515. }
  1516. line = Tcl_DStringValue(&lineString);
  1517. if (line[0] != 'R') {
  1518.     break;
  1519. }
  1520. for (Tcl_DStringSetLength(&lineString, 0);
  1521.      (len = Tcl_Gets(chan, &lineString)) >= 0;
  1522.      Tcl_DStringSetLength(&lineString, 0)) {
  1523.     unsigned char* p;
  1524.     int to, from;
  1525.     if (len < 5) {
  1526. continue;
  1527.     }
  1528.     p = (unsigned char*) Tcl_DStringValue(&lineString);
  1529.     to = (staticHex[p[0]] << 12) + (staticHex[p[1]] << 8)
  1530. + (staticHex[p[2]] << 4) + staticHex[p[3]];
  1531.     if (to == 0) {
  1532.      continue;
  1533.     }
  1534.     for (p += 5, len -= 5; len >= 0 && *p; p += 5, len -= 5) {
  1535. from = (staticHex[p[0]] << 12) + (staticHex[p[1]] << 8)
  1536. + (staticHex[p[2]] << 4) + staticHex[p[3]];
  1537.      if (from == 0) {
  1538.     continue;
  1539. }
  1540. dataPtr->fromUnicode[from >> 8][from & 0xff] = to;
  1541.     }
  1542. }
  1543.     } while (0);
  1544.     Tcl_DStringFree(&lineString);
  1545.     encType.encodingName    = name;
  1546.     encType.toUtfProc     = TableToUtfProc;
  1547.     encType.fromUtfProc     = TableFromUtfProc;
  1548.     encType.freeProc     = TableFreeProc;
  1549.     encType.nullSize     = (type == ENCODING_DOUBLEBYTE) ? 2 : 1;
  1550.     encType.clientData     = (ClientData) dataPtr;
  1551.     return Tcl_CreateEncoding(&encType);
  1552. }
  1553. /*
  1554.  *-------------------------------------------------------------------------
  1555.  *
  1556.  * LoadEscapeEncoding --
  1557.  *
  1558.  * Helper function for LoadEncodingTable().  Loads a state machine
  1559.  * that converts between Unicode and some other encoding.  
  1560.  *
  1561.  * File contains text data that describes the escape sequences that
  1562.  * are used to choose an encoding and the associated names for the 
  1563.  * sub-encodings.
  1564.  *
  1565.  * Results:
  1566.  * The return value is the new encoding, or NULL if the encoding 
  1567.  * could not be created (because the file contained invalid data).
  1568.  *
  1569.  * Side effects:
  1570.  * None.
  1571.  *
  1572.  *-------------------------------------------------------------------------
  1573.  */
  1574. static Tcl_Encoding
  1575. LoadEscapeEncoding(name, chan)
  1576.     CONST char *name; /* Name for new encoding. */
  1577.     Tcl_Channel chan; /* File containing new encoding. */
  1578. {
  1579.     int i, missingSubEncoding = 0;
  1580.     unsigned int size;
  1581.     Tcl_DString escapeData;
  1582.     char init[16], final[16];
  1583.     EscapeEncodingData *dataPtr;
  1584.     Tcl_EncodingType type;
  1585.     init[0] = '';
  1586.     final[0] = '';
  1587.     Tcl_DStringInit(&escapeData);
  1588.     while (1) {
  1589. int argc;
  1590. CONST char **argv;
  1591. char *line;
  1592. Tcl_DString lineString;
  1593. Tcl_DStringInit(&lineString);
  1594. if (Tcl_Gets(chan, &lineString) < 0) {
  1595.     break;
  1596. }
  1597. line = Tcl_DStringValue(&lineString);
  1598.         if (Tcl_SplitList(NULL, line, &argc, &argv) != TCL_OK) {
  1599.     continue;
  1600. }
  1601. if (argc >= 2) {
  1602.     if (strcmp(argv[0], "name") == 0) {
  1603. ;
  1604.     } else if (strcmp(argv[0], "init") == 0) {
  1605. strncpy(init, argv[1], sizeof(init));
  1606. init[sizeof(init) - 1] = '';
  1607.     } else if (strcmp(argv[0], "final") == 0) {
  1608. strncpy(final, argv[1], sizeof(final));
  1609. final[sizeof(final) - 1] = '';
  1610.     } else {
  1611. EscapeSubTable est;
  1612. strncpy(est.sequence, argv[1], sizeof(est.sequence));
  1613. est.sequence[sizeof(est.sequence) - 1] = '';
  1614. est.sequenceLen = strlen(est.sequence);
  1615. strncpy(est.name, argv[0], sizeof(est.name));
  1616. est.name[sizeof(est.name) - 1] = '';
  1617. /*
  1618.  * Load the subencodings first so we're never stuck
  1619.  * trying to use a half-loaded system encoding to
  1620.  * open/read a *.enc file.
  1621.  */
  1622. est.encodingPtr = (Encoding *) Tcl_GetEncoding(NULL, est.name);
  1623. if ((est.encodingPtr == NULL) 
  1624. || (est.encodingPtr->toUtfProc != TableToUtfProc)) {
  1625.     missingSubEncoding = 1;
  1626. }
  1627. Tcl_DStringAppend(&escapeData, (char *) &est, sizeof(est));
  1628.     }
  1629. }
  1630. ckfree((char *) argv);
  1631. Tcl_DStringFree(&lineString);
  1632.     }
  1633.     if (missingSubEncoding) {
  1634. Tcl_DStringFree(&escapeData);
  1635. return NULL;
  1636.     }
  1637.     size = sizeof(EscapeEncodingData)
  1638.     - sizeof(EscapeSubTable) + Tcl_DStringLength(&escapeData);
  1639.     dataPtr = (EscapeEncodingData *) ckalloc(size);
  1640.     dataPtr->initLen = strlen(init);
  1641.     strcpy(dataPtr->init, init);
  1642.     dataPtr->finalLen = strlen(final);
  1643.     strcpy(dataPtr->final, final);
  1644.     dataPtr->numSubTables = Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable);
  1645.     memcpy((VOID *) dataPtr->subTables, (VOID *) Tcl_DStringValue(&escapeData),
  1646.     (size_t) Tcl_DStringLength(&escapeData));
  1647.     Tcl_DStringFree(&escapeData);
  1648.     memset(dataPtr->prefixBytes, 0, sizeof(dataPtr->prefixBytes));
  1649.     for (i = 0; i < dataPtr->numSubTables; i++) {
  1650. dataPtr->prefixBytes[UCHAR(dataPtr->subTables[i].sequence[0])] = 1;
  1651.     }
  1652.     if (dataPtr->init[0] != '') {
  1653. dataPtr->prefixBytes[UCHAR(dataPtr->init[0])] = 1;
  1654.     }
  1655.     if (dataPtr->final[0] != '') {
  1656. dataPtr->prefixBytes[UCHAR(dataPtr->final[0])] = 1;
  1657.     }
  1658.     type.encodingName = name;
  1659.     type.toUtfProc = EscapeToUtfProc;
  1660.     type.fromUtfProc    = EscapeFromUtfProc;
  1661.     type.freeProc = EscapeFreeProc;
  1662.     type.nullSize = 1;
  1663.     type.clientData = (ClientData) dataPtr;
  1664.     return Tcl_CreateEncoding(&type);
  1665. }
  1666. /*
  1667.  *-------------------------------------------------------------------------
  1668.  *
  1669.  * BinaryProc --
  1670.  *
  1671.  * The default conversion when no other conversion is specified.
  1672.  * No translation is done; source bytes are copied directly to 
  1673.  * destination bytes.
  1674.  *
  1675.  * Results:
  1676.  * Returns TCL_OK if conversion was successful.
  1677.  *
  1678.  * Side effects:
  1679.  * None.
  1680.  *
  1681.  *-------------------------------------------------------------------------
  1682.  */
  1683. static int
  1684. BinaryProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  1685. srcReadPtr, dstWrotePtr, dstCharsPtr)
  1686.     ClientData clientData; /* Not used. */
  1687.     CONST char *src; /* Source string (unknown encoding). */
  1688.     int srcLen; /* Source string length in bytes. */
  1689.     int flags; /* Conversion control flags. */
  1690.     Tcl_EncodingState *statePtr;/* Place for conversion routine to store
  1691.  * state information used during a piecewise
  1692.  * conversion.  Contents of statePtr are
  1693.  * initialized and/or reset by conversion
  1694.  * routine under control of flags argument. */
  1695.     char *dst; /* Output buffer in which converted string
  1696.  * is stored. */
  1697.     int dstLen; /* The maximum length of output buffer in
  1698.  * bytes. */
  1699.     int *srcReadPtr; /* Filled with the number of bytes from the
  1700.  * source string that were converted. */
  1701.     int *dstWrotePtr; /* Filled with the number of bytes that were
  1702.  * stored in the output buffer as a result of
  1703.  * the conversion. */
  1704.     int *dstCharsPtr; /* Filled with the number of characters that
  1705.  * correspond to the bytes stored in the
  1706.  * output buffer. */
  1707. {
  1708.     int result;
  1709.     result = TCL_OK;
  1710.     dstLen -= TCL_UTF_MAX - 1;
  1711.     if (dstLen < 0) {
  1712. dstLen = 0;
  1713.     }
  1714.     if (srcLen > dstLen) {
  1715. srcLen = dstLen;
  1716. result = TCL_CONVERT_NOSPACE;
  1717.     }
  1718.     *srcReadPtr = srcLen;
  1719.     *dstWrotePtr = srcLen;
  1720.     *dstCharsPtr = srcLen;
  1721.     memcpy((void *) dst, (void *) src, (size_t) srcLen);
  1722.     return result;
  1723. }
  1724. /*
  1725.  *-------------------------------------------------------------------------
  1726.  *
  1727.  * UtfExtToUtfIntProc --
  1728.  *
  1729.  * Convert from UTF-8 to UTF-8. While converting null-bytes from
  1730.  * the Tcl's internal representation (0xc0, 0x80) to the official
  1731.  * representation (0x00). See UtfToUtfProc for details.
  1732.  *
  1733.  * Results:
  1734.  * Returns TCL_OK if conversion was successful.
  1735.  *
  1736.  * Side effects:
  1737.  * None.
  1738.  *
  1739.  *-------------------------------------------------------------------------
  1740.  */
  1741. static int 
  1742. UtfIntToUtfExtProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  1743.      srcReadPtr, dstWrotePtr, dstCharsPtr)
  1744.     ClientData clientData; /* Not used. */
  1745.     CONST char *src; /* Source string in UTF-8. */
  1746.     int srcLen; /* Source string length in bytes. */
  1747.     int flags; /* Conversion control flags. */
  1748.     Tcl_EncodingState *statePtr;/* Place for conversion routine to store
  1749.  * state information used during a piecewise
  1750.  * conversion.  Contents of statePtr are
  1751.  * initialized and/or reset by conversion
  1752.  * routine under control of flags argument. */
  1753.     char *dst; /* Output buffer in which converted string
  1754.  * is stored. */
  1755.     int dstLen; /* The maximum length of output buffer in
  1756.  * bytes. */
  1757.     int *srcReadPtr; /* Filled with the number of bytes from the
  1758.  * source string that were converted.  This
  1759.  * may be less than the original source length
  1760.  * if there was a problem converting some
  1761.  * source characters. */
  1762.     int *dstWrotePtr; /* Filled with the number of bytes that were
  1763.  * stored in the output buffer as a result of
  1764.  * the conversion. */
  1765.     int *dstCharsPtr; /* Filled with the number of characters that
  1766.  * correspond to the bytes stored in the
  1767.  * output buffer. */
  1768. {
  1769.     return UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  1770. srcReadPtr, dstWrotePtr, dstCharsPtr, 1);
  1771. }
  1772. /*
  1773.  *-------------------------------------------------------------------------
  1774.  *
  1775.  * UtfExtToUtfIntProc --
  1776.  *
  1777.  * Convert from UTF-8 to UTF-8 while converting null-bytes from
  1778.  * the official representation (0x00) to Tcl's internal
  1779.  * representation (0xc0, 0x80). See UtfToUtfProc for details.
  1780.  *
  1781.  * Results:
  1782.  * Returns TCL_OK if conversion was successful.
  1783.  *
  1784.  * Side effects:
  1785.  * None.
  1786.  *
  1787.  *-------------------------------------------------------------------------
  1788.  */
  1789. static int 
  1790. UtfExtToUtfIntProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  1791.      srcReadPtr, dstWrotePtr, dstCharsPtr)
  1792.     ClientData clientData; /* Not used. */
  1793.     CONST char *src; /* Source string in UTF-8. */
  1794.     int srcLen; /* Source string length in bytes. */
  1795.     int flags; /* Conversion control flags. */
  1796.     Tcl_EncodingState *statePtr;/* Place for conversion routine to store
  1797.  * state information used during a piecewise
  1798.  * conversion.  Contents of statePtr are
  1799.  * initialized and/or reset by conversion
  1800.  * routine under control of flags argument. */
  1801.     char *dst; /* Output buffer in which converted string
  1802.  * is stored. */
  1803.     int dstLen; /* The maximum length of output buffer in
  1804.  * bytes. */
  1805.     int *srcReadPtr; /* Filled with the number of bytes from the
  1806.  * source string that were converted.  This
  1807.  * may be less than the original source length
  1808.  * if there was a problem converting some
  1809.  * source characters. */
  1810.     int *dstWrotePtr; /* Filled with the number of bytes that were
  1811.  * stored in the output buffer as a result of
  1812.  * the conversion. */
  1813.     int *dstCharsPtr; /* Filled with the number of characters that
  1814.  * correspond to the bytes stored in the
  1815.  * output buffer. */
  1816. {
  1817.     return UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  1818. srcReadPtr, dstWrotePtr, dstCharsPtr, 0);
  1819. }
  1820. /*
  1821.  *-------------------------------------------------------------------------
  1822.  *
  1823.  * UtfToUtfProc --
  1824.  *
  1825.  * Convert from UTF-8 to UTF-8.  Note that the UTF-8 to UTF-8 
  1826.  * translation is not a no-op, because it will turn a stream of
  1827.  * improperly formed UTF-8 into a properly formed stream.
  1828.  *
  1829.  * Results:
  1830.  * Returns TCL_OK if conversion was successful.
  1831.  *
  1832.  * Side effects:
  1833.  * None.
  1834.  *
  1835.  *-------------------------------------------------------------------------
  1836.  */
  1837. static int 
  1838. UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  1839.      srcReadPtr, dstWrotePtr, dstCharsPtr, pureNullMode)
  1840.     ClientData clientData; /* Not used. */
  1841.     CONST char *src; /* Source string in UTF-8. */
  1842.     int srcLen; /* Source string length in bytes. */
  1843.     int flags; /* Conversion control flags. */
  1844.     Tcl_EncodingState *statePtr;/* Place for conversion routine to store
  1845.  * state information used during a piecewise
  1846.  * conversion.  Contents of statePtr are
  1847.  * initialized and/or reset by conversion
  1848.  * routine under control of flags argument. */
  1849.     char *dst; /* Output buffer in which converted string
  1850.  * is stored. */
  1851.     int dstLen; /* The maximum length of output buffer in
  1852.  * bytes. */
  1853.     int *srcReadPtr; /* Filled with the number of bytes from the
  1854.  * source string that were converted.  This
  1855.  * may be less than the original source length
  1856.  * if there was a problem converting some
  1857.  * source characters. */
  1858.     int *dstWrotePtr; /* Filled with the number of bytes that were
  1859.  * stored in the output buffer as a result of
  1860.  * the conversion. */
  1861.     int *dstCharsPtr; /* Filled with the number of characters that
  1862.  * correspond to the bytes stored in the
  1863.  * output buffer. */
  1864.     int pureNullMode; /* Convert embedded nulls from
  1865.  * internal representation to real
  1866.  * null-bytes or vice versa */
  1867. {
  1868.     CONST char *srcStart, *srcEnd, *srcClose;
  1869.     char *dstStart, *dstEnd;
  1870.     int result, numChars;
  1871.     Tcl_UniChar ch;
  1872.     result = TCL_OK;
  1873.     
  1874.     srcStart = src;
  1875.     srcEnd = src + srcLen;
  1876.     srcClose = srcEnd;
  1877.     if ((flags & TCL_ENCODING_END) == 0) {
  1878. srcClose -= TCL_UTF_MAX;
  1879.     }
  1880.     dstStart = dst;
  1881.     dstEnd = dst + dstLen - TCL_UTF_MAX;
  1882.     for (numChars = 0; src < srcEnd; numChars++) {
  1883. if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
  1884.     /*
  1885.      * If there is more string to follow, this will ensure that the
  1886.      * last UTF-8 character in the source buffer hasn't been cut off.
  1887.      */
  1888.     result = TCL_CONVERT_MULTIBYTE;
  1889.     break;
  1890. }
  1891. if (dst > dstEnd) {
  1892.     result = TCL_CONVERT_NOSPACE;
  1893.     break;
  1894. }
  1895. if (UCHAR(*src) < 0x80 &&
  1896.     !(UCHAR(*src) == 0 && pureNullMode == 0)) {
  1897.     /*
  1898.      * Copy 7bit chatacters, but skip null-bytes when we are
  1899.      * in input mode, so that they get converted to 0xc080.
  1900.      */
  1901.     *dst++ = *src++;
  1902. } else if (pureNullMode == 1 &&
  1903.    UCHAR(*src) == 0xc0 &&
  1904.    UCHAR(*(src+1)) == 0x80) {
  1905.     /* 
  1906.      * Convert 0xc080 to real nulls when we are in output mode.
  1907.      */
  1908.     *dst++ = 0;
  1909.     src += 2;
  1910. } else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
  1911.     /* Always check before using Tcl_UtfToUniChar. Not doing
  1912.      * can so cause it run beyond the endof the buffer!  If we
  1913.      * * happen such an incomplete char its byts are made to *
  1914.      * represent themselves.
  1915.      */
  1916.     ch = (Tcl_UniChar) *src;
  1917.     src += 1;
  1918.     dst += Tcl_UniCharToUtf(ch, dst);
  1919. } else {
  1920.     src += Tcl_UtfToUniChar(src, &ch);
  1921.     dst += Tcl_UniCharToUtf(ch, dst);
  1922. }
  1923.     }
  1924.     *srcReadPtr  = src - srcStart;
  1925.     *dstWrotePtr = dst - dstStart;
  1926.     *dstCharsPtr = numChars;
  1927.     return result;
  1928. }
  1929. /*
  1930.  *-------------------------------------------------------------------------
  1931.  *
  1932.  * UnicodeToUtfProc --
  1933.  *
  1934.  * Convert from Unicode to UTF-8.
  1935.  *
  1936.  * Results:
  1937.  * Returns TCL_OK if conversion was successful.
  1938.  *
  1939.  * Side effects:
  1940.  * None.
  1941.  *
  1942.  *-------------------------------------------------------------------------
  1943.  */
  1944. static int 
  1945. UnicodeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  1946. srcReadPtr, dstWrotePtr, dstCharsPtr)
  1947.     ClientData clientData; /* Not used. */
  1948.     CONST char *src; /* Source string in Unicode. */
  1949.     int srcLen; /* Source string length in bytes. */
  1950.     int flags; /* Conversion control flags. */
  1951.     Tcl_EncodingState *statePtr;/* Place for conversion routine to store
  1952.  * state information used during a piecewise
  1953.  * conversion.  Contents of statePtr are
  1954.  * initialized and/or reset by conversion
  1955.  * routine under control of flags argument. */
  1956.     char *dst; /* Output buffer in which converted string
  1957.  * is stored. */
  1958.     int dstLen; /* The maximum length of output buffer in
  1959.  * bytes. */
  1960.     int *srcReadPtr; /* Filled with the number of bytes from the
  1961.  * source string that were converted.  This
  1962.  * may be less than the original source length
  1963.  * if there was a problem converting some
  1964.  * source characters. */
  1965.     int *dstWrotePtr; /* Filled with the number of bytes that were
  1966.  * stored in the output buffer as a result of
  1967.  * the conversion. */
  1968.     int *dstCharsPtr; /* Filled with the number of characters that
  1969.  * correspond to the bytes stored in the
  1970.  * output buffer. */
  1971. {
  1972.     CONST char *srcStart, *srcEnd;
  1973.     char *dstEnd, *dstStart;
  1974.     int result, numChars;
  1975.     Tcl_UniChar ch;
  1976.     result = TCL_OK;
  1977.     if ((srcLen % sizeof(Tcl_UniChar)) != 0) {
  1978. result = TCL_CONVERT_MULTIBYTE;
  1979. srcLen /= sizeof(Tcl_UniChar);
  1980. srcLen *= sizeof(Tcl_UniChar);
  1981.     }
  1982.     srcStart = src;
  1983.     srcEnd = src + srcLen;
  1984.     dstStart = dst;
  1985.     dstEnd = dst + dstLen - TCL_UTF_MAX;
  1986.     for (numChars = 0; src < srcEnd; numChars++) {
  1987. if (dst > dstEnd) {
  1988.     result = TCL_CONVERT_NOSPACE;
  1989.     break;
  1990. }
  1991. /*
  1992.  * Special case for 1-byte utf chars for speed.  Make sure we
  1993.  * work with Tcl_UniChar-size data.
  1994.  */
  1995. ch = *(Tcl_UniChar *)src;
  1996. if (ch && ch < 0x80) {
  1997.     *dst++ = (ch & 0xFF);
  1998. } else {
  1999.     dst += Tcl_UniCharToUtf(ch, dst);
  2000. }
  2001. src += sizeof(Tcl_UniChar);
  2002.     }
  2003.     *srcReadPtr = src - srcStart;
  2004.     *dstWrotePtr = dst - dstStart;
  2005.     *dstCharsPtr = numChars;
  2006.     return result;
  2007. }
  2008. /*
  2009.  *-------------------------------------------------------------------------
  2010.  *
  2011.  * UtfToUnicodeProc --
  2012.  *
  2013.  * Convert from UTF-8 to Unicode.
  2014.  *
  2015.  * Results:
  2016.  * Returns TCL_OK if conversion was successful.
  2017.  *
  2018.  * Side effects:
  2019.  * None.
  2020.  *
  2021.  *-------------------------------------------------------------------------
  2022.  */
  2023. static int 
  2024. UtfToUnicodeProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  2025. srcReadPtr, dstWrotePtr, dstCharsPtr)
  2026.     ClientData clientData; /* TableEncodingData that specifies encoding. */
  2027.     CONST char *src; /* Source string in UTF-8. */
  2028.     int srcLen; /* Source string length in bytes. */
  2029.     int flags; /* Conversion control flags. */
  2030.     Tcl_EncodingState *statePtr;/* Place for conversion routine to store
  2031.  * state information used during a piecewise
  2032.  * conversion.  Contents of statePtr are
  2033.  * initialized and/or reset by conversion
  2034.  * routine under control of flags argument. */
  2035.     char *dst; /* Output buffer in which converted string
  2036.  * is stored. */
  2037.     int dstLen; /* The maximum length of output buffer in
  2038.  * bytes. */
  2039.     int *srcReadPtr; /* Filled with the number of bytes from the
  2040.  * source string that were converted.  This
  2041.  * may be less than the original source length
  2042.  * if there was a problem converting some
  2043.  * source characters. */
  2044.     int *dstWrotePtr; /* Filled with the number of bytes that were
  2045.  * stored in the output buffer as a result of
  2046.  * the conversion. */
  2047.     int *dstCharsPtr; /* Filled with the number of characters that
  2048.  * correspond to the bytes stored in the
  2049.  * output buffer. */
  2050. {
  2051.     CONST char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
  2052.     int result, numChars;
  2053.     Tcl_UniChar ch;
  2054.     srcStart = src;
  2055.     srcEnd = src + srcLen;
  2056.     srcClose = srcEnd;
  2057.     if ((flags & TCL_ENCODING_END) == 0) {
  2058. srcClose -= TCL_UTF_MAX;
  2059.     }
  2060.     dstStart = dst;
  2061.     dstEnd   = dst + dstLen - sizeof(Tcl_UniChar);
  2062.     result = TCL_OK;
  2063.     for (numChars = 0; src < srcEnd; numChars++) {
  2064. if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
  2065.     /*
  2066.      * If there is more string to follow, this will ensure that the
  2067.      * last UTF-8 character in the source buffer hasn't been cut off.
  2068.      */
  2069.     result = TCL_CONVERT_MULTIBYTE;
  2070.     break;
  2071. }
  2072. if (dst > dstEnd) {
  2073.     result = TCL_CONVERT_NOSPACE;
  2074.     break;
  2075.         }
  2076. src += TclUtfToUniChar(src, &ch);
  2077. /*
  2078.  * Need to handle this in a way that won't cause misalignment
  2079.  * by casting dst to a Tcl_UniChar. [Bug 1122671]
  2080.  * XXX: This hard-codes the assumed size of Tcl_UniChar as 2.
  2081.  */
  2082. #ifdef WORDS_BIGENDIAN
  2083. *dst++ = (ch >> 8);
  2084. *dst++ = (ch & 0xFF);
  2085. #else
  2086. *dst++ = (ch & 0xFF);
  2087. *dst++ = (ch >> 8);
  2088. #endif
  2089.     }
  2090.     *srcReadPtr = src - srcStart;
  2091.     *dstWrotePtr = dst - dstStart;
  2092.     *dstCharsPtr = numChars;
  2093.     return result;
  2094. }
  2095. /*
  2096.  *-------------------------------------------------------------------------
  2097.  *
  2098.  * TableToUtfProc --
  2099.  *
  2100.  * Convert from the encoding specified by the TableEncodingData into
  2101.  * UTF-8.
  2102.  *
  2103.  * Results:
  2104.  * Returns TCL_OK if conversion was successful.
  2105.  *
  2106.  * Side effects:
  2107.  * None.
  2108.  *
  2109.  *-------------------------------------------------------------------------
  2110.  */
  2111. static int 
  2112. TableToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  2113. srcReadPtr, dstWrotePtr, dstCharsPtr)
  2114.     ClientData clientData; /* TableEncodingData that specifies
  2115.  * encoding. */
  2116.     CONST char *src; /* Source string in specified encoding. */
  2117.     int srcLen; /* Source string length in bytes. */
  2118.     int flags; /* Conversion control flags. */
  2119.     Tcl_EncodingState *statePtr;/* Place for conversion routine to store
  2120.  * state information used during a piecewise
  2121.  * conversion.  Contents of statePtr are
  2122.  * initialized and/or reset by conversion
  2123.  * routine under control of flags argument. */
  2124.     char *dst; /* Output buffer in which converted string
  2125.  * is stored. */
  2126.     int dstLen; /* The maximum length of output buffer in
  2127.  * bytes. */
  2128.     int *srcReadPtr; /* Filled with the number of bytes from the
  2129.  * source string that were converted.  This
  2130.  * may be less than the original source length
  2131.  * if there was a problem converting some
  2132.  * source characters. */
  2133.     int *dstWrotePtr; /* Filled with the number of bytes that were
  2134.  * stored in the output buffer as a result of
  2135.  * the conversion. */
  2136.     int *dstCharsPtr; /* Filled with the number of characters that
  2137.  * correspond to the bytes stored in the
  2138.  * output buffer. */
  2139. {
  2140.     CONST char *srcStart, *srcEnd;
  2141.     char *dstEnd, *dstStart, *prefixBytes;
  2142.     int result, byte, numChars;
  2143.     Tcl_UniChar ch;
  2144.     unsigned short **toUnicode;
  2145.     unsigned short *pageZero;
  2146.     TableEncodingData *dataPtr;
  2147.     
  2148.     srcStart = src;
  2149.     srcEnd = src + srcLen;
  2150.     dstStart = dst;
  2151.     dstEnd = dst + dstLen - TCL_UTF_MAX;
  2152.     dataPtr = (TableEncodingData *) clientData;
  2153.     toUnicode = dataPtr->toUnicode;
  2154.     prefixBytes = dataPtr->prefixBytes;
  2155.     pageZero = toUnicode[0];
  2156.     result = TCL_OK;
  2157.     for (numChars = 0; src < srcEnd; numChars++) {
  2158.         if (dst > dstEnd) {
  2159.             result = TCL_CONVERT_NOSPACE;
  2160.             break;
  2161.         }
  2162. byte = *((unsigned char *) src);
  2163. if (prefixBytes[byte]) {
  2164.     src++;
  2165.     if (src >= srcEnd) {
  2166. src--;
  2167. result = TCL_CONVERT_MULTIBYTE;
  2168. break;
  2169.     }
  2170.     ch = toUnicode[byte][*((unsigned char *) src)];
  2171. } else {
  2172.     ch = pageZero[byte];
  2173. }
  2174. if ((ch == 0) && (byte != 0)) {
  2175.     if (flags & TCL_ENCODING_STOPONERROR) {
  2176. result = TCL_CONVERT_SYNTAX;
  2177. break;
  2178.     }
  2179.     if (prefixBytes[byte]) {
  2180. src--;
  2181.     }
  2182.     ch = (Tcl_UniChar) byte;
  2183. }
  2184. /*
  2185.  * Special case for 1-byte utf chars for speed.
  2186.  */
  2187. if (ch && ch < 0x80) {
  2188.     *dst++ = (char) ch;
  2189. } else {
  2190.     dst += Tcl_UniCharToUtf(ch, dst);
  2191. }
  2192.         src++;
  2193.     }
  2194.     *srcReadPtr = src - srcStart;
  2195.     *dstWrotePtr = dst - dstStart;
  2196.     *dstCharsPtr = numChars;
  2197.     return result;
  2198. }
  2199. /*
  2200.  *-------------------------------------------------------------------------
  2201.  *
  2202.  * TableFromUtfProc --
  2203.  *
  2204.  * Convert from UTF-8 into the encoding specified by the
  2205.  * TableEncodingData.
  2206.  *
  2207.  * Results:
  2208.  * Returns TCL_OK if conversion was successful.
  2209.  *
  2210.  * Side effects:
  2211.  * None.
  2212.  *
  2213.  *-------------------------------------------------------------------------
  2214.  */
  2215. static int 
  2216. TableFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  2217. srcReadPtr, dstWrotePtr, dstCharsPtr)
  2218.     ClientData clientData; /* TableEncodingData that specifies
  2219.  * encoding. */
  2220.     CONST char *src; /* Source string in UTF-8. */
  2221.     int srcLen; /* Source string length in bytes. */
  2222.     int flags; /* Conversion control flags. */
  2223.     Tcl_EncodingState *statePtr;/* Place for conversion routine to store
  2224.  * state information used during a piecewise
  2225.  * conversion.  Contents of statePtr are
  2226.  * initialized and/or reset by conversion
  2227.  * routine under control of flags argument. */
  2228.     char *dst; /* Output buffer in which converted string
  2229.  * is stored. */
  2230.     int dstLen; /* The maximum length of output buffer in
  2231.  * bytes. */
  2232.     int *srcReadPtr; /* Filled with the number of bytes from the
  2233.  * source string that were converted.  This
  2234.  * may be less than the original source length
  2235.  * if there was a problem converting some
  2236.  * source characters. */
  2237.     int *dstWrotePtr; /* Filled with the number of bytes that were
  2238.  * stored in the output buffer as a result of
  2239.  * the conversion. */
  2240.     int *dstCharsPtr; /* Filled with the number of characters that
  2241.  * correspond to the bytes stored in the
  2242.  * output buffer. */
  2243. {
  2244.     CONST char *srcStart, *srcEnd, *srcClose;
  2245.     char *dstStart, *dstEnd, *prefixBytes;
  2246.     Tcl_UniChar ch;
  2247.     int result, len, word, numChars;
  2248.     TableEncodingData *dataPtr;
  2249.     unsigned short **fromUnicode;
  2250.     
  2251.     result = TCL_OK;    
  2252.     dataPtr = (TableEncodingData *) clientData;
  2253.     prefixBytes = dataPtr->prefixBytes;
  2254.     fromUnicode = dataPtr->fromUnicode;
  2255.     
  2256.     srcStart = src;
  2257.     srcEnd = src + srcLen;
  2258.     srcClose = srcEnd;
  2259.     if ((flags & TCL_ENCODING_END) == 0) {
  2260. srcClose -= TCL_UTF_MAX;
  2261.     }
  2262.     dstStart = dst;
  2263.     dstEnd = dst + dstLen - 1;
  2264.     for (numChars = 0; src < srcEnd; numChars++) {
  2265. if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
  2266.     /*
  2267.      * If there is more string to follow, this will ensure that the
  2268.      * last UTF-8 character in the source buffer hasn't been cut off.
  2269.      */
  2270.     result = TCL_CONVERT_MULTIBYTE;
  2271.     break;
  2272. }
  2273. len = TclUtfToUniChar(src, &ch);
  2274. #if TCL_UTF_MAX > 3
  2275. /*
  2276.  * This prevents a crash condition.  More evaluation is required
  2277.  * for full support of int Tcl_UniChar. [Bug 1004065]
  2278.  */
  2279. if (ch & 0xffff0000) {
  2280.     word = 0;
  2281. } else
  2282. #endif
  2283.     word = fromUnicode[(ch >> 8)][ch & 0xff];
  2284. if ((word == 0) && (ch != 0)) {
  2285.     if (flags & TCL_ENCODING_STOPONERROR) {
  2286. result = TCL_CONVERT_UNKNOWN;
  2287. break;
  2288.     }
  2289.     word = dataPtr->fallback; 
  2290. }
  2291. if (prefixBytes[(word >> 8)] != 0) {
  2292.     if (dst + 1 > dstEnd) {
  2293. result = TCL_CONVERT_NOSPACE;
  2294. break;
  2295.     }
  2296.     dst[0] = (char) (word >> 8);
  2297.     dst[1] = (char) word;
  2298.     dst += 2;
  2299. } else {
  2300.     if (dst > dstEnd) {
  2301. result = TCL_CONVERT_NOSPACE;
  2302. break;
  2303.     }
  2304.     dst[0] = (char) word;
  2305.     dst++;
  2306. src += len;
  2307.     }
  2308.     *srcReadPtr = src - srcStart;
  2309.     *dstWrotePtr = dst - dstStart;
  2310.     *dstCharsPtr = numChars;
  2311.     return result;
  2312. }
  2313. /*
  2314.  *---------------------------------------------------------------------------
  2315.  *
  2316.  * TableFreeProc --
  2317.  *
  2318.  * This procedure is invoked when an encoding is deleted.  It deletes
  2319.  * the memory used by the TableEncodingData.
  2320.  *
  2321.  * Results:
  2322.  * None.
  2323.  *
  2324.  * Side effects:
  2325.  * Memory freed.
  2326.  *
  2327.  *---------------------------------------------------------------------------
  2328.  */
  2329. static void
  2330. TableFreeProc(clientData)
  2331.     ClientData clientData; /* TableEncodingData that specifies
  2332.  * encoding. */
  2333. {
  2334.     TableEncodingData *dataPtr;
  2335.     /*
  2336.      * Make sure we aren't freeing twice on shutdown.  [Bug #219314]
  2337.      */
  2338.     dataPtr = (TableEncodingData *) clientData;
  2339.     ckfree((char *) dataPtr->toUnicode);
  2340.     ckfree((char *) dataPtr->fromUnicode);
  2341.     ckfree((char *) dataPtr);
  2342. }
  2343. /*
  2344.  *-------------------------------------------------------------------------
  2345.  *
  2346.  * EscapeToUtfProc --
  2347.  *
  2348.  * Convert from the encoding specified by the EscapeEncodingData into
  2349.  * UTF-8.
  2350.  *
  2351.  * Results:
  2352.  * Returns TCL_OK if conversion was successful.
  2353.  *
  2354.  * Side effects:
  2355.  * None.
  2356.  *
  2357.  *-------------------------------------------------------------------------
  2358.  */
  2359. static int 
  2360. EscapeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  2361. srcReadPtr, dstWrotePtr, dstCharsPtr)
  2362.     ClientData clientData; /* EscapeEncodingData that specifies
  2363.  * encoding. */
  2364.     CONST char *src; /* Source string in specified encoding. */
  2365.     int srcLen; /* Source string length in bytes. */
  2366.     int flags; /* Conversion control flags. */
  2367.     Tcl_EncodingState *statePtr;/* Place for conversion routine to store
  2368.  * state information used during a piecewise
  2369.  * conversion.  Contents of statePtr are
  2370.  * initialized and/or reset by conversion
  2371.  * routine under control of flags argument. */
  2372.     char *dst; /* Output buffer in which converted string
  2373.  * is stored. */
  2374.     int dstLen; /* The maximum length of output buffer in
  2375.  * bytes. */
  2376.     int *srcReadPtr; /* Filled with the number of bytes from the
  2377.  * source string that were converted.  This
  2378.  * may be less than the original source length
  2379.  * if there was a problem converting some
  2380.  * source characters. */
  2381.     int *dstWrotePtr; /* Filled with the number of bytes that were
  2382.  * stored in the output buffer as a result of
  2383.  * the conversion. */
  2384.     int *dstCharsPtr; /* Filled with the number of characters that
  2385.  * correspond to the bytes stored in the
  2386.  * output buffer. */
  2387. {
  2388.     EscapeEncodingData *dataPtr;
  2389.     char *prefixBytes, *tablePrefixBytes;
  2390.     unsigned short **tableToUnicode;
  2391.     Encoding *encodingPtr;
  2392.     int state, result, numChars;
  2393.     CONST char *srcStart, *srcEnd;
  2394.     char *dstStart, *dstEnd;
  2395.     result = TCL_OK;
  2396.     tablePrefixBytes = NULL; /* lint. */
  2397.     tableToUnicode = NULL; /* lint. */
  2398.     dataPtr = (EscapeEncodingData *) clientData;
  2399.     prefixBytes = dataPtr->prefixBytes;
  2400.     encodingPtr = NULL;
  2401.     srcStart = src;
  2402.     srcEnd = src + srcLen;
  2403.     dstStart = dst;
  2404.     dstEnd = dst + dstLen - TCL_UTF_MAX;
  2405.     state = (int) *statePtr;
  2406.     if (flags & TCL_ENCODING_START) {
  2407. state = 0;
  2408.     }
  2409.     for (numChars = 0; src < srcEnd; ) {
  2410. int byte, hi, lo, ch;
  2411.         if (dst > dstEnd) {
  2412.             result = TCL_CONVERT_NOSPACE;
  2413.             break;
  2414.         }
  2415. byte = *((unsigned char *) src);
  2416. if (prefixBytes[byte]) {
  2417.     unsigned int left, len, longest;
  2418.     int checked, i;
  2419.     EscapeSubTable *subTablePtr;
  2420.     
  2421.     /*
  2422.      * Saw the beginning of an escape sequence. 
  2423.      */
  2424.      
  2425.     left = srcEnd - src;
  2426.     len = dataPtr->initLen;
  2427.     longest = len;
  2428.     checked = 0;
  2429.     if (len <= left) {
  2430. checked++;
  2431. if ((len > 0) && 
  2432. (memcmp(src, dataPtr->init, len) == 0)) {
  2433.     /*
  2434.      * If we see initialization string, skip it, even if we're
  2435.      * not at the beginning of the buffer. 
  2436.      */
  2437.      
  2438.     src += len;
  2439.     continue;
  2440. }
  2441.     }
  2442.     len = dataPtr->finalLen;
  2443.     if (len > longest) {
  2444. longest = len;
  2445.     }
  2446.     if (len <= left) {
  2447. checked++;
  2448. if ((len > 0) && 
  2449. (memcmp(src, dataPtr->final, len) == 0)) {
  2450.     /*
  2451.      * If we see finalization string, skip it, even if we're
  2452.      * not at the end of the buffer. 
  2453.      */
  2454.      
  2455.     src += len;
  2456.     continue;
  2457. }
  2458.     }
  2459.     subTablePtr = dataPtr->subTables;
  2460.     for (i = 0; i < dataPtr->numSubTables; i++) {
  2461. len = subTablePtr->sequenceLen;
  2462. if (len > longest) {
  2463.     longest = len;
  2464. }
  2465. if (len <= left) {
  2466.     checked++;
  2467.     if ((len > 0) && 
  2468.     (memcmp(src, subTablePtr->sequence, len) == 0)) {
  2469. state = i;
  2470. encodingPtr = NULL;
  2471. subTablePtr = NULL;
  2472. src += len;
  2473. break;
  2474.     }
  2475. }
  2476. subTablePtr++;
  2477.     }
  2478.     if (subTablePtr == NULL) {
  2479. /*
  2480.  * A match was found, the escape sequence was consumed, and
  2481.  * the state was updated.
  2482.  */
  2483. continue;
  2484.     }
  2485.     /*
  2486.      * We have a split-up or unrecognized escape sequence.  If we
  2487.      * checked all the sequences, then it's a syntax error,
  2488.      * otherwise we need more bytes to determine a match.
  2489.      */
  2490.     if ((checked == dataPtr->numSubTables + 2)
  2491.     || (flags & TCL_ENCODING_END)) {
  2492. if ((flags & TCL_ENCODING_STOPONERROR) == 0) {
  2493.     /*
  2494.      * Skip the unknown escape sequence.
  2495.      */
  2496.     src += longest;
  2497.     continue;
  2498. }
  2499. result = TCL_CONVERT_SYNTAX;
  2500.     } else {
  2501. result = TCL_CONVERT_MULTIBYTE;
  2502.     }
  2503.     break;
  2504. }
  2505. if (encodingPtr == NULL) {
  2506.     TableEncodingData *tableDataPtr;
  2507.     encodingPtr = GetTableEncoding(dataPtr, state);
  2508.     tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
  2509.     tablePrefixBytes = tableDataPtr->prefixBytes;
  2510.     tableToUnicode = tableDataPtr->toUnicode;
  2511. }
  2512. if (tablePrefixBytes[byte]) {
  2513.     src++;
  2514.     if (src >= srcEnd) {
  2515. src--;
  2516. result = TCL_CONVERT_MULTIBYTE;
  2517. break;
  2518.     }
  2519.     hi = byte;
  2520.     lo = *((unsigned char *) src);
  2521. } else {
  2522.     hi = 0;
  2523.     lo = byte;
  2524. }
  2525. ch = tableToUnicode[hi][lo];
  2526. dst += Tcl_UniCharToUtf(ch, dst);
  2527. src++;
  2528. numChars++;
  2529.     }
  2530.     *statePtr = (Tcl_EncodingState) state;
  2531.     *srcReadPtr = src - srcStart;
  2532.     *dstWrotePtr = dst - dstStart;
  2533.     *dstCharsPtr = numChars;
  2534.     return result;
  2535. }
  2536. /*
  2537.  *-------------------------------------------------------------------------
  2538.  *
  2539.  * EscapeFromUtfProc --
  2540.  *
  2541.  * Convert from UTF-8 into the encoding specified by the
  2542.  * EscapeEncodingData.
  2543.  *
  2544.  * Results:
  2545.  * Returns TCL_OK if conversion was successful.
  2546.  *
  2547.  * Side effects:
  2548.  * None.
  2549.  *
  2550.  *-------------------------------------------------------------------------
  2551.  */
  2552. static int 
  2553. EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  2554. srcReadPtr, dstWrotePtr, dstCharsPtr)
  2555.     ClientData clientData; /* EscapeEncodingData that specifies
  2556.  * encoding. */
  2557.     CONST char *src; /* Source string in UTF-8. */
  2558.     int srcLen; /* Source string length in bytes. */
  2559.     int flags; /* Conversion control flags. */
  2560.     Tcl_EncodingState *statePtr;/* Place for conversion routine to store
  2561.  * state information used during a piecewise
  2562.  * conversion.  Contents of statePtr are
  2563.  * initialized and/or reset by conversion
  2564.  * routine under control of flags argument. */
  2565.     char *dst; /* Output buffer in which converted string
  2566.  * is stored. */
  2567.     int dstLen; /* The maximum length of output buffer in
  2568.  * bytes. */
  2569.     int *srcReadPtr; /* Filled with the number of bytes from the
  2570.  * source string that were converted.  This
  2571.  * may be less than the original source length
  2572.  * if there was a problem converting some
  2573.  * source characters. */
  2574.     int *dstWrotePtr; /* Filled with the number of bytes that were
  2575.  * stored in the output buffer as a result of
  2576.  * the conversion. */
  2577.     int *dstCharsPtr; /* Filled with the number of characters that
  2578.  * correspond to the bytes stored in the
  2579.  * output buffer. */
  2580. {
  2581.     EscapeEncodingData *dataPtr;
  2582.     Encoding *encodingPtr;
  2583.     CONST char *srcStart, *srcEnd, *srcClose;
  2584.     char *dstStart, *dstEnd;
  2585.     int state, result, numChars;
  2586.     TableEncodingData *tableDataPtr;
  2587.     char *tablePrefixBytes;
  2588.     unsigned short **tableFromUnicode;
  2589.     
  2590.     result = TCL_OK;    
  2591.     dataPtr = (EscapeEncodingData *) clientData;
  2592.     srcStart = src;
  2593.     srcEnd = src + srcLen;
  2594.     srcClose = srcEnd;
  2595.     if ((flags & TCL_ENCODING_END) == 0) {
  2596. srcClose -= TCL_UTF_MAX;
  2597.     }
  2598.     dstStart = dst;
  2599.     dstEnd = dst + dstLen - 1;
  2600.     /*
  2601.      * RFC1468 states that the text starts in ASCII, and switches to Japanese
  2602.      * characters, and that the text must end in ASCII. [Patch #474358]
  2603.      */
  2604.     if (flags & TCL_ENCODING_START) {
  2605. state = 0;
  2606. if ((dst + dataPtr->initLen) > dstEnd) {
  2607.     *srcReadPtr = 0;
  2608.     *dstWrotePtr = 0;
  2609.     return TCL_CONVERT_NOSPACE;
  2610. }
  2611. memcpy((VOID *) dst, (VOID *) dataPtr->init,
  2612. (size_t) dataPtr->initLen);
  2613. dst += dataPtr->initLen;
  2614.     } else {
  2615.         state = (int) *statePtr;
  2616.     }
  2617.     encodingPtr = GetTableEncoding(dataPtr, state);
  2618.     tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
  2619.     tablePrefixBytes = tableDataPtr->prefixBytes;
  2620.     tableFromUnicode = tableDataPtr->fromUnicode;
  2621.     for (numChars = 0; src < srcEnd; numChars++) {
  2622. unsigned int len;
  2623. int word;
  2624. Tcl_UniChar ch;
  2625. if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
  2626.     /*
  2627.      * If there is more string to follow, this will ensure that the
  2628.      * last UTF-8 character in the source buffer hasn't been cut off.
  2629.      */
  2630.     result = TCL_CONVERT_MULTIBYTE;
  2631.     break;
  2632. }
  2633. len = TclUtfToUniChar(src, &ch);
  2634. word = tableFromUnicode[(ch >> 8)][ch & 0xff];
  2635. if ((word == 0) && (ch != 0)) {
  2636.     int oldState;
  2637.     EscapeSubTable *subTablePtr;
  2638.     
  2639.     oldState = state;
  2640.     for (state = 0; state < dataPtr->numSubTables; state++) {
  2641. encodingPtr = GetTableEncoding(dataPtr, state);
  2642. tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
  2643.      word = tableDataPtr->fromUnicode[(ch >> 8)][ch & 0xff];
  2644. if (word != 0) {
  2645.     break;
  2646. }
  2647.     }
  2648.     if (word == 0) {
  2649. state = oldState;
  2650. if (flags & TCL_ENCODING_STOPONERROR) {
  2651.     result = TCL_CONVERT_UNKNOWN;
  2652.     break;
  2653. }
  2654. encodingPtr = GetTableEncoding(dataPtr, state);
  2655. tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
  2656. word = tableDataPtr->fallback;
  2657.     } 
  2658.     
  2659.     tablePrefixBytes = tableDataPtr->prefixBytes;
  2660.     tableFromUnicode = tableDataPtr->fromUnicode;
  2661.     /*
  2662.      * The state variable has the value of oldState when word is 0.
  2663.      * In this case, the escape sequense should not be copied to dst 
  2664.      * because the current character set is not changed.
  2665.      */
  2666.     if (state != oldState) {
  2667. subTablePtr = &dataPtr->subTables[state];
  2668. if ((dst + subTablePtr->sequenceLen) > dstEnd) {
  2669.     /*
  2670.      * If there is no space to write the escape sequence, the
  2671.      * state variable must be changed to the value of oldState
  2672.      * variable because this escape sequence must be written
  2673.      * in the next conversion.
  2674.      */
  2675.     state = oldState;
  2676.     result = TCL_CONVERT_NOSPACE;
  2677.     break;
  2678. }
  2679. memcpy((VOID *) dst, (VOID *) subTablePtr->sequence,
  2680. (size_t) subTablePtr->sequenceLen);
  2681. dst += subTablePtr->sequenceLen;
  2682.     }
  2683. }
  2684. if (tablePrefixBytes[(word >> 8)] != 0) {
  2685.     if (dst + 1 > dstEnd) {
  2686. result = TCL_CONVERT_NOSPACE;
  2687. break;
  2688.     }
  2689.     dst[0] = (char) (word >> 8);
  2690.     dst[1] = (char) word;
  2691.     dst += 2;
  2692. } else {
  2693.     if (dst > dstEnd) {
  2694. result = TCL_CONVERT_NOSPACE;
  2695. break;
  2696.     }
  2697.     dst[0] = (char) word;
  2698.     dst++;
  2699. src += len;
  2700.     }
  2701.     if ((result == TCL_OK) && (flags & TCL_ENCODING_END)) {
  2702. unsigned int len = dataPtr->subTables[0].sequenceLen;
  2703. /*
  2704.  * [Bug 1516109].
  2705.  * Certain encodings like iso2022-jp need to write
  2706.  * an escape sequence after all characters have
  2707.  * been converted. This logic checks that enough
  2708.  * room is available in the buffer for the escape bytes.
  2709.  * The TCL_ENCODING_END flag is cleared after a final
  2710.  * escape sequence has been added to the buffer so
  2711.  * that another call to this method does not attempt
  2712.  * to append escape bytes a second time.
  2713.  */
  2714. if ((dst + dataPtr->finalLen + (state?len:0)) > dstEnd) {
  2715.     result = TCL_CONVERT_NOSPACE;
  2716. } else {
  2717.     if (state) {
  2718. memcpy((VOID *) dst, (VOID *) dataPtr->subTables[0].sequence,
  2719. (size_t) len);
  2720. dst += len;
  2721.     }
  2722.     memcpy((VOID *) dst, (VOID *) dataPtr->final,
  2723.     (size_t) dataPtr->finalLen);
  2724.     dst += dataPtr->finalLen;
  2725.     state &= ~TCL_ENCODING_END;
  2726. }
  2727.     }
  2728.     *statePtr = (Tcl_EncodingState) state;
  2729.     *srcReadPtr = src - srcStart;
  2730.     *dstWrotePtr = dst - dstStart;
  2731.     *dstCharsPtr = numChars;
  2732.     return result;
  2733. }
  2734. /*
  2735.  *---------------------------------------------------------------------------
  2736.  *
  2737.  * EscapeFreeProc --
  2738.  *
  2739.  * This procedure is invoked when an EscapeEncodingData encoding is 
  2740.  * deleted.  It deletes the memory used by the encoding.
  2741.  *
  2742.  * Results:
  2743.  * None.
  2744.  *
  2745.  * Side effects:
  2746.  * Memory freed.
  2747.  *
  2748.  *---------------------------------------------------------------------------
  2749.  */
  2750. static void
  2751. EscapeFreeProc(clientData)
  2752.     ClientData clientData; /* EscapeEncodingData that specifies encoding. */
  2753. {
  2754.     EscapeEncodingData *dataPtr;
  2755.     EscapeSubTable *subTablePtr;
  2756.     int i;
  2757.     dataPtr = (EscapeEncodingData *) clientData;
  2758.     if (dataPtr == NULL) {
  2759. return;
  2760.     }
  2761.     subTablePtr = dataPtr->subTables;
  2762.     for (i = 0; i < dataPtr->numSubTables; i++) {
  2763. FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr);
  2764. subTablePtr++;
  2765.     }
  2766.     ckfree((char *) dataPtr);
  2767. }
  2768. /*
  2769.  *---------------------------------------------------------------------------
  2770.  *
  2771.  * GetTableEncoding --
  2772.  *
  2773.  * Helper function for the EscapeEncodingData conversions.  Gets the
  2774.  * encoding (of type TextEncodingData) that represents the specified
  2775.  * state.
  2776.  *
  2777.  * Results:
  2778.  * The return value is the encoding.
  2779.  *
  2780.  * Side effects:
  2781.  * If the encoding that represents the specified state has not
  2782.  * already been used by this EscapeEncoding, it will be loaded
  2783.  * and cached in the dataPtr.
  2784.  *
  2785.  *---------------------------------------------------------------------------
  2786.  */
  2787. static Encoding *
  2788. GetTableEncoding(dataPtr, state)
  2789.     EscapeEncodingData *dataPtr;/* Contains names of encodings. */
  2790.     int state; /* Index in dataPtr of desired Encoding. */
  2791. {
  2792.     EscapeSubTable *subTablePtr;
  2793.     Encoding *encodingPtr;
  2794.     
  2795.     subTablePtr = &dataPtr->subTables[state];
  2796.     encodingPtr = subTablePtr->encodingPtr;
  2797.     if (encodingPtr == NULL) {
  2798. /*
  2799.  * Now that escape encodings load their sub-encodings first, and
  2800.  * fail to load if any sub-encodings are missing, this branch should
  2801.  * never happen.  
  2802.  */
  2803. encodingPtr = (Encoding *) Tcl_GetEncoding(NULL, subTablePtr->name);
  2804. if ((encodingPtr == NULL) 
  2805. || (encodingPtr->toUtfProc != TableToUtfProc)) {
  2806.     panic("EscapeToUtfProc: invalid sub table");
  2807. }
  2808. subTablePtr->encodingPtr = encodingPtr;
  2809.     }
  2810.     return encodingPtr;
  2811. }
  2812. /*
  2813.  *---------------------------------------------------------------------------
  2814.  *
  2815.  * unilen --
  2816.  *
  2817.  * A helper function for the Tcl_ExternalToUtf functions.  This
  2818.  * function is similar to strlen for double-byte characters: it
  2819.  * returns the number of bytes in a 0x0000 terminated string.
  2820.  *
  2821.  * Results:
  2822.  * As above.
  2823.  *
  2824.  * Side effects:
  2825.  * None.
  2826.  *
  2827.  *---------------------------------------------------------------------------
  2828.  */
  2829. static size_t
  2830. unilen(src)
  2831.     CONST char *src;
  2832. {
  2833.     unsigned short *p;
  2834.     p = (unsigned short *) src;
  2835.     while (*p != 0x0000) {
  2836. p++;
  2837.     }
  2838.     return (char *) p - src;
  2839. }
  2840. /*
  2841.  *-------------------------------------------------------------------------
  2842.  *
  2843.  * TclFindEncodings --
  2844.  *
  2845.  * Find and load the encoding file for this operating system.
  2846.  * Before this is called, Tcl makes assumptions about the
  2847.  * native string representation, but the true encoding is not
  2848.  * assured.
  2849.  *
  2850.  * Results:
  2851.  * Return result of TclpInitLibraryPath, which reports whether the
  2852.  * path is clean (0) or dirty (1) UTF.
  2853.  *
  2854.  * Side effects:
  2855.  * Varied, see the respective initialization routines.
  2856.  *
  2857.  *-------------------------------------------------------------------------
  2858.  */
  2859. static int
  2860. TclFindEncodings(argv0)
  2861.     CONST char *argv0; /* Name of executable from argv[0] to main()
  2862.  * in native multi-byte encoding. */
  2863. {
  2864.     int mustCleanUtf = 0;
  2865.     if (encodingsInitialized == 0) {
  2866. /* 
  2867.  * Double check inside the mutex.  There may be calls
  2868.  * back into this routine from some of the procedures below.
  2869.  */
  2870. TclpInitLock();
  2871. if (encodingsInitialized == 0) {
  2872.     char *native;
  2873.     Tcl_Obj *pathPtr;
  2874.     Tcl_DString libPath, buffer;
  2875.     /*
  2876.      * Have to set this bit here to avoid deadlock with the
  2877.      * routines below us that call into TclInitSubsystems.
  2878.      */
  2879.     encodingsInitialized = 1;
  2880.     native = TclpFindExecutable(argv0);
  2881.     mustCleanUtf = TclpInitLibraryPath(native);
  2882.     /*
  2883.      * The library path was set in the TclpInitLibraryPath routine.
  2884.      * The string set is a dirty UTF string.  To preserve the value
  2885.      * convert the UTF string back to native before setting the new
  2886.      * default encoding.
  2887.      */
  2888.     pathPtr = TclGetLibraryPath();
  2889.     if ((pathPtr != NULL) && mustCleanUtf) {
  2890. Tcl_UtfToExternalDString(NULL, Tcl_GetString(pathPtr), -1,
  2891. &libPath);
  2892.     }
  2893.     TclpSetInitialEncodings();
  2894.     /*
  2895.      * Now convert the native string back to UTF.
  2896.      */
  2897.     if ((pathPtr != NULL) && mustCleanUtf) {
  2898. Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&libPath), -1,
  2899. &buffer);
  2900. pathPtr = Tcl_NewStringObj(Tcl_DStringValue(&buffer), -1);
  2901. TclSetLibraryPath(pathPtr);
  2902. Tcl_DStringFree(&libPath);
  2903. Tcl_DStringFree(&buffer);
  2904.     }
  2905. }
  2906. TclpInitUnlock();
  2907.     }
  2908.     return mustCleanUtf;
  2909. }