CONST char *
Tcl_GetEncodingNameFromEnvironment(
Tcl_DString *bufPtr)
{
CONST char *encoding;
CONST char *knownEncoding;
Tcl_DStringInit(bufPtr);
/*
* Determine the current encoding from the LC_* or LANG environment
* variables. We previously used setlocale() to determine the locale, but
* this does not work on some systems (e.g. Linux/i386 RH 5.0).
*/
#ifdef HAVE_LANGINFO
if (
#ifdef WEAK_IMPORT_NL_LANGINFO
nl_langinfo != NULL &&
#endif
setlocale(LC_CTYPE, "") != NULL) {
Tcl_DString ds;
/*
* Use a DString so we can modify case.
*/
Tcl_DStringInit(&ds);
encoding = Tcl_DStringAppend(&ds, nl_langinfo(CODESET), -1);
Tcl_UtfToLower(Tcl_DStringValue(&ds));
knownEncoding = SearchKnownEncodings(encoding);
if (knownEncoding != NULL) {
Tcl_DStringAppend(bufPtr, knownEncoding, -1);
} else if (NULL != Tcl_GetEncoding(NULL, encoding)) {
Tcl_DStringAppend(bufPtr, encoding, -1);
}
Tcl_DStringFree(&ds);
if (Tcl_DStringLength(bufPtr)) {
return Tcl_DStringValue(bufPtr);
}
}
#endif /* HAVE_LANGINFO */
/*
* Classic fallback check. This tries a homebrew algorithm to determine
* what encoding should be used based on env vars.
*/
encoding = getenv("LC_ALL");
if (encoding == NULL || encoding[0] == '\0') {
encoding = getenv("LC_CTYPE");
}
if (encoding == NULL || encoding[0] == '\0') {
encoding = getenv("LANG");
}
if (encoding == NULL || encoding[0] == '\0') {
encoding = NULL;
}
if (encoding != NULL) {
CONST char *p;
Tcl_DString ds;
Tcl_DStringInit(&ds);
p = encoding;
encoding = Tcl_DStringAppend(&ds, p, -1);
Tcl_UtfToLower(Tcl_DStringValue(&ds));
knownEncoding = SearchKnownEncodings(encoding);
if (knownEncoding != NULL) {
Tcl_DStringAppend(bufPtr, knownEncoding, -1);
} else if (NULL != Tcl_GetEncoding(NULL, encoding)) {
Tcl_DStringAppend(bufPtr, encoding, -1);
}
if (Tcl_DStringLength(bufPtr)) {
Tcl_DStringFree(&ds);
return Tcl_DStringValue(bufPtr);
}
/*
* We didn't recognize the full value as an encoding name. If there is
* an encoding subfield, we can try to guess from that.
*/
for (p = encoding; *p != '\0'; p++) {
if (*p == '.') {
p++;
break;
}
}
if (*p != '\0') {
knownEncoding = SearchKnownEncodings(p);
if (knownEncoding != NULL) {
Tcl_DStringAppend(bufPtr, knownEncoding, -1);
} else if (NULL != Tcl_GetEncoding(NULL, p)) {
Tcl_DStringAppend(bufPtr, p, -1);
}
}
Tcl_DStringFree(&ds);
if (Tcl_DStringLength(bufPtr)) {
return Tcl_DStringValue(bufPtr);
}
}
return Tcl_DStringAppend(bufPtr, TCL_DEFAULT_ENCODING, -1);
}
int
TclpLoadFile(
Tcl_Interp *interp, /* Used for error reporting. */
char *fileName, /* Name of the file containing the desired
* code. */
char *sym1, char *sym2, /* Names of two procedures to look up in
* the file's symbol table. */
Tcl_PackageInitProc **proc1Ptr,
Tcl_PackageInitProc **proc2Ptr,
/* Where to return the addresses corresponding
* to sym1 and sym2. */
ClientData *clientDataPtr) /* Filled with token for dynamically loaded
* file which will be passed back to
* TclpUnloadFile() to unload the file. */
{
CFragConnectionID connID;
Ptr dummy;
OSErr err;
CFragSymbolClass symClass;
FSSpec fileSpec;
short fragFileRef, saveFileRef;
Handle fragResource;
UInt32 offset = 0;
UInt32 length = kCFragGoesToEOF;
char packageName[255];
Str255 errName;
Tcl_DString ds;
char *native;
/*
* First thing we must do is infer the package name from the sym1
* variable. This is kind of dumb since the caller actually knows
* this value, it just doesn't give it to us.
*/
strcpy(packageName, sym1);
Tcl_UtfToLower(packageName);
*(Tcl_UtfAtIndex(packageName, Tcl_NumUtfChars(packageName, -1) - 5)) = 0;
native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
err = FSpLocationFromPath(strlen(native), native, &fileSpec);
Tcl_DStringFree(&ds);
if (err != noErr) {
Tcl_SetResult(interp, "could not locate shared library", TCL_STATIC);
return TCL_ERROR;
}
/*
* See if this fragment has a 'cfrg' resource. It will tell us where
* to look for the fragment in the file. If it doesn't exist we will
* assume we have a ppc frag using the whole data fork. If it does
* exist we find the frag that matches the one we are looking for and
* get the offset and size from the resource.
*/
saveFileRef = CurResFile();
SetResLoad(false);
fragFileRef = FSpOpenResFile(&fileSpec, fsRdPerm);
SetResLoad(true);
if (fragFileRef != -1) {
UseResFile(fragFileRef);
fragResource = Get1Resource(kCFragResourceType, kCFragResourceID);
HLock(fragResource);
if (ResError() == noErr) {
CfrgItem* srcItem;
long itemCount, index;
Ptr itemStart;
itemCount = (*(CfrgHeaderPtrHand)fragResource)->itemCount;
itemStart = &(*(CfrgHeaderPtrHand)fragResource)->arrayStart;
for (index = 0; index < itemCount;
index++, itemStart += srcItem->itemSize) {
srcItem = (CfrgItem*)itemStart;
if (srcItem->archType != OUR_ARCH_TYPE) continue;
if (!strncasecmp(packageName, (char *) srcItem->name + 1,
srcItem->name[0])) {
offset = srcItem->codeOffset;
length = srcItem->codeLength;
}
}
}
/*
* Close the resource file. If the extension wants to reopen the
* resource fork it should use the tclMacLibrary.c file during it's
* construction.
*/
HUnlock(fragResource);
ReleaseResource(fragResource);
CloseResFile(fragFileRef);
UseResFile(saveFileRef);
}
/*
* Now we can attempt to load the fragement using the offset & length
* obtained from the resource. We don't worry about the main entry point
* as we are going to search for specific entry points passed to us.
*/
c2pstr(packageName);
err = GetDiskFragment(&fileSpec, offset, length, (StringPtr) packageName,
kLoadCFrag, &connID, &dummy, errName);
if (err != fragNoErr) {
p2cstr(errName);
Tcl_AppendResult(interp, "couldn't load file \"", fileName,
"\": ", errName, (char *) NULL);
return TCL_ERROR;
}
c2pstr(sym1);
err = FindSymbol(connID, (StringPtr) sym1, (Ptr *) proc1Ptr, &symClass);
p2cstr((StringPtr) sym1);
if (err != fragNoErr || symClass == kDataCFragSymbol) {
Tcl_SetResult(interp,
"could not find Initialization routine in library",
TCL_STATIC);
return TCL_ERROR;
}
c2pstr(sym2);
err = FindSymbol(connID, (StringPtr) sym2, (Ptr *) proc2Ptr, &symClass);
p2cstr((StringPtr) sym2);
if (err != fragNoErr || symClass == kDataCFragSymbol) {
*proc2Ptr = NULL;
}
*clientDataPtr = (ClientData) connID;
return TCL_OK;
}
