summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.decls2
-rw-r--r--generic/tcl.h2
-rw-r--r--generic/tclCmdIL.c2
-rw-r--r--generic/tclConfig.c2
-rw-r--r--generic/tclEncoding.c285
-rw-r--r--generic/tclEvent.c2
-rw-r--r--generic/tclIORChan.c3
-rw-r--r--generic/tclIndexObj.c2
-rw-r--r--generic/tclInt.decls2
-rw-r--r--generic/tclInt.h2
-rw-r--r--generic/tclIntDecls.h4
-rw-r--r--generic/tclLoad.c582
-rw-r--r--generic/tclPkgConfig.c2
-rw-r--r--generic/tclTest.c2
-rw-r--r--generic/tclThreadAlloc.c2
-rw-r--r--generic/tclZipfs.c307
16 files changed, 632 insertions, 571 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 9aae5dc..bd175d6 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -888,7 +888,7 @@ declare 243 {
}
# Removed in 9.0 (stub entry only)
#declare 244 {
-# void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName,
+# void Tcl_StaticPackage(Tcl_Interp *interp, const char *prefix,
# Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
#}
# Removed in 9.0 (stub entry only)
diff --git a/generic/tcl.h b/generic/tcl.h
index 5c6e35b..1ae0785 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2189,7 +2189,7 @@ EXTERN void Tcl_FindExecutable(const char *argv0);
EXTERN void Tcl_SetPanicProc(
TCL_NORETURN1 Tcl_PanicProc *panicProc);
EXTERN void Tcl_StaticPackage(Tcl_Interp *interp,
- const char *pkgName,
+ const char *prefix,
Tcl_PackageInitProc *initProc,
Tcl_PackageInitProc *safeInitProc);
EXTERN Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc);
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 75eb441..64ba829 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -1699,7 +1699,7 @@ InfoLoadedCmd(
} else { /* Get pkgs just in specified interp. */
packageName = TclGetString(objv[2]);
}
- return TclGetLoadedPackagesEx(interp, interpName, packageName);
+ return TclGetLoadedLibraries(interp, interpName, packageName);
}
/*
diff --git a/generic/tclConfig.c b/generic/tclConfig.c
index 85e05e9..09b1b27 100644
--- a/generic/tclConfig.c
+++ b/generic/tclConfig.c
@@ -178,7 +178,7 @@ Tcl_RegisterConfig(
* QueryConfigObjCmd --
*
* Implementation of "::<package>::pkgconfig", the command to query
- * configuration information embedded into a binary library.
+ * configuration information embedded into a library.
*
* Results:
* A standard tcl result.
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 2601614..1bc1360 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -220,14 +220,7 @@ static size_t unilen(const char *src);
static Tcl_EncodingConvertProc Utf16ToUtfProc;
static Tcl_EncodingConvertProc UtfToUtf16Proc;
static Tcl_EncodingConvertProc UtfToUcs2Proc;
-static int UtfToUtfProc(ClientData clientData,
- const char *src, int srcLen, int flags,
- Tcl_EncodingState *statePtr, char *dst,
- int dstLen, int *srcReadPtr,
- int *dstWrotePtr, int *dstCharsPtr,
- int pureNullMode);
-static Tcl_EncodingConvertProc UtfIntToUtfExtProc;
-static Tcl_EncodingConvertProc UtfExtToUtfIntProc;
+static Tcl_EncodingConvertProc UtfToUtfProc;
static Tcl_EncodingConvertProc Iso88591FromUtfProc;
static Tcl_EncodingConvertProc Iso88591ToUtfProc;
@@ -517,6 +510,10 @@ FillEncodingFileMap(void)
*---------------------------------------------------------------------------
*/
+/* Those flags must not conflict with other TCL_ENCODING_* flags in tcl.h */
+#define TCL_ENCODING_LE 0x40 /* Little-endian encoding */
+#define TCL_ENCODING_EXTERNAL 0x80 /* Converting from internal to external variant */
+
void
TclInitEncodingSubsystem(void)
{
@@ -525,7 +522,7 @@ TclInitEncodingSubsystem(void)
unsigned size;
unsigned short i;
union {
- char c;
+ unsigned char c;
short s;
} isLe;
@@ -533,7 +530,7 @@ TclInitEncodingSubsystem(void)
return;
}
- isLe.s = 1;
+ isLe.s = TCL_ENCODING_LE;
Tcl_MutexLock(&encodingMutex);
Tcl_InitHashTable(&encodingTable, TCL_STRING_KEYS);
Tcl_MutexUnlock(&encodingMutex);
@@ -553,8 +550,8 @@ TclInitEncodingSubsystem(void)
tclIdentityEncoding = Tcl_CreateEncoding(&type);
type.encodingName = "utf-8";
- type.toUtfProc = UtfExtToUtfIntProc;
- type.fromUtfProc = UtfIntToUtfExtProc;
+ type.toUtfProc = UtfToUtfProc;
+ type.fromUtfProc = UtfToUtfProc;
type.freeProc = NULL;
type.nullSize = 1;
type.clientData = NULL;
@@ -565,7 +562,7 @@ TclInitEncodingSubsystem(void)
type.freeProc = NULL;
type.nullSize = 2;
type.encodingName = "ucs-2le";
- type.clientData = INT2PTR(1);
+ type.clientData = INT2PTR(TCL_ENCODING_LE);
Tcl_CreateEncoding(&type);
type.encodingName = "ucs-2be";
type.clientData = INT2PTR(0);
@@ -579,7 +576,7 @@ TclInitEncodingSubsystem(void)
type.freeProc = NULL;
type.nullSize = 2;
type.encodingName = "utf-16le";
- type.clientData = INT2PTR(1);
+ type.clientData = INT2PTR(TCL_ENCODING_LE);
Tcl_CreateEncoding(&type);
type.encodingName = "utf-16be";
type.clientData = INT2PTR(0);
@@ -1269,8 +1266,8 @@ Tcl_UtfToExternalDString(
flags = TCL_ENCODING_START | TCL_ENCODING_END;
while (1) {
result = encodingPtr->fromUtfProc(encodingPtr->clientData, src,
- srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote,
- &dstChars);
+ srcLen, flags | TCL_ENCODING_EXTERNAL, &state, dst, dstLen,
+ &srcRead, &dstWrote, &dstChars);
soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
if (result != TCL_CONVERT_NOSPACE) {
@@ -1371,8 +1368,8 @@ Tcl_UtfToExternal(
dstLen -= encodingPtr->nullSize;
result = encodingPtr->fromUtfProc(encodingPtr->clientData, src, srcLen,
- flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
- dstCharsPtr);
+ flags | TCL_ENCODING_EXTERNAL, statePtr, dst, dstLen, srcReadPtr,
+ dstWrotePtr, dstCharsPtr);
if (encodingPtr->nullSize == 2) {
dst[*dstWrotePtr + 1] = '\0';
}
@@ -2094,104 +2091,6 @@ BinaryProc(
/*
*-------------------------------------------------------------------------
*
- * UtfIntToUtfExtProc --
- *
- * Convert from UTF-8 to UTF-8. While converting null-bytes from the
- * Tcl's internal representation (0xC0, 0x80) to the official
- * representation (0x00). See UtfToUtfProc for details.
- *
- * Results:
- * Returns TCL_OK if conversion was successful.
- *
- * Side effects:
- * None.
- *
- *-------------------------------------------------------------------------
- */
-
-static int
-UtfIntToUtfExtProc(
- ClientData clientData,
- const char *src, /* Source string in UTF-8. */
- int srcLen, /* Source string length in bytes. */
- int flags, /* Conversion control flags. */
- Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
- * information used during a piecewise
- * conversion. Contents of statePtr are
- * initialized and/or reset by conversion
- * routine under control of flags argument. */
- char *dst, /* Output buffer in which converted string
- * is stored. */
- int dstLen, /* The maximum length of output buffer in
- * bytes. */
- int *srcReadPtr, /* Filled with the number of bytes from the
- * source string that were converted. This may
- * be less than the original source length if
- * there was a problem converting some source
- * characters. */
- int *dstWrotePtr, /* Filled with the number of bytes that were
- * stored in the output buffer as a result of
- * the conversion. */
- int *dstCharsPtr) /* Filled with the number of characters that
- * correspond to the bytes stored in the
- * output buffer. */
-{
- return UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
- srcReadPtr, dstWrotePtr, dstCharsPtr, 1);
-}
-
-/*
- *-------------------------------------------------------------------------
- *
- * UtfExtToUtfIntProc --
- *
- * Convert from UTF-8 to UTF-8 while converting null-bytes from the
- * official representation (0x00) to Tcl's internal representation (0xC0,
- * 0x80). See UtfToUtfProc for details.
- *
- * Results:
- * Returns TCL_OK if conversion was successful.
- *
- * Side effects:
- * None.
- *
- *-------------------------------------------------------------------------
- */
-
-static int
-UtfExtToUtfIntProc(
- ClientData clientData,
- const char *src, /* Source string in UTF-8. */
- int srcLen, /* Source string length in bytes. */
- int flags, /* Conversion control flags. */
- Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
- * information used during a piecewise
- * conversion. Contents of statePtr are
- * initialized and/or reset by conversion
- * routine under control of flags argument. */
- char *dst, /* Output buffer in which converted string is
- * stored. */
- int dstLen, /* The maximum length of output buffer in
- * bytes. */
- int *srcReadPtr, /* Filled with the number of bytes from the
- * source string that were converted. This may
- * be less than the original source length if
- * there was a problem converting some source
- * characters. */
- int *dstWrotePtr, /* Filled with the number of bytes that were
- * stored in the output buffer as a result of
- * the conversion. */
- int *dstCharsPtr) /* Filled with the number of characters that
- * correspond to the bytes stored in the
- * output buffer. */
-{
- return UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
- srcReadPtr, dstWrotePtr, dstCharsPtr, 0);
-}
-
-/*
- *-------------------------------------------------------------------------
- *
* UtfToUtfProc --
*
* Convert from UTF-8 to UTF-8. Note that the UTF-8 to UTF-8 translation
@@ -2213,11 +2112,7 @@ UtfToUtfProc(
const char *src, /* Source string in UTF-8. */
int srcLen, /* Source string length in bytes. */
int flags, /* Conversion control flags. */
- Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
- * information used during a piecewise
- * conversion. Contents of statePtr are
- * initialized and/or reset by conversion
- * routine under control of flags argument. */
+ TCL_UNUSED(Tcl_EncodingState *),
char *dst, /* Output buffer in which converted string is
* stored. */
int dstLen, /* The maximum length of output buffer in
@@ -2230,21 +2125,15 @@ UtfToUtfProc(
int *dstWrotePtr, /* Filled with the number of bytes that were
* stored in the output buffer as a result of
* the conversion. */
- int *dstCharsPtr, /* Filled with the number of characters that
+ int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
- int pureNullMode) /* Convert embedded nulls from internal
- * representation to real null-bytes or vice
- * versa. Also combine or separate surrogate pairs */
{
const char *srcStart, *srcEnd, *srcClose;
const char *dstStart, *dstEnd;
int result, numChars, charLimit = INT_MAX;
- int *chPtr = (int *) statePtr;
+ int ch;
- if (flags & TCL_ENCODING_START) {
- *statePtr = 0;
- }
result = TCL_OK;
srcStart = src;
@@ -2274,15 +2163,15 @@ UtfToUtfProc(
result = TCL_CONVERT_NOSPACE;
break;
}
- if (UCHAR(*src) < 0x80 && !(UCHAR(*src) == 0 && pureNullMode == 0)) {
+ if (UCHAR(*src) < 0x80 && !(UCHAR(*src) == 0 && !(flags & TCL_ENCODING_EXTERNAL))) {
/*
* Copy 7bit characters, but skip null-bytes when we are in input
* mode, so that they get converted to 0xC080.
*/
*dst++ = *src++;
- } else if (pureNullMode == 1 && UCHAR(*src) == 0xC0 &&
- (src + 1 < srcEnd) && UCHAR(*(src+1)) == 0x80) {
+ } else if (UCHAR(*src) == 0xC0 && (src + 1 < srcEnd)
+ && UCHAR(src[1]) == 0x80 && (flags & TCL_ENCODING_EXTERNAL)) {
/*
* Convert 0xC080 to real nulls when we are in output mode.
*/
@@ -2293,29 +2182,43 @@ UtfToUtfProc(
/*
* Always check before using TclUtfToUCS4. Not doing can so
* cause it run beyond the end of the buffer! If we happen such an
- * incomplete char its bytes are made to represent themselves.
+ * incomplete char its bytes are made to represent themselves
+ * unless the user has explicitly asked to be told.
*/
- *chPtr = UCHAR(*src);
+ if (flags & TCL_ENCODING_STOPONERROR) {
+ result = TCL_CONVERT_MULTIBYTE;
+ break;
+ }
+ ch = UCHAR(*src);
src += 1;
- dst += Tcl_UniCharToUtf(*chPtr, dst);
+ dst += Tcl_UniCharToUtf(ch, dst);
} else {
- src += TclUtfToUCS4(src, chPtr);
- if ((*chPtr | 0x7FF) == 0xDFFF) {
- /* A surrogate character is detected, handle especially */
- int low = *chPtr;
- size_t len = (src <= srcEnd-3) ? TclUtfToUCS4(src, &low) : 0;
- if (((low & ~0x3FF) != 0xDC00) || (*chPtr & 0x400)) {
- *dst++ = (char) (((*chPtr >> 12) | 0xE0) & 0xEF);
- *dst++ = (char) (((*chPtr >> 6) | 0x80) & 0xBF);
- *dst++ = (char) ((*chPtr | 0x80) & 0xBF);
- continue;
+ size_t len = TclUtfToUCS4(src, &ch);
+ if ((len < 2) && (ch != 0) && (flags & TCL_ENCODING_STOPONERROR)) {
+ result = TCL_CONVERT_SYNTAX;
+ break;
+ }
+ src += len;
+ if ((ch | 0x7FF) == 0xDFFF) {
+ /*
+ * A surrogate character is detected, handle especially.
+ */
+
+ int low = ch;
+ len = (src <= srcEnd-3) ? TclUtfToUCS4(src, &low) : 0;
+
+ if (((low & ~0x3FF) != 0xDC00) || (ch & 0x400)) {
+ *dst++ = (char) (((ch >> 12) | 0xE0) & 0xEF);
+ *dst++ = (char) (((ch >> 6) | 0x80) & 0xBF);
+ *dst++ = (char) ((ch | 0x80) & 0xBF);
+ continue;
}
src += len;
- dst += Tcl_UniCharToUtf(*chPtr, dst);
- *chPtr = low;
+ dst += Tcl_UniCharToUtf(ch, dst);
+ ch = low;
}
- dst += Tcl_UniCharToUtf(*chPtr, dst);
+ dst += Tcl_UniCharToUtf(ch, dst);
}
}
@@ -2343,7 +2246,7 @@ UtfToUtfProc(
static int
Utf16ToUtfProc(
- ClientData clientData, /* != NULL means LE, == NUL means BE */
+ ClientData clientData, /* additional flags, e.g. TCL_ENCODING_LE */
const char *src, /* Source string in Unicode. */
int srcLen, /* Source string length in bytes. */
int flags, /* Conversion control flags. */
@@ -2369,18 +2272,27 @@ Utf16ToUtfProc(
int result, numChars, charLimit = INT_MAX;
unsigned short ch;
+ flags |= PTR2INT(clientData);
if (flags & TCL_ENCODING_CHAR_LIMIT) {
charLimit = *dstCharsPtr;
}
result = TCL_OK;
- /* check alignment with utf-16 (2 == sizeof(UTF-16)) */
+ /*
+ * Check alignment with utf-16 (2 == sizeof(UTF-16))
+ */
+
if ((srcLen % 2) != 0) {
result = TCL_CONVERT_MULTIBYTE;
srcLen--;
}
- /* If last code point is a high surrogate, we cannot handle that yet */
- if ((srcLen >= 2) && ((src[srcLen - (clientData?1:2)] & 0xFC) == 0xD8)) {
+
+ /*
+ * If last code point is a high surrogate, we cannot handle that yet.
+ */
+
+ if ((srcLen >= 2) &&
+ ((src[srcLen - ((flags & TCL_ENCODING_LE)?1:2)] & 0xFC) == 0xD8)) {
result = TCL_CONVERT_MULTIBYTE;
srcLen-= 2;
}
@@ -2397,15 +2309,17 @@ Utf16ToUtfProc(
break;
}
- if (clientData) {
+ if (flags & TCL_ENCODING_LE) {
ch = (src[1] & 0xFF) << 8 | (src[0] & 0xFF);
} else {
ch = (src[0] & 0xFF) << 8 | (src[1] & 0xFF);
}
+
/*
* Special case for 1-byte utf chars for speed. Make sure we work with
* unsigned short-size data.
*/
+
if (ch && ch < 0x80) {
*dst++ = (ch & 0xFF);
} else {
@@ -2442,11 +2356,7 @@ UtfToUtf16Proc(
const char *src, /* Source string in UTF-8. */
int srcLen, /* Source string length in bytes. */
int flags, /* Conversion control flags. */
- Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
- * information used during a piecewise
- * conversion. Contents of statePtr are
- * initialized and/or reset by conversion
- * routine under control of flags argument. */
+ TCL_UNUSED(Tcl_EncodingState *),
char *dst, /* Output buffer in which converted string is
* stored. */
int dstLen, /* The maximum length of output buffer in
@@ -2465,11 +2375,8 @@ UtfToUtf16Proc(
{
const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
int result, numChars;
- Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr;
+ int ch;
- if (flags & TCL_ENCODING_START) {
- *statePtr = 0;
- }
srcStart = src;
srcEnd = src + srcLen;
srcClose = srcEnd;
@@ -2495,38 +2402,27 @@ UtfToUtf16Proc(
result = TCL_CONVERT_NOSPACE;
break;
}
- src += TclUtfToUniChar(src, chPtr);
-
+ src += TclUtfToUCS4(src, &ch);
if (clientData) {
-#if TCL_UTF_MAX > 3
- if (*chPtr <= 0xFFFF) {
- *dst++ = (*chPtr & 0xFF);
- *dst++ = (*chPtr >> 8);
+ if (ch <= 0xFFFF) {
+ *dst++ = (ch & 0xFF);
+ *dst++ = (ch >> 8);
} else {
- *dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);
- *dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
- *dst++ = (*chPtr & 0xFF);
- *dst++ = ((*chPtr >> 8) & 0x3) | 0xDC;
+ *dst++ = (((ch - 0x10000) >> 10) & 0xFF);
+ *dst++ = (((ch - 0x10000) >> 18) & 0x3) | 0xD8;
+ *dst++ = (ch & 0xFF);
+ *dst++ = ((ch >> 8) & 0x3) | 0xDC;
}
-#else
- *dst++ = (*chPtr & 0xFF);
- *dst++ = (*chPtr >> 8);
-#endif
} else {
-#if TCL_UTF_MAX > 3
- if (*chPtr <= 0xFFFF) {
- *dst++ = (*chPtr >> 8);
- *dst++ = (*chPtr & 0xFF);
+ if (ch <= 0xFFFF) {
+ *dst++ = (ch >> 8);
+ *dst++ = (ch & 0xFF);
} else {
- *dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
- *dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);
- *dst++ = ((*chPtr >> 8) & 0x3) | 0xDC;
- *dst++ = (*chPtr & 0xFF);
+ *dst++ = (((ch - 0x10000) >> 18) & 0x3) | 0xD8;
+ *dst++ = (((ch - 0x10000) >> 10) & 0xFF);
+ *dst++ = ((ch >> 8) & 0x3) | 0xDC;
+ *dst++ = (ch & 0xFF);
}
-#else
- *dst++ = (*chPtr >> 8);
- *dst++ = (*chPtr & 0xFF);
-#endif
}
}
*srcReadPtr = src - srcStart;
@@ -2553,7 +2449,7 @@ UtfToUtf16Proc(
static int
UtfToUcs2Proc(
- ClientData clientData, /* != NULL means LE, == NUL means BE */
+ ClientData clientData, /* additional flags, e.g. TCL_ENCODING_LE */
const char *src, /* Source string in UTF-8. */
int srcLen, /* Source string length in bytes. */
int flags, /* Conversion control flags. */
@@ -2581,6 +2477,7 @@ UtfToUcs2Proc(
#endif
Tcl_UniChar ch = 0;
+ flags |= PTR2INT(clientData);
srcStart = src;
srcEnd = src + srcLen;
srcClose = srcEnd;
@@ -2624,7 +2521,7 @@ UtfToUcs2Proc(
* casting dst to a Tcl_UniChar. [Bug 1122671]
*/
- if (clientData) {
+ if (flags & TCL_ENCODING_LE) {
*dst++ = (ch & 0xFF);
*dst++ = (ch >> 8);
} else {
@@ -3032,7 +2929,9 @@ Iso88591FromUtfProc(
break;
}
#if TCL_UTF_MAX <= 3
- if ((ch >= 0xD800) && (len < 3)) len = 4;
+ if ((ch >= 0xD800) && (len < 3)) {
+ len = 4;
+ }
#endif
/*
* Plunge on, using '?' as a fallback character.
@@ -3077,7 +2976,7 @@ TableFreeProc(
ClientData clientData) /* TableEncodingData that specifies
* encoding. */
{
- TableEncodingData *dataPtr = (TableEncodingData *)clientData;
+ TableEncodingData *dataPtr = (TableEncodingData *) clientData;
/*
* Make sure we aren't freeing twice on shutdown. [Bug 219314]
@@ -3135,7 +3034,7 @@ EscapeToUtfProc(
* correspond to the bytes stored in the
* output buffer. */
{
- EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData;
+ EscapeEncodingData *dataPtr = (EscapeEncodingData *) clientData;
const char *prefixBytes, *tablePrefixBytes, *srcStart, *srcEnd;
const unsigned short *const *tableToUnicode;
const Encoding *encodingPtr;
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 3717896..4d46acf 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -1502,7 +1502,7 @@ Tcl_UpdateObjCmd(
}
switch ((enum updateOptionsEnum) optionIndex) {
case OPT_IDLETASKS:
- flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
+ flags = TCL_IDLE_EVENTS|TCL_DONT_WAIT;
break;
default:
Tcl_Panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions");
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 770533f..93d0a32 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -56,8 +56,7 @@ static void TimerRunRead(ClientData clientData);
static void TimerRunWrite(ClientData clientData);
/*
- * The C layer channel type/driver definition used by the reflection. This is
- * a version 3 structure.
+ * The C layer channel type/driver definition used by the reflection.
*/
static const Tcl_ChannelType tclRChannelType = {
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 3a9e07f..b665589 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -1237,7 +1237,6 @@ PrintUsage(
int width, numSpaces;
#define NUM_SPACES 20
static const char spaces[] = " ";
- char tmp[TCL_DOUBLE_SPACE];
Tcl_Obj *msg;
/*
@@ -1287,7 +1286,6 @@ PrintUsage(
case TCL_ARGV_FLOAT:
Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %g",
*((double *) infoPtr->dstPtr));
- sprintf(tmp, "%g", *((double *) infoPtr->dstPtr));
break;
case TCL_ARGV_STRING: {
char *string = *((char **) infoPtr->dstPtr);
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index ba4da9e..f0d430a 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -577,7 +577,7 @@ declare 256 {
Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags)
}
declare 257 {
- void TclStaticPackage(Tcl_Interp *interp, const char *pkgName,
+ void TclStaticPackage(Tcl_Interp *interp, const char *prefix,
Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index cd3baa7..4bf077b 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2974,7 +2974,7 @@ MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr,
size_t *sizePtr);
-MODULE_SCOPE int TclGetLoadedPackagesEx(Tcl_Interp *interp,
+MODULE_SCOPE int TclGetLoadedLibraries(Tcl_Interp *interp,
const char *targetName,
const char *packageName);
MODULE_SCOPE int TclGetWideBitsFromObj(Tcl_Interp *, Tcl_Obj *,
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 48eb4b2..e660e40 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -573,7 +573,7 @@ EXTERN int TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr,
Tcl_Obj *part2Ptr, const int flags);
/* 257 */
EXTERN void TclStaticPackage(Tcl_Interp *interp,
- const char *pkgName,
+ const char *prefix,
Tcl_PackageInitProc *initProc,
Tcl_PackageInitProc *safeInitProc);
/* 258 */
@@ -841,7 +841,7 @@ typedef struct TclIntStubs {
Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */
int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */
int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 256 */
- void (*tclStaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */
+ void (*tclStaticPackage) (Tcl_Interp *interp, const char *prefix, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */
Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */
} TclIntStubs;
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index 364e97b..8c163b7 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -13,21 +13,21 @@
#include "tclInt.h"
/*
- * The following structure describes a package that has been loaded either
+ * The following structure describes a library that has been loaded either
* dynamically (with the "load" command) or statically (as indicated by a call
- * to TclGetLoadedPackages). All such packages are linked together into a
- * single list for the process. Packages are never unloaded, until the
+ * to Tcl_StaticPackage). All such libraries are linked together into a
+ * single list for the process. Library are never unloaded, until the
* application exits, when TclFinalizeLoad is called, and these structures are
* freed.
*/
-typedef struct LoadedPackage {
- char *fileName; /* Name of the file from which the package was
- * loaded. An empty string means the package
+typedef struct LoadedLibrary {
+ char *fileName; /* Name of the file from which the library was
+ * loaded. An empty string means the library
* is loaded statically. Malloc-ed. */
- char *packageName; /* Name of package prefix for the package,
+ char *prefix; /* Prefix for the library,
* properly capitalized (first letter UC,
- * others LC), no "_", as in "Net".
+ * others LC), as in "Net".
* Malloc-ed. */
Tcl_LoadHandle loadHandle; /* Token for the loaded file which should be
* passed to (*unLoadProcPtr)() when the file
@@ -35,59 +35,59 @@ typedef struct LoadedPackage {
* then this field is irrelevant. */
Tcl_PackageInitProc *initProc;
/* Initialization function to call to
- * incorporate this package into a trusted
+ * incorporate this library into a trusted
* interpreter. */
Tcl_PackageInitProc *safeInitProc;
/* Initialization function to call to
- * incorporate this package into a safe
+ * incorporate this library into a safe
* interpreter (one that will execute
- * untrusted scripts). NULL means the package
+ * untrusted scripts). NULL means the library
* can't be used in unsafe interpreters. */
Tcl_PackageUnloadProc *unloadProc;
- /* Finalisation function to unload a package
+ /* Finalization function to unload a library
* from a trusted interpreter. NULL means that
- * the package cannot be unloaded. */
+ * the library cannot be unloaded. */
Tcl_PackageUnloadProc *safeUnloadProc;
- /* Finalisation function to unload a package
+ /* Finalization function to unload a library
* from a safe interpreter. NULL means that
- * the package cannot be unloaded. */
- int interpRefCount; /* How many times the package has been loaded
+ * the library cannot be unloaded. */
+ int interpRefCount; /* How many times the library has been loaded
* in trusted interpreters. */
- int safeInterpRefCount; /* How many times the package has been loaded
+ int safeInterpRefCount; /* How many times the library has been loaded
* in safe interpreters. */
- struct LoadedPackage *nextPtr;
- /* Next in list of all packages loaded into
+ struct LoadedLibrary *nextPtr;
+ /* Next in list of all libraries loaded into
* this application process. NULL means end of
* list. */
-} LoadedPackage;
+} LoadedLibrary;
/*
* TCL_THREADS
- * There is a global list of packages that is anchored at firstPackagePtr.
+ * There is a global list of libraries that is anchored at firstLibraryPtr.
* Access to this list is governed by a mutex.
*/
-static LoadedPackage *firstPackagePtr = NULL;
- /* First in list of all packages loaded into
+static LoadedLibrary *firstLibraryPtr = NULL;
+ /* First in list of all libraries loaded into
* this process. */
-TCL_DECLARE_MUTEX(packageMutex)
+TCL_DECLARE_MUTEX(libraryMutex)
/*
- * The following structure represents a particular package that has been
+ * The following structure represents a particular library that has been
* incorporated into a particular interpreter (by calling its initialization
* function). There is a list of these structures for each interpreter, with
* an AssocData value (key "load") for the interpreter that points to the
- * first package (if any).
+ * first library (if any).
*/
-typedef struct InterpPackage {
- LoadedPackage *pkgPtr; /* Points to detailed information about
- * package. */
- struct InterpPackage *nextPtr;
- /* Next package in this interpreter, or NULL
+typedef struct InterpLibrary {
+ LoadedLibrary *libraryPtr; /* Points to detailed information about
+ * library. */
+ struct InterpLibrary *nextPtr;
+ /* Next library in this interpreter, or NULL
* for end of list. */
-} InterpPackage;
+} InterpLibrary;
/*
* Prototypes for functions that are private to this file:
@@ -121,14 +121,14 @@ Tcl_LoadObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Interp *target;
- LoadedPackage *pkgPtr, *defaultPtr;
- Tcl_DString pkgName, tmp, initName, safeInitName;
+ LoadedLibrary *libraryPtr, *defaultPtr;
+ Tcl_DString pfx, tmp, initName, safeInitName;
Tcl_DString unloadName, safeUnloadName;
- InterpPackage *ipFirstPtr, *ipPtr;
+ InterpLibrary *ipFirstPtr, *ipPtr;
int code, namesMatch, filesMatch, offset;
const char *symbols[2];
Tcl_PackageInitProc *initProc;
- const char *p, *fullFileName, *packageName;
+ const char *p, *fullFileName, *prefix;
Tcl_LoadHandle loadHandle;
Tcl_UniChar ch = 0;
size_t len;
@@ -159,7 +159,7 @@ Tcl_LoadObjCmd(
}
}
if ((objc < 2) || (objc > 4)) {
- Tcl_WrongNumArgs(interp, 1, savedobjv, "?-global? ?-lazy? ?--? fileName ?packageName? ?interp?");
+ Tcl_WrongNumArgs(interp, 1, savedobjv, "?-global? ?-lazy? ?--? fileName ?prefix? ?interp?");
return TCL_ERROR;
}
if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
@@ -167,23 +167,23 @@ Tcl_LoadObjCmd(
}
fullFileName = TclGetString(objv[1]);
- Tcl_DStringInit(&pkgName);
+ Tcl_DStringInit(&pfx);
Tcl_DStringInit(&initName);
Tcl_DStringInit(&safeInitName);
Tcl_DStringInit(&unloadName);
Tcl_DStringInit(&safeUnloadName);
Tcl_DStringInit(&tmp);
- packageName = NULL;
+ prefix = NULL;
if (objc >= 3) {
- packageName = TclGetString(objv[2]);
- if (packageName[0] == '\0') {
- packageName = NULL;
+ prefix = TclGetString(objv[2]);
+ if (prefix[0] == '\0') {
+ prefix = NULL;
}
}
- if ((fullFileName[0] == 0) && (packageName == NULL)) {
+ if ((fullFileName[0] == 0) && (prefix == NULL)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "must specify either file name or package name", -1));
+ "must specify either file name or prefix", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOLIBRARY",
NULL);
code = TCL_ERROR;
@@ -191,7 +191,7 @@ Tcl_LoadObjCmd(
}
/*
- * Figure out which interpreter we're going to load the package into.
+ * Figure out which interpreter we're going to load the library into.
*/
target = interp;
@@ -206,89 +206,89 @@ Tcl_LoadObjCmd(
}
/*
- * Scan through the packages that are currently loaded to see if the
- * package we want is already loaded. We'll use a loaded package if it
+ * Scan through the libraries that are currently loaded to see if the
+ * library we want is already loaded. We'll use a loaded library if it
* meets any of the following conditions:
* - Its name and file match the once we're looking for.
* - Its file matches, and we weren't given a name.
* - Its name matches, the file name was specified as empty, and there is
- * only no statically loaded package with the same name.
+ * only no statically loaded library with the same prefix.
*/
- Tcl_MutexLock(&packageMutex);
+ Tcl_MutexLock(&libraryMutex);
defaultPtr = NULL;
- for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
- if (packageName == NULL) {
+ for (libraryPtr = firstLibraryPtr; libraryPtr != NULL; libraryPtr = libraryPtr->nextPtr) {
+ if (prefix == NULL) {
namesMatch = 0;
} else {
- TclDStringClear(&pkgName);
- Tcl_DStringAppend(&pkgName, packageName, -1);
+ TclDStringClear(&pfx);
+ Tcl_DStringAppend(&pfx, prefix, -1);
TclDStringClear(&tmp);
- Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
- Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
+ Tcl_DStringAppend(&tmp, libraryPtr->prefix, -1);
+ Tcl_UtfToLower(Tcl_DStringValue(&pfx));
Tcl_UtfToLower(Tcl_DStringValue(&tmp));
if (strcmp(Tcl_DStringValue(&tmp),
- Tcl_DStringValue(&pkgName)) == 0) {
+ Tcl_DStringValue(&pfx)) == 0) {
namesMatch = 1;
} else {
namesMatch = 0;
}
}
- TclDStringClear(&pkgName);
+ TclDStringClear(&pfx);
- filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
- if (filesMatch && (namesMatch || (packageName == NULL))) {
+ filesMatch = (strcmp(libraryPtr->fileName, fullFileName) == 0);
+ if (filesMatch && (namesMatch || (prefix == NULL))) {
break;
}
if (namesMatch && (fullFileName[0] == 0)) {
- defaultPtr = pkgPtr;
+ defaultPtr = libraryPtr;
}
if (filesMatch && !namesMatch && (fullFileName[0] != 0)) {
/*
- * Can't have two different packages loaded from the same file.
+ * Can't have two different libraries loaded from the same file.
*/
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "file \"%s\" is already loaded for package \"%s\"",
- fullFileName, pkgPtr->packageName));
+ "file \"%s\" is already loaded for prefix \"%s\"",
+ fullFileName, libraryPtr->prefix));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
"SPLITPERSONALITY", NULL);
code = TCL_ERROR;
- Tcl_MutexUnlock(&packageMutex);
+ Tcl_MutexUnlock(&libraryMutex);
goto done;
}
}
- Tcl_MutexUnlock(&packageMutex);
- if (pkgPtr == NULL) {
- pkgPtr = defaultPtr;
+ Tcl_MutexUnlock(&libraryMutex);
+ if (libraryPtr == NULL) {
+ libraryPtr = defaultPtr;
}
/*
- * Scan through the list of packages already loaded in the target
- * interpreter. If the package we want is already loaded there, then
+ * Scan through the list of libraries already loaded in the target
+ * interpreter. If the library we want is already loaded there, then
* there's nothing for us to do.
*/
- if (pkgPtr != NULL) {
- ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
+ if (libraryPtr != NULL) {
+ ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);
for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
- if (ipPtr->pkgPtr == pkgPtr) {
+ if (ipPtr->libraryPtr == libraryPtr) {
code = TCL_OK;
goto done;
}
}
}
- if (pkgPtr == NULL) {
+ if (libraryPtr == NULL) {
/*
* The desired file isn't currently loaded, so load it. It's an error
- * if the desired package is a static one.
+ * if the desired library is a static one.
*/
if (fullFileName[0] == 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "package \"%s\" isn't loaded statically", packageName));
+ "no library with prefix \"%s\" is loaded statically", prefix));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOTSTATIC",
NULL);
code = TCL_ERROR;
@@ -296,11 +296,11 @@ Tcl_LoadObjCmd(
}
/*
- * Figure out the module name if it wasn't provided explicitly.
+ * Figure out the prefix if it wasn't provided explicitly.
*/
- if (packageName != NULL) {
- Tcl_DStringAppend(&pkgName, packageName, -1);
+ if (prefix != NULL) {
+ Tcl_DStringAppend(&pfx, prefix, -1);
} else {
Tcl_Obj *splitPtr, *pkgGuessPtr;
int pElements;
@@ -311,11 +311,11 @@ Tcl_LoadObjCmd(
*/
/*
- * The platform-specific code couldn't figure out the module
- * name. Make a guess by taking the last element of the file
- * name, stripping off any leading "lib", and then using all
- * of the alphabetic and underline characters that follow
- * that.
+ * The platform-specific code couldn't figure out the prefix.
+ * Make a guess by taking the last element of the file
+ * name, stripping off any leading "lib" and/or "tcl", and
+ * then using all of the alphabetic and underline characters
+ * that follow that.
*/
splitPtr = Tcl_FSSplitPath(objv[1], &pElements);
@@ -346,85 +346,85 @@ Tcl_LoadObjCmd(
if (p == pkgGuess) {
Tcl_DecrRefCount(splitPtr);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't figure out package name for %s",
+ "couldn't figure out prefix for %s",
fullFileName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
- "WHATPACKAGE", NULL);
+ "WHATLIBRARY", NULL);
code = TCL_ERROR;
goto done;
}
- Tcl_DStringAppend(&pkgName, pkgGuess, p - pkgGuess);
+ Tcl_DStringAppend(&pfx, pkgGuess, p - pkgGuess);
Tcl_DecrRefCount(splitPtr);
}
/*
- * Fix the capitalization in the package name so that the first
+ * Fix the capitalization in the prefix so that the first
* character is in caps (or title case) but the others are all
* lower-case.
*/
- Tcl_DStringSetLength(&pkgName,
- Tcl_UtfToTitle(Tcl_DStringValue(&pkgName)));
+ Tcl_DStringSetLength(&pfx,
+ Tcl_UtfToTitle(Tcl_DStringValue(&pfx)));
/*
* Compute the names of the two initialization functions, based on the
- * package name.
+ * prefix.
*/
- TclDStringAppendDString(&initName, &pkgName);
+ TclDStringAppendDString(&initName, &pfx);
TclDStringAppendLiteral(&initName, "_Init");
- TclDStringAppendDString(&safeInitName, &pkgName);
+ TclDStringAppendDString(&safeInitName, &pfx);
TclDStringAppendLiteral(&safeInitName, "_SafeInit");
- TclDStringAppendDString(&unloadName, &pkgName);
+ TclDStringAppendDString(&unloadName, &pfx);
TclDStringAppendLiteral(&unloadName, "_Unload");
- TclDStringAppendDString(&safeUnloadName, &pkgName);
+ TclDStringAppendDString(&safeUnloadName, &pfx);
TclDStringAppendLiteral(&safeUnloadName, "_SafeUnload");
/*
- * Call platform-specific code to load the package and find the two
+ * Call platform-specific code to load the library and find the two
* initialization functions.
*/
symbols[0] = Tcl_DStringValue(&initName);
symbols[1] = NULL;
- Tcl_MutexLock(&packageMutex);
+ Tcl_MutexLock(&libraryMutex);
code = Tcl_LoadFile(interp, objv[1], symbols, flags, &initProc,
&loadHandle);
- Tcl_MutexUnlock(&packageMutex);
+ Tcl_MutexUnlock(&libraryMutex);
if (code != TCL_OK) {
goto done;
}
/*
- * Create a new record to describe this package.
+ * Create a new record to describe this library.
*/
- pkgPtr = (LoadedPackage *)Tcl_Alloc(sizeof(LoadedPackage));
+ libraryPtr = (LoadedLibrary *)Tcl_Alloc(sizeof(LoadedLibrary));
len = strlen(fullFileName) + 1;
- pkgPtr->fileName = (char *)Tcl_Alloc(len);
- memcpy(pkgPtr->fileName, fullFileName, len);
- len = Tcl_DStringLength(&pkgName) + 1;
- pkgPtr->packageName = (char *)Tcl_Alloc(len);
- memcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName), len);
- pkgPtr->loadHandle = loadHandle;
- pkgPtr->initProc = initProc;
- pkgPtr->safeInitProc = (Tcl_PackageInitProc *)
+ libraryPtr->fileName = (char *)Tcl_Alloc(len);
+ memcpy(libraryPtr->fileName, fullFileName, len);
+ len = Tcl_DStringLength(&pfx) + 1;
+ libraryPtr->prefix = (char *)Tcl_Alloc(len);
+ memcpy(libraryPtr->prefix, Tcl_DStringValue(&pfx), len);
+ libraryPtr->loadHandle = loadHandle;
+ libraryPtr->initProc = initProc;
+ libraryPtr->safeInitProc = (Tcl_PackageInitProc *)
Tcl_FindSymbol(interp, loadHandle,
Tcl_DStringValue(&safeInitName));
- pkgPtr->unloadProc = (Tcl_PackageUnloadProc *)
+ libraryPtr->unloadProc = (Tcl_PackageUnloadProc *)
Tcl_FindSymbol(interp, loadHandle,
Tcl_DStringValue(&unloadName));
- pkgPtr->safeUnloadProc = (Tcl_PackageUnloadProc *)
+ libraryPtr->safeUnloadProc = (Tcl_PackageUnloadProc *)
Tcl_FindSymbol(interp, loadHandle,
Tcl_DStringValue(&safeUnloadName));
- pkgPtr->interpRefCount = 0;
- pkgPtr->safeInterpRefCount = 0;
+ libraryPtr->interpRefCount = 0;
+ libraryPtr->safeInterpRefCount = 0;
- Tcl_MutexLock(&packageMutex);
- pkgPtr->nextPtr = firstPackagePtr;
- firstPackagePtr = pkgPtr;
- Tcl_MutexUnlock(&packageMutex);
+ Tcl_MutexLock(&libraryMutex);
+ libraryPtr->nextPtr = firstLibraryPtr;
+ firstLibraryPtr = libraryPtr;
+ Tcl_MutexUnlock(&libraryMutex);
/*
* The Tcl_FindSymbol calls may have left a spurious error message in
@@ -435,32 +435,32 @@ Tcl_LoadObjCmd(
}
/*
- * Invoke the package's initialization function (either the normal one or
+ * Invoke the library's initialization function (either the normal one or
* the safe one, depending on whether or not the interpreter is safe).
*/
if (Tcl_IsSafe(target)) {
- if (pkgPtr->safeInitProc == NULL) {
+ if (libraryPtr->safeInitProc == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't use package in a safe interpreter: no"
- " %s_SafeInit procedure", pkgPtr->packageName));
+ "can't use library in a safe interpreter: no"
+ " %s_SafeInit procedure", libraryPtr->prefix));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "UNSAFE",
NULL);
code = TCL_ERROR;
goto done;
}
- code = pkgPtr->safeInitProc(target);
+ code = libraryPtr->safeInitProc(target);
} else {
- if (pkgPtr->initProc == NULL) {
+ if (libraryPtr->initProc == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't attach package to interpreter: no %s_Init procedure",
- pkgPtr->packageName));
+ "can't attach library to interpreter: no %s_Init procedure",
+ libraryPtr->prefix));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "ENTRYPOINT",
NULL);
code = TCL_ERROR;
goto done;
}
- code = pkgPtr->initProc(target);
+ code = libraryPtr->initProc(target);
}
/*
@@ -485,33 +485,33 @@ Tcl_LoadObjCmd(
}
/*
- * Record the fact that the package has been loaded in the target
+ * Record the fact that the library has been loaded in the target
* interpreter.
*
* Update the proper reference count.
*/
- Tcl_MutexLock(&packageMutex);
+ Tcl_MutexLock(&libraryMutex);
if (Tcl_IsSafe(target)) {
- pkgPtr->safeInterpRefCount++;
+ libraryPtr->safeInterpRefCount++;
} else {
- pkgPtr->interpRefCount++;
+ libraryPtr->interpRefCount++;
}
- Tcl_MutexUnlock(&packageMutex);
+ Tcl_MutexUnlock(&libraryMutex);
/*
- * Refetch ipFirstPtr: loading the package may have introduced additional
- * static packages at the head of the linked list!
+ * Refetch ipFirstPtr: loading the library may have introduced additional
+ * static libraries at the head of the linked list!
*/
- ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
- ipPtr = (InterpPackage *)Tcl_Alloc(sizeof(InterpPackage));
- ipPtr->pkgPtr = pkgPtr;
+ ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);
+ ipPtr = (InterpLibrary *)Tcl_Alloc(sizeof(InterpLibrary));
+ ipPtr->libraryPtr = libraryPtr;
ipPtr->nextPtr = ipFirstPtr;
Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr);
done:
- Tcl_DStringFree(&pkgName);
+ Tcl_DStringFree(&pfx);
Tcl_DStringFree(&initName);
Tcl_DStringFree(&safeInitName);
Tcl_DStringFree(&unloadName);
@@ -545,14 +545,14 @@ Tcl_UnloadObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Interp *target; /* Which interpreter to unload from. */
- LoadedPackage *pkgPtr, *defaultPtr;
- Tcl_DString pkgName, tmp;
+ LoadedLibrary *libraryPtr, *defaultPtr;
+ Tcl_DString pfx, tmp;
Tcl_PackageUnloadProc *unloadProc;
- InterpPackage *ipFirstPtr, *ipPtr;
+ InterpLibrary *ipFirstPtr, *ipPtr;
int i, index, code, complain = 1, keepLibrary = 0;
int trustedRefCount = -1, safeRefCount = -1;
const char *fullFileName = "";
- const char *packageName;
+ const char *prefix;
static const char *const options[] = {
"-nocomplain", "-keeplibrary", "--", NULL
};
@@ -596,7 +596,7 @@ Tcl_UnloadObjCmd(
endOfForLoop:
if ((objc-i < 1) || (objc-i > 3)) {
Tcl_WrongNumArgs(interp, 1, objv,
- "?-switch ...? fileName ?packageName? ?interp?");
+ "?-switch ...? fileName ?prefix? ?interp?");
return TCL_ERROR;
}
if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
@@ -604,19 +604,19 @@ Tcl_UnloadObjCmd(
}
fullFileName = TclGetString(objv[i]);
- Tcl_DStringInit(&pkgName);
+ Tcl_DStringInit(&pfx);
Tcl_DStringInit(&tmp);
- packageName = NULL;
+ prefix = NULL;
if (objc - i >= 2) {
- packageName = TclGetString(objv[i+1]);
- if (packageName[0] == '\0') {
- packageName = NULL;
+ prefix = TclGetString(objv[i+1]);
+ if (prefix[0] == '\0') {
+ prefix = NULL;
}
}
- if ((fullFileName[0] == 0) && (packageName == NULL)) {
+ if ((fullFileName[0] == 0) && (prefix == NULL)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "must specify either file name or package name", -1));
+ "must specify either file name or prefix", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NOLIBRARY",
NULL);
code = TCL_ERROR;
@@ -624,7 +624,7 @@ Tcl_UnloadObjCmd(
}
/*
- * Figure out which interpreter we're going to load the package into.
+ * Figure out which interpreter we're going to load the library into.
*/
target = interp;
@@ -638,65 +638,65 @@ Tcl_UnloadObjCmd(
}
/*
- * Scan through the packages that are currently loaded to see if the
- * package we want is already loaded. We'll use a loaded package if it
+ * Scan through the libraries that are currently loaded to see if the
+ * library we want is already loaded. We'll use a loaded library if it
* meets any of the following conditions:
- * - Its name and file match the once we're looking for.
- * - Its file matches, and we weren't given a name.
- * - Its name matches, the file name was specified as empty, and there is
- * only no statically loaded package with the same name.
+ * - Its prefix and file match the once we're looking for.
+ * - Its file matches, and we weren't given a prefix.
+ * - Its prefix matches, the file name was specified as empty, and there is
+ * only no statically loaded library with the same prefix.
*/
- Tcl_MutexLock(&packageMutex);
+ Tcl_MutexLock(&libraryMutex);
defaultPtr = NULL;
- for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
+ for (libraryPtr = firstLibraryPtr; libraryPtr != NULL; libraryPtr = libraryPtr->nextPtr) {
int namesMatch, filesMatch;
- if (packageName == NULL) {
+ if (prefix == NULL) {
namesMatch = 0;
} else {
- TclDStringClear(&pkgName);
- Tcl_DStringAppend(&pkgName, packageName, -1);
+ TclDStringClear(&pfx);
+ Tcl_DStringAppend(&pfx, prefix, -1);
TclDStringClear(&tmp);
- Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
- Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
+ Tcl_DStringAppend(&tmp, libraryPtr->prefix, -1);
+ Tcl_UtfToLower(Tcl_DStringValue(&pfx));
Tcl_UtfToLower(Tcl_DStringValue(&tmp));
if (strcmp(Tcl_DStringValue(&tmp),
- Tcl_DStringValue(&pkgName)) == 0) {
+ Tcl_DStringValue(&pfx)) == 0) {
namesMatch = 1;
} else {
namesMatch = 0;
}
}
- TclDStringClear(&pkgName);
+ TclDStringClear(&pfx);
- filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
- if (filesMatch && (namesMatch || (packageName == NULL))) {
+ filesMatch = (strcmp(libraryPtr->fileName, fullFileName) == 0);
+ if (filesMatch && (namesMatch || (prefix == NULL))) {
break;
}
if (namesMatch && (fullFileName[0] == 0)) {
- defaultPtr = pkgPtr;
+ defaultPtr = libraryPtr;
}
if (filesMatch && !namesMatch && (fullFileName[0] != 0)) {
break;
}
}
- Tcl_MutexUnlock(&packageMutex);
+ Tcl_MutexUnlock(&libraryMutex);
if (fullFileName[0] == 0) {
/*
- * It's an error to try unload a static package.
+ * It's an error to try unload a static library.
*/
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "package \"%s\" is loaded statically and cannot be unloaded",
- packageName));
+ "library with prefix \"%s\" is loaded statically and cannot be unloaded",
+ prefix));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "STATIC",
NULL);
code = TCL_ERROR;
goto done;
}
- if (pkgPtr == NULL) {
+ if (libraryPtr == NULL) {
/*
* The DLL pointed by the provided filename has never been loaded.
*/
@@ -710,16 +710,16 @@ Tcl_UnloadObjCmd(
}
/*
- * Scan through the list of packages already loaded in the target
- * interpreter. If the package we want is already loaded there, then we
+ * Scan through the list of libraries already loaded in the target
+ * interpreter. If the library we want is already loaded there, then we
* should proceed with unloading.
*/
code = TCL_ERROR;
- if (pkgPtr != NULL) {
- ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
+ if (libraryPtr != NULL) {
+ ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);
for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
- if (ipPtr->pkgPtr == pkgPtr) {
+ if (ipPtr->libraryPtr == libraryPtr) {
code = TCL_OK;
break;
}
@@ -727,7 +727,7 @@ Tcl_UnloadObjCmd(
}
if (code != TCL_OK) {
/*
- * The package has not been loaded in this interpreter.
+ * The library has not been loaded in this interpreter.
*/
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -741,12 +741,12 @@ Tcl_UnloadObjCmd(
/*
* Ensure that the DLL can be unloaded. If it is a trusted interpreter,
- * pkgPtr->unloadProc must not be NULL for the DLL to be unloadable. If
- * the interpreter is a safe one, pkgPtr->safeUnloadProc must be non-NULL.
+ * libraryPtr->unloadProc must not be NULL for the DLL to be unloadable. If
+ * the interpreter is a safe one, libraryPtr->safeUnloadProc must be non-NULL.
*/
if (Tcl_IsSafe(target)) {
- if (pkgPtr->safeUnloadProc == NULL) {
+ if (libraryPtr->safeUnloadProc == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"file \"%s\" cannot be unloaded under a safe interpreter",
fullFileName));
@@ -755,9 +755,9 @@ Tcl_UnloadObjCmd(
code = TCL_ERROR;
goto done;
}
- unloadProc = pkgPtr->safeUnloadProc;
+ unloadProc = libraryPtr->safeUnloadProc;
} else {
- if (pkgPtr->unloadProc == NULL) {
+ if (libraryPtr->unloadProc == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"file \"%s\" cannot be unloaded under a trusted interpreter",
fullFileName));
@@ -766,11 +766,11 @@ Tcl_UnloadObjCmd(
code = TCL_ERROR;
goto done;
}
- unloadProc = pkgPtr->unloadProc;
+ unloadProc = libraryPtr->unloadProc;
}
/*
- * We are ready to unload the package. First, evaluate the unload
+ * We are ready to unload the library. First, evaluate the unload
* function. If this fails, we cannot proceed with unload. Also, we must
* specify the proper flag to pass to the unload callback.
* TCL_UNLOAD_DETACH_FROM_INTERPRETER is defined when the callback should
@@ -781,10 +781,10 @@ Tcl_UnloadObjCmd(
code = TCL_UNLOAD_DETACH_FROM_INTERPRETER;
if (!keepLibrary) {
- Tcl_MutexLock(&packageMutex);
- trustedRefCount = pkgPtr->interpRefCount;
- safeRefCount = pkgPtr->safeInterpRefCount;
- Tcl_MutexUnlock(&packageMutex);
+ Tcl_MutexLock(&libraryMutex);
+ trustedRefCount = libraryPtr->interpRefCount;
+ safeRefCount = libraryPtr->safeInterpRefCount;
+ Tcl_MutexUnlock(&libraryMutex);
if (Tcl_IsSafe(target)) {
safeRefCount--;
@@ -807,34 +807,34 @@ Tcl_UnloadObjCmd(
* if we unload the DLL.
*/
- Tcl_MutexLock(&packageMutex);
+ Tcl_MutexLock(&libraryMutex);
if (Tcl_IsSafe(target)) {
- pkgPtr->safeInterpRefCount--;
+ libraryPtr->safeInterpRefCount--;
/*
* Do not let counter get negative.
*/
- if (pkgPtr->safeInterpRefCount < 0) {
- pkgPtr->safeInterpRefCount = 0;
+ if (libraryPtr->safeInterpRefCount < 0) {
+ libraryPtr->safeInterpRefCount = 0;
}
} else {
- pkgPtr->interpRefCount--;
+ libraryPtr->interpRefCount--;
/*
* Do not let counter get negative.
*/
- if (pkgPtr->interpRefCount < 0) {
- pkgPtr->interpRefCount = 0;
+ if (libraryPtr->interpRefCount < 0) {
+ libraryPtr->interpRefCount = 0;
}
}
- trustedRefCount = pkgPtr->interpRefCount;
- safeRefCount = pkgPtr->safeInterpRefCount;
- Tcl_MutexUnlock(&packageMutex);
+ trustedRefCount = libraryPtr->interpRefCount;
+ safeRefCount = libraryPtr->safeInterpRefCount;
+ Tcl_MutexUnlock(&libraryMutex);
code = TCL_OK;
- if (pkgPtr->safeInterpRefCount <= 0 && pkgPtr->interpRefCount <= 0
+ if (libraryPtr->safeInterpRefCount <= 0 && libraryPtr->interpRefCount <= 0
&& !keepLibrary) {
/*
* Unload the shared library from the application memory...
@@ -848,21 +848,21 @@ Tcl_UnloadObjCmd(
* it's been unloaded.
*/
- if (pkgPtr->fileName[0] != '\0') {
- Tcl_MutexLock(&packageMutex);
- if (Tcl_FSUnloadFile(interp, pkgPtr->loadHandle) == TCL_OK) {
+ if (libraryPtr->fileName[0] != '\0') {
+ Tcl_MutexLock(&libraryMutex);
+ if (Tcl_FSUnloadFile(interp, libraryPtr->loadHandle) == TCL_OK) {
/*
* Remove this library from the loaded library cache.
*/
- defaultPtr = pkgPtr;
- if (defaultPtr == firstPackagePtr) {
- firstPackagePtr = pkgPtr->nextPtr;
+ defaultPtr = libraryPtr;
+ if (defaultPtr == firstLibraryPtr) {
+ firstLibraryPtr = libraryPtr->nextPtr;
} else {
- for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
- pkgPtr = pkgPtr->nextPtr) {
- if (pkgPtr->nextPtr == defaultPtr) {
- pkgPtr->nextPtr = defaultPtr->nextPtr;
+ for (libraryPtr = firstLibraryPtr; libraryPtr != NULL;
+ libraryPtr = libraryPtr->nextPtr) {
+ if (libraryPtr->nextPtr == defaultPtr) {
+ libraryPtr->nextPtr = defaultPtr->nextPtr;
break;
}
}
@@ -872,16 +872,16 @@ Tcl_UnloadObjCmd(
* Remove this library from the interpreter's library cache.
*/
- ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
+ ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);
ipPtr = ipFirstPtr;
- if (ipPtr->pkgPtr == defaultPtr) {
+ if (ipPtr->libraryPtr == defaultPtr) {
ipFirstPtr = ipFirstPtr->nextPtr;
} else {
- InterpPackage *ipPrevPtr;
+ InterpLibrary *ipPrevPtr;
for (ipPrevPtr = ipPtr; ipPtr != NULL;
ipPrevPtr = ipPtr, ipPtr = ipPtr->nextPtr) {
- if (ipPtr->pkgPtr == defaultPtr) {
+ if (ipPtr->libraryPtr == defaultPtr) {
ipPrevPtr->nextPtr = ipPtr->nextPtr;
break;
}
@@ -890,10 +890,10 @@ Tcl_UnloadObjCmd(
Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
ipFirstPtr);
Tcl_Free(defaultPtr->fileName);
- Tcl_Free(defaultPtr->packageName);
+ Tcl_Free(defaultPtr->prefix);
Tcl_Free(defaultPtr);
Tcl_Free(ipPtr);
- Tcl_MutexUnlock(&packageMutex);
+ Tcl_MutexUnlock(&libraryMutex);
} else {
code = TCL_ERROR;
}
@@ -909,7 +909,7 @@ Tcl_UnloadObjCmd(
}
done:
- Tcl_DStringFree(&pkgName);
+ Tcl_DStringFree(&pfx);
Tcl_DStringFree(&tmp);
if (!complain && (code != TCL_OK)) {
code = TCL_OK;
@@ -923,14 +923,14 @@ Tcl_UnloadObjCmd(
*
* Tcl_StaticPackage --
*
- * This function is invoked to indicate that a particular package has
+ * This function is invoked to indicate that a particular library has
* been linked statically with an application.
*
* Results:
* None.
*
* Side effects:
- * Once this function completes, the package becomes loadable via the
+ * Once this function completes, the library becomes loadable via the
* "load" command with an empty file name.
*
*----------------------------------------------------------------------
@@ -938,82 +938,82 @@ Tcl_UnloadObjCmd(
void
Tcl_StaticPackage(
- Tcl_Interp *interp, /* If not NULL, it means that the package has
+ Tcl_Interp *interp, /* If not NULL, it means that the library has
* already been loaded into the given
* interpreter by calling the appropriate init
* proc. */
- const char *pkgName, /* Name of package (must be properly
+ const char *prefix, /* Prefix (must be properly
* capitalized: first letter upper case,
* others lower case). */
Tcl_PackageInitProc *initProc,
/* Function to call to incorporate this
- * package into a trusted interpreter. */
+ * library into a trusted interpreter. */
Tcl_PackageInitProc *safeInitProc)
/* Function to call to incorporate this
- * package into a safe interpreter (one that
+ * library into a safe interpreter (one that
* will execute untrusted scripts). NULL means
- * the package can't be used in safe
+ * the library can't be used in safe
* interpreters. */
{
- LoadedPackage *pkgPtr;
- InterpPackage *ipPtr, *ipFirstPtr;
+ LoadedLibrary *libraryPtr;
+ InterpLibrary *ipPtr, *ipFirstPtr;
/*
- * Check to see if someone else has already reported this package as
+ * Check to see if someone else has already reported this library as
* statically loaded in the process.
*/
- Tcl_MutexLock(&packageMutex);
- for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
- if ((pkgPtr->initProc == initProc)
- && (pkgPtr->safeInitProc == safeInitProc)
- && (strcmp(pkgPtr->packageName, pkgName) == 0)) {
+ Tcl_MutexLock(&libraryMutex);
+ for (libraryPtr = firstLibraryPtr; libraryPtr != NULL; libraryPtr = libraryPtr->nextPtr) {
+ if ((libraryPtr->initProc == initProc)
+ && (libraryPtr->safeInitProc == safeInitProc)
+ && (strcmp(libraryPtr->prefix, prefix) == 0)) {
break;
}
}
- Tcl_MutexUnlock(&packageMutex);
+ Tcl_MutexUnlock(&libraryMutex);
/*
- * If the package is not yet recorded as being loaded statically, add it
+ * If the library is not yet recorded as being loaded statically, add it
* to the list now.
*/
- if (pkgPtr == NULL) {
- pkgPtr = (LoadedPackage *)Tcl_Alloc(sizeof(LoadedPackage));
- pkgPtr->fileName = (char *)Tcl_Alloc(1);
- pkgPtr->fileName[0] = 0;
- pkgPtr->packageName = (char *)Tcl_Alloc(strlen(pkgName) + 1);
- strcpy(pkgPtr->packageName, pkgName);
- pkgPtr->loadHandle = NULL;
- pkgPtr->initProc = initProc;
- pkgPtr->safeInitProc = safeInitProc;
- Tcl_MutexLock(&packageMutex);
- pkgPtr->nextPtr = firstPackagePtr;
- firstPackagePtr = pkgPtr;
- Tcl_MutexUnlock(&packageMutex);
+ if (libraryPtr == NULL) {
+ libraryPtr = (LoadedLibrary *)Tcl_Alloc(sizeof(LoadedLibrary));
+ libraryPtr->fileName = (char *)Tcl_Alloc(1);
+ libraryPtr->fileName[0] = 0;
+ libraryPtr->prefix = (char *)Tcl_Alloc(strlen(prefix) + 1);
+ strcpy(libraryPtr->prefix, prefix);
+ libraryPtr->loadHandle = NULL;
+ libraryPtr->initProc = initProc;
+ libraryPtr->safeInitProc = safeInitProc;
+ Tcl_MutexLock(&libraryMutex);
+ libraryPtr->nextPtr = firstLibraryPtr;
+ firstLibraryPtr = libraryPtr;
+ Tcl_MutexUnlock(&libraryMutex);
}
if (interp != NULL) {
/*
- * If we're loading the package into an interpreter, determine whether
+ * If we're loading the library into an interpreter, determine whether
* it's already loaded.
*/
- ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(interp, "tclLoad", NULL);
+ ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(interp, "tclLoad", NULL);
for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
- if (ipPtr->pkgPtr == pkgPtr) {
+ if (ipPtr->libraryPtr == libraryPtr) {
return;
}
}
/*
- * Package isn't loaded in the current interp yet. Mark it as now being
+ * Library isn't loaded in the current interp yet. Mark it as now being
* loaded.
*/
- ipPtr = (InterpPackage *)Tcl_Alloc(sizeof(InterpPackage));
- ipPtr->pkgPtr = pkgPtr;
+ ipPtr = (InterpLibrary *)Tcl_Alloc(sizeof(InterpLibrary));
+ ipPtr->libraryPtr = libraryPtr;
ipPtr->nextPtr = ipFirstPtr;
Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, ipPtr);
}
@@ -1022,7 +1022,7 @@ Tcl_StaticPackage(
/*
*----------------------------------------------------------------------
*
- * TclGetLoadedPackagesEx --
+ * TclGetLoadedLibraries --
*
* This function returns information about all of the files that are
* loaded (either in a particular interpreter, or for all interpreters).
@@ -1032,7 +1032,7 @@ Tcl_StaticPackage(
* list of lists is placed in the interp's result. Each sublist
* corresponds to one loaded file; its first element is the name of the
* file (or an empty string for something that's statically loaded) and
- * the second element is the name of the package in that file.
+ * the second element is the prefix of the library in that file.
*
* Side effects:
* None.
@@ -1041,33 +1041,33 @@ Tcl_StaticPackage(
*/
int
-TclGetLoadedPackagesEx(
+TclGetLoadedLibraries(
Tcl_Interp *interp, /* Interpreter in which to return information
* or error message. */
const char *targetName, /* Name of target interpreter or NULL. If
* NULL, return info about all interps;
* otherwise, just return info about this
* interpreter. */
- const char *packageName) /* Package name or NULL. If NULL, return info
- * for all packages.
+ const char *prefix) /* Prefix or NULL. If NULL, return info
+ * for all prefixes.
*/
{
Tcl_Interp *target;
- LoadedPackage *pkgPtr;
- InterpPackage *ipPtr;
+ LoadedLibrary *libraryPtr;
+ InterpLibrary *ipPtr;
Tcl_Obj *resultObj, *pkgDesc[2];
if (targetName == NULL) {
TclNewObj(resultObj);
- Tcl_MutexLock(&packageMutex);
- for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
- pkgPtr = pkgPtr->nextPtr) {
- pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
- pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -1);
+ Tcl_MutexLock(&libraryMutex);
+ for (libraryPtr = firstLibraryPtr; libraryPtr != NULL;
+ libraryPtr = libraryPtr->nextPtr) {
+ pkgDesc[0] = Tcl_NewStringObj(libraryPtr->fileName, -1);
+ pkgDesc[1] = Tcl_NewStringObj(libraryPtr->prefix, -1);
Tcl_ListObjAppendElement(NULL, resultObj,
Tcl_NewListObj(2, pkgDesc));
}
- Tcl_MutexUnlock(&packageMutex);
+ Tcl_MutexUnlock(&libraryMutex);
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
@@ -1076,19 +1076,19 @@ TclGetLoadedPackagesEx(
if (target == NULL) {
return TCL_ERROR;
}
- ipPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
+ ipPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);
/*
- * Return information about all of the available packages.
+ * Return information about all of the available libraries.
*/
- if (packageName) {
+ if (prefix) {
resultObj = NULL;
for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
- pkgPtr = ipPtr->pkgPtr;
+ libraryPtr = ipPtr->libraryPtr;
- if (!strcmp(packageName, pkgPtr->packageName)) {
- resultObj = Tcl_NewStringObj(pkgPtr->fileName, -1);
+ if (!strcmp(prefix, libraryPtr->prefix)) {
+ resultObj = Tcl_NewStringObj(libraryPtr->fileName, -1);
break;
}
}
@@ -1100,15 +1100,15 @@ TclGetLoadedPackagesEx(
}
/*
- * Return information about only the packages that are loaded in a given
+ * Return information about only the libraries that are loaded in a given
* interpreter.
*/
TclNewObj(resultObj);
for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
- pkgPtr = ipPtr->pkgPtr;
- pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
- pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -1);
+ libraryPtr = ipPtr->libraryPtr;
+ pkgDesc[0] = Tcl_NewStringObj(libraryPtr->fileName, -1);
+ pkgDesc[1] = Tcl_NewStringObj(libraryPtr->prefix, -1);
Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewListObj(2, pkgDesc));
}
Tcl_SetObjResult(interp, resultObj);
@@ -1120,7 +1120,7 @@ TclGetLoadedPackagesEx(
*
* LoadCleanupProc --
*
- * This function is called to delete all of the InterpPackage structures
+ * This function is called to delete all of the InterpLibrary structures
* for an interpreter when the interpreter is deleted. It gets invoked
* via the Tcl AssocData mechanism.
*
@@ -1128,20 +1128,20 @@ TclGetLoadedPackagesEx(
* None.
*
* Side effects:
- * Storage for all of the InterpPackage functions for interp get deleted.
+ * Storage for all of the InterpLibrary functions for interp get deleted.
*
*----------------------------------------------------------------------
*/
static void
LoadCleanupProc(
- ClientData clientData, /* Pointer to first InterpPackage structure
+ ClientData clientData, /* Pointer to first InterpLibrary structure
* for interp. */
TCL_UNUSED(Tcl_Interp *))
{
- InterpPackage *ipPtr, *nextPtr;
+ InterpLibrary *ipPtr, *nextPtr;
- ipPtr = (InterpPackage *)clientData;
+ ipPtr = (InterpLibrary *)clientData;
while (ipPtr != NULL) {
nextPtr = ipPtr->nextPtr;
Tcl_Free(ipPtr);
@@ -1155,7 +1155,7 @@ LoadCleanupProc(
* TclFinalizeLoad --
*
* This function is invoked just before the application exits. It frees
- * all of the LoadedPackage structures.
+ * all of the LoadedLibrary structures.
*
* Results:
* None.
@@ -1169,18 +1169,18 @@ LoadCleanupProc(
void
TclFinalizeLoad(void)
{
- LoadedPackage *pkgPtr;
+ LoadedLibrary *libraryPtr;
/*
* No synchronization here because there should just be one thread alive
- * at this point. Logically, packageMutex should be grabbed at this point,
+ * at this point. Logically, libraryMutex should be grabbed at this point,
* but the Mutexes get finalized before the call to this routine. The only
* subsystem left alive at this point is the memory allocator.
*/
- while (firstPackagePtr != NULL) {
- pkgPtr = firstPackagePtr;
- firstPackagePtr = pkgPtr->nextPtr;
+ while (firstLibraryPtr != NULL) {
+ libraryPtr = firstLibraryPtr;
+ firstLibraryPtr = libraryPtr->nextPtr;
#if defined(TCL_UNLOAD_DLLS) || defined(_WIN32)
/*
@@ -1190,14 +1190,14 @@ TclFinalizeLoad(void)
* it has been unloaded.
*/
- if (pkgPtr->fileName[0] != '\0') {
- Tcl_FSUnloadFile(NULL, pkgPtr->loadHandle);
+ if (libraryPtr->fileName[0] != '\0') {
+ Tcl_FSUnloadFile(NULL, libraryPtr->loadHandle);
}
#endif
- Tcl_Free(pkgPtr->fileName);
- Tcl_Free(pkgPtr->packageName);
- Tcl_Free(pkgPtr);
+ Tcl_Free(libraryPtr->fileName);
+ Tcl_Free(libraryPtr->prefix);
+ Tcl_Free(libraryPtr);
}
}
diff --git a/generic/tclPkgConfig.c b/generic/tclPkgConfig.c
index 672d3c9..d84472c 100644
--- a/generic/tclPkgConfig.c
+++ b/generic/tclPkgConfig.c
@@ -2,7 +2,7 @@
* tclPkgConfig.c --
*
* This file contains the configuration information to embed into the tcl
- * binary library.
+ * library.
*
* Copyright © 2002 Andreas Kupries <andreas_kupries@users.sourceforge.net>
*
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 0ff643b..83f982a 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -4243,7 +4243,7 @@ TeststaticpkgCmd(
if (argc != 4) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
- argv[0], " pkgName safe loaded\"", NULL);
+ argv[0], " prefix safe loaded\"", NULL);
return TCL_ERROR;
}
if (Tcl_GetInt(interp, argv[2], &safe) != TCL_OK) {
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index f343196..1eb6315 100644
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.c
@@ -538,7 +538,7 @@ TclThreadAllocObj(void)
cachePtr->numObjects = numMove = NOBJALLOC;
newObjsPtr = (Tcl_Obj *)TclpSysAlloc(sizeof(Tcl_Obj) * numMove);
if (newObjsPtr == NULL) {
- Tcl_Panic("alloc: could not allocate %ld new objects", numMove);
+ Tcl_Panic("alloc: could not allocate %" TCL_Z_MODIFIER "u new objects", numMove);
}
cachePtr->lastPtr = newObjsPtr + numMove - 1;
objPtr = cachePtr->firstObjPtr; /* NULL */
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index c36cf42..dbe6171 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -47,6 +47,7 @@
#define ZIPFS_VOLUME_LEN 9
#define ZIPFS_APP_MOUNT "//zipfs:/app"
#define ZIPFS_ZIP_MOUNT "//zipfs:/lib/tcl"
+#define ZIPFS_FALLBACK_ENCODING "cp437"
/*
* Various constants and offsets found in ZIP archive files
@@ -262,11 +263,19 @@ static struct {
int wrmax; /* Maximum write size of a file; only written
* to from Tcl code in a trusted interpreter,
* so NOT protected by mutex. */
+ char *fallbackEntryEncoding;/* The fallback encoding for ZIP entries when
+ * they are believed to not be UTF-8; only
+ * written to from Tcl code in a trusted
+ * interpreter, so not protected by mutex. */
+ Tcl_Encoding utf8; /* The UTF-8 encoding that we prefer to use
+ * for the strings (especially filenames)
+ * embedded in a ZIP. Other encodings are used
+ * dynamically. */
int idCount; /* Counter for channel names */
Tcl_HashTable fileHash; /* File name to ZipEntry mapping */
Tcl_HashTable zipHash; /* Mount to ZipFile mapping */
} ZipFS = {
- 0, 0, 0, DEFAULT_WRITE_MAX_SIZE, 0,
+ 0, 0, 0, DEFAULT_WRITE_MAX_SIZE, NULL, NULL, 0,
{0,{0,0,0,0},0,0,0,0,0,0,0,0,0},
{0,{0,0,0,0},0,0,0,0,0,0,0,0,0}
};
@@ -686,6 +695,115 @@ CountSlashes(
/*
*-------------------------------------------------------------------------
*
+ * DecodeZipEntryText --
+ *
+ * Given a sequence of bytes from an entry in a ZIP central directory,
+ * convert that into a Tcl string. This is complicated because we don't
+ * actually know what encoding is in use! So we try to use UTF-8, and if
+ * that goes wrong, we fall back to a user-specified encoding, or to an
+ * encoding we specify (Windows code page 437), or to ISO 8859-1 if
+ * absolutely nothing else works.
+ *
+ * During Tcl startup, we skip the user-specified encoding and cp437, as
+ * we may well not have any loadable encodings yet. Tcl's own library
+ * files ought to be using ASCII filenames.
+ *
+ * Results:
+ * The decoded filename; the filename is owned by the argument DString.
+ *
+ * Side effects:
+ * Updates dstPtr.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static char *
+DecodeZipEntryText(
+ const unsigned char *inputBytes,
+ unsigned int inputLength,
+ Tcl_DString *dstPtr)
+{
+ Tcl_Encoding encoding;
+ const char *src;
+ char *dst;
+ int dstLen, srcLen = inputLength, flags;
+ Tcl_EncodingState state;
+
+ Tcl_DStringInit(dstPtr);
+ if (inputLength < 1) {
+ return Tcl_DStringValue(dstPtr);
+ }
+
+ /*
+ * We can't use Tcl_ExternalToUtfDString at this point; it has no way to
+ * fail. So we use this modified version of it that can report encoding
+ * errors to us (so we can fall back to something else).
+ *
+ * The utf-8 encoding is implemented internally, and so is guaranteed to
+ * be present.
+ */
+
+ src = (const char *) inputBytes;
+ dst = Tcl_DStringValue(dstPtr);
+ dstLen = dstPtr->spaceAvl - 1;
+ flags = TCL_ENCODING_START | TCL_ENCODING_END |
+ TCL_ENCODING_STOPONERROR; /* Special flag! */
+
+ while (1) {
+ int srcRead, dstWrote;
+ int result = Tcl_ExternalToUtf(NULL, ZipFS.utf8, src, srcLen, flags,
+ &state, dst, dstLen, &srcRead, &dstWrote, NULL);
+ int soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
+
+ if (result == TCL_OK) {
+ Tcl_DStringSetLength(dstPtr, soFar);
+ return Tcl_DStringValue(dstPtr);
+ } else if (result != TCL_CONVERT_NOSPACE) {
+ break;
+ }
+
+ flags &= ~TCL_ENCODING_START;
+ src += srcRead;
+ srcLen -= srcRead;
+ if (Tcl_DStringLength(dstPtr) == 0) {
+ Tcl_DStringSetLength(dstPtr, dstLen);
+ }
+ Tcl_DStringSetLength(dstPtr, 2 * Tcl_DStringLength(dstPtr) + 1);
+ dst = Tcl_DStringValue(dstPtr) + soFar;
+ dstLen = Tcl_DStringLength(dstPtr) - soFar - 1;
+ }
+
+ /*
+ * Something went wrong. Fall back to another encoding. Those *can* use
+ * Tcl_ExternalToUtfDString().
+ */
+
+ encoding = NULL;
+ if (ZipFS.fallbackEntryEncoding) {
+ encoding = Tcl_GetEncoding(NULL, ZipFS.fallbackEntryEncoding);
+ }
+ if (!encoding) {
+ encoding = Tcl_GetEncoding(NULL, ZIPFS_FALLBACK_ENCODING);
+ }
+ if (!encoding) {
+ /*
+ * Fallback to internal encoding that always converts all bytes.
+ * Should only happen when a filename isn't UTF-8 and we've not got
+ * our encodings initialised for some reason.
+ */
+
+ encoding = Tcl_GetEncoding(NULL, "iso8859-1");
+ }
+
+ char *converted = Tcl_ExternalToUtfDString(encoding,
+ (const char *) inputBytes, inputLength, dstPtr);
+ Tcl_FreeEncoding(encoding);
+ return converted;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
* CanonicalPath --
*
* This function computes the canonical path from a directory and file
@@ -873,7 +991,7 @@ CanonicalPath(
static inline ZipEntry *
ZipFSLookup(
- char *filename)
+ const char *filename)
{
Tcl_HashEntry *hPtr;
ZipEntry *z = NULL;
@@ -1064,7 +1182,7 @@ ZipFSFindTOC(
ZipFile *zf)
{
size_t i;
- unsigned char *p, *q;
+ const unsigned char *p, *q;
const unsigned char *start = zf->data;
const unsigned char *end = zf->data + zf->length;
@@ -1121,7 +1239,7 @@ ZipFSFindTOC(
q = zf->data + ZipReadInt(start, end, p + ZIP_CENTRAL_DIRSTART_OFFS);
p -= ZipReadInt(start, end, p + ZIP_CENTRAL_DIRSIZE_OFFS);
- if ((p < zf->data) || (p > zf->data + zf->length)
+ if ((p < q) || (p < zf->data) || (p > zf->data + zf->length)
|| (q < zf->data) || (q > zf->data + zf->length)) {
if (!needZip) {
zf->baseOffset = zf->passOffset = zf->length;
@@ -1166,10 +1284,13 @@ ZipFSFindTOC(
q = zf->data + zf->baseOffset;
if ((zf->baseOffset >= 6) &&
(ZipReadInt(start, end, q - 4) == ZIP_PASSWORD_END_SIG)) {
+ const unsigned char *passPtr;
+
i = q[-5];
- if (q - 5 - i > zf->data) {
+ passPtr = q - 5 - i;
+ if (passPtr >= start && passPtr + i < end) {
zf->passBuf[0] = i;
- memcpy(zf->passBuf + 1, q - 5 - i, i);
+ memcpy(zf->passBuf + 1, passPtr, i);
zf->passOffset -= i ? (5 + i) : 0;
}
}
@@ -1449,9 +1570,8 @@ ZipFSCatalogFilesystem(
* Validate the TOC data. If that's bad, things fall apart.
*/
- if (zf0->baseOffset < 0 || zf0->baseOffset >= zf0->length ||
- zf0->passOffset < 0 || zf0->passOffset >= zf0->length ||
- zf0->directoryOffset < 0 || zf0->directoryOffset >= zf0->length) {
+ if (zf0->baseOffset >= zf0->length || zf0->passOffset >= zf0->length ||
+ zf0->directoryOffset >= zf0->length) {
ZIPFS_ERROR(interp, "bad zip data");
ZIPFS_ERROR_CODE(interp, "BAD_ZIP");
return TCL_ERROR;
@@ -1499,9 +1619,11 @@ ZipFSCatalogFilesystem(
zf->mountPoint = (char *) Tcl_GetHashKey(&ZipFS.zipHash, hPtr);
Tcl_CreateExitHandler(ZipfsExitHandler, zf);
zf->mountPointLen = strlen(zf->mountPoint);
+
zf->nameLength = strlen(zipname);
zf->name = (char *) Tcl_Alloc(zf->nameLength + 1);
memcpy(zf->name, zipname, zf->nameLength + 1);
+
Tcl_SetHashValue(hPtr, zf);
if ((zf->passBuf[0] == 0) && pwlen) {
int k = 0;
@@ -1542,9 +1664,7 @@ ZipFSCatalogFilesystem(
pathlen = ZipReadShort(start, end, q + ZIP_CENTRAL_PATHLEN_OFFS);
comlen = ZipReadShort(start, end, q + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
extra = ZipReadShort(start, end, q + ZIP_CENTRAL_EXTRALEN_OFFS);
- Tcl_DStringSetLength(&ds, 0);
- Tcl_DStringAppend(&ds, (char *) q + ZIP_CENTRAL_HEADER_LEN, pathlen);
- path = Tcl_DStringValue(&ds);
+ path = DecodeZipEntryText(q + ZIP_CENTRAL_HEADER_LEN, pathlen, &ds);
if ((pathlen > 0) && (path[pathlen - 1] == '/')) {
Tcl_DStringSetLength(&ds, pathlen - 1);
path = Tcl_DStringValue(&ds);
@@ -1734,6 +1854,10 @@ ZipfsSetup(void)
Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS);
ZipFS.idCount = 1;
ZipFS.wrmax = DEFAULT_WRITE_MAX_SIZE;
+ ZipFS.fallbackEntryEncoding =
+ Tcl_Alloc(strlen(ZIPFS_FALLBACK_ENCODING) + 1);
+ strcpy(ZipFS.fallbackEntryEncoding, ZIPFS_FALLBACK_ENCODING);
+ ZipFS.utf8 = Tcl_GetEncoding(NULL, "utf-8");
ZipFS.initialized = 1;
}
@@ -1763,17 +1887,28 @@ ListMountPoints(
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
ZipFile *zf;
+ Tcl_Obj *resultList;
+
+ if (!interp) {
+ /*
+ * Are there any entries in the zipHash? Don't need to enumerate them
+ * all to know.
+ */
+ return (ZipFS.zipHash.numEntries ? TCL_OK : TCL_BREAK);
+ }
+
+ resultList = Tcl_NewObj();
for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
hPtr = Tcl_NextHashEntry(&search)) {
- if (!interp) {
- return TCL_OK;
- }
zf = (ZipFile *) Tcl_GetHashValue(hPtr);
- Tcl_AppendElement(interp, zf->mountPoint);
- Tcl_AppendElement(interp, zf->name);
+ Tcl_ListObjAppendElement(NULL, resultList, Tcl_NewStringObj(
+ zf->mountPoint, -1));
+ Tcl_ListObjAppendElement(NULL, resultList, Tcl_NewStringObj(
+ zf->name, -1));
}
- return (interp ? TCL_OK : TCL_BREAK);
+ Tcl_SetObjResult(interp, resultList);
+ return TCL_OK;
}
/*
@@ -1969,7 +2104,6 @@ TclZipfs_MountBuffer(
zf->data = data;
zf->ptrToFree = NULL;
}
- zf->passBuf[0] = 0; /* stop valgrind cries */
if (ZipFSFindTOC(interp, 0, zf) != TCL_OK) {
return TCL_ERROR;
}
@@ -2225,7 +2359,6 @@ ZipFSUnmountObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
-
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "zipfile");
return TCL_ERROR;
@@ -2258,35 +2391,35 @@ ZipFSMkKeyObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
int len, i = 0;
- char *pw, passBuf[264];
+ const char *pw;
+ Tcl_Obj *passObj;
+ unsigned char *passBuf;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "password");
return TCL_ERROR;
}
- pw = TclGetString(objv[1]);
- len = strlen(pw);
+ pw = TclGetStringFromObj(objv[1], &len);
if (len == 0) {
return TCL_OK;
}
if (IsPasswordValid(interp, pw, len) != TCL_OK) {
return TCL_ERROR;
}
+
+ passObj = Tcl_NewByteArrayObj(NULL, 264);
+ passBuf = Tcl_GetByteArrayFromObj(passObj, (int *)NULL);
while (len > 0) {
int ch = pw[len - 1];
- passBuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
- i++;
+ passBuf[i++] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
len--;
}
passBuf[i] = i;
- ++i;
- passBuf[i++] = (char) ZIP_PASSWORD_END_SIG;
- passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8);
- passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16);
- passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24);
- passBuf[i] = '\0';
- Tcl_AppendResult(interp, passBuf, (char *) NULL);
+ i++;
+ ZipWriteInt(passBuf, passBuf + 264, passBuf + i, ZIP_PASSWORD_END_SIG);
+ Tcl_SetByteArrayLength(passObj, i + 4);
+ Tcl_SetObjResult(interp, passObj);
return TCL_OK;
}
@@ -2344,6 +2477,9 @@ RandomChar(
* input file is added to the given fileHash table for later creation of
* the central ZIP directory.
*
+ * Tcl *always* encodes filenames in the ZIP as UTF-8. Similarly, it
+ * would always encode comments as UTF-8, if it supported comments.
+ *
* Results:
* A standard Tcl result.
*
@@ -2358,7 +2494,8 @@ static int
ZipAddFile(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *pathObj, /* Actual name of the file to add. */
- const char *name, /* Name to use in the ZIP archive. */
+ const char *name, /* Name to use in the ZIP archive, in Tcl's
+ * internal encoding. */
Tcl_Channel out, /* The open ZIP archive being built. */
const char *passwd, /* Password for encoding the file, or NULL if
* the file is to be unprotected. */
@@ -2373,7 +2510,10 @@ ZipAddFile(
Tcl_HashEntry *hPtr;
ZipEntry *z;
z_stream stream;
- const char *zpath;
+ Tcl_DString zpathDs; /* Buffer for the encoded filename. */
+ const char *zpathExt; /* Filename in external encoding (true
+ * UTF-8). */
+ const char *zpathTcl; /* Filename in Tcl's internal encoding. */
int crc, flush, zpathlen;
size_t nbyte, nbytecompr, len, olen, align = 0;
long long headerStartOffset, dataStartOffset, dataEndOffset;
@@ -2386,23 +2526,31 @@ ZipAddFile(
* nothing to do.
*/
- zpath = name;
- while (zpath && zpath[0] == '/') {
- zpath++;
+ zpathTcl = name;
+ while (zpathTcl && zpathTcl[0] == '/') {
+ zpathTcl++;
}
- if (!zpath || (zpath[0] == '\0')) {
+ if (!zpathTcl || (zpathTcl[0] == '\0')) {
return TCL_OK;
}
- zpathlen = strlen(zpath);
+ /*
+ * Convert to encoded form. Note that we use strlen() here; if someone's
+ * crazy enough to embed NULs in filenames, they deserve what they get!
+ */
+
+ zpathExt = Tcl_UtfToExternalDString(ZipFS.utf8, zpathTcl, -1, &zpathDs);
+ zpathlen = strlen(zpathExt);
if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"path too long for \"%s\"", TclGetString(pathObj)));
ZIPFS_ERROR_CODE(interp, "PATH_LEN");
+ Tcl_DStringFree(&zpathDs);
return TCL_ERROR;
}
in = Tcl_FSOpenFileChannel(interp, pathObj, "rb", 0);
if (!in) {
+ Tcl_DStringFree(&zpathDs);
#ifdef _WIN32
/* hopefully a directory */
if (strcmp("permission denied", Tcl_PosixError(interp)) == 0) {
@@ -2430,6 +2578,7 @@ ZipAddFile(
while (1) {
len = Tcl_Read(in, buf, bufsize);
if (len == ERROR_LENGTH) {
+ Tcl_DStringFree(&zpathDs);
if (nbyte == 0 && errno == EISDIR) {
Tcl_Close(interp, in);
return TCL_OK;
@@ -2450,6 +2599,7 @@ ZipAddFile(
Tcl_SetObjResult(interp, Tcl_ObjPrintf("seek error on \"%s\": %s",
TclGetString(pathObj), Tcl_PosixError(interp)));
Tcl_Close(interp, in);
+ Tcl_DStringFree(&zpathDs);
return TCL_ERROR;
}
@@ -2466,7 +2616,7 @@ ZipAddFile(
*/
memset(buf, '\0', ZIP_LOCAL_HEADER_LEN);
- memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpath, zpathlen);
+ memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpathExt, zpathlen);
len = zpathlen + ZIP_LOCAL_HEADER_LEN;
if ((size_t) Tcl_Write(out, buf, len) != len) {
writeErrorWithChannelOpen:
@@ -2474,6 +2624,7 @@ ZipAddFile(
"write error on \"%s\": %s",
TclGetString(pathObj), Tcl_PosixError(interp)));
Tcl_Close(interp, in);
+ Tcl_DStringFree(&zpathDs);
return TCL_ERROR;
}
@@ -2550,6 +2701,7 @@ ZipAddFile(
"compression init error on \"%s\"", TclGetString(pathObj)));
ZIPFS_ERROR_CODE(interp, "DEFLATE_INIT");
Tcl_Close(interp, in);
+ Tcl_DStringFree(&zpathDs);
return TCL_ERROR;
}
@@ -2572,6 +2724,7 @@ ZipAddFile(
ZIPFS_ERROR_CODE(interp, "DEFLATE");
deflateEnd(&stream);
Tcl_Close(interp, in);
+ Tcl_DStringFree(&zpathDs);
return TCL_ERROR;
}
olen = sizeof(obuf) - stream.avail_out;
@@ -2612,6 +2765,7 @@ ZipAddFile(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"seek error: %s", Tcl_PosixError(interp)));
Tcl_Close(interp, in);
+ Tcl_DStringFree(&zpathDs);
return TCL_ERROR;
}
nbytecompr = (passwd ? 12 : 0);
@@ -2647,8 +2801,10 @@ ZipAddFile(
Tcl_TruncateChannel(out, dataEndOffset);
}
Tcl_Close(interp, in);
+ Tcl_DStringFree(&zpathDs);
+ zpathExt = NULL;
- hPtr = Tcl_CreateHashEntry(fileHash, zpath, &isNew);
+ hPtr = Tcl_CreateHashEntry(fileHash, zpathTcl, &isNew);
if (!isNew) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"non-unique path name \"%s\"", TclGetString(pathObj)));
@@ -2745,8 +2901,8 @@ ZipFSFind(
* should be skipped.
*
* Returns:
- * Pointer to the name, which will be in memory owned by one of the
- * argument objects.
+ * Pointer to the name (in Tcl's internal encoding), which will be in
+ * memory owned by one of the argument objects.
*
* Side effects:
* None (if Tcl_Objs have string representations)
@@ -2759,8 +2915,10 @@ ComputeNameInArchive(
Tcl_Obj *pathObj, /* The path to the origin file */
Tcl_Obj *directNameObj, /* User-specified name for use in the ZIP
* archive */
- const char *strip, /* A prefix to strip */
- int slen) /* The length of the prefix */
+ const char *strip, /* A prefix to strip; may be NULL if no
+ * stripping need be done. */
+ int slen) /* The length of the prefix; must be 0 if no
+ * stripping need be done. */
{
const char *name;
int len;
@@ -2798,6 +2956,9 @@ ComputeNameInArchive(
* file. It's the core of the implementation of [zipfs mkzip], [zipfs
* mkimg], [zipfs lmkzip] and [zipfs lmkimg].
*
+ * Tcl *always* encodes filenames in the ZIP as UTF-8. Similarly, it
+ * would always encode comments as UTF-8, if it supported comments.
+ *
* Results:
* A standard Tcl result.
*
@@ -3010,6 +3171,9 @@ ZipFSMkZipOrImg(
dataStartOffset = Tcl_Tell(out);
if (mappingList == NULL && stripPrefix != NULL) {
strip = TclGetStringFromObj(stripPrefix, &slen);
+ if (!slen) {
+ strip = NULL;
+ }
}
for (i = 0; i < (size_t) lobjc; i += (mappingList ? 2 : 1)) {
Tcl_Obj *pathObj = lobjv[i];
@@ -3034,25 +3198,27 @@ ZipFSMkZipOrImg(
for (i = 0; i < (size_t) lobjc; i += (mappingList ? 2 : 1)) {
const char *name = ComputeNameInArchive(lobjv[i],
(mappingList ? lobjv[i + 1] : NULL), strip, slen);
+ Tcl_DString ds;
- if (name[0] == '\0') {
- continue;
- }
hPtr = Tcl_FindHashEntry(&fileHash, name);
if (!hPtr) {
continue;
}
z = (ZipEntry *) Tcl_GetHashValue(hPtr);
- len = strlen(z->name);
+
+ name = Tcl_UtfToExternalDString(ZipFS.utf8, z->name, -1, &ds);
+ len = Tcl_DStringLength(&ds);
SerializeCentralDirectoryEntry(start, end, (unsigned char *) buf,
z, len, dataStartOffset);
if ((Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN)
!= ZIP_CENTRAL_HEADER_LEN)
- || ((size_t) Tcl_Write(out, z->name, len) != len)) {
+ || ((size_t) Tcl_Write(out, name, len) != len)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"write error: %s", Tcl_PosixError(interp)));
+ Tcl_DStringFree(&ds);
goto done;
}
+ Tcl_DStringFree(&ds);
count++;
}
@@ -3733,7 +3899,7 @@ TclZipfs_TclLibrary(void)
#if !defined(STATIC_BUILD)
#if defined(_WIN32) || defined(__CYGWIN__)
- hModule = TclWinGetTclInstance();
+ hModule = (HMODULE)TclWinGetTclInstance();
GetModuleFileNameW(hModule, wName, MAX_PATH);
#ifdef __CYGWIN__
cygwin_conv_path(3, wName, dllName, sizeof(dllName));
@@ -4674,7 +4840,6 @@ ZipFSOpenFileChannelProc(
{
int trunc = (mode & O_TRUNC) != 0;
int wr = (mode & (O_WRONLY | O_RDWR)) != 0;
- int len;
pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
if (!pathPtr) {
@@ -4695,8 +4860,7 @@ ZipFSOpenFileChannelProc(
return NULL;
}
- return ZipChannelOpen(interp, TclGetStringFromObj(pathPtr, &len), wr,
- trunc);
+ return ZipChannelOpen(interp, TclGetString(pathPtr), wr, trunc);
}
/*
@@ -4721,13 +4885,11 @@ ZipFSStatProc(
Tcl_Obj *pathPtr,
Tcl_StatBuf *buf)
{
- int len;
-
pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
if (!pathPtr) {
return -1;
}
- return ZipEntryStat(TclGetStringFromObj(pathPtr, &len), buf);
+ return ZipEntryStat(TclGetString(pathPtr), buf);
}
/*
@@ -4752,13 +4914,11 @@ ZipFSAccessProc(
Tcl_Obj *pathPtr,
int mode)
{
- int len;
-
pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
if (!pathPtr) {
return -1;
}
- return ZipEntryAccess(TclGetStringFromObj(pathPtr, &len), mode);
+ return ZipEntryAccess(TclGetString(pathPtr), mode);
}
/*
@@ -4850,7 +5010,7 @@ ZipFSMatchInDirectoryProc(
Tcl_HashSearch search;
Tcl_Obj *normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
int scnt, l, dirOnly = -1, prefixLen, strip = 0, mounts = 0;
- size_t len;
+ int len;
char *pat, *prefix, *path;
Tcl_DString dsPref, *prefixBuf = NULL;
@@ -4872,8 +5032,7 @@ ZipFSMatchInDirectoryProc(
* The (normalized) path we're searching.
*/
- path = TclGetString(normPathPtr);
- len = normPathPtr->length;
+ path = TclGetStringFromObj(normPathPtr, &len);
Tcl_DStringInit(&dsPref);
if (strcmp(prefix, path) == 0) {
@@ -4991,6 +5150,13 @@ ZipFSMatchMountPoints(
const char *path = TclGetStringFromObj(normPathPtr, &normLength);
size_t len = (size_t) normLength;
+ if (len < 1) {
+ /*
+ * Shouldn't happen. But "shouldn't"...
+ */
+
+ return;
+ }
l = CountSlashes(path);
if (path[len - 1] == '/') {
len--;
@@ -5061,22 +5227,18 @@ ZipFSPathInFilesystemProc(
{
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
- int ret = -1;
- size_t len;
+ int ret = -1, len;
char *path;
pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
if (!pathPtr) {
return -1;
}
-
- path = TclGetString(pathPtr);
+ path = TclGetStringFromObj(pathPtr, &len);
if (strncmp(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) != 0) {
return -1;
}
- len = pathPtr->length;
-
ReadLock();
hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
if (hPtr) {
@@ -5094,12 +5256,13 @@ ZipFSPathInFilesystemProc(
for (z = zf->topEnts; z != NULL; z = z->tnext) {
size_t lenz = strlen(z->name);
- if ((len >= lenz) && (strncmp(path, z->name, lenz) == 0)) {
+ if (((size_t) len >= lenz) &&
+ (strncmp(path, z->name, lenz) == 0)) {
ret = TCL_OK;
goto endloop;
}
}
- } else if ((len >= zf->mountPointLen) &&
+ } else if (((size_t) len >= zf->mountPointLen) &&
(strncmp(path, zf->mountPoint, zf->mountPointLen) == 0)) {
ret = TCL_OK;
break;
@@ -5508,6 +5671,8 @@ TclZipfs_Init(
if (!Tcl_IsSafe(interp)) {
Tcl_LinkVar(interp, "::tcl::zipfs::wrmax", (char *) &ZipFS.wrmax,
TCL_LINK_INT);
+ Tcl_LinkVar(interp, "::tcl::zipfs::fallbackEntryEncoding",
+ (char *) &ZipFS.fallbackEntryEncoding, TCL_LINK_STRING);
}
ensemble = TclMakeEnsemble(interp, "zipfs",
Tcl_IsSafe(interp) ? (initMap + 4) : initMap);
generated by cgit v0.12 at 2024-10-23 15:37:08 (GMT)