/*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); }