Compare commits
31
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
018bd0c8f3 | ||
|
|
4805095ce3 | ||
|
|
127270e9b8 | ||
|
|
18abd48d10 | ||
|
|
c33d9ad2b8 | ||
|
|
11593d64b8 | ||
|
|
e4a0b9dbfd | ||
|
|
bb770e33f8 | ||
|
|
2ca180563f | ||
|
|
d048128004 | ||
|
|
eecece2afe | ||
|
|
74c7068a25 | ||
|
|
59360240b3 | ||
|
|
91ba235b3c | ||
|
|
d13fe1e431 | ||
|
|
f361c1805c | ||
|
|
52b8ad45d1 | ||
|
|
9b6c85d82e | ||
|
|
88b8fc30a2 | ||
|
|
1a0463ea04 | ||
|
|
cab91124b4 | ||
|
|
8d9ea7c132 | ||
|
|
c5558280d7 | ||
|
|
3913f5f7ae | ||
|
|
e8c69aa654 | ||
|
|
b2b37d97cf | ||
|
|
4796adf5cb | ||
|
|
2c02c2ae5d | ||
|
|
ef824b7395 | ||
|
|
2930daf68c | ||
|
|
0481e3ca74 |
@@ -83,6 +83,10 @@ non-zero means that only the specified \fIversion\fR is acceptable.
|
||||
\fBTcl_InitStubs\fR returns a string containing the actual version
|
||||
of Tcl satisfying the request, or NULL if the Tcl version is not
|
||||
acceptable, does not support stubs, or any other error condition occurred.
|
||||
.PP
|
||||
If \fBTcl_InitStubs\fR is called with as first argument the
|
||||
pseudo interpreter returned by \fBTcl_InitSubsystems(0)\fR, then
|
||||
the \fIversion\fR and \fIexact\fR parameters have no effect.
|
||||
.SH "SEE ALSO"
|
||||
Tk_InitStubs
|
||||
.SH KEYWORDS
|
||||
|
||||
@@ -0,0 +1,122 @@
|
||||
'\"
|
||||
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
|
||||
'\"
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.so man.macros
|
||||
.TH Tcl_InitSubsystems 3 8.6.1 Tcl "Tcl Library Procedures"
|
||||
.BS
|
||||
.SH NAME
|
||||
Tcl_InitSubsystems \- initialize the Tcl library.
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
.sp
|
||||
Tcl_Interp *
|
||||
\fBTcl_InitSubsystems\fR(\fIflags\fR, \fI...\fR)
|
||||
.SH ARGUMENTS
|
||||
.AS int flags
|
||||
.AP int flags in
|
||||
Any combination of flags which indicate whether a custom panicProc
|
||||
is registered, a custom initialization function is executed and/or
|
||||
a real interpreter is created.
|
||||
The value 0 can be used if Tcl is used as utility library only.
|
||||
.BE
|
||||
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
The \fBTcl_InitSubsystems\fR procedure initializes the Tcl
|
||||
library. This procedure is typically invoked as the very
|
||||
first thing in the application's main program.
|
||||
Its \fBflags\fR argument controls exactly what is initialized,
|
||||
and what additional arguments are expected.
|
||||
.PP
|
||||
The call \fBTcl_InitSubsystems(0)\fR does the same as
|
||||
\fBTcl_FindExecutable(NULL)\fR, except that a Tcl_Interp *
|
||||
is returned which can be used only by \fBTcl_InitStubs\fR
|
||||
to initialize the stub table. This opens up the Tcl Stub
|
||||
technology for Tcl embedders, which now can dynamically
|
||||
load the Tcl shared library and use functions in it
|
||||
without ever creating an interpreter. E.g. the
|
||||
following code can be compiled with -DUSE_TCL_STUBS:
|
||||
.CS
|
||||
Tcl_Interp *interp, *(*initSubSystems)(int, ...);
|
||||
const char *version;
|
||||
void *handle = dlopen("libtcl8.6.so", RTLD_NOW|RTLD_LOCAL);
|
||||
initSubSystems = dlsym(handle, "Tcl_InitSubsystems");
|
||||
version = Tcl_InitStubs(initSubSystems(0), NULL, 0);
|
||||
/* At this point, Tcl C API calls without interp are ready for use */
|
||||
interp = Tcl_CreateInterp(); /* Now we have a real interpreter */
|
||||
Tcl_InitStubs(interp, version, 0); /* Initialize the stub table again */
|
||||
.CE
|
||||
This is equivalent to (without dynamical loading)
|
||||
.CS
|
||||
Tcl_Interp *interp;
|
||||
const char *version;
|
||||
version = Tcl_InitStubs(Tcl_InitSubSystems(0), NULL, 0);
|
||||
/* At this point, Tcl C API calls without interp are ready for use */
|
||||
interp = Tcl_CreateInterp(); /* Now we have a real interpreter */
|
||||
Tcl_InitStubs(interp, version, 0); /* Initialize the stub table again */
|
||||
.CE
|
||||
The function \fBTcl_CreateInterp\fR, or any other Tcl function you
|
||||
would like to call, no longer needs to be searched for in the
|
||||
shared library. It can be called directly through the stub table.
|
||||
Note that the stub table needs to be initialized twice, in order
|
||||
to be sure that you can call all functions without limitations
|
||||
after the real interpreter is created.
|
||||
.PP
|
||||
If you supply the flag \fBTCL_INIT_PANIC\fR to \fBTcl_InitSubsystems\fR,
|
||||
the function expects an additional argument, a custom panicProc.
|
||||
This is equivalent to calling \fBTcl_SetPanicProc\fR immediately
|
||||
before \fBTcl_InitSubsystems\fR, except that you possibly cannot do
|
||||
that yet if it requires an initialized stub table. Of course you
|
||||
could call \fBTcl_SetPanicProc\fR immediately after \fBTcl_InitSubsystems\fR,
|
||||
but then panics which could be produced by the initialization
|
||||
itself still use the default panic procedure.
|
||||
.PP
|
||||
If you supply one of the flags \fBTCL_INIT_CREATE\fR, \fBTCL_INIT_CREATE_UTF8\fR or
|
||||
\fBTCL_INIT_CREATE_UNICODE\fR to \fBTcl_InitSubsystems\fR, the function
|
||||
gets two additional parameters, argc and argv. Then a real
|
||||
Tcl interpreter will be created. If argc > 0 then the variables
|
||||
\fBargc\fR and \fBargv\fR will be set in this interpreter. The 3
|
||||
variants assume a different encoding for the arguments, except for
|
||||
\fIargv[0]\fR which is always assumed to be in the system encoding.
|
||||
So, the above example code could be simplified to:
|
||||
.CS
|
||||
Tcl_Interp *interp = Tcl_InitSubSystems(TCL_INIT_CREATE, 0, NULL);
|
||||
Tcl_InitStubs(interp, TCL_VERSION, 0); /* initialize the stub table */
|
||||
.CE
|
||||
.PP
|
||||
If you supply the flag \fBTCL_INIT_CUSTOM\fR to \fBTcl_InitSubsystems\fR,
|
||||
the function expects two additional arguments: ClientData and a
|
||||
custom proc. The proc will be supplied two arguments, the (pseudo
|
||||
or real) Tcl interpreter and ClientData. The given function will
|
||||
be executed just before the encodings are initialized. Remember that
|
||||
encodings other than UTF-8, unicode and iso8859-1 are not yet
|
||||
available when the customProc is run, the system encoding is not
|
||||
determined, and no variables are set in the interpreter yet. This
|
||||
means that no libaries/packages can be found yet, it is typically
|
||||
only used for calling functions like \fBTcl_SetEncodingSearchPath\fR
|
||||
and \fBTcl_FSRegister\fR.
|
||||
.PP
|
||||
If multiple flags are combined, the \fBpanicProc\fR argument always comes
|
||||
first, followed by argc/argv followed by clientData and the custom proc
|
||||
in that order.
|
||||
.PP
|
||||
The reason for \fBargv[0]\fR always using the system encoding is that this way,
|
||||
argv[0] can be derived directly from the main() (or mainw, on Windows)
|
||||
arguments without any processing. \fBTCL_INIT_CREATE_UNICODE\fR is really only
|
||||
useful on Windows. But on Windows, the argv[0] parameter is not used for
|
||||
determining the value of [info executable] anyway. Modern UNIX system already
|
||||
have UTF-8 as system encoding, so \fBTCL_INIT_CREATE_UTF8\fR would have the same
|
||||
effect as \fBTCL_INIT_CREATE\fR, only slightly faster. Other parameters can be
|
||||
preprocessed at will by the application, and if the application uses unicode
|
||||
or UTF-8 internally there is no need to convert it back to the system encoding.
|
||||
.PP
|
||||
The interpreter returned by Tcl_InitSubsystems(0) or passed to the
|
||||
TCL_INIT_CUSTOM function cannot be passed to any other function than
|
||||
Tcl_InitStubs(). Tcl functions with an "interp" argument can only
|
||||
be called if the function supports passing NULL.
|
||||
.SH KEYWORDS
|
||||
binary, executable file
|
||||
+12
-1
@@ -2409,13 +2409,24 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
|
||||
* TODO - tommath stubs export goes here!
|
||||
*/
|
||||
|
||||
/* Tcl_InitSubsystems, see TIP #414 */
|
||||
|
||||
#define TCL_INIT_PANIC (1) /* Set Panic proc */
|
||||
#define TCL_INIT_CREATE (6) /* Call Tcl_CreateInterp(), and set argc/argv */
|
||||
#define TCL_INIT_CREATE_UNICODE (2) /* The same, but argv is in unicode */
|
||||
#define TCL_INIT_CREATE_UTF8 (4) /* The same, but argv is in utf-8 */
|
||||
#define TCL_INIT_CUSTOM (8) /* Do custom initialization. */
|
||||
|
||||
EXTERN Tcl_Interp *Tcl_InitSubsystems(int flags, ...);
|
||||
|
||||
/*
|
||||
* Public functions that are not accessible via the stubs table.
|
||||
* Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171]
|
||||
*/
|
||||
|
||||
#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
|
||||
(Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)()))
|
||||
(Tcl_InitSubsystems(),Tcl_SetInitialEncodings(), \
|
||||
Tcl_FindExecutable(argv[0]), Tcl_CreateInterp()))
|
||||
EXTERN void Tcl_MainEx(int argc, char **argv,
|
||||
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
|
||||
EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
|
||||
|
||||
+76
-4
@@ -1411,21 +1411,93 @@ Tcl_UtfToExternal(
|
||||
/*
|
||||
*---------------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_FindExecutable --
|
||||
* Tcl_InitSubsystems/Tcl_FindExecutable --
|
||||
*
|
||||
* This function computes the absolute path name of the current
|
||||
* application, given its argv[0] value.
|
||||
* This function initializes everything needed for the Tcl library
|
||||
* to be able to operate.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* The absolute pathname for the application is computed and stored to be
|
||||
* returned later be [info nameofexecutable].
|
||||
* returned later by [info nameofexecutable]. The system encoding is
|
||||
* determined and stored to be returned later by [encoding system]
|
||||
*
|
||||
*---------------------------------------------------------------------------
|
||||
*/
|
||||
MODULE_SCOPE const TclStubs tclStubs;
|
||||
|
||||
/* Dummy const structure returned by Tcl_InitSubsystems,
|
||||
* which looks like an Tcl_Interp, but in reality is not.
|
||||
* It contains just enough for Tcl_InitStubs to be able
|
||||
* to initialize the stub table. */
|
||||
static const struct {
|
||||
/* A real interpreter has interp->result/freeProc here: */
|
||||
const char version[sizeof(struct {char *r; void (*f)(void);})];
|
||||
int errorLine;
|
||||
const struct TclStubs *stubTable;
|
||||
} dummyInterp = {
|
||||
TCL_PATCH_LEVEL, TCL_STUB_MAGIC, &tclStubs
|
||||
};
|
||||
|
||||
#undef Tcl_FindExecutable
|
||||
Tcl_Interp *
|
||||
Tcl_InitSubsystems(int flags, ...)
|
||||
{
|
||||
va_list argList;
|
||||
int argc = 0;
|
||||
void **argv = NULL;
|
||||
Tcl_Interp *interp = (Tcl_Interp *) &dummyInterp;
|
||||
|
||||
va_start(argList, flags);
|
||||
if (flags & TCL_INIT_PANIC) {
|
||||
Tcl_SetPanicProc(va_arg(argList, Tcl_PanicProc *));
|
||||
}
|
||||
TclInitSubsystems();
|
||||
if (flags & TCL_INIT_CREATE) {
|
||||
argc = va_arg(argList, int);
|
||||
argv = va_arg(argList, void **);
|
||||
interp = Tcl_CreateInterp();
|
||||
}
|
||||
if (flags & TCL_INIT_CUSTOM) {
|
||||
ClientData clientData = va_arg(argList, ClientData);
|
||||
void (*fn)(Tcl_Interp *, ClientData) = va_arg(argList,
|
||||
void (*)(Tcl_Interp *, ClientData));
|
||||
fn(interp, clientData);
|
||||
}
|
||||
va_end(argList);
|
||||
|
||||
TclpSetInitialEncodings();
|
||||
TclpFindExecutable(argv ? argv[0] : NULL);
|
||||
if ((flags&TCL_INIT_CREATE) && (--argc >= 0)) {
|
||||
Tcl_Obj *argvPtr;
|
||||
|
||||
Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY);
|
||||
argvPtr = Tcl_NewListObj(argc, NULL);
|
||||
if ((flags & TCL_INIT_CREATE) == TCL_INIT_CREATE_UTF8) {
|
||||
while (argc--) {
|
||||
Tcl_ListObjAppendElement(NULL, argvPtr,
|
||||
Tcl_NewStringObj(*++argv, -1));
|
||||
}
|
||||
} else if ((flags & TCL_INIT_CREATE) == TCL_INIT_CREATE_UNICODE) {
|
||||
while (argc--) {
|
||||
Tcl_ListObjAppendElement(NULL, argvPtr,
|
||||
Tcl_NewUnicodeObj(*++argv, -1));
|
||||
}
|
||||
} else {
|
||||
Tcl_DString ds;
|
||||
|
||||
while (argc--) {
|
||||
Tcl_ExternalToUtfDString(NULL, *++argv, -1, &ds);
|
||||
Tcl_ListObjAppendElement(NULL, argvPtr, TclDStringToObj(&ds));
|
||||
}
|
||||
}
|
||||
Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
|
||||
}
|
||||
return interp;
|
||||
}
|
||||
|
||||
void
|
||||
Tcl_FindExecutable(
|
||||
const char *argv0) /* The value of the application's argv[0]
|
||||
|
||||
+30
-25
@@ -73,37 +73,42 @@ Tcl_InitStubs(
|
||||
return NULL;
|
||||
}
|
||||
|
||||
actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData);
|
||||
if (actualVersion == NULL) {
|
||||
return NULL;
|
||||
}
|
||||
if (exact) {
|
||||
const char *p = version;
|
||||
int count = 0;
|
||||
|
||||
while (*p) {
|
||||
count += !isDigit(*p++);
|
||||
if(iPtr->errorLine == TCL_STUB_MAGIC) {
|
||||
actualVersion = (const char *)interp;
|
||||
tclStubsPtr = stubsPtr;
|
||||
} else {
|
||||
actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData);
|
||||
if (actualVersion == NULL) {
|
||||
return NULL;
|
||||
}
|
||||
if (count == 1) {
|
||||
const char *q = actualVersion;
|
||||
if (exact) {
|
||||
const char *p = version;
|
||||
int count = 0;
|
||||
|
||||
p = version;
|
||||
while (*p && (*p == *q)) {
|
||||
p++; q++;
|
||||
while (*p) {
|
||||
count += !isDigit(*p++);
|
||||
}
|
||||
if (*p || isDigit(*q)) {
|
||||
/* Construct error message */
|
||||
stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
|
||||
return NULL;
|
||||
}
|
||||
} else {
|
||||
actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
|
||||
if (actualVersion == NULL) {
|
||||
return NULL;
|
||||
if (count == 1) {
|
||||
const char *q = actualVersion;
|
||||
|
||||
p = version;
|
||||
while (*p && (*p == *q)) {
|
||||
p++; q++;
|
||||
}
|
||||
if (*p || isDigit(*q)) {
|
||||
/* Construct error message */
|
||||
stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
|
||||
return NULL;
|
||||
}
|
||||
} else {
|
||||
actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
|
||||
if (actualVersion == NULL) {
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
}
|
||||
tclStubsPtr = (const TclStubs *)pkgData;
|
||||
}
|
||||
tclStubsPtr = (TclStubs *)pkgData;
|
||||
|
||||
if (tclStubsPtr->hooks) {
|
||||
tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
|
||||
|
||||
Reference in New Issue
Block a user