diff options
Diffstat (limited to 'contrib/sqlite3/tea/generic/tclsqlite3.c')
| -rw-r--r-- | contrib/sqlite3/tea/generic/tclsqlite3.c | 231 |
1 files changed, 158 insertions, 73 deletions
diff --git a/contrib/sqlite3/tea/generic/tclsqlite3.c b/contrib/sqlite3/tea/generic/tclsqlite3.c index 0810b079e2e6..197ce744836c 100644 --- a/contrib/sqlite3/tea/generic/tclsqlite3.c +++ b/contrib/sqlite3/tea/generic/tclsqlite3.c @@ -1,7 +1,7 @@ #ifdef USE_SYSTEM_SQLITE # include <sqlite3.h> #else -#include "sqlite3.c" +# include "sqlite3.c" #endif /* ** 2001 September 15 @@ -40,14 +40,23 @@ # include "msvc.h" #endif +/****** Copy of tclsqlite.h ******/ #if defined(INCLUDE_SQLITE_TCL_H) -# include "sqlite_tcl.h" +# include "sqlite_tcl.h" /* Special case for Windows using STDCALL */ #else -# include "tcl.h" +# include <tcl.h> /* All normal cases */ # ifndef SQLITE_TCLAPI -# define SQLITE_TCLAPI +# define SQLITE_TCLAPI # endif #endif +/* Compatability between Tcl8.6 and Tcl9.0 */ +#if TCL_MAJOR_VERSION==9 +# define CONST const +#elif !defined(Tcl_Size) + typedef int Tcl_Size; +#endif +/**** End copy of tclsqlite.h ****/ + #include <errno.h> /* @@ -72,7 +81,9 @@ # define SQLITE_PTRSIZE 8 # endif # endif /* SQLITE_PTRSIZE */ -# if defined(HAVE_STDINT_H) +# if defined(HAVE_STDINT_H) || (defined(__STDC_VERSION__) && \ + (__STDC_VERSION__ >= 199901L)) +# include <stdint.h> typedef uintptr_t uptr; # elif SQLITE_PTRSIZE==4 typedef unsigned int uptr; @@ -214,7 +225,8 @@ struct SqliteDb { struct IncrblobChannel { sqlite3_blob *pBlob; /* sqlite3 blob handle */ SqliteDb *pDb; /* Associated database connection */ - int iSeek; /* Current seek offset */ + sqlite3_int64 iSeek; /* Current seek offset */ + unsigned int isClosed; /* TCL_CLOSE_READ or TCL_CLOSE_WRITE */ Tcl_Channel channel; /* Channel identifier */ IncrblobChannel *pNext; /* Linked list of all open incrblob channels */ IncrblobChannel *pPrev; /* Linked list of all open incrblob channels */ @@ -254,14 +266,23 @@ static void closeIncrblobChannels(SqliteDb *pDb){ /* ** Close an incremental blob channel. */ -static int SQLITE_TCLAPI incrblobClose( +static int SQLITE_TCLAPI incrblobClose2( ClientData instanceData, - Tcl_Interp *interp + Tcl_Interp *interp, + int flags ){ IncrblobChannel *p = (IncrblobChannel *)instanceData; - int rc = sqlite3_blob_close(p->pBlob); + int rc; sqlite3 *db = p->pDb->db; + if( flags ){ + p->isClosed |= flags; + return TCL_OK; + } + + /* If we reach this point, then we really do need to close the channel */ + rc = sqlite3_blob_close(p->pBlob); + /* Remove the channel from the SqliteDb.pIncrblob list. */ if( p->pNext ){ p->pNext->pPrev = p->pPrev; @@ -282,6 +303,13 @@ static int SQLITE_TCLAPI incrblobClose( } return TCL_OK; } +static int SQLITE_TCLAPI incrblobClose( + ClientData instanceData, + Tcl_Interp *interp +){ + return incrblobClose2(instanceData, interp, 0); +} + /* ** Read data from an incremental blob channel. @@ -293,9 +321,9 @@ static int SQLITE_TCLAPI incrblobInput( int *errorCodePtr ){ IncrblobChannel *p = (IncrblobChannel *)instanceData; - int nRead = bufSize; /* Number of bytes to read */ - int nBlob; /* Total size of the blob */ - int rc; /* sqlite error code */ + sqlite3_int64 nRead = bufSize; /* Number of bytes to read */ + sqlite3_int64 nBlob; /* Total size of the blob */ + int rc; /* sqlite error code */ nBlob = sqlite3_blob_bytes(p->pBlob); if( (p->iSeek+nRead)>nBlob ){ @@ -305,7 +333,7 @@ static int SQLITE_TCLAPI incrblobInput( return 0; } - rc = sqlite3_blob_read(p->pBlob, (void *)buf, nRead, p->iSeek); + rc = sqlite3_blob_read(p->pBlob, (void *)buf, (int)nRead, (int)p->iSeek); if( rc!=SQLITE_OK ){ *errorCodePtr = rc; return -1; @@ -320,14 +348,14 @@ static int SQLITE_TCLAPI incrblobInput( */ static int SQLITE_TCLAPI incrblobOutput( ClientData instanceData, - CONST char *buf, + const char *buf, int toWrite, int *errorCodePtr ){ IncrblobChannel *p = (IncrblobChannel *)instanceData; - int nWrite = toWrite; /* Number of bytes to write */ - int nBlob; /* Total size of the blob */ - int rc; /* sqlite error code */ + sqlite3_int64 nWrite = toWrite; /* Number of bytes to write */ + sqlite3_int64 nBlob; /* Total size of the blob */ + int rc; /* sqlite error code */ nBlob = sqlite3_blob_bytes(p->pBlob); if( (p->iSeek+nWrite)>nBlob ){ @@ -338,7 +366,7 @@ static int SQLITE_TCLAPI incrblobOutput( return 0; } - rc = sqlite3_blob_write(p->pBlob, (void *)buf, nWrite, p->iSeek); + rc = sqlite3_blob_write(p->pBlob, (void*)buf,(int)nWrite, (int)p->iSeek); if( rc!=SQLITE_OK ){ *errorCodePtr = EIO; return -1; @@ -348,12 +376,19 @@ static int SQLITE_TCLAPI incrblobOutput( return nWrite; } +/* The datatype of Tcl_DriverWideSeekProc changes between tcl8.6 and tcl9.0 */ +#if TCL_MAJOR_VERSION==9 +# define WideSeekProcType long long +#else +# define WideSeekProcType Tcl_WideInt +#endif + /* ** Seek an incremental blob channel. */ -static int SQLITE_TCLAPI incrblobSeek( +static WideSeekProcType SQLITE_TCLAPI incrblobWideSeek( ClientData instanceData, - long offset, + WideSeekProcType offset, int seekMode, int *errorCodePtr ){ @@ -375,6 +410,14 @@ static int SQLITE_TCLAPI incrblobSeek( return p->iSeek; } +static int SQLITE_TCLAPI incrblobSeek( + ClientData instanceData, + long offset, + int seekMode, + int *errorCodePtr +){ + return incrblobWideSeek(instanceData,offset,seekMode,errorCodePtr); +} static void SQLITE_TCLAPI incrblobWatch( @@ -393,7 +436,7 @@ static int SQLITE_TCLAPI incrblobHandle( static Tcl_ChannelType IncrblobChannelType = { "incrblob", /* typeName */ - TCL_CHANNEL_VERSION_2, /* version */ + TCL_CHANNEL_VERSION_5, /* version */ incrblobClose, /* closeProc */ incrblobInput, /* inputProc */ incrblobOutput, /* outputProc */ @@ -402,11 +445,11 @@ static Tcl_ChannelType IncrblobChannelType = { 0, /* getOptionProc */ incrblobWatch, /* watchProc (this is a no-op) */ incrblobHandle, /* getHandleProc (always returns error) */ - 0, /* close2Proc */ + incrblobClose2, /* close2Proc */ 0, /* blockModeProc */ 0, /* flushProc */ 0, /* handlerProc */ - 0, /* wideSeekProc */ + incrblobWideSeek, /* wideSeekProc */ }; /* @@ -438,8 +481,9 @@ static int createIncrblobChannel( } p = (IncrblobChannel *)Tcl_Alloc(sizeof(IncrblobChannel)); - p->iSeek = 0; + memset(p, 0, sizeof(*p)); p->pBlob = pBlob; + if( (flags & TCL_WRITABLE)==0 ) p->isClosed |= TCL_CLOSE_WRITE; sqlite3_snprintf(sizeof(zChannel), zChannel, "incrblob_%d", ++count); p->channel = Tcl_CreateChannel(&IncrblobChannelType, zChannel, p, flags); @@ -473,13 +517,13 @@ static int createIncrblobChannel( ** or {...} or ; to be seen anywhere. Most callback scripts consist ** of just a single procedure name and they meet this requirement. */ -static int safeToUseEvalObjv(Tcl_Interp *interp, Tcl_Obj *pCmd){ +static int safeToUseEvalObjv(Tcl_Obj *pCmd){ /* We could try to do something with Tcl_Parse(). But we will instead ** just do a search for forbidden characters. If any of the forbidden ** characters appear in pCmd, we will report the string as unsafe. */ const char *z; - int n; + Tcl_Size n; z = Tcl_GetStringFromObj(pCmd, &n); while( n-- > 0 ){ int c = *(z++); @@ -986,7 +1030,7 @@ static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){ ** be preserved and reused on the next invocation. */ Tcl_Obj **aArg; - int nArg; + Tcl_Size nArg; if( Tcl_ListObjGetElements(p->interp, p->pScript, &nArg, &aArg) ){ sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1); return; @@ -1049,7 +1093,7 @@ static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){ sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1); }else{ Tcl_Obj *pVar = Tcl_GetObjResult(p->interp); - int n; + Tcl_Size n; u8 *data; const char *zType = (pVar->typePtr ? pVar->typePtr->name : ""); char c = zType[0]; @@ -1060,7 +1104,8 @@ static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){ /* Only return a BLOB type if the Tcl variable is a bytearray and ** has no string representation. */ eType = SQLITE_BLOB; - }else if( (c=='b' && strcmp(zType,"boolean")==0) + }else if( (c=='b' && pVar->bytes==0 && strcmp(zType,"boolean")==0 ) + || (c=='b' && pVar->bytes==0 && strcmp(zType,"booleanString")==0 ) || (c=='w' && strcmp(zType,"wideInt")==0) || (c=='i' && strcmp(zType,"int")==0) ){ @@ -1096,7 +1141,8 @@ static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){ } default: { data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n); - sqlite3_result_text(context, (char *)data, n, SQLITE_TRANSIENT); + sqlite3_result_text64(context, (char *)data, n, SQLITE_TRANSIENT, + SQLITE_UTF8); break; } } @@ -1118,9 +1164,6 @@ static int auth_callback( const char *zArg2, const char *zArg3, const char *zArg4 -#ifdef SQLITE_USER_AUTHENTICATION - ,const char *zArg5 -#endif ){ const char *zCode; Tcl_DString str; @@ -1180,9 +1223,6 @@ static int auth_callback( Tcl_DStringAppendElement(&str, zArg2 ? zArg2 : ""); Tcl_DStringAppendElement(&str, zArg3 ? zArg3 : ""); Tcl_DStringAppendElement(&str, zArg4 ? zArg4 : ""); -#ifdef SQLITE_USER_AUTHENTICATION - Tcl_DStringAppendElement(&str, zArg5 ? zArg5 : ""); -#endif rc = Tcl_GlobalEval(pDb->interp, Tcl_DStringValue(&str)); Tcl_DStringFree(&str); zReply = rc==TCL_OK ? Tcl_GetStringResult(pDb->interp) : "SQLITE_DENY"; @@ -1199,6 +1239,7 @@ static int auth_callback( } #endif /* SQLITE_OMIT_AUTHORIZATION */ +#if 0 /* ** This routine reads a line of text from FILE in, stores ** the text in memory obtained from malloc() and returns a pointer @@ -1243,6 +1284,7 @@ static char *local_getline(char *zPrompt, FILE *in){ zLine = realloc( zLine, n+1 ); return zLine; } +#endif /* @@ -1460,7 +1502,7 @@ static int dbPrepareAndBind( } } if( pVar ){ - int n; + Tcl_Size n; u8 *data; const char *zType = (pVar->typePtr ? pVar->typePtr->name : ""); c = zType[0]; @@ -1473,9 +1515,13 @@ static int dbPrepareAndBind( sqlite3_bind_blob(pStmt, i, data, n, SQLITE_STATIC); Tcl_IncrRefCount(pVar); pPreStmt->apParm[iParm++] = pVar; - }else if( c=='b' && strcmp(zType,"boolean")==0 ){ - Tcl_GetIntFromObj(interp, pVar, &n); - sqlite3_bind_int(pStmt, i, n); + }else if( c=='b' && pVar->bytes==0 + && (strcmp(zType,"booleanString")==0 + || strcmp(zType,"boolean")==0) + ){ + int nn; + Tcl_GetBooleanFromObj(interp, pVar, &nn); + sqlite3_bind_int(pStmt, i, nn); }else if( c=='d' && strcmp(zType,"double")==0 ){ double r; Tcl_GetDoubleFromObj(interp, pVar, &r); @@ -1487,7 +1533,8 @@ static int dbPrepareAndBind( sqlite3_bind_int64(pStmt, i, v); }else{ data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n); - sqlite3_bind_text(pStmt, i, (char *)data, n, SQLITE_STATIC); + sqlite3_bind_text64(pStmt, i, (char *)data, n, SQLITE_STATIC, + SQLITE_UTF8); Tcl_IncrRefCount(pVar); pPreStmt->apParm[iParm++] = pVar; } @@ -1809,7 +1856,8 @@ static Tcl_Obj *dbEvalColumnValue(DbEvalContext *p, int iCol){ ** are 8.6 or newer, the code still tests the Tcl version at runtime. ** This allows stubs-enabled builds to be used with older Tcl libraries. */ -#if TCL_MAJOR_VERSION>8 || (TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION>=6) +#if TCL_MAJOR_VERSION>8 || !defined(TCL_MINOR_VERSION) \ + || TCL_MINOR_VERSION>=6 # define SQLITE_TCL_NRE 1 static int DbUseNre(void){ int major, minor; @@ -1925,7 +1973,7 @@ static void DbHookCmd( } if( pArg ){ assert( !(*ppHook) ); - if( Tcl_GetCharLength(pArg)>0 ){ + if( Tcl_GetString(pArg)[0] ){ *ppHook = pArg; Tcl_IncrRefCount(*ppHook); } @@ -2018,7 +2066,7 @@ static int SQLITE_TCLAPI DbObjCmd( ** (4) Name of the database (ex: "main", "temp") ** (5) Name of trigger that is doing the access ** - ** The callback should return on of the following strings: SQLITE_OK, + ** The callback should return one of the following strings: SQLITE_OK, ** SQLITE_IGNORE, or SQLITE_DENY. Any other return value is an error. ** ** If this method is invoked with no arguments, the current authorization @@ -2039,7 +2087,7 @@ static int SQLITE_TCLAPI DbObjCmd( } }else{ char *zAuth; - int len; + Tcl_Size len; if( pDb->zAuth ){ Tcl_Free(pDb->zAuth); } @@ -2142,7 +2190,7 @@ static int SQLITE_TCLAPI DbObjCmd( } }else{ char *zCallback; - int len; + Tcl_Size len; if( pDb->zBindFallback ){ Tcl_Free(pDb->zBindFallback); } @@ -2172,7 +2220,7 @@ static int SQLITE_TCLAPI DbObjCmd( } }else{ char *zBusy; - int len; + Tcl_Size len; if( pDb->zBusy ){ Tcl_Free(pDb->zBusy); } @@ -2279,7 +2327,7 @@ static int SQLITE_TCLAPI DbObjCmd( SqlCollate *pCollate; char *zName; char *zScript; - int nScript; + Tcl_Size nScript; if( objc!=4 ){ Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT"); return TCL_ERROR; @@ -2338,7 +2386,7 @@ static int SQLITE_TCLAPI DbObjCmd( } }else{ const char *zCommit; - int len; + Tcl_Size len; if( pDb->zCommit ){ Tcl_Free(pDb->zCommit); } @@ -2481,9 +2529,10 @@ static int SQLITE_TCLAPI DbObjCmd( char *zLine; /* A single line of input from the file */ char **azCol; /* zLine[] broken up into columns */ const char *zCommit; /* How to commit changes */ - FILE *in; /* The input file */ + Tcl_Channel in; /* The input file */ int lineno = 0; /* Line number of input file */ char zLineNum[80]; /* Line number print buffer */ + Tcl_Obj *str; Tcl_Obj *pResult; /* interp result */ const char *zSep; @@ -2562,23 +2611,27 @@ static int SQLITE_TCLAPI DbObjCmd( sqlite3_finalize(pStmt); return TCL_ERROR; } - in = fopen(zFile, "rb"); + in = Tcl_OpenFileChannel(interp, zFile, "rb", 0666); if( in==0 ){ - Tcl_AppendResult(interp, "Error: cannot open file: ", zFile, (char*)0); sqlite3_finalize(pStmt); return TCL_ERROR; } + Tcl_SetChannelOption(NULL, in, "-translation", "auto"); azCol = malloc( sizeof(azCol[0])*(nCol+1) ); if( azCol==0 ) { Tcl_AppendResult(interp, "Error: can't malloc()", (char*)0); - fclose(in); + Tcl_Close(interp, in); return TCL_ERROR; } + str = Tcl_NewObj(); + Tcl_IncrRefCount(str); (void)sqlite3_exec(pDb->db, "BEGIN", 0, 0, 0); zCommit = "COMMIT"; - while( (zLine = local_getline(0, in))!=0 ){ + while( Tcl_GetsObj(in, str)>=0 ) { char *z; + Tcl_Size byteLen; lineno++; + zLine = (char *)Tcl_GetByteArrayFromObj(str, &byteLen); azCol[0] = zLine; for(i=0, z=zLine; *z; z++){ if( *z==zSep[0] && strncmp(z, zSep, nSep)==0 ){ @@ -2616,15 +2669,16 @@ static int SQLITE_TCLAPI DbObjCmd( } sqlite3_step(pStmt); rc = sqlite3_reset(pStmt); - free(zLine); + Tcl_SetObjLength(str, 0); if( rc!=SQLITE_OK ){ Tcl_AppendResult(interp,"Error: ", sqlite3_errmsg(pDb->db), (char*)0); zCommit = "ROLLBACK"; break; } } + Tcl_DecrRefCount(str); free(azCol); - fclose(in); + Tcl_Close(interp, in); sqlite3_finalize(pStmt); (void)sqlite3_exec(pDb->db, zCommit, 0, 0, 0); @@ -2658,7 +2712,8 @@ static int SQLITE_TCLAPI DbObjCmd( Tcl_Obj *pValue = 0; unsigned char *pBA; unsigned char *pData; - int len, xrc; + Tcl_Size len; + int xrc; sqlite3_int64 mxSize = 0; int i; int isReadonly = 0; @@ -2953,7 +3008,7 @@ deserialize_error: } pFunc->pScript = pScript; Tcl_IncrRefCount(pScript); - pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript); + pFunc->useEvalObjv = safeToUseEvalObjv(pScript); pFunc->eType = eType; rc = sqlite3_create_function(pDb->db, zName, nArg, flags, pFunc, tclSqlFunc, 0, 0); @@ -3029,7 +3084,7 @@ deserialize_error: return TCL_ERROR; } if( objc==3 ){ - int len; + Tcl_Size len; char *zNull = Tcl_GetStringFromObj(objv[2], &len); if( pDb->zNull ){ Tcl_Free(pDb->zNull); @@ -3083,7 +3138,7 @@ deserialize_error: #endif }else if( objc==4 ){ char *zProgress; - int len; + Tcl_Size len; int N; if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &N) ){ return TCL_ERROR; @@ -3129,7 +3184,7 @@ deserialize_error: } }else{ char *zProfile; - int len; + Tcl_Size len; if( pDb->zProfile ){ Tcl_Free(pDb->zProfile); } @@ -3340,7 +3395,7 @@ deserialize_error: } }else{ char *zTrace; - int len; + Tcl_Size len; if( pDb->zTrace ){ Tcl_Free(pDb->zTrace); } @@ -3380,7 +3435,7 @@ deserialize_error: } }else{ char *zTraceV2; - int len; + Tcl_Size len; Tcl_WideInt wMask = 0; if( objc==4 ){ static const char *TTYPE_strs[] = { @@ -3389,7 +3444,7 @@ deserialize_error: enum TTYPE_enum { TTYPE_STMT, TTYPE_PROFILE, TTYPE_ROW, TTYPE_CLOSE }; - int i; + Tcl_Size i; if( TCL_OK!=Tcl_ListObjLength(interp, objv[3], &len) ){ return TCL_ERROR; } @@ -3942,7 +3997,7 @@ static int SQLITE_TCLAPI DbMain( ** The EXTERN macros are required by TCL in order to work on windows. */ EXTERN int Sqlite3_Init(Tcl_Interp *interp){ - int rc = Tcl_InitStubs(interp, "8.4", 0) ? TCL_OK : TCL_ERROR; + int rc = Tcl_InitStubs(interp, "8.5-", 0) ? TCL_OK : TCL_ERROR; if( rc==TCL_OK ){ Tcl_CreateObjCommand(interp, "sqlite3", (Tcl_ObjCmdProc*)DbMain, 0, 0); #ifndef SQLITE_3_SUFFIX_ONLY @@ -3966,14 +4021,27 @@ EXTERN int Tclsqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; } EXTERN int Sqlite3_SafeInit(Tcl_Interp *interp){ return TCL_ERROR; } EXTERN int Sqlite3_SafeUnload(Tcl_Interp *interp, int flags){return TCL_ERROR;} +/* +** Versions of all of the above entry points that omit the "3" at the end +** of the name. Years ago (circa 2004) the "3" was necessary to distinguish +** SQLite version 3 from Sqlite version 2. But two decades have elapsed. +** SQLite2 is not longer a conflict. So it is ok to omit the "3". +** +** Omitting the "3" helps TCL find the entry point. +*/ +EXTERN int Sqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp);} +EXTERN int Tclsqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); } +EXTERN int Sqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; } +EXTERN int Tclsqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; } +EXTERN int Sqlite_SafeInit(Tcl_Interp *interp){ return TCL_ERROR; } +EXTERN int Sqlite_SafeUnload(Tcl_Interp *interp, int flags){return TCL_ERROR;} +/* Also variants with a lowercase "s". I'm told that these are +** deprecated in Tcl9, but they continue to be included for backwards +** compatibility. */ +EXTERN int sqlite3_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp);} +EXTERN int sqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp);} -#ifndef SQLITE_3_SUFFIX_ONLY -int Sqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); } -int Tclsqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); } -int Sqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; } -int Tclsqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; } -#endif /* ** If the TCLSH macro is defined, add code to make a stand-alone program. @@ -3981,12 +4049,29 @@ int Tclsqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; } #if defined(TCLSH) /* This is the main routine for an ordinary TCL shell. If there are -** are arguments, run the first argument as a script. Otherwise, -** read TCL commands from standard input +** arguments, run the first argument as a script. Otherwise, read TCL +** commands from standard input */ static const char *tclsh_main_loop(void){ static const char zMainloop[] = "if {[llength $argv]>=1} {\n" +#ifdef WIN32 + "set new [list]\n" + "foreach arg $argv {\n" + "if {[string match -* $arg] || [file exists $arg]} {\n" + "lappend new $arg\n" + "} else {\n" + "set once 0\n" + "foreach match [lsort [glob -nocomplain $arg]] {\n" + "lappend new $match\n" + "set once 1\n" + "}\n" + "if {!$once} {lappend new $arg}\n" + "}\n" + "}\n" + "set argv $new\n" + "unset new\n" +#endif "set argv0 [lindex $argv 0]\n" "set argv [lrange $argv 1 end]\n" "source $argv0\n" |