os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclInitScript.h
changeset 0 bde4ae8d615e
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclInitScript.h	Fri Jun 15 03:10:57 2012 +0200
     1.3 @@ -0,0 +1,112 @@
     1.4 +/* 
     1.5 + * tclInitScript.h --
     1.6 + *
     1.7 + *	This file contains Unix & Windows common init script
     1.8 + *      It is not used on the Mac. (the mac init script is in tclMacInit.c)
     1.9 + *
    1.10 + * Copyright (c) 1998 Sun Microsystems, Inc.
    1.11 + * Copyright (c) 1999 by Scriptics Corporation.
    1.12 + * All rights reserved.
    1.13 + *
    1.14 + * RCS: @(#) $Id: tclInitScript.h,v 1.13 2001/09/10 21:06:55 dgp Exp $
    1.15 + */
    1.16 +
    1.17 +/*
    1.18 + * In order to find init.tcl during initialization, the following script
    1.19 + * is invoked by Tcl_Init().  It looks in several different directories:
    1.20 + *
    1.21 + *	$tcl_library		- can specify a primary location, if set
    1.22 + *				  no other locations will be checked
    1.23 + *
    1.24 + *	$env(TCL_LIBRARY)	- highest priority so user can always override
    1.25 + *				  the search path unless the application has
    1.26 + *				  specified an exact directory above
    1.27 + *
    1.28 + *	$tclDefaultLibrary	- this value is initialized by TclPlatformInit
    1.29 + *				  from a static C variable that was set at
    1.30 + *				  compile time
    1.31 + *
    1.32 + *	$tcl_libPath		- this value is initialized by a call to
    1.33 + *				  TclGetLibraryPath called from Tcl_Init.
    1.34 + *
    1.35 + * The first directory on this path that contains a valid init.tcl script
    1.36 + * will be set as the value of tcl_library.
    1.37 + *
    1.38 + * Note that this entire search mechanism can be bypassed by defining an
    1.39 + * alternate tclInit procedure before calling Tcl_Init().
    1.40 + */
    1.41 +
    1.42 +static char initScript[] = "if {[info proc tclInit]==\"\"} {\n\
    1.43 +  proc tclInit {} {\n\
    1.44 +    global tcl_libPath tcl_library errorInfo\n\
    1.45 +    global env tclDefaultLibrary\n\
    1.46 +    rename tclInit {}\n\
    1.47 +    set errors {}\n\
    1.48 +    set dirs {}\n\
    1.49 +    if {[info exists tcl_library]} {\n\
    1.50 +	lappend dirs $tcl_library\n\
    1.51 +    } else {\n\
    1.52 +	if {[info exists env(TCL_LIBRARY)]} {\n\
    1.53 +	    lappend dirs $env(TCL_LIBRARY)\n\
    1.54 +	}\n\
    1.55 +	catch {\n\
    1.56 +	    lappend dirs $tclDefaultLibrary\n\
    1.57 +	    unset tclDefaultLibrary\n\
    1.58 +	}\n\
    1.59 +        set dirs [concat $dirs $tcl_libPath]\n\
    1.60 +    }\n\
    1.61 +    foreach i $dirs {\n\
    1.62 +	set tcl_library $i\n\
    1.63 +	set tclfile [file join $i init.tcl]\n\
    1.64 +	if {[file exists $tclfile]} {\n\
    1.65 +	    if {![catch {uplevel #0 [list source $tclfile]} msg]} {\n\
    1.66 +		return\n\
    1.67 +	    } else {\n\
    1.68 +		append errors \"$tclfile: $msg\n$errorInfo\n\"\n\
    1.69 +	    }\n\
    1.70 +	}\n\
    1.71 +    }\n\
    1.72 +    set msg \"Can't find a usable init.tcl in the following directories: \n\"\n\
    1.73 +    append msg \"    $dirs\n\n\"\n\
    1.74 +    append msg \"$errors\n\n\"\n\
    1.75 +    append msg \"This probably means that Tcl wasn't installed properly.\n\"\n\
    1.76 +    error $msg\n\
    1.77 +  }\n\
    1.78 +}\n\
    1.79 +tclInit";
    1.80 +
    1.81 +
    1.82 +/*
    1.83 + * A pointer to a string that holds an initialization script that if non-NULL
    1.84 + * is evaluated in Tcl_Init() prior to the the built-in initialization script
    1.85 + * above.  This variable can be modified by the procedure below.
    1.86 + */
    1.87 + 
    1.88 +static char *          tclPreInitScript = NULL;
    1.89 +
    1.90 +
    1.91 +/*
    1.92 + *----------------------------------------------------------------------
    1.93 + *
    1.94 + * TclSetPreInitScript --
    1.95 + *
    1.96 + *	This routine is used to change the value of the internal
    1.97 + *	variable, tclPreInitScript.
    1.98 + *
    1.99 + * Results:
   1.100 + *	Returns the current value of tclPreInitScript.
   1.101 + *
   1.102 + * Side effects:
   1.103 + *	Changes the way Tcl_Init() routine behaves.
   1.104 + *
   1.105 + *----------------------------------------------------------------------
   1.106 + */
   1.107 +
   1.108 +char *
   1.109 +TclSetPreInitScript (string)
   1.110 +    char *string;		/* Pointer to a script. */
   1.111 +{
   1.112 +    char *prevString = tclPreInitScript;
   1.113 +    tclPreInitScript = string;
   1.114 +    return(prevString);
   1.115 +}