/*LINTLIBRARY*/
int
Blt_x_Init(Tcl_Interp *interp) /* Interpreter to add extra commands */
{
Tcl_Namespace *nsPtr;
Tcl_AppInitProc **p;
const int isExact = 1;
#ifdef USE_TCL_STUBS
if (Tcl_InitStubs(interp, TCL_VERSION_LOADED, isExact) == NULL) {
return TCL_ERROR;
};
#endif
if (Tcl_PkgRequire(interp, "blt_core", BLT_VERSION, isExact) == NULL) {
return TCL_ERROR;
}
#if (_TCL_VERSION >= _VERSION(8,1,0))
#ifdef USE_TK_STUBS
if (Tk_InitStubs(interp, TK_VERSION_LOADED, isExact) == NULL) {
return TCL_ERROR;
};
#endif
if (Tcl_PkgPresent(interp, "Tk", TK_VERSION_LOADED, isExact) == NULL) {
return TCL_OK;
}
#else
if (Tcl_PkgRequire(interp, "Tk", TK_VERSION_LOADED, isExact) == NULL) {
Tcl_ResetResult(interp);
return TCL_OK;
}
#endif
nsPtr = Tcl_CreateNamespace(interp, "::blt::tk", NULL, NULL);
if (nsPtr == NULL) {
return TCL_ERROR;
}
nsPtr = Tcl_FindNamespace(interp, "::blt", NULL, TCL_LEAVE_ERR_MSG);
if (nsPtr == NULL) {
return TCL_ERROR;
}
Blt_RegisterPictureImageType(interp);
Blt_RegisterEpsCanvasItem();
Blt_InitXRandrConfig(interp);
/* Initialize the BLT commands that only use Tk. */
for (p = cmdProcs; *p != NULL; p++) {
if ((**p) (interp) != TCL_OK) {
Tcl_DeleteNamespace(nsPtr);
return TCL_ERROR;
}
}
if (Tcl_PkgProvide(interp, "blt_extra", BLT_VERSION) != TCL_OK) {
return TCL_ERROR;
}
return TCL_OK;
}
int
TnmInit(Tcl_Interp *interp, int safe)
{
#ifdef USE_TCL_STUBS
if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
return TCL_ERROR;
}
#endif
if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_PkgProvide(interp, "Tnm", TNM_VERSION) != TCL_OK) {
return TCL_ERROR;
}
Tcl_RegisterObjType(&tnmUnsigned64Type);
Tcl_RegisterObjType(&tnmUnsigned32Type);
Tcl_RegisterObjType(&tnmOctetStringType);
Tcl_RegisterObjType(&tnmIpAddressType);
InitVars(interp);
TnmInitDns(interp);
if (InitCmds(interp, safe) != TCL_OK) {
return TCL_ERROR;
}
if (TnmSmxInit(interp) != TCL_OK) {
return TCL_ERROR;
}
return SourceInitFiles(interp);
}
int NpInitInterp(Tcl_Interp *interp, int install_tk) {
Tcl_Preserve((ClientData) interp);
/*
* Set sharedlib in interp while we are here. This will be used to
* base the location of the default pluginX.Y package in the stardll
* usage scenario.
*/
if (Tcl_SetVar2(interp, "plugin", "sharedlib", dllName, TCL_GLOBAL_ONLY)
== NULL) {
NpPlatformMsg("Failed to set plugin(sharedlib)!", "NpInitInterp");
return TCL_ERROR;
}
/*
* The plugin doesn't directly call Tk C APIs - it's all managed at
* the Tcl level, so we can just pkg req Tk here instead of calling
* Tk_InitStubs.
*/
if (TCL_OK != Tcl_Init(interp)) {
CONST char *msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
fprintf(stderr, "GTKWAVE | Tcl_Init error: %s\n", msg) ;
exit(EXIT_FAILURE);
}
if (install_tk) {
NpLog("Tcl_PkgRequire(\"Tk\", \"%s\", 0)\n", TK_VERSION);
if (1 && Tcl_PkgRequire(interp, "Tk", TK_VERSION, 0) == NULL) {
CONST char *msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
NpPlatformMsg(msg, "NpInitInterp Tcl_PkgRequire(Tk)");
NpPlatformMsg("Failed to create initialize Tk", "NpInitInterp");
return TCL_ERROR;
}
}
return TCL_OK;
}
static int
Ta4r_CommonInit (Tcl_Interp *interp) {
if (Tcl_InitStubs (interp, MIN_TCL_VERSION, 0) == NULL) { return TCL_ERROR; }
if (Tcl_PkgRequire (interp, "Tcl", MIN_TCL_VERSION, 0) == NULL) { return TCL_ERROR; }
if (Tcl_CreateNamespace (interp, Ta4r, NULL, NULL) == NULL) { return TCL_ERROR; }
return TCL_OK;
}
int Viewimage_Init(Tcl_Interp *interp) {
/* initialize the stub table interface */
if (Tcl_InitStubs(interp,"8.1",0)==NULL) {
return TCL_ERROR;
}
if (Tk_InitStubs(interp,"8.1",0)==NULL) {
return TCL_ERROR;
}
if (Tcl_PkgRequire(interp,"Tk","8.1",0)==NULL) {
return TCL_ERROR;
}
if (Tcl_PkgRequire(interp,"mvthimage","1.0",0)==NULL) {
return TCL_ERROR;
}
/* initialize the new, alternative image context handling code */
MvthImageState_Init(interp);
/* Initialize the Tcl script for viewing images in a Tk window.*/
char buff[1024];
snprintf(buff,sizeof(buff),"%s/viewimage.tcl",TCLSCRIPTDIR);
fprintf(stdout,"viewimage.tcl should be located at: %s\n",buff);
Tcl_EvalFile(interp,buff);
Tcl_VarEval(interp,
"puts stdout {viewimage Copyright (C) 2009 Sam Bromley};",
"puts stdout {This software comes with ABSOLUTELY NO WARRANTY.};",
"puts stdout {This is free software, and you are welcome to};",
"puts stdout {redistribute it under certain conditions.};",
"puts stdout {For details, see the GNU Lesser Public License V.3 <http://www.gnu.org/licenses>.};",
NULL);
Tcl_VarEval(interp,
"proc miexpand {w} {"
"foreach {wo ho do bo} [mi size $w] break;"
"set c [::viewimage::canvasNameFromImg $w];"
"set wi [winfo width $c];"
"set hi [winfo height $c];"
"set wi [expr {$wi-3}];"
"set hi [expr {$hi-3}];"
"if {$wi<=0} {set wi 10};"
"if {$hi<=0} {set hi 10};"
"mi size $w [list $wi $hi $bo];"
"xblitimage $w;"
"}",NULL);
/* Declare that we provide the buriedtargets package */
Tcl_PkgProvide(interp,"viewimage","1.0");
return TCL_OK;
}
static int ALSProlog_Package_Init(Tcl_Interp *interp, AP_World *w)
{
if (!Tcl_PkgRequire(interp, (char *)"Tcl", (char *)"8.0", 0)
|| !Tcl_CreateObjCommand(interp, (char *)"prolog", Tcl_ALS_Prolog_ObjCmd, w, NULL)
|| !Tcl_CreateObjCommand(interp, (char *)"dooneevent", Tcl_DoOneEventCmd, w, NULL))
{
return TCL_ERROR;
}
return Tcl_PkgProvide(interp, (char *)"ALSProlog", (char *)VERSION_STRING);
}
int Cgmap_Init(Tcl_Interp *interp)
#endif
{
#if defined(USE_TCL_STUBS)
if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL)
return TCL_ERROR;
if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL)
return TCL_ERROR;
#endif
if (Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION) != TCL_OK)
return TCL_ERROR;
Tcl_CreateObjCommand(interp, "::CGit::cgmap", obj_Cgmap,
(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
return TCL_OK;
}
int
Tcllauncher_Init(Tcl_Interp *interp)
{
/*
* This may work with 8.0, but we are using strictly stubs here,
* which requires 8.1.
*/
if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_PkgRequire(interp, "Tcl", "8.1", 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_PkgProvide(interp, "tcllauncher", PACKAGE_VERSION) != TCL_OK) {
return TCL_ERROR;
}
return TCL_OK;
}
int Dbus_Init(Tcl_Interp *interp)
{
if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_PkgRequire(interp, "Tcl", "8.5", 0) == NULL) {
return TCL_ERROR;
}
Tcl_MutexLock(&dbusMutex);
if (!initialized) {
Tcl_InitObjHashTable(&bus);
Tcl_CreateEventSource(DBus_SetupProc, DBus_CheckProc, interp);
initialized = TRUE;
}
Tcl_MutexUnlock(&dbusMutex);
TclInitDBusCmd(interp);
/* Provide the historical name for compatibility */
Tcl_PkgProvide(interp, "dbus-tcl", PACKAGE_VERSION);
return Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION);
}
int
Blt_PicturePbmInit(Tcl_Interp *interp)
{
#ifdef USE_TCL_STUBS
if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
return TCL_ERROR;
};
#endif
if (Tcl_PkgRequire(interp, "blt_extra", BLT_VERSION, /*Exact*/1) == NULL) {
return TCL_ERROR;
}
if (Tcl_PkgProvide(interp, "blt_picture_pbm", BLT_VERSION) != TCL_OK) {
return TCL_ERROR;
}
return Blt_PictureRegisterFormat(interp,
"pbm", /* Name of format. */
IsPbm, /* Discovery routine. */
ReadPbm, /* Read format procedure. */
WritePbm, /* Write format procedure. */
ImportPbm, /* Import format procedure. */
ExportPbm); /* Export format switches. */
}
int Tclpathplan_Init(Tcl_Interp * interp)
{
#ifdef USE_TCL_STUBS
if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
return TCL_ERROR;
}
#else
if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
return TCL_ERROR;
}
#endif
if (Tcl_PkgProvide(interp, "Tclpathplan", VERSION) != TCL_OK) {
return TCL_ERROR;
}
Tcl_CreateCommand(interp, "vgpane", vgpane,
(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
vgpaneTable = tclhandleInit("vgpane", sizeof(vgpane_t), 10);
return TCL_OK;
}
int Ow_Init(Tcl_Interp * interp)
{
int i;
/* This defines the static chars tkTable(Safe)InitScript */
#include "owtclInitScript.h"
if (
#ifdef USE_TCL_STUBS
Tcl_InitStubs(interp, "8.1", 0)
#else
Tcl_PkgRequire(interp, "Tcl", "8.1", 0)
#endif
== NULL)
return TCL_ERROR;
OwtclState.used = 0;
/* Initialize the new Tcl commands */
i = 0;
while (OwtclCmdList[i].name != NULL) {
Tcl_CreateObjCommand(interp, OwtclCmdList[i].name, (Tcl_ObjCmdProc *) OwtclCmdList[i].func,
(ClientData) & OwtclState, (Tcl_CmdDeleteProc *) NULL);
i++;
}
/* Callback - clean up procs left open on interpreter deletetion. */
Tcl_CallWhenDeleted(interp, (Tcl_InterpDeleteProc *) Owtcl_Delete, (ClientData) & OwtclState);
/* Announce successful package loading to "package require". */
if (Tcl_PkgProvide(interp, "ow", OWTCL_VERSION) != TCL_OK)
return TCL_ERROR;
/*
* The init script can't make certain calls in a safe interpreter,
* so we always have to use the embedded runtime for it
*/
return Tcl_Eval(interp, Tcl_IsSafe(interp) ? owtclSafeInitScript : owtclInitScript);
}
EXTERN int
Pilights_Init(Tcl_Interp *interp)
{
/*
* This may work with 8.0, but we are using strictly stubs here,
* which requires 8.1.
*/
if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_PkgRequire(interp, "Tcl", "8.1", 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_PkgProvide(interp, "pilights", PACKAGE_VERSION) != TCL_OK) {
return TCL_ERROR;
}
/* Create the pilights command */
Tcl_CreateObjCommand(interp, "pilight", (Tcl_ObjCmdProc *) pilights_pilightObjCmd, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
return TCL_OK;
}
int
Tweezer_Init(Tcl_Interp *interp)
{
/*
* This may work with 8.0, but we are using strictly stubs here,
* which requires 8.1.
*/
if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_PkgRequire(interp, "Tcl", "8.1", 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_PkgProvide(interp, "tweezer", PACKAGE_VERSION) != TCL_OK) {
return TCL_ERROR;
}
Tcl_CreateObjCommand(interp, "tweezer", (Tcl_ObjCmdProc *) sc_TweezerObjCmd,
(ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
return TCL_OK;
}
int
Tclae_Init(Tcl_Interp *interp)
{
OSErr err;
SInt32 attr;
//Check for AppleEvents
err = Gestalt(gestaltAppleEventsAttr, &attr);
if ((err != noErr)
|| !(attr & (1 << gestaltAppleEventsPresent))) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "The AppleEvent Manager is either missing or misbehaving",
(char *) NULL);
}
err = AEObjectInit();
if (Tcl_InitStubs(interp, "8.0", 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
if (TCL_VERSION[0] == '7') {
if (Tcl_PkgRequire(interp, "Tcl", "8.0", 0) == NULL) {
return TCL_ERROR;
}
}
}
if (Tcl_PkgProvide(interp, TCLAE_NAME, TCLAE_BASIC_VERSION) != TCL_OK) {
return TCL_ERROR;
}
/* Why?!? */
Tcl_SetVar(interp, "tclAE_version", TCLAE_VERSION, TCL_GLOBAL_ONLY);
tclAE_macRoman_encoding = Tcl_GetEncoding(interp,"macRoman");
TclaeInitAEAddresses();
TclaeInitAEDescs();
TclaeInitEventHandlers(interp);
TclaeInitCoercionHandlers(interp);
TclaeInitObjectAccessors(interp);
/* Define Tcl commands */
Tcl_CreateObjCommand(interp, "tclAE::build", Tclae_BuildCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::send", Tclae_SendCmd, NULL, 0L);
/* Handler commands */
Tcl_CreateObjCommand(interp, "tclAE::getCoercionHandler", Tclae_GetCoercionHandlerCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::getEventHandler", Tclae_GetEventHandlerCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::installCoercionHandler", Tclae_InstallCoercionHandlerCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::installEventHandler", Tclae_InstallEventHandlerCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::removeCoercionHandler", Tclae_RemoveCoercionHandlerCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::removeEventHandler", Tclae_RemoveEventHandlerCmd, NULL, 0L);
/* Target commands */
#if !TARGET_API_MAC_CARBON && !defined(TCLAE_NO_EPPC) // das 25/10/00: Carbonization
Tcl_CreateObjCommand(interp, "tclAE::IPCListPorts", Tclae_IPCListPortsCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::PPCBrowser", Tclae_PPCBrowserCmd, NULL, 0L);
#endif
#if TARGET_API_MAC_CARBON
Tcl_CreateObjCommand(interp, "tclAE::getPOSIXPath", Tclae_GetPOSIXPathCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::getHFSPath", Tclae_GetHFSPathCmd, NULL, 0L);
#endif
Tcl_CreateObjCommand(interp, "tclAE::launch", Tclae_LaunchCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::processes", Tclae_ProcessesCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::remoteProcessResolverGetProcesses", Tclae_RemoteProcessResolverGetProcessesCmd, NULL, 0L);
/* AEDesc commands */
Tcl_CreateObjCommand(interp, "tclAE::coerceData", Tclae_CoerceDataCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::coerceDesc", Tclae_CoerceDescCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::countItems", Tclae_CountItemsCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::createDesc", Tclae_CreateDescCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::createList", Tclae_CreateListCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::deleteItem", Tclae_DeleteItemCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::deleteKeyDesc", Tclae_DeleteKeyDescCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::duplicateDesc", Tclae_DuplicateDescCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::getAttributeData", Tclae_GetAttributeDataCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::getAttributeDesc", Tclae_GetAttributeDescCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::getData", Tclae_GetDataCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::getDescType", Tclae_GetDescTypeCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::getKeyData", Tclae_GetKeyDataCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::getKeyDesc", Tclae_GetKeyDescCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::getNthData", Tclae_GetNthDataCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::getNthDesc", Tclae_GetNthDescCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::putData", Tclae_PutDataCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::putDesc", Tclae_PutDescCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::putKeyData", Tclae_PutKeyDataCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::putKeyDesc", Tclae_PutKeyDescCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::replaceDescData", Tclae_ReplaceDescDataCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::setDescType", Tclae_SetDescTypeCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::_private::_getAEDesc", Tclae__GetAEDescCmd, NULL, 0L);
/* Object commands */
Tcl_CreateObjCommand(interp, "tclAE::setObjectCallbacks", Tclae_SetObjectCallbacksCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::resolve", Tclae_ResolveCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::callObjectAccessor", Tclae_CallObjectAccessorCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::getObjectAccessor", Tclae_GetObjectAccessorCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::installObjectAccessor", Tclae_InstallObjectAccessorCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::removeObjectAccessor", Tclae_RemoveObjectAccessorCmd, NULL, 0L);
Tcl_CreateObjCommand(interp, "tclAE::disposeToken", Tclae_DisposeTokenCmd, NULL, 0L);
return TCL_OK;
}
EXTERN int
Bsd_Init(Tcl_Interp *interp)
{
/* not until Tcl 8.5 */
/* Tcl_Namespace *namespace; */
/*
* This may work with 8.0, but we are using strictly stubs here,
* which requires 8.1.
*/
if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_PkgRequire(interp, "Tcl", "8.1", 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_PkgProvide(interp, "BSD", PACKAGE_VERSION) != TCL_OK) {
return TCL_ERROR;
}
/* Not until Tcl 8.5 */
/* namespace = Tcl_CreateNamespace (interp, "bsd", (ClientData)NULL, (Tcl_NamespaceDeleteProc *)NULL); */
if (Tcl_Eval (interp, "namespace eval bsd {}") == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_CreateObjCommand (interp,
"bsd::rusage",
BSD_RusageObjCmd,
(ClientData) NULL,
(Tcl_CmdDeleteProc*) NULL);
Tcl_CreateObjCommand (interp,
"bsd::rlimit",
BSD_RlimitObjCmd,
(ClientData) NULL,
(Tcl_CmdDeleteProc*) NULL);
Tcl_CreateObjCommand (interp,
"bsd::statfs",
BSD_StatfsObjCmd,
(ClientData) NULL,
(Tcl_CmdDeleteProc*) NULL);
Tcl_CreateObjCommand (interp,
"bsd::getfsstat",
BSD_GetfsstatObjCmd,
(ClientData) NULL,
(Tcl_CmdDeleteProc*) NULL);
Tcl_CreateObjCommand (interp,
"bsd::getloadavg",
BSD_GetLoadAvgObjCmd,
(ClientData) NULL,
(Tcl_CmdDeleteProc*) NULL);
Tcl_CreateObjCommand (interp,
"bsd::setproctitle",
BSD_SetProcTitleObjCmd,
(ClientData) NULL,
(Tcl_CmdDeleteProc*) NULL);
Tcl_CreateObjCommand (interp,
"bsd::getkey",
BSD_GetKeyObjCmd,
(ClientData) NULL,
(Tcl_CmdDeleteProc*) NULL);
Tcl_CreateObjCommand (interp,
"bsd::syslog",
BSD_SyslogObjCmd,
(ClientData) NULL,
(Tcl_CmdDeleteProc*) NULL);
Tcl_CreateObjCommand (interp,
"bsd::abort",
BSD_AbortCmd,
(ClientData) NULL,
(Tcl_CmdDeleteProc*) NULL);
/* Not until Tcl 8.5 */
/* if (Tcl_Export (interp, namespace, "*", 0) == TCL_ERROR) {
return TCL_ERROR;
} */
if (Tcl_Eval (interp, "namespace eval bsd {namespace export *}") == TCL_ERROR) {
return TCL_ERROR;
}
return TCL_OK;
}
/*++
Alcoext_Init
Initialises the extension for a regular interpreter.
Arguments:
interp - Current interpreter.
Return Value:
A standard Tcl result.
--*/
int
Alcoext_Init(
Tcl_Interp *interp
)
{
ExtState *statePtr;
StateList *stateListPtr;
// Wide integer support was added in Tcl 8.4.
#ifdef USE_TCL_STUBS
if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
return TCL_ERROR;
}
#else // USE_TCL_STUBS
if (Tcl_PkgRequire(interp, "Tcl", "8.4", 0) == NULL) {
return TCL_ERROR;
}
#endif // USE_TCL_STUBS
if (Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION) != TCL_OK) {
return TCL_ERROR;
}
//
// Check if the library is already initialised before locking
// the global initialisation mutex (improves loading time).
//
if (!initialised) {
Tcl_MutexLock(&initMutex);
// Check initialisation status again now that we're in the mutex.
if (!initialised) {
#ifdef _WINDOWS
// Initialise the OS version structure.
osVersion.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
GetVersionExA(&osVersion);
ZeroMemory(&winProcs, sizeof(WinProcs));
winProcs.module = LoadLibraryA("kernel32.dll");
if (winProcs.module != NULL) {
//
// These functions must be resolved on run-time for backwards
// compatibility on older Windows systems (earlier than NT v5).
//
winProcs.getDiskFreeSpaceEx = (GetDiskFreeSpaceExProc)
GetProcAddress(winProcs.module, "GetDiskFreeSpaceExA");
winProcs.findFirstVolumeMountPoint = (FindFirstVolumeMountPointProc)
GetProcAddress(winProcs.module, "FindFirstVolumeMountPointA");
winProcs.findNextVolumeMountPoint = (FindNextVolumeMountPointProc)
GetProcAddress(winProcs.module, "FindNextVolumeMountPointA");
winProcs.findVolumeMountPointClose = (FindVolumeMountPointCloseProc)
GetProcAddress(winProcs.module, "FindVolumeMountPointClose");
winProcs.getVolumeNameForVolumeMountPoint = (GetVolumeNameForVolumeMountPointProc)
GetProcAddress(winProcs.module, "GetVolumeNameForVolumeMountPointA");
}
//
// If GetVolumeInformation() is called on a floppy drive or a CD-ROM
// drive that does not have a disk inserted, the system will display
// a message box asking the user to insert one.
//
SetErrorMode(SetErrorMode(0) | SEM_FAILCRITICALERRORS);
#endif // _WINDOWS
// An exit handler must only be registered once.
Tcl_CreateExitHandler(ExitHandler, NULL);
// Register ciphers, hashes, and PRNGs for LibTomCrypt.
register_cipher(&des3_desc);
register_cipher(&aes_desc);
register_cipher(&anubis_desc);
register_cipher(&blowfish_desc);
register_cipher(&cast5_desc);
register_cipher(&des_desc);
register_cipher(&khazad_desc);
register_cipher(&noekeon_desc);
register_cipher(&rc2_desc);
register_cipher(&rc5_desc);
register_cipher(&rc6_desc);
register_cipher(&saferp_desc);
register_cipher(&safer_k128_desc);
register_cipher(&safer_k64_desc);
register_cipher(&safer_sk128_desc);
register_cipher(&safer_sk64_desc);
register_cipher(&skipjack_desc);
register_cipher(&twofish_desc);
register_cipher(&xtea_desc);
register_hash(&md2_desc);
register_hash(&md4_desc);
register_hash(&md5_desc);
register_hash(&rmd128_desc);
register_hash(&rmd160_desc);
register_hash(&sha1_desc);
register_hash(&sha224_desc);
register_hash(&sha256_desc);
register_hash(&sha384_desc);
register_hash(&sha512_desc);
register_hash(&tiger_desc);
register_hash(&whirlpool_desc);
register_prng(&fortuna_desc);
register_prng(&rc4_desc);
register_prng(&sober128_desc);
register_prng(&sprng_desc);
register_prng(&yarrow_desc);
initialised = 1;
}
Tcl_MutexUnlock(&initMutex);
}
// Allocate state structures.
stateListPtr = (StateList *)ckalloc(sizeof(StateList));
statePtr = (ExtState *)ckalloc(sizeof(ExtState));
statePtr->cryptTable = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(statePtr->cryptTable, TCL_STRING_KEYS);
#ifndef _WINDOWS
statePtr->glftpdTable = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(statePtr->glftpdTable, TCL_STRING_KEYS);
#endif // !_WINDOWS
//
// Since callbacks registered with Tcl_CallWhenDeleted() are not executed in
// certain situations (calling Tcl_Finalize() or invoking the "exit" command),
// these resources must be freed by an exit handler registered with
// Tcl_CreateExitHandler().
//
stateListPtr->interp = interp;
stateListPtr->state = statePtr;
stateListPtr->next = NULL;
stateListPtr->prev = NULL;
Tcl_MutexLock(&stateMutex);
// Insert at the list head.
if (stateListHead == NULL) {
stateListHead = stateListPtr;
} else {
stateListPtr->next = stateListHead;
stateListHead->prev = stateListPtr;
stateListHead = stateListPtr;
}
Tcl_MutexUnlock(&stateMutex);
// Clean up state on interpreter deletion.
Tcl_CallWhenDeleted(interp, InterpDeleteHandler, (ClientData)statePtr);
// Create Tcl commands.
Tcl_CreateObjCommand(interp, "::alcoholicz::compress", CompressObjCmd,
(ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "::alcoholicz::crypt", CryptObjCmd,
(ClientData)statePtr, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "::alcoholicz::decode", EncodingObjCmd,
(ClientData)decodeFuncts, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "::alcoholicz::encode", EncodingObjCmd,
(ClientData)encodeFuncts, (Tcl_CmdDeleteProc *)NULL);
//
// These commands are not created for safe interpreters because
// they interact with the file system and/or other processes.
//
if (!Tcl_IsSafe(interp)) {
Tcl_CreateObjCommand(interp, "::alcoholicz::volume", VolumeObjCmd,
(ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
#ifdef _WINDOWS
Tcl_CreateObjCommand(interp, "::alcoholicz::ioftpd", IoFtpdObjCmd,
(ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
#else // _WINDOWS
Tcl_CreateObjCommand(interp, "::alcoholicz::glftpd", GlFtpdObjCmd,
(ClientData)statePtr, (Tcl_CmdDeleteProc *)NULL);
#endif // _WINDOWS
}
Tcl_Eval(interp, "namespace eval ::alcoholicz {"
"namespace export compress crypt encode decode volume "
#ifdef _WINDOWS
"ioftpd"
#else
"glftpd"
#endif // _WINDOWS
"}"
);
return TCL_OK;
}
/*
** This routine runs first.
*/
int main(int argc, char **argv){
Tcl_Interp *interp;
char *args;
char buf[100];
int tty;
char TCLdir[20];
char TKdir[20];
char autopath[20];
char sourceCmd[80];
#ifdef WITHOUT_TK
Tcl_Obj *resultPtr;
Tcl_Obj *commandPtr = NULL;
char buffer[1000];
int code, gotPartial, length;
Tcl_Channel inChannel, outChannel, errChannel;
#endif
/* Create a Tcl interpreter
*/
Tcl_FindExecutable(argv[0]);
interp = Tcl_CreateInterp();
if( Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1)==0 ){
return 1;
}
args = Tcl_Merge(argc-1, (CONST84 char * CONST *)argv+1);
Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
ckfree(args);
sprintf(buf, "%d", argc-1);
Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "argv0", argv[0], TCL_GLOBAL_ONLY);
tty = isatty(0);
Tcl_SetVar(interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
/* We have to initialize the virtual filesystem before calling
** Tcl_Init(). Otherwise, Tcl_Init() will not be able to find
** its startup script files.
*/
Zvfs_Init(interp);
Tcl_SetVar(interp, "extname", "", TCL_GLOBAL_ONLY);
Zvfs_Mount(interp, (char *)Tcl_GetNameOfExecutable(), "/");
sprintf(TCLdir, "%s/tcl", mountPt);
Tcl_SetVar2(interp, "env", "TCL_LIBRARY", TCLdir, TCL_GLOBAL_ONLY);
sprintf(TKdir, "%s/tk", mountPt);
Tcl_SetVar2(interp, "env", "TK_LIBRARY", TKdir, TCL_GLOBAL_ONLY);
/* Initialize Tcl and Tk
*/
if( Tcl_Init(interp) ) return TCL_ERROR;
sprintf(autopath, " %s", TCLdir);
Tcl_SetVar(interp, "auto_path", autopath, TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
Tcl_SetVar(interp, "tcl_libPath", TCLdir, TCL_GLOBAL_ONLY);
#ifdef WITHOUT_TK
Tcl_SetVar(interp, "extname", "tclsh", TCL_GLOBAL_ONLY);
#else
Tk_InitConsoleChannels(interp);
if ( Tk_Init(interp) ) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp,"Tk", Tk_Init, 0);
Tk_CreateConsoleWindow(interp);
#endif
/* Start up all extensions.
*/
#if defined(__WIN32__)
/* DRL - Do the standard Windows extentions */
if (Registry_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Registry", Registry_Init, 0);
if (Dde_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Dde", Dde_Init, 0);
#endif
#ifndef WITHOUT_TDOM
if (Tdom_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tdom", Tdom_Init, Tdom_SafeInit);
#endif
#ifndef WITHOUT_TLS
if (Tls_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tls", Tls_Init, Tls_SafeInit);
#endif
/*
#ifndef WITHOUT_MKZIPLIB
if (Mkziplib_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Mkziplib", Mkziplib_Init, Mkziplib_SafeInit);
#endif
*/
#ifndef WITHOUT_XOTCL
if (Xotcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Xotcl", Xotcl_Init, Xotcl_SafeInit);
/*
if (Xotclexpat_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "xotclexpat", Xotclexpat_Init, 0);
*/
/*
if (Xotclsdbm_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
*/
// Tcl_StaticPackage(interp, "xotclsdbm", Xotclsdbm_Init, Xotclsdbm_SafeInit);
/*
if (Xotclgdbm_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
*/
// Tcl_StaticPackage(interp, "xotclgdbm", Xotclgdbm_Init, Xotclgdbm_SafeInit);
#endif
#ifndef WITHOUT_TGDBM
if (Tgdbm_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tgdbm", Tgdbm_Init, 0);
#endif
#ifndef WITHOUT_THREAD
if (Thread_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Thread", Thread_Init, 0);
#endif
#if !defined(WITHOUT_TK) && !defined(WITHOUT_WINICO) && (defined(__WIN32__) || defined(_WIN32))
if (Winico_Init(interp) == TCL_ERROR) return TCL_ERROR;
Tcl_StaticPackage(interp, "Winico", Winico_Init, Winico_SafeInit);
#endif
/* Add some freeWrap commands */
if (Freewrap_Init(interp) == TCL_ERROR) return TCL_ERROR;
/* After all extensions are registered, start up the
** program by running freewrapCmds.tcl.
*/
sprintf(sourceCmd, "source %s/freewrapCmds.tcl", mountPt);
Tcl_Eval(interp, sourceCmd);
#ifndef WITHOUT_TK
/*
* Loop infinitely, waiting for commands to execute. When there
* are no windows left, Tk_MainLoop returns and we exit.
*/
Tk_MainLoop();
Tcl_DeleteInterp(interp);
Tcl_Exit(0);
#else
/*
* Process commands from stdin until there's an end-of-file. Note
* that we need to fetch the standard channels again after every
* eval, since they may have been changed.
*/
commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
gotPartial = 0;
while (1) {
if (tty) {
Tcl_Obj *promptCmdPtr;
promptCmdPtr = Tcl_GetVar2Ex(interp,
(gotPartial ? "tcl_prompt2" : "tcl_prompt1"),
NULL, TCL_GLOBAL_ONLY);
if (promptCmdPtr == NULL) {
defaultPrompt:
if (!gotPartial && outChannel) {
Tcl_WriteChars(outChannel, "% ", 2);
}
} else {
code = Tcl_EvalObjEx(interp, promptCmdPtr, 0);
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (code != TCL_OK) {
if (errChannel) {
Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
Tcl_WriteChars(errChannel, "\n", 1);
}
Tcl_AddErrorInfo(interp,
"\n (script that generates prompt)");
goto defaultPrompt;
}
}
if (outChannel) {
Tcl_Flush(outChannel);
}
}
if (!inChannel) {
goto done;
}
length = Tcl_GetsObj(inChannel, commandPtr);
if (length < 0) {
goto done;
}
if ((length == 0) && Tcl_Eof(inChannel) && (!gotPartial)) {
goto done;
}
/*
* Add the newline removed by Tcl_GetsObj back to the string.
*/
Tcl_AppendToObj(commandPtr, "\n", 1);
if (!TclObjCommandComplete(commandPtr)) {
gotPartial = 1;
continue;
}
gotPartial = 0;
code = Tcl_RecordAndEvalObj(interp, commandPtr, 0);
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
errChannel = Tcl_GetStdChannel(TCL_STDERR);
Tcl_DecrRefCount(commandPtr);
commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
if (code != TCL_OK) {
if (errChannel) {
Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
Tcl_WriteChars(errChannel, "\n", 1);
}
} else if (tty) {
resultPtr = Tcl_GetObjResult(interp);
Tcl_GetStringFromObj(resultPtr, &length);
if ((length > 0) && outChannel) {
Tcl_WriteObj(outChannel, resultPtr);
Tcl_WriteChars(outChannel, "\n", 1);
}
}
}
/*
* Rather than calling exit, invoke the "exit" command so that
* users can replace "exit" with some other command to do additional
* cleanup on exit. The Tcl_Eval call should never return.
*/
done:
if (commandPtr != NULL) {
Tcl_DecrRefCount(commandPtr);
}
sprintf(buffer, "exit %d", 0);
Tcl_Eval(interp, buffer);
#endif
return TCL_OK;
}
int Tkpath_Init(Tcl_Interp *interp) /* Tcl interpreter. */
{
#if defined(USE_TCL_STUBS)
if (Tcl_InitStubs(interp, TKPATH_REQUIRE, 0) == NULL) {
return TCL_ERROR;
}
#endif
if (Tcl_PkgRequire(interp, "Tcl", TKPATH_REQUIRE, 0) == NULL) {
return TCL_ERROR;
}
#if defined(USE_TK_STUBS)
if (Tk_InitStubs(interp, TKPATH_REQUIRE, 0) == NULL) {
return TCL_ERROR;
}
#endif
if (Tcl_PkgRequire(interp, "Tk", TKPATH_REQUIRE, 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_CreateNamespace(interp, "::tkp", NULL, NULL) == NULL) {
Tcl_ResetResult(interp);
}
Tcl_CreateObjCommand(interp, "::tkp::canvas", Tk_PathCanvasObjCmd,
(ClientData) Tk_MainWindow(interp), NULL);
gInterp = interp;
/*
* Link the ::tkp::antialias variable to control antialiasing.
*/
if (Tcl_LinkVar(interp, "::tkp::antialias",
(char *) &gAntiAlias, TCL_LINK_BOOLEAN) != TCL_OK) {
Tcl_ResetResult(interp);
}
/*
* With gSurfaceCopyPremultiplyAlpha true we ignore the "premultiply alpha"
* and use RGB as is. Else we need to divide each RGB with alpha
* to get "true" values.
*/
if (Tcl_LinkVar(interp, "::tkp::premultiplyalpha",
(char *) &gSurfaceCopyPremultiplyAlpha, TCL_LINK_BOOLEAN) != TCL_OK) {
Tcl_ResetResult(interp);
}
if (Tcl_LinkVar(interp, "::tkp::depixelize",
(char *) &gDepixelize, TCL_LINK_BOOLEAN) != TCL_OK) {
Tcl_ResetResult(interp);
}
Tcl_CreateObjCommand(interp, "::tkp::pixelalign",
PixelAlignObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
/*
* Make separate gradient objects, similar to SVG.
*/
PathGradientInit(interp);
SurfaceInit(interp);
/*
* Style object.
*/
PathStyleInit(interp);
return Tcl_PkgProvide(interp, "tkpath", TKPATH_PATCHLEVEL);
}
