/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclencoding.c
ViewVC logotype

Annotation of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclencoding.c

Parent Directory Parent Directory | Revision Log Revision Log


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

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25