Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: downloads/tcl8.5.2/generic/tclEncoding.c @ 63

Last change on this file since 63 was 25, checked in by landauf, 17 years ago

added tcl to libs

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