247 lines
6.4 KiB
C
247 lines
6.4 KiB
C
|
/*
|
|||
|
|
* tclUnixInit.c --
|
|||
|
|
*
|
|||
|
|
* Contains the Unix-specific interpreter initialization functions.
|
|||
|
|
*
|
|||
|
|
* 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.
|
|||
|
|
*
|
|||
|
|
* SCCS: @(#) tclUnixInit.c 1.19 96/10/04 10:28:56
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
#include "tclInt.h"
|
|||
|
|
#include "tclPort.h"
|
|||
|
|
#if defined(__FreeBSD__)
|
|||
|
|
# include <floatingpoint.h>
|
|||
|
|
#endif
|
|||
|
|
#if defined(__bsdi__)
|
|||
|
|
# include <sys/param.h>
|
|||
|
|
# if _BSDI_VERSION > 199501
|
|||
|
|
# include <dlfcn.h>
|
|||
|
|
# endif
|
|||
|
|
#endif
|
|||
|
|
|
|||
|
|
/*
|
|||
|
|
* Default directory in which to look for Tcl library scripts. The
|
|||
|
|
* symbol is defined by Makefile.
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
static char defaultLibraryDir[200] = TCL_LIBRARY;
|
|||
|
|
|
|||
|
|
/*
|
|||
|
|
* Directory in which to look for packages (each package is typically
|
|||
|
|
* installed as a subdirectory of this directory). The symbol is
|
|||
|
|
* defined by Makefile.
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
static char pkgPath[200] = TCL_PACKAGE_PATH;
|
|||
|
|
|
|||
|
|
/*
|
|||
|
|
* The following string is the startup script executed in new
|
|||
|
|
* interpreters. It looks on disk in several different directories
|
|||
|
|
* for a script "init.tcl" that is compatible with this version
|
|||
|
|
* of Tcl. The init.tcl script does all of the real work of
|
|||
|
|
* initialization.
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
static char initScript[] =
|
|||
|
|
"proc tclInit {} {\n\
|
|||
|
|
global tcl_library tcl_version tcl_patchLevel env\n\
|
|||
|
|
rename tclInit {}\n\
|
|||
|
|
set dirs {}\n\
|
|||
|
|
if [info exists env(TCL_LIBRARY)] {\n\
|
|||
|
|
lappend dirs $env(TCL_LIBRARY)\n\
|
|||
|
|
}\n\
|
|||
|
|
lappend dirs [info library]\n\
|
|||
|
|
set parentDir [file dirname [file dirname [info nameofexecutable]]]\n\
|
|||
|
|
lappend dirs $parentDir/lib/tcl$tcl_version\n\
|
|||
|
|
if [string match {*[ab]*} $tcl_patchLevel] {\n\
|
|||
|
|
set lib tcl$tcl_patchLevel\n\
|
|||
|
|
} else {\n\
|
|||
|
|
set lib tcl$tcl_version\n\
|
|||
|
|
}\n\
|
|||
|
|
lappend dirs [file dirname $parentDir]/$lib/library\n\
|
|||
|
|
lappend dirs $parentDir/library\n\
|
|||
|
|
foreach i $dirs {\n\
|
|||
|
|
set tcl_library $i\n\
|
|||
|
|
if ![catch {uplevel #0 source $i/init.tcl}] {\n\
|
|||
|
|
return\n\
|
|||
|
|
}\n\
|
|||
|
|
}\n\
|
|||
|
|
set msg \"Can't find a usable init.tcl in the following directories: \n\"\n\
|
|||
|
|
append msg \" $dirs\n\"\n\
|
|||
|
|
append msg \"This probably means that Tcl wasn't installed properly.\n\"\n\
|
|||
|
|
error $msg\n\
|
|||
|
|
}\n\
|
|||
|
|
tclInit";
|
|||
|
|
|
|||
|
|
/*
|
|||
|
|
*----------------------------------------------------------------------
|
|||
|
|
*
|
|||
|
|
* TclPlatformInit --
|
|||
|
|
*
|
|||
|
|
* Performs Unix-specific interpreter initialization related to the
|
|||
|
|
* tcl_library and tcl_platform variables, and other platform-
|
|||
|
|
* specific things.
|
|||
|
|
*
|
|||
|
|
* Results:
|
|||
|
|
* None.
|
|||
|
|
*
|
|||
|
|
* Side effects:
|
|||
|
|
* Sets "tcl_library" and "tcl_platform" Tcl variables.
|
|||
|
|
*
|
|||
|
|
*----------------------------------------------------------------------
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
void
|
|||
|
|
TclPlatformInit(interp)
|
|||
|
|
Tcl_Interp *interp;
|
|||
|
|
{
|
|||
|
|
#ifndef NO_UNAME
|
|||
|
|
struct utsname name;
|
|||
|
|
#endif
|
|||
|
|
int unameOK;
|
|||
|
|
static int initialized = 0;
|
|||
|
|
|
|||
|
|
tclPlatform = TCL_PLATFORM_UNIX;
|
|||
|
|
Tcl_SetVar(interp, "tcl_library", defaultLibraryDir, TCL_GLOBAL_ONLY);
|
|||
|
|
Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY);
|
|||
|
|
Tcl_SetVar2(interp, "tcl_platform", "platform", "unix", TCL_GLOBAL_ONLY);
|
|||
|
|
unameOK = 0;
|
|||
|
|
#ifndef NO_UNAME
|
|||
|
|
if (uname(&name) >= 0) {
|
|||
|
|
unameOK = 1;
|
|||
|
|
Tcl_SetVar2(interp, "tcl_platform", "os", name.sysname,
|
|||
|
|
TCL_GLOBAL_ONLY);
|
|||
|
|
Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
|
|||
|
|
TCL_GLOBAL_ONLY);
|
|||
|
|
Tcl_SetVar2(interp, "tcl_platform", "machine", name.machine,
|
|||
|
|
TCL_GLOBAL_ONLY);
|
|||
|
|
}
|
|||
|
|
#endif
|
|||
|
|
if (!unameOK) {
|
|||
|
|
Tcl_SetVar2(interp, "tcl_platform", "os", "", TCL_GLOBAL_ONLY);
|
|||
|
|
Tcl_SetVar2(interp, "tcl_platform", "osVersion", "", TCL_GLOBAL_ONLY);
|
|||
|
|
Tcl_SetVar2(interp, "tcl_platform", "machine", "", TCL_GLOBAL_ONLY);
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
if (!initialized) {
|
|||
|
|
/*
|
|||
|
|
* The code below causes SIGPIPE (broken pipe) errors to
|
|||
|
|
* be ignored. This is needed so that Tcl processes don't
|
|||
|
|
* die if they create child processes (e.g. using "exec" or
|
|||
|
|
* "open") that terminate prematurely. The signal handler
|
|||
|
|
* is only set up when the first interpreter is created;
|
|||
|
|
* after this the application can override the handler with
|
|||
|
|
* a different one of its own, if it wants.
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
#ifdef SIGPIPE
|
|||
|
|
(void) signal(SIGPIPE, SIG_IGN);
|
|||
|
|
#endif /* SIGPIPE */
|
|||
|
|
|
|||
|
|
#ifdef __FreeBSD__
|
|||
|
|
fpsetround(FP_RN);
|
|||
|
|
fpsetmask(0L);
|
|||
|
|
#endif
|
|||
|
|
|
|||
|
|
#if defined(__bsdi__) && (_BSDI_VERSION > 199501)
|
|||
|
|
/*
|
|||
|
|
* Find local symbols. Don't report an error if we fail.
|
|||
|
|
*/
|
|||
|
|
(void) dlopen (NULL, RTLD_NOW);
|
|||
|
|
#endif
|
|||
|
|
initialized = 1;
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
/*
|
|||
|
|
*----------------------------------------------------------------------
|
|||
|
|
*
|
|||
|
|
* Tcl_Init --
|
|||
|
|
*
|
|||
|
|
* This procedure is typically invoked by Tcl_AppInit procedures
|
|||
|
|
* to perform additional initialization for a Tcl interpreter,
|
|||
|
|
* such as sourcing the "init.tcl" script.
|
|||
|
|
*
|
|||
|
|
* Results:
|
|||
|
|
* Returns a standard Tcl completion code and sets interp->result
|
|||
|
|
* if there is an error.
|
|||
|
|
*
|
|||
|
|
* Side effects:
|
|||
|
|
* Depends on what's in the init.tcl script.
|
|||
|
|
*
|
|||
|
|
*----------------------------------------------------------------------
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
int
|
|||
|
|
Tcl_Init(interp)
|
|||
|
|
Tcl_Interp *interp; /* Interpreter to initialize. */
|
|||
|
|
{
|
|||
|
|
return Tcl_Eval(interp, initScript);
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
/*
|
|||
|
|
*----------------------------------------------------------------------
|
|||
|
|
*
|
|||
|
|
* Tcl_SourceRCFile --
|
|||
|
|
*
|
|||
|
|
* This procedure is typically invoked by Tcl_Main of Tk_Main
|
|||
|
|
* procedure to source an application specific rc file into the
|
|||
|
|
* interpreter at startup time.
|
|||
|
|
*
|
|||
|
|
* Results:
|
|||
|
|
* None.
|
|||
|
|
*
|
|||
|
|
* Side effects:
|
|||
|
|
* Depends on what's in the rc script.
|
|||
|
|
*
|
|||
|
|
*----------------------------------------------------------------------
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
void
|
|||
|
|
Tcl_SourceRCFile(interp)
|
|||
|
|
Tcl_Interp *interp; /* Interpreter to source rc file into. */
|
|||
|
|
{
|
|||
|
|
Tcl_DString temp;
|
|||
|
|
char *fileName;
|
|||
|
|
Tcl_Channel errChannel;
|
|||
|
|
|
|||
|
|
fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
|
|||
|
|
|
|||
|
|
if (fileName != NULL) {
|
|||
|
|
Tcl_Channel c;
|
|||
|
|
char *fullName;
|
|||
|
|
|
|||
|
|
Tcl_DStringInit(&temp);
|
|||
|
|
fullName = Tcl_TranslateFileName(interp, fileName, &temp);
|
|||
|
|
if (fullName == NULL) {
|
|||
|
|
errChannel = Tcl_GetStdChannel(TCL_STDERR);
|
|||
|
|
if (errChannel) {
|
|||
|
|
Tcl_Write(errChannel, interp->result, -1);
|
|||
|
|
Tcl_Write(errChannel, "\n", 1);
|
|||
|
|
}
|
|||
|
|
} else {
|
|||
|
|
|
|||
|
|
/*
|
|||
|
|
* Test for the existence of the rc file before trying to read it.
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
|
|||
|
|
if (c != (Tcl_Channel) NULL) {
|
|||
|
|
Tcl_Close(NULL, c);
|
|||
|
|
if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
|
|||
|
|
errChannel = Tcl_GetStdChannel(TCL_STDERR);
|
|||
|
|
if (errChannel) {
|
|||
|
|
Tcl_Write(errChannel, interp->result, -1);
|
|||
|
|
Tcl_Write(errChannel, "\n", 1);
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
Tcl_DStringFree(&temp);
|
|||
|
|
}
|
|||
|
|
}
|