Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Update Practcl.tcl to the latest
Workaround in tclZipFs for an internal API change in the Tcl Core post 8.6.9 |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | practcl |
| Files: | files | file ages | folders |
| SHA3-256: |
79972997da53915f7d71b2597f741388 |
| User & Date: | hypnotoad 2019-09-09 13:11:05 |
Context
|
2019-09-09
| ||
| 13:17 | Closing fork Leaf check-in: 832915fb01 user: hypnotoad tags: practcl | |
| 13:11 |
Update Practcl.tcl to the latest
Workaround in tclZipFs for an internal API change in the Tcl Core post 8.6.9 check-in: 79972997da user: hypnotoad tags: practcl | |
|
2019-07-26
| ||
| 13:14 | Updating to the latest practcl check-in: 149b1e1e5f user: hypnotoad tags: practcl | |
Changes
Changes to compat/tclZipfs.c.
939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 .... 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 .... 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 .... 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 .... 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 .... 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 .... 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 .... 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 .... 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 .... 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 .... 4566 4567 4568 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 |
if(zf->is_membuf==1) {
/* Pointer to memory */
if (zf->tofree != NULL) {
Tcl_Free((char *) zf->tofree);
zf->tofree = NULL;
}
zf->data = NULL;
return;
}
#if defined(_WIN32) || defined(_WIN64)
if ((zf->data != NULL) && (zf->tofree == NULL)) {
UnmapViewOfFile(zf->data);
zf->data = NULL;
}
if (zf->mh != INVALID_HANDLE_VALUE) {
CloseHandle(zf->mh);
................................................................................
i = q[-5];
if (q - 5 - i > zf->data) {
zf->pwbuf[0] = i;
memcpy(zf->pwbuf + 1, q - 5 - i, i);
zf->baseoffsp -= i ? (5 + i) : 0;
}
}
return TCL_OK;
error:
ZipFSCloseArchive(interp, zf);
return TCL_ERROR;
}
................................................................................
*/
static int
ZipFSOpenArchive(Tcl_Interp *interp, const char *zipname, int needZip, ZipFile *zf)
{
int i;
ClientData handle;
zf->is_membuf=0;
#if defined(_WIN32) || defined(_WIN64)
zf->data = NULL;
zf->mh = INVALID_HANDLE_VALUE;
#else
zf->data = MAP_FAILED;
#endif
................................................................................
Tcl_HashEntry *hPtr;
Tcl_DString ds, dsm, fpBuf;
unsigned char *q;
#if HAS_DRIVES
int drive = 0;
#endif
WriteLock();
pwlen = 0;
if (passwd != NULL) {
pwlen = strlen(passwd);
if ((pwlen > 255) || (strchr(passwd, 0xff) != NULL)) {
if (interp) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("illegal password", -1));
................................................................................
}
if (interp == NULL) {
ret = (i > 0) ? TCL_OK : TCL_BREAK;
}
Unlock();
return ret;
}
if (zipname == NULL) {
Tcl_HashEntry *hPtr;
if (interp == NULL) {
Unlock();
return TCL_OK;
}
hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mntpt);
................................................................................
}
if (interp == NULL) {
ret = (i > 0) ? TCL_OK : TCL_BREAK;
}
Unlock();
return ret;
}
if (data == NULL) {
Tcl_HashEntry *hPtr;
if (interp == NULL) {
Unlock();
return TCL_OK;
}
................................................................................
if (!ZipFS.initialized) goto done;
/*
* Mount point sometimes is a relative or otherwise denormalized path.
* But an absolute name is needed as mount point here.
*/
Tcl_DStringInit(&dsm);
mntpt = CanonicalPath("", mntpt, &dsm, 1);
hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mntpt);
/* don't report error */
if (hPtr == NULL) goto done;
zf = (ZipFile *) Tcl_GetHashValue(hPtr);
if (zf->nopen > 0) {
................................................................................
}
if(objc<2) {
int i;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
int ret = TCL_OK;
ZipFile *zf;
ReadLock();
i = 0;
hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search);
while (hPtr != NULL) {
if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) {
if (interp != NULL) {
Tcl_AppendElement(interp, zf->mntpt);
................................................................................
Tcl_Obj *TclZipfs_TclLibrary(void) {
if(zipfs_literal_tcl_library) {
return Tcl_NewStringObj(zipfs_literal_tcl_library,-1);
} else {
Tcl_Obj *vfsinitscript;
int found=0;
/* Look for the library file system within the executable */
vfsinitscript=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl",-1);
Tcl_IncrRefCount(vfsinitscript);
found=Tcl_FSAccess(vfsinitscript,F_OK);
Tcl_DecrRefCount(vfsinitscript);
if(found==TCL_OK) {
zipfs_literal_tcl_library=ZIPFS_APP_MOUNT "/tcl_library";
................................................................................
}
}
if (objs[0] == NULL) {
objs[0] = TclPathPart(interp, TclGetObjNameOfExecutable(),
TCL_PATH_DIRNAME);
}
if (objs[0] != NULL) {
altPath = TclJoinPath(2, objs);
if (altPath != NULL) {
Tcl_IncrRefCount(altPath);
if (Tcl_FSAccess(altPath, R_OK) == 0) {
path = altPath;
}
}
}
................................................................................
*
* Dummy version when no ZLIB support available.
*
*-------------------------------------------------------------------------
*/
int
TclZipfs_Mount(Tcl_Interp *interp, const char *mntpt, const char *zipname,
const char *passwd)
{
return TclZipfs_Init(interp, 1);
}
int
TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname)
|
| | | | | | | | | | > > > > | |
939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 .... 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 .... 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 .... 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 .... 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 .... 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 .... 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 .... 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 .... 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 .... 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 .... 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 4584 |
if(zf->is_membuf==1) {
/* Pointer to memory */
if (zf->tofree != NULL) {
Tcl_Free((char *) zf->tofree);
zf->tofree = NULL;
}
zf->data = NULL;
return;
}
#if defined(_WIN32) || defined(_WIN64)
if ((zf->data != NULL) && (zf->tofree == NULL)) {
UnmapViewOfFile(zf->data);
zf->data = NULL;
}
if (zf->mh != INVALID_HANDLE_VALUE) {
CloseHandle(zf->mh);
................................................................................
i = q[-5];
if (q - 5 - i > zf->data) {
zf->pwbuf[0] = i;
memcpy(zf->pwbuf + 1, q - 5 - i, i);
zf->baseoffsp -= i ? (5 + i) : 0;
}
}
return TCL_OK;
error:
ZipFSCloseArchive(interp, zf);
return TCL_ERROR;
}
................................................................................
*/
static int
ZipFSOpenArchive(Tcl_Interp *interp, const char *zipname, int needZip, ZipFile *zf)
{
int i;
ClientData handle;
zf->is_membuf=0;
#if defined(_WIN32) || defined(_WIN64)
zf->data = NULL;
zf->mh = INVALID_HANDLE_VALUE;
#else
zf->data = MAP_FAILED;
#endif
................................................................................
Tcl_HashEntry *hPtr;
Tcl_DString ds, dsm, fpBuf;
unsigned char *q;
#if HAS_DRIVES
int drive = 0;
#endif
WriteLock();
pwlen = 0;
if (passwd != NULL) {
pwlen = strlen(passwd);
if ((pwlen > 255) || (strchr(passwd, 0xff) != NULL)) {
if (interp) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("illegal password", -1));
................................................................................
}
if (interp == NULL) {
ret = (i > 0) ? TCL_OK : TCL_BREAK;
}
Unlock();
return ret;
}
if (zipname == NULL) {
Tcl_HashEntry *hPtr;
if (interp == NULL) {
Unlock();
return TCL_OK;
}
hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mntpt);
................................................................................
}
if (interp == NULL) {
ret = (i > 0) ? TCL_OK : TCL_BREAK;
}
Unlock();
return ret;
}
if (data == NULL) {
Tcl_HashEntry *hPtr;
if (interp == NULL) {
Unlock();
return TCL_OK;
}
................................................................................
if (!ZipFS.initialized) goto done;
/*
* Mount point sometimes is a relative or otherwise denormalized path.
* But an absolute name is needed as mount point here.
*/
Tcl_DStringInit(&dsm);
mntpt = CanonicalPath("", mntpt, &dsm, 1);
hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mntpt);
/* don't report error */
if (hPtr == NULL) goto done;
zf = (ZipFile *) Tcl_GetHashValue(hPtr);
if (zf->nopen > 0) {
................................................................................
}
if(objc<2) {
int i;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
int ret = TCL_OK;
ZipFile *zf;
ReadLock();
i = 0;
hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search);
while (hPtr != NULL) {
if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) {
if (interp != NULL) {
Tcl_AppendElement(interp, zf->mntpt);
................................................................................
Tcl_Obj *TclZipfs_TclLibrary(void) {
if(zipfs_literal_tcl_library) {
return Tcl_NewStringObj(zipfs_literal_tcl_library,-1);
} else {
Tcl_Obj *vfsinitscript;
int found=0;
/* Look for the library file system within the executable */
vfsinitscript=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl",-1);
Tcl_IncrRefCount(vfsinitscript);
found=Tcl_FSAccess(vfsinitscript,F_OK);
Tcl_DecrRefCount(vfsinitscript);
if(found==TCL_OK) {
zipfs_literal_tcl_library=ZIPFS_APP_MOUNT "/tcl_library";
................................................................................
}
}
if (objs[0] == NULL) {
objs[0] = TclPathPart(interp, TclGetObjNameOfExecutable(),
TCL_PATH_DIRNAME);
}
if (objs[0] != NULL) {
#if TCL_RELEASE_SERIAL < 9
altPath = TclJoinPath(2, objs);
#else
altPath = TclJoinPath(2, objs, 0);
#endif
if (altPath != NULL) {
Tcl_IncrRefCount(altPath);
if (Tcl_FSAccess(altPath, R_OK) == 0) {
path = altPath;
}
}
}
................................................................................
*
* Dummy version when no ZLIB support available.
*
*-------------------------------------------------------------------------
*/
int
TclZipfs_Mount(Tcl_Interp *interp, const char *mntpt, const char *zipname,
const char *passwd)
{
return TclZipfs_Init(interp, 1);
}
int
TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname)
|
Changes to practcl.tcl.
3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 .... 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 .... 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 .... 7268 7269 7270 7271 7272 7273 7274 7275 7276 7277 7278 7279 7280 7281 7282 .... 7283 7284 7285 7286 7287 7288 7289 7290 7291 7292 7293 7294 7295 7296 7297 7298 7299 7300 7301 7302 7303 7304 7305 7306 7307 7308 7309 7310 7311 7312 7313 7314 7315 7316 7317 7318 7319 7320 7321 7322 .... 7395 7396 7397 7398 7399 7400 7401 7402 7403 7404 7405 7406 7407 7408 .... 7409 7410 7411 7412 7413 7414 7415 7416 7417 7418 7419 7420 7421 7422 7423 7424 7425 7426 7427 7428 7429 7430 7431 |
set modfile [file join $path [file tail $path].tcl]
set use_pkgindex [file exists $pkgidxfile]
set tclfiles {}
set found 0
set mlist [list pkgIndex.tcl index.tcl [file tail $modfile] version_info.tcl]
foreach file [glob -nocomplain [file join $path *.tcl]] {
if {[file tail $file] ni $mlist} {
puts [list NONMODFILE $file]
return {}
}
}
foreach file [glob -nocomplain [file join $path *.tcl]] {
if { [file tail $file] == "version_info.tcl" } continue
set fin [open $file r]
set dat [read $fin]
................................................................................
foreach line [split $dat \n] {
set line [string trim $line]
if { [string range $line 0 14] != "package provide" } continue
set package [lindex $line 2]
set version [lindex $line 3]
if {[string index $package 0] in "\$ \[ @"} continue
if {[string index $version 0] in "\$ \[ @"} continue
puts "PKGLINE $line"
append buffer "package ifneeded $package $version \[list source \[file join %DIR% [file tail $file]\]\]" \n
break
}
}
return $buffer
}
proc ::practcl::_pkgindex_directory {path} {
................................................................................
set IdxTime [file mtime $pkgIndexFile]
if {$latest<$IdxTime} return
}
::practcl::dotclexec $buildscript
}
proc ::practcl::installModule {modpath DEST} {
set dpath [file join $DEST modules [file tail $modpath]]
puts [list ::practcl::installModule $modpath -> $dpath]
if {[file exists [file join $modpath index.tcl]]} {
# IRM/Tao style modules non-amalgamated
::practcl::installDir $modpath $dpath
return
}
if {[file exists [file join $modpath build build.tcl]]} {
buildModule $modpath
................................................................................
set map {}
foreach var {
vfsroot mainhook mainfunc vfs_main
} {
dict set map %${var}% [set $var]
}
set preinitscript {
set ::odie(boot_vfs) %vfsroot%
set ::SRCDIR $::odie(boot_vfs)
namespace eval ::starkit {}
set ::starkit::topdir %vfsroot%
if {[file exists [file join %vfsroot% tcl_library init.tcl]]} {
set ::tcl_library [file join %vfsroot% tcl_library]
................................................................................
set ::auto_path {}
}
if {[file exists [file join %vfsroot% tk_library tk.tcl]]} {
set ::tk_library [file join %vfsroot% tk_library]
}
} ; # Preinitscript
set main_init_script {}
set thread_init_script {}
append preinitscript \n {namespace eval ::starkit {}}
append preinitscript \n [list set ::starkit::topdir $vfsroot]
foreach {statpkg info} $statpkglist {
set script [list package ifneeded $statpkg [dict get $info version] [list ::load {} $statpkg]]
append preinitscript \n $script
if {[dict get $info autoload]} {
append main_init_script \n [list ::load {} $statpkg]
}
}
append main_init_script \n {
# Specify a user-specific startup file to invoke if the application
# is run interactively. Typically the startup file is "~/.apprc"
# where "app" is the name of the application. If this line is deleted
# then no user-specific startup file will be run under any conditions.
}
append main_init_script \n {if {[file exists [file join $::starkit::topdir pkgIndex.tcl]]} {
#In a wrapped exe, we don't go out to the environment
set dir $::starkit::topdir
source [file join $::starkit::topdir pkgIndex.tcl]
}}
append main_init_script \n [list set tcl_rcFileName [$PROJECT define get tcl_rcFileName ~/.tclshrc]]
append preinitscript \n [list set ::starkit::thread_init $thread_init_script]
append preinitscript \n {eval $::starkit::thread_init}
set zvfsboot {
/*
* %mainhook% --
* Performs the argument munging for the shell
*/
}
::practcl::cputs zvfsboot {
................................................................................
return TCL_ERROR;
}
}
if {![$PROJECT define get tip_430 0]} {
::practcl::cputs appinit { TclZipfs_Init(interp);}
}
foreach {statpkg info} $statpkglist {
set initfunc {}
if {[dict exists $info initfunc]} {
set initfunc [dict get $info initfunc]
}
if {$initfunc eq {}} {
set initfunc [string totitle ${statpkg}]_Init
................................................................................
}
if {![dict exists $info version]} {
error "$statpkg HAS NO VERSION"
}
# We employ a NULL to prevent the package system from thinking the
# package is actually loaded into the interpreter
$PROJECT code header "extern Tcl_PackageInitProc $initfunc\;\n"
if {[dict get $info autoload]} {
::practcl::cputs appinit " if(${initfunc}(interp)) return TCL_ERROR\;"
::practcl::cputs appinit " Tcl_StaticPackage(interp,\"$statpkg\",$initfunc,NULL)\;"
} else {
::practcl::cputs appinit "\n Tcl_StaticPackage(NULL,\"$statpkg\",$initfunc,NULL)\;"
}
}
practcl::cputs appinit " Tcl_Eval(interp,[::practcl::tcl_to_c $main_init_script]);"
practcl::cputs appinit { return TCL_OK;}
$PROJECT c_function [string map $map "int %mainfunc%(Tcl_Interp *interp)"] [string map $map $appinit]
}
method Collate_Source CWD {
next $CWD
set name [my define get name]
# Assume a static shell
|
| | | | > < < < < < < < < < < < < < < < < < < < < < < < < < < > > > > > > > > > > > > > > > > > > | > > > > > | |
3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 .... 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 .... 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 .... 7268 7269 7270 7271 7272 7273 7274 7275 7276 7277 7278 7279 7280 7281 7282 7283 .... 7284 7285 7286 7287 7288 7289 7290 7291 7292 7293 7294 7295 7296 7297 .... 7370 7371 7372 7373 7374 7375 7376 7377 7378 7379 7380 7381 7382 7383 7384 7385 .... 7386 7387 7388 7389 7390 7391 7392 7393 7394 7395 7396 7397 7398 7399 7400 7401 7402 7403 7404 7405 7406 7407 7408 7409 7410 7411 7412 7413 7414 7415 7416 7417 7418 7419 7420 7421 7422 7423 7424 7425 7426 7427 7428 7429 |
set modfile [file join $path [file tail $path].tcl]
set use_pkgindex [file exists $pkgidxfile]
set tclfiles {}
set found 0
set mlist [list pkgIndex.tcl index.tcl [file tail $modfile] version_info.tcl]
foreach file [glob -nocomplain [file join $path *.tcl]] {
if {[file tail $file] ni $mlist} {
#puts [list NONMODFILE $file]
return {}
}
}
foreach file [glob -nocomplain [file join $path *.tcl]] {
if { [file tail $file] == "version_info.tcl" } continue
set fin [open $file r]
set dat [read $fin]
................................................................................
foreach line [split $dat \n] {
set line [string trim $line]
if { [string range $line 0 14] != "package provide" } continue
set package [lindex $line 2]
set version [lindex $line 3]
if {[string index $package 0] in "\$ \[ @"} continue
if {[string index $version 0] in "\$ \[ @"} continue
#puts "PKGLINE $line"
append buffer "package ifneeded $package $version \[list source \[file join %DIR% [file tail $file]\]\]" \n
break
}
}
return $buffer
}
proc ::practcl::_pkgindex_directory {path} {
................................................................................
set IdxTime [file mtime $pkgIndexFile]
if {$latest<$IdxTime} return
}
::practcl::dotclexec $buildscript
}
proc ::practcl::installModule {modpath DEST} {
set dpath [file join $DEST modules [file tail $modpath]]
#puts [list ::practcl::installModule $modpath -> $dpath]
if {[file exists [file join $modpath index.tcl]]} {
# IRM/Tao style modules non-amalgamated
::practcl::installDir $modpath $dpath
return
}
if {[file exists [file join $modpath build build.tcl]]} {
buildModule $modpath
................................................................................
set map {}
foreach var {
vfsroot mainhook mainfunc vfs_main
} {
dict set map %${var}% [set $var]
}
set thread_init_script {namespace eval ::starkit {}}
append thread_init_script \n [list set ::starkit::topdir $vfsroot]
set preinitscript {
set ::odie(boot_vfs) %vfsroot%
set ::SRCDIR $::odie(boot_vfs)
namespace eval ::starkit {}
set ::starkit::topdir %vfsroot%
if {[file exists [file join %vfsroot% tcl_library init.tcl]]} {
set ::tcl_library [file join %vfsroot% tcl_library]
................................................................................
set ::auto_path {}
}
if {[file exists [file join %vfsroot% tk_library tk.tcl]]} {
set ::tk_library [file join %vfsroot% tk_library]
}
} ; # Preinitscript
set zvfsboot {
/*
* %mainhook% --
* Performs the argument munging for the shell
*/
}
::practcl::cputs zvfsboot {
................................................................................
return TCL_ERROR;
}
}
if {![$PROJECT define get tip_430 0]} {
::practcl::cputs appinit { TclZipfs_Init(interp);}
}
set main_init_script {}
foreach {statpkg info} $statpkglist {
set initfunc {}
if {[dict exists $info initfunc]} {
set initfunc [dict get $info initfunc]
}
if {$initfunc eq {}} {
set initfunc [string totitle ${statpkg}]_Init
................................................................................
}
if {![dict exists $info version]} {
error "$statpkg HAS NO VERSION"
}
# We employ a NULL to prevent the package system from thinking the
# package is actually loaded into the interpreter
$PROJECT code header "extern Tcl_PackageInitProc $initfunc\;\n"
set script [list package ifneeded $statpkg [dict get $info version] [list ::load {} $statpkg]]
append main_init_script \n [list set ::starkit::static_packages(${statpkg}) $script]
if {[dict get $info autoload]} {
::practcl::cputs appinit " if(${initfunc}(interp)) return TCL_ERROR\;"
::practcl::cputs appinit " Tcl_StaticPackage(interp,\"$statpkg\",$initfunc,NULL)\;"
} else {
::practcl::cputs appinit "\n Tcl_StaticPackage(NULL,\"$statpkg\",$initfunc,NULL)\;"
append main_init_script \n $script
}
}
append main_init_script \n {
if {[file exists [file join $::starkit::topdir pkgIndex.tcl]]} {
#In a wrapped exe, we don't go out to the environment
set dir $::starkit::topdir
source [file join $::starkit::topdir pkgIndex.tcl]
}}
append thread_init_script $main_init_script
append main_init_script \n {
# Specify a user-specific startup file to invoke if the application
# is run interactively. Typically the startup file is "~/.apprc"
# where "app" is the name of the application. If this line is deleted
# then no user-specific startup file will be run under any conditions.
}
append thread_init_script \n [list set ::starkit::thread_init $thread_init_script]
append main_init_script \n [list set ::starkit::thread_init $thread_init_script]
append main_init_script \n [list set tcl_rcFileName [$PROJECT define get tcl_rcFileName ~/.tclshrc]]
practcl::cputs appinit " Tcl_Eval(interp,[::practcl::tcl_to_c $thread_init_script]);"
practcl::cputs appinit { return TCL_OK;}
$PROJECT c_function [string map $map "int %mainfunc%(Tcl_Interp *interp)"] [string map $map $appinit]
}
method Collate_Source CWD {
next $CWD
set name [my define get name]
# Assume a static shell
|