diff options
author | dgp <dgp@noemail.net> | 2004-06-11 21:30:04 (GMT) |
---|---|---|
committer | dgp <dgp@noemail.net> | 2004-06-11 21:30:04 (GMT) |
commit | 95179c734d2d051a4d7ec8b2da71a2e5b61b8b4e (patch) | |
tree | bc418bb1e1a10d6b91c844443c129679ccfbbbd1 /generic/tclMain.c | |
parent | 6c6afb90939815b733845d8bcb2f175c40ef06ca (diff) | |
download | tcl-95179c734d2d051a4d7ec8b2da71a2e5b61b8b4e.zip tcl-95179c734d2d051a4d7ec8b2da71a2e5b61b8b4e.tar.gz tcl-95179c734d2d051a4d7ec8b2da71a2e5b61b8b4e.tar.bz2 |
* unix/tclUnixInit.c: The routines Tcl_Init() and TclSourceRCFile()
* win/tclWinInit.c: had identical implementations for both win and
* generic/tclInterp.c: unix. Moved to a single generic implementation.
* generic/tclMain.c:
* library/init.tcl:
* generic/tclInitScript.h (removed):
* unix/Makefile.in:
* win/tcl.dsp:
FossilOrigin-Name: 406f195e757db44b10d9e08b7b4d9d0da5a71574
Diffstat (limited to 'generic/tclMain.c')
-rw-r--r-- | generic/tclMain.c | 62 |
1 files changed, 59 insertions, 3 deletions
diff --git a/generic/tclMain.c b/generic/tclMain.c index f1ca13f..1e736fe 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclMain.c,v 1.26 2004/05/13 12:59:23 dkf Exp $ + * RCS: @(#) $Id: tclMain.c,v 1.27 2004/06/11 21:30:08 dgp Exp $ */ #include "tclInt.h" @@ -237,10 +237,66 @@ CONST char *TclGetStartupScriptFileName() } return Tcl_GetString(path); } - -/* +/*---------------------------------------------------------------------- + * + * 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; + CONST char *fileName; + Tcl_Channel errChannel; + + fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY); + if (fileName != NULL) { + Tcl_Channel c; + CONST char *fullName; + + Tcl_DStringInit(&temp); + fullName = Tcl_TranslateFileName(interp, fileName, &temp); + if (fullName == NULL) { + /* + * Couldn't translate the file name (e.g. it referred to a + * bogus user or there was no HOME environment variable). + * Just do nothing. + */ + } 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_WriteObj(errChannel, Tcl_GetObjResult(interp)); + Tcl_WriteChars(errChannel, "\n", 1); + } + } + } + } + Tcl_DStringFree(&temp); + } +} + +/*---------------------------------------------------------------------- * * Tcl_Main -- * |