Diff

Differences From Artifact [2ea4599da9]:

To Artifact [dd6f45df03]:


    13     13    * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    14     14    *
    15     15    * RCS: @(#) $Id$
    16     16    */
    17     17   
    18     18   #ifdef KIT_INCLUDES_TK
    19     19   #  include <tk.h>
    20         -#else
    21         -#  include <tcl.h>
    22     20   #endif /* KIT_INCLUDES_TK */
           21  +#include <tcl.h>
    23     22   
    24     23   #ifdef _WIN32
    25     24   #  define WIN32_LEAN_AND_MEAN
    26     25   #  include <windows.h>
    27     26   #  undef WIN32_LEAN_AND_MEAN
    28     27   #endif /* _WIN32 */
    29     28   
................................................................................
    57     56   
    58     57   #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85
    59     58   #  define KIT_INCLUDES_PWB 1
    60     59   #endif
    61     60   #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 86
    62     61   #  define KIT_INCLUDES_ZLIB 1
    63     62   #endif
           63  +
           64  +/* Determine which type of storage to use -- MK4, ZIP, or CVFS */
           65  +#if defined(KIT_STORAGE_MK4) && defined(KIT_STORAGE_ZIP)
           66  +#  undef KIT_STORAGE_ZIP
           67  +#endif
           68  +#if defined(KIT_STORAGE_MK4) && defined(KIT_STORAGE_CVFS)
           69  +#  ifdef TCLKIT_DLL
           70  +#    undef KIT_STORAGE_MK4
           71  +#  else
           72  +#    undef KIT_STORAGE_CVFS
           73  +#  endif
           74  +#endif
           75  +#if !defined(KIT_STORAGE_MK4) && !defined(KIT_STORAGE_ZIP) && !defined(KIT_STORAGE_CVFS)
           76  +#  ifdef TCLKIT_DLL
           77  +#    define KIT_STORAGE_CVFS 1
           78  +#  else
           79  +#    ifdef KIT_INCLUDES_MK4TCL
           80  +#      define KIT_STORAGE_MK4 1
           81  +#    else
           82  +#      define KIT_STORAGE_ZIP 1
           83  +#    endif
           84  +#  endif
           85  +#endif
    64     86   
    65     87   #ifdef KIT_INCLUDES_ITCL
    66     88   Tcl_AppInitProc	Itcl_Init;
    67     89   #endif
    68     90   #ifdef KIT_INCLUDES_MK4TCL
    69     91   Tcl_AppInitProc	Mk4tcl_Init;
    70     92   #endif
................................................................................
    71     93   Tcl_AppInitProc Vfs_Init, Rechan_Init;
    72     94   #ifdef KIT_INCLUDES_PWB
    73     95   Tcl_AppInitProc	Pwb_Init;
    74     96   #endif
    75     97   #ifdef KIT_INCLUDES_ZLIB
    76     98   Tcl_AppInitProc Zlib_Init;
    77     99   #endif
          100  +#ifdef KIT_STORAGE_CVFS
          101  +Tcl_AppInitProc Vfs_kitdll_data_tcl_Init;
          102  +#endif
    78    103   #ifdef TCL_THREADS
    79    104   Tcl_AppInitProc	Thread_Init;
    80    105   #endif
    81    106   #ifdef _WIN32
    82    107   Tcl_AppInitProc	Dde_Init, Registry_Init;
    83    108   #endif
    84    109   
    85         -/* Determine which type of storage to use -- MK4 or ZIP */
    86         -#if defined(KIT_STORAGE_MK4) && defined(KIT_STORAGE_ZIP)
    87         -#  undef KIT_STORAGE_ZIP
    88         -#endif
    89         -#if !defined(KIT_STORAGE_MK4) && !defined(KIT_STORAGE_ZIP)
    90         -#  ifdef KIT_INCLUDES_MK4TCL
    91         -#    define KIT_STORAGE_MK4 1
    92         -#  else
    93         -#    define KIT_STORAGE_ZIP 1
    94         -#  endif
    95         -#endif
          110  +#ifdef TCLKIT_DLL
          111  +#  define TCLKIT_MOUNTPOINT "/.KITDLL_TCL"
          112  +#else
          113  +#  define TCLKIT_MOUNTPOINT "[info nameofexecutable]"
          114  +#endif /* TCLKIT_DLL */
          115  +
          116  +#ifdef HAVE_ACCEPTABLE_DLADDR
          117  +#  ifdef KITSH_NEED_WINMAIN
          118  +#    ifdef _WIN32_WCE
          119  +int wWinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpszCmdLine, int nCmdShow);
          120  +#    else
          121  +int WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpszCmdLine, int nCmdShow);
          122  +#    endif /* _WIN32_WCE */
          123  +#  endif /* KITSH_NEED_WINMAIN */
          124  +int main(int argc, char **argv);
          125  +#endif /* HAVE_ACCEPTABLE_DLADDR */
    96    126   
    97    127   #ifdef TCLKIT_REQUIRE_TCLEXECUTABLENAME
    98    128   char *tclExecutableName;
    99    129   #endif
   100    130   
   101         -    /*
   102         -     *  Attempt to load a "boot.tcl" entry from the embedded MetaKit file.
   103         -     *  If there isn't one, try to open a regular "setup.tcl" file instead.
   104         -     *  If that fails, this code will throw an error, using a message box.
   105         -     */
   106         -
          131  +/*
          132  + *  Attempt to load a "boot.tcl" entry from the embedded MetaKit file.
          133  + *  If there isn't one, try to open a regular "setup.tcl" file instead.
          134  + *  If that fails, this code will throw an error, using a message box.
          135  + */
          136  +/*
          137  + * This Tcl code is invoked whenever Tcl_Init() is called on an
          138  + * interpreter.  It should mount up the VFS and make everything ready for
          139  + * that interpreter to do its job.
          140  + */
   107    141   static char *preInitCmd = 
   108         -#ifdef _WIN32_WCE
          142  +#if defined(_WIN32_WCE) && !defined(TCLKIT_DLL)
   109    143   /* silly hack to get wince port to launch, some sort of std{in,out,err} problem */
   110    144   "open /kitout.txt a; open /kitout.txt a; open /kitout.txt a\n"
   111    145   /* this too seems to be needed on wince - it appears to be related to the above */
   112    146   "catch {rename source ::tcl::source}\n"
   113    147   "proc source file {\n"
   114    148   	"set old [info script]\n"
   115    149   	"info script $file\n"
................................................................................
   117    151   	"set data [read $fid]\n"
   118    152   	"close $fid\n"
   119    153   	"set code [catch {uplevel 1 $data} res]\n"
   120    154   	"info script $old\n"
   121    155   	"if {$code == 2} { set code 0 }\n"
   122    156   	"return -code $code $res\n"
   123    157   "}\n"
   124         -#endif /* _WIN32_WCE */
          158  +#endif /* _WIN32_WCE && !TCLKIT_DLL */
   125    159   "proc tclKitInit {} {\n"
   126    160   	"rename tclKitInit {}\n"
          161  +#ifdef KIT_INCLUDES_ZLIB
          162  +	"catch { load {} zlib }\n"
          163  +#endif
   127    164   #ifdef KIT_INCLUDES_MK4TCL
   128    165   	"catch { load {} Mk4tcl }\n"
   129    166   #endif
          167  +#ifdef TCLKIT_DLL
          168  +	"load {} tclkit::init\n"
          169  +#endif
          170  +	"set bootfile [file join " TCLKIT_MOUNTPOINT " boot.tcl]\n"
          171  +	"if {[file exists $bootfile]} {\n"
          172  +		"catch {\n"
          173  +			"set f [open $bootfile]\n"
          174  +			"set s [read $f]\n"
          175  +			"close $f\n"
          176  +		"}\n"
          177  +	"}\n"
   130    178   #ifdef KIT_STORAGE_MK4
   131    179   	"set ::tclKitStorage \"mk4\"\n"
   132         -	"mk::file open exe [info nameofexecutable] -readonly\n"
   133         -	"set n [mk::select exe.dirs!0.files name boot.tcl]\n"
   134         -	"if {$n != \"\"} {\n"
   135         -		"set s [mk::get exe.dirs!0.files!$n contents]\n"
   136         -		"if {![string length $s]} { error \"empty boot.tcl\" }\n"
   137         -		"catch {load {} zlib}\n"
   138         -		"if {[mk::get exe.dirs!0.files!$n size] != [string length $s]} {\n"
   139         -			"set s [zlib decompress $s]\n"
          180  +	"if {![info exists s]} {\n"
          181  +		"mk::file open exe [info nameofexecutable] -readonly\n"
          182  +		"set n [mk::select exe.dirs!0.files name boot.tcl]\n"
          183  +		"if {$n != \"\"} {\n"
          184  +			"set s [mk::get exe.dirs!0.files!$n contents]\n"
          185  +			"if {![string length $s]} { error \"empty boot.tcl\" }\n"
          186  +			"catch {load {} zlib}\n"
          187  +			"if {[mk::get exe.dirs!0.files!$n size] != [string length $s]} {\n"
          188  +				"set s [zlib decompress $s]\n"
          189  +			"}\n"
   140    190   		"}\n"
   141    191   	"}\n"
   142    192   #endif /* KIT_STORAGE_MK4 */
   143    193   #ifdef KIT_STORAGE_ZIP
   144    194   	"set ::tclKitStorage \"zip\"\n"
   145    195   	"catch { load {} vfs }\n"
   146         -	"if {![info exists s]} {\n"
   147         -		"catch {\n"
   148         -			"set bootfile [file join [info nameofexecutable] boot.tcl]\n"
   149         -			"if {[file exists $bootfile]} {\n"
   150         -				"set f [open $bootfile]\n"
   151         -				"set s [read $f]\n"
   152         -				"close $f\n"
   153         -			"}\n"
   154         -		"}\n"
   155         -	"}\n"
   156    196   	"if {![info exists s]} {\n"
   157    197   #  include "zipvfs.tcl.h"
   158    198   		"catch {\n"
   159    199   			"set ::tclKitStorage_fd [::zip::open [info nameofexecutable]]\n"
   160    200   			"::zip::stat $::tclKitStorage_fd boot.tcl sb\n"
   161    201   			"seek $::tclKitStorage_fd $sb(ino)\n"
   162         -			"zip::Data $::tclKitStorage_fd sb s\n"
          202  +			"::zip::Data $::tclKitStorage_fd sb s\n"
   163    203   		"}\n"
   164    204   	"}\n"
   165    205   #endif /* KIT_STORAGE_ZIP */
          206  +#ifdef KIT_STORAGE_CVFS
          207  +	"set ::tclKitStorage \"cvfs\"\n"
          208  +	"load {} rechan\n"
          209  +	"load {} vfs\n"
          210  +	"load {} vfs_kitdll_data_tcl\n"
          211  +#include "vfs_kitdll.tcl.h"
          212  +	"if {![info exists s]} {\n"
          213  +		"catch {\n"
          214  +			"set s [::vfs::kitdll::data::getData tcl boot.tcl]\n"
          215  +		"}\n"
          216  +	"}\n"
          217  +#endif /* KIT_STORAGE_CVFS */
          218  +#ifdef TCLKIT_DLL
          219  +	"::tclkit::init::initInterp\n"
          220  +	"rename ::tclkit::init::initInterp {}\n"
          221  +#else
   166    222   	"if {![info exists s]} {\n"
   167    223   		"set f [open setup.tcl]\n"
   168    224   		"set s [read $f]\n"
   169    225   		"close $f\n"
   170    226   	"}\n"
          227  +#endif /* TCLKIT_DLL */
   171    228   	"uplevel #0 $s\n"
   172    229   #if defined(KIT_INCLUDES_TK) && defined(KIT_TK_VERSION)
   173    230   	"package ifneeded Tk " KIT_TK_VERSION " {\n"
   174    231   		"load {} Tk\n"
   175    232   	"}\n"
   176    233   #endif
   177    234   #ifdef _WIN32
................................................................................
   242    299   				return;
   243    300   			}
   244    301   		}
   245    302   	}
   246    303   #endif /* HAVE_READLINK */
   247    304   
   248    305   #ifdef HAVE_ACCEPTABLE_DLADDR
          306  +#  ifndef TCLKIT_DLL
   249    307   	if (Tcl_GetNameOfExecutable() == NULL) {
   250    308   		dladdr_ret = dladdr(&SetExecName, &syminfo);
   251    309   		if (dladdr_ret != 0) {
   252    310   			SetExecName(interp, syminfo.dli_fname);
          311  +
          312  +			return;
          313  +		}
          314  +	}
          315  +#  endif /* !TCLKIT_DLL */
          316  +
          317  +#  ifdef KITSH_NEED_WINMAIN
          318  +	if (Tcl_GetNameOfExecutable() == NULL) {
          319  +#    ifdef _WIN32_WCE
          320  +		dladdr_ret = dladdr(&WinMain, &syminfo);
          321  +#    else
          322  +		dladdr_ret = dladdr(&wWinMain, &syminfo);
          323  +#    endif /* _WIN32_WCE */
          324  +
          325  +		if (dladdr_ret != 0) {
          326  +			SetExecName(interp, syminfo.dli_fname);
          327  +
          328  +			return;
          329  +		}
          330  +	}
          331  +#  endif /* KITSH_NEED_WINMAIN */
          332  +
          333  +	if (Tcl_GetNameOfExecutable() == NULL) {
          334  +		dladdr_ret = dladdr(&main, &syminfo);
          335  +		if (dladdr_ret != 0) {
          336  +			SetExecName(interp, syminfo.dli_fname);
          337  +
          338  +			return;
   253    339   		}
   254    340   	}
   255    341   #endif /* HAVE_ACCEPTABLE_DLADDR */
   256    342   
   257    343   	if (Tcl_GetNameOfExecutable() == NULL) {
   258    344   		lobjv[0] = Tcl_GetVar2Ex(interp, "argv0", NULL, TCL_GLOBAL_ONLY);
   259    345   		execNameObj = Tcl_FSJoinToPath(Tcl_FSGetCwd(interp), 1, lobjv);
................................................................................
   262    348   
   263    349   		return;
   264    350   	}
   265    351   
   266    352   	return;
   267    353   }
   268    354   
   269         -int TclKit_AppInit(Tcl_Interp *interp) {
   270         -#ifdef KIT_INCLUDES_TK
   271         -#  ifdef _WIN32
   272         -#    ifndef _WIN32_WCE
   273         -	char msgBuf[2049];
   274         -#    endif /* !_WIN32_WCE */
   275         -#  endif /* _WIN32 */
   276         -#endif /* KIT_INCLUDES_TK */
   277         -#ifdef TCLKIT_CAN_SET_ENCODING
   278         -	Tcl_DString encodingName;
   279         -#endif /* TCLKIT_CAN_SET_ENCODING */
   280         -
          355  +static void _Tclkit_Generic_Init(void) {
   281    356   #ifdef KIT_INCLUDES_ITCL
   282    357   	Tcl_StaticPackage(0, "Itcl", Itcl_Init, NULL);
   283    358   #endif 
   284    359   #ifdef KIT_INCLUDES_MK4TCL
   285    360   	Tcl_StaticPackage(0, "Mk4tcl", Mk4tcl_Init, NULL);
   286    361   #endif
   287    362   #ifdef KIT_INCLUDES_PWB
................................................................................
   288    363   	Tcl_StaticPackage(0, "pwb", Pwb_Init, NULL);
   289    364   #endif 
   290    365   	Tcl_StaticPackage(0, "rechan", Rechan_Init, NULL);
   291    366   	Tcl_StaticPackage(0, "vfs", Vfs_Init, NULL);
   292    367   #ifdef KIT_INCLUDES_ZLIB
   293    368   	Tcl_StaticPackage(0, "zlib", Zlib_Init, NULL);
   294    369   #endif
          370  +#ifdef KIT_STORAGE_CVFS
          371  +	Tcl_StaticPackage(0, "vfs_kitdll_data_tcl", Vfs_kitdll_data_tcl_Init, NULL);
          372  +#endif
   295    373   #ifdef TCL_THREADS
   296    374   	Tcl_StaticPackage(0, "Thread", Thread_Init, NULL);
   297    375   #endif
   298    376   #ifdef _WIN32
   299    377   	Tcl_StaticPackage(0, "dde", Dde_Init, NULL);
   300    378   	Tcl_StaticPackage(0, "registry", Registry_Init, NULL);
   301    379   #endif
   302    380   #ifdef KIT_INCLUDES_TK
   303    381   	Tcl_StaticPackage(0, "Tk", Tk_Init, Tk_SafeInit);
   304    382   #endif
   305    383   
          384  +	TclSetPreInitScript(preInitCmd);
          385  +
          386  +	return;
          387  +}
          388  +
          389  +static void _Tclkit_Interp_Init(Tcl_Interp *interp) {
          390  +#ifdef TCLKIT_CAN_SET_ENCODING
          391  +	Tcl_DString encodingName;
          392  +#endif /* TCLKIT_CAN_SET_ENCODING */
          393  +
   306    394   	/* the tcl_rcFileName variable only exists in the initial interpreter */
   307    395   #ifdef _WIN32
   308    396   	Tcl_SetVar(interp, "tcl_rcFileName", "~/tclkitrc.tcl", TCL_GLOBAL_ONLY);
   309    397   #else
   310    398   	Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclkitrc", TCL_GLOBAL_ONLY);
   311    399   #endif
   312    400   
................................................................................
   319    407   #endif
   320    408   
   321    409   	/* Hack to get around Tcl bug 1224888.  This must be run here and
   322    410   	 * in LibraryPathObjCmd because this information is needed both
   323    411   	 * before and after that command is run. */
   324    412   	FindAndSetExecName(interp);
   325    413   
   326         -	TclSetPreInitScript(preInitCmd);
          414  +	return;
          415  +}
          416  +
          417  +int TclKit_AppInit(Tcl_Interp *interp) {
          418  +#ifdef KIT_INCLUDES_TK
          419  +#  ifdef _WIN32
          420  +#    ifndef _WIN32_WCE
          421  +	char msgBuf[2049];
          422  +#    endif /* !_WIN32_WCE */
          423  +#  endif /* _WIN32 */
          424  +#endif /* KIT_INCLUDES_TK */
          425  +
          426  +	/* Perform common initialization */
          427  +	_Tclkit_Generic_Init();
          428  +
          429  +	_Tclkit_Interp_Init(interp);
          430  +
   327    431   	if (Tcl_Init(interp) == TCL_ERROR) {
   328    432   		goto error;
   329    433   	}
   330    434   
   331    435   #ifdef KIT_INCLUDES_TK
   332    436   #  ifdef _WIN32
   333    437   	if (Tk_Init(interp) == TCL_ERROR) {
................................................................................
   376    480   #    endif /* !_WIN32_WCE */
   377    481       /* we won't reach this, but we need the return */
   378    482   #  endif /* _WIN32 */
   379    483   #endif /* KIT_INCLUDES_TK */
   380    484   
   381    485   	return TCL_ERROR;
   382    486   }
          487  +
          488  +
          489  +#ifdef TCLKIT_DLL
          490  +#  ifdef HAVE_ACCEPTABLE_DLADDR
          491  +/* Symbol to resolve against dladdr() */
          492  +static void _tclkit_dummy_func(void) {
          493  +	return;
          494  +}
          495  +#  endif /* HAVE_ACCEPTABLE_DLADDR */
          496  +
          497  +/*
          498  + * This function will return a pathname we can open() to treat as a VFS,
          499  + * hopefully
          500  + */
          501  +static char *find_tclkit_dll_path(void) {
          502  +#ifdef HAVE_ACCEPTABLE_DLADDR
          503  +	Dl_info syminfo;
          504  +	int dladdr_ret;
          505  +#endif /* HAVE_ACCEPTABLE_DLADDR */
          506  +#ifdef _WIN32
          507  +	TCHAR modulename[8192];
          508  +	DWORD gmfn_ret;
          509  +#endif /* _WIN32 */
          510  +
          511  +#ifdef HAVE_ACCEPTABLE_DLADDR
          512  +	dladdr_ret = dladdr(&_tclkit_dummy_func, &syminfo);
          513  +	if (dladdr_ret != 0) {
          514  +		if (syminfo.dli_fname && syminfo.dli_fname[0] != '\0') {
          515  +			return(strdup(syminfo.dli_fname));
          516  +		}
          517  +	}
          518  +#endif /* HAVE_ACCEPTABLE_DLADDR */
          519  +
          520  +#ifdef _WIN32
          521  +	gmfn_ret = GetModuleFileName(TclWinGetTclInstance(), modulename, sizeof(modulename) / sizeof(modulename[0]) - 1);
          522  +
          523  +	if (gmfn_ret != 0) {
          524  +		return(strdup(modulename));
          525  +	}
          526  +#endif /* _WIN32 */
          527  +
          528  +	return(NULL);
          529  +}
          530  +
          531  +/*
          532  + * This function exists to allow C code to initialize a particular
          533  + * interpreter.
          534  + */
          535  +static int tclkit_init_initinterp(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
          536  +	char *kitdll_path;
          537  +
          538  +	kitdll_path = find_tclkit_dll_path();
          539  +	if (kitdll_path != NULL) {
          540  +		Tcl_SetVar(interp, "tclKitFilename", kitdll_path, TCL_GLOBAL_ONLY);
          541  +
          542  +		free(kitdll_path);
          543  +	}
          544  +
          545  +	_Tclkit_Interp_Init(interp);
          546  +
          547  +	return(TCL_OK);
          548  +}
          549  +
          550  +/*
          551  + * Create a package for initializing a particular interpreter.  This is
          552  + * our hook to have Tcl invoke C commands when creating an interpreter.
          553  + * The preInitCmd will load the package in the new interpreter and invoke
          554  + * this function.
          555  + */
          556  +int Tclkit_init_Init(Tcl_Interp *interp) {
          557  +	Tcl_Command tclCreatComm_ret;
          558  +	int tclPkgProv_ret;
          559  +
          560  +	tclCreatComm_ret = Tcl_CreateObjCommand(interp, "::tclkit::init::initInterp", tclkit_init_initinterp, NULL, NULL);
          561  +	if (!tclCreatComm_ret) {
          562  +		return(TCL_ERROR);
          563  +	}
          564  +
          565  +	tclPkgProv_ret = Tcl_PkgProvide(interp, "tclkit::init", "1.0");
          566  +
          567  +	return(tclPkgProv_ret);
          568  +}
          569  +
          570  +/*
          571  + * Initialize the Tcl system when we are loaded, that way Tcl functions
          572  + * are ready to be used when invoked.
          573  + */
          574  +void __attribute__((constructor)) _Tclkit_Init(void) {
          575  +	Tcl_StaticPackage(0, "tclkit::init", Tclkit_init_Init, NULL);
          576  +
          577  +	_Tclkit_Generic_Init();
          578  +
          579  +	return;
          580  +}
          581  +#endif