tcl/generic/tclInitScript.h

   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$
  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
  39 static 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\
  76 tclInit";
  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
  85 static char *          tclPreInitScript = NULL;
  86
  87 \f
  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
 105 char *
 106 TclSetPreInitScript (string)
 107     char *string;               /* Pointer to a script. */
 108 {
 109     char *prevString = tclPreInitScript;
 110     tclPreInitScript = string;
 111     return(prevString);
 112 }