/* * CDE - Common Desktop Environment * * Copyright (c) 1993-2012, The Open Group. All rights reserved. * * These libraries and programs are free software; you can * redistribute them and/or modify them under the terms of the GNU * Lesser General Public License as published by the Free Software * Foundation; either version 2 of the License, or (at your option) * any later version. * * These libraries and programs are distributed in the hope that * they will be useful, but WITHOUT ANY WARRANTY; without even the * implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR * PURPOSE. See the GNU Lesser General Public License for more * details. * * You should have received a copy of the GNU Lesser General Public * License along with these librararies and programs; if not, write * to the Free Software Foundation, Inc., 51 Franklin Street, Fifth * Floor, Boston, MA 02110-1301 USA */ /* $XConsortium: tclUnixInit.c /main/2 1996/08/08 14:46:42 cde-hp $ */ /* * 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.10 96/03/12 09:05:59 */ #include "tclInt.h" #include "tclPort.h" #ifndef NO_UNAME # include #endif #if defined(__FreeBSD__) #include #endif /* * Default directory in which to look for libraries: */ static char defaultLibraryDir[200] = TCL_LIBRARY; /* * 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 init {} {\n\ global tcl_library tcl_version tcl_patchLevel env\n\ rename init {}\n\ set dirs {}\n\ if [info exists env(TCL_LIBRARY)] {\n\ lappend dirs $env(TCL_LIBRARY)\n\ }\n\ lappend dirs [info library]\n\ lappend dirs [file dirname [file dirname [info nameofexecutable]]]/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 [file dirname [pwd]]]/$lib/library\n\ lappend dirs [file dirname [pwd]]/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\ init"; /* *---------------------------------------------------------------------- * * 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_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 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); }