概要
Tclの初期化
引数
戻り値
処理
tclPreInitScript がNULLでなければ、それを
Tcl_Eval する。
その時にエラーが発生すれば、TCL_ERROR を返す。
if (tclPreInitScript != NULL) {
if (
Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
return (TCL_ERROR);
};
}
/*
* In order to find init.tcl during initialization, the following script
* is invoked by Tcl_Init(). It looks in several different directories:
*
* $tcl_library - can specify a primary location, if set, no
* other locations will be checked. This is the
* recommended way for a program that embeds
* Tcl to specifically tell Tcl where to find
* an init.tcl file.
*
* $env(TCL_LIBRARY) - highest priority so user can always override
* the search path unless the application has
* specified an exact directory above
*
* $tclDefaultLibrary - INTERNAL: This variable is set by Tcl on
* those platforms where it can determine at
* runtime the directory where it expects the
* init.tcl file to be. After [tclInit] reads
* and uses this value, it [unset]s it.
* External users of Tcl should not make use of
* the variable to customize [tclInit].
*
* $tcl_libPath - OBSOLETE: This variable is no longer set by
* Tcl itself, but [tclInit] examines it in
* case some program that embeds Tcl is
* customizing [tclInit] by setting this
* variable to a list of directories in which
* to search.
*
* [tcl::pkgconfig get scriptdir,runtime]
* - the directory determined by configure to be
* the place where Tcl's script library is to
* be installed.
*
* The first directory on this path that contains a valid init.tcl script
* will be set as the value of tcl_library.
*
* Note that this entire search mechanism can be bypassed by defining an
* alternate tclInit command before calling Tcl_Init().
*/
return Tcl_Eval(interp,
"if {[namespace which -command tclInit] eq \"\"} {\n"
" proc tclInit {} {\n"
" global tcl_libPath tcl_library env tclDefaultLibrary\n"
" rename tclInit {}\n"
" if {[info exists tcl_library]} {\n"
" set scripts {{set tcl_library}}\n"
" } else {\n"
" set scripts {}\n"
" if {[info exists env(TCL_LIBRARY)] && ($env(TCL_LIBRARY) ne {})} {\n"
" lappend scripts {set env(TCL_LIBRARY)}\n"
" lappend scripts {\n"
"if {[regexp ^tcl(.*)$ [file tail $env(TCL_LIBRARY)] -> tail] == 0} continue\n"
"if {$tail eq [info tclversion]} continue\n"
"file join [file dirname $env(TCL_LIBRARY)] tcl[info tclversion]}\n"
" }\n"
" if {[info exists tclDefaultLibrary]} {\n"
" lappend scripts {set tclDefaultLibrary}\n"
" } else {\n"
" lappend scripts {::tcl::pkgconfig get scriptdir,runtime}\n"
" }\n"
" lappend scripts {\n"
"set parentDir [file dirname [file dirname [info nameofexecutable]]]\n"
"set grandParentDir [file dirname $parentDir]\n"
"file join $parentDir lib tcl[info tclversion]} \\\n"
" {file join $grandParentDir lib tcl[info tclversion]} \\\n"
" {file join $parentDir library} \\\n"
" {file join $grandParentDir library} \\\n"
" {file join $grandParentDir tcl[info patchlevel] library} \\\n"
" {\n"
"file join [file dirname $grandParentDir] tcl[info patchlevel] library}\n"
" if {[info exists tcl_libPath]\n"
" && [catch {llength $tcl_libPath} len] == 0} {\n"
" for {set i 0} {$i < $len} {incr i} {\n"
" lappend scripts [list lindex \\$tcl_libPath $i]\n"
" }\n"
" }\n"
" }\n"
" set dirs {}\n"
" set errors {}\n"
" foreach script $scripts {\n"
" lappend dirs [eval $script]\n"
" set tcl_library [lindex $dirs end]\n"
" set tclfile [file join $tcl_library init.tcl]\n"
" if {[file exists $tclfile]} {\n"
" if {[catch {uplevel #0 [list source $tclfile]} msg opts]} {\n"
" append errors \"$tclfile: $msg\n\"\n"
" append errors \"[dict get $opts -errorinfo]\n\"\n"
" continue\n"
" }\n"
" unset -nocomplain tclDefaultLibrary\n"
" return\n"
" }\n"
" }\n"
" unset -nocomplain tclDefaultLibrary\n"
" set msg \"Can't find a usable init.tcl in the following directories: \n\"\n"
" append msg \" $dirs\n\n\"\n"
" append msg \"$errors\n\n\"\n"
" append msg \"This probably means that Tcl wasn't installed properly.\n\"\n"
" error $msg\n"
" }\n"
"}\n"
"tclInit");
}
ソース
/*
*----------------------------------------------------------------------
*
* Tcl_Init --
*
* This function is typically invoked by Tcl_AppInit functions to find
* and source the "init.tcl" script, which should exist somewhere on the
* Tcl library path.
*
* Results:
* Returns a standard Tcl completion code and sets the interp's result if
* there is an error.
*
* Side effects:
* Depends on what's in the init.tcl script.
*
*----------------------------------------------------------------------
*/
int
Tcl_Init(
[[Tcl_Interp]] *interp) /* Interpreter to initialize. */
{
if (tclPreInitScript != NULL) {
if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
return (TCL_ERROR);
};
}
/*
* In order to find init.tcl during initialization, the following script
* is invoked by Tcl_Init(). It looks in several different directories:
*
* $tcl_library - can specify a primary location, if set, no
* other locations will be checked. This is the
* recommended way for a program that embeds
* Tcl to specifically tell Tcl where to find
* an init.tcl file.
*
* $env(TCL_LIBRARY) - highest priority so user can always override
* the search path unless the application has
* specified an exact directory above
*
* $tclDefaultLibrary - INTERNAL: This variable is set by Tcl on
* those platforms where it can determine at
* runtime the directory where it expects the
* init.tcl file to be. After [tclInit] reads
* and uses this value, it [unset]s it.
* External users of Tcl should not make use of
* the variable to customize [tclInit].
*
* $tcl_libPath - OBSOLETE: This variable is no longer set by
* Tcl itself, but [tclInit] examines it in
* case some program that embeds Tcl is
* customizing [tclInit] by setting this
* variable to a list of directories in which
* to search.
*
* [tcl::pkgconfig get scriptdir,runtime]
* - the directory determined by configure to be
* the place where Tcl's script library is to
* be installed.
*
* The first directory on this path that contains a valid init.tcl script
* will be set as the value of tcl_library.
*
* Note that this entire search mechanism can be bypassed by defining an
* alternate tclInit command before calling Tcl_Init().
*/
return Tcl_Eval(interp,
"if {[namespace which -command tclInit] eq \"\"} {\n"
" proc tclInit {} {\n"
" global tcl_libPath tcl_library env tclDefaultLibrary\n"
" rename tclInit {}\n"
" if {[info exists tcl_library]} {\n"
" set scripts {{set tcl_library}}\n"
" } else {\n"
" set scripts {}\n"
" if {[info exists env(TCL_LIBRARY)] && ($env(TCL_LIBRARY) ne {})} {\n"
" lappend scripts {set env(TCL_LIBRARY)}\n"
" lappend scripts {\n"
"if {[regexp ^tcl(.*)$ [file tail $env(TCL_LIBRARY)] -> tail] == 0} continue\n"
"if {$tail eq [info tclversion]} continue\n"
"file join [file dirname $env(TCL_LIBRARY)] tcl[info tclversion]}\n"
" }\n"
" if {[info exists tclDefaultLibrary]} {\n"
" lappend scripts {set tclDefaultLibrary}\n"
" } else {\n"
" lappend scripts {::tcl::pkgconfig get scriptdir,runtime}\n"
" }\n"
" lappend scripts {\n"
"set parentDir [file dirname [file dirname [info nameofexecutable]]]\n"
"set grandParentDir [file dirname $parentDir]\n"
"file join $parentDir lib tcl[info tclversion]} \\\n"
" {file join $grandParentDir lib tcl[info tclversion]} \\\n"
" {file join $parentDir library} \\\n"
" {file join $grandParentDir library} \\\n"
" {file join $grandParentDir tcl[info patchlevel] library} \\\n"
" {\n"
"file join [file dirname $grandParentDir] tcl[info patchlevel] library}\n"
" if {[info exists tcl_libPath]\n"
" && [catch {llength $tcl_libPath} len] == 0} {\n"
" for {set i 0} {$i < $len} {incr i} {\n"
" lappend scripts [list lindex \\$tcl_libPath $i]\n"
" }\n"
" }\n"
" }\n"
" set dirs {}\n"
" set errors {}\n"
" foreach script $scripts {\n"
" lappend dirs [eval $script]\n"
" set tcl_library [lindex $dirs end]\n"
" set tclfile [file join $tcl_library init.tcl]\n"
" if {[file exists $tclfile]} {\n"
" if {[catch {uplevel #0 [list source $tclfile]} msg opts]} {\n"
" append errors \"$tclfile: $msg\n\"\n"
" append errors \"[dict get $opts -errorinfo]\n\"\n"
" continue\n"
" }\n"
" unset -nocomplain tclDefaultLibrary\n"
" return\n"
" }\n"
" }\n"
" unset -nocomplain tclDefaultLibrary\n"
" set msg \"Can't find a usable init.tcl in the following directories: \n\"\n"
" append msg \" $dirs\n\n\"\n"
" append msg \"$errors\n\n\"\n"
" append msg \"This probably means that Tcl wasn't installed properly.\n\"\n"
" error $msg\n"
" }\n"
"}\n"
"tclInit");
}
最終更新：2011年11月01日 09:44
