1/* 2 * tclInitScript.h -- 3 * 4 * This file contains Unix & Windows common init script 5 * It is not used on the Mac. (the mac init script is in tclMacInit.c) 6 * 7 * Copyright (c) 1998 Sun Microsystems, Inc. 8 * Copyright (c) 1999 by Scriptics Corporation. 9 * All rights reserved. 10 * 11 * RCS: @(#) $Id: tclInitScript.h,v 1.13 2001/09/10 21:06:55 dgp Exp $ 12 */ 13 14/* 15 * In order to find init.tcl during initialization, the following script 16 * is invoked by Tcl_Init(). It looks in several different directories: 17 * 18 * $tcl_library - can specify a primary location, if set 19 * no other locations will be checked 20 * 21 * $env(TCL_LIBRARY) - highest priority so user can always override 22 * the search path unless the application has 23 * specified an exact directory above 24 * 25 * $tclDefaultLibrary - this value is initialized by TclPlatformInit 26 * from a static C variable that was set at 27 * compile time 28 * 29 * $tcl_libPath - this value is initialized by a call to 30 * TclGetLibraryPath called from Tcl_Init. 31 * 32 * The first directory on this path that contains a valid init.tcl script 33 * will be set as the value of tcl_library. 34 * 35 * Note that this entire search mechanism can be bypassed by defining an 36 * alternate tclInit procedure before calling Tcl_Init(). 37 */ 38 39static char initScript[] = "if {[info proc tclInit]==\"\"} {\n\ 40 proc tclInit {} {\n\ 41 global tcl_libPath tcl_library errorInfo\n\ 42 global env tclDefaultLibrary\n\ 43 rename tclInit {}\n\ 44 set errors {}\n\ 45 set dirs {}\n\ 46 if {[info exists tcl_library]} {\n\ 47 lappend dirs $tcl_library\n\ 48 } else {\n\ 49 if {[info exists env(TCL_LIBRARY)]} {\n\ 50 lappend dirs $env(TCL_LIBRARY)\n\ 51 }\n\ 52 catch {\n\ 53 lappend dirs $tclDefaultLibrary\n\ 54 unset tclDefaultLibrary\n\ 55 }\n\ 56 set dirs [concat $dirs $tcl_libPath]\n\ 57 }\n\ 58 foreach i $dirs {\n\ 59 set tcl_library $i\n\ 60 set tclfile [file join $i init.tcl]\n\ 61 if {[file exists $tclfile]} {\n\ 62 if {![catch {uplevel #0 [list source $tclfile]} msg]} {\n\ 63 return\n\ 64 } else {\n\ 65 append errors \"$tclfile: $msg\n$errorInfo\n\"\n\ 66 }\n\ 67 }\n\ 68 }\n\ 69 set msg \"Can't find a usable init.tcl in the following directories: \n\"\n\ 70 append msg \" $dirs\n\n\"\n\ 71 append msg \"$errors\n\n\"\n\ 72 append msg \"This probably means that Tcl wasn't installed properly.\n\"\n\ 73 error $msg\n\ 74 }\n\ 75}\n\ 76tclInit"; 77 78 79/* 80 * A pointer to a string that holds an initialization script that if non-NULL 81 * is evaluated in Tcl_Init() prior to the the built-in initialization script 82 * above. This variable can be modified by the procedure below. 83 */ 84 85static char * tclPreInitScript = NULL; 86 87 88/* 89 *---------------------------------------------------------------------- 90 * 91 * TclSetPreInitScript -- 92 * 93 * This routine is used to change the value of the internal 94 * variable, tclPreInitScript. 95 * 96 * Results: 97 * Returns the current value of tclPreInitScript. 98 * 99 * Side effects: 100 * Changes the way Tcl_Init() routine behaves. 101 * 102 *---------------------------------------------------------------------- 103 */ 104 105char * 106TclSetPreInitScript (string) 107 char *string; /* Pointer to a script. */ 108{ 109 char *prevString = tclPreInitScript; 110 tclPreInitScript = string; 111 return(prevString); 112} 113