Return to tclinit.tcl CVS log

Up to [Micropolis - Activity] / micropolis / src / tclx / tcllib

Annotation of micropolis/src/tclx/tcllib/tclinit.tcl, revision 1.1

1.1     ! root        1: #-----------------------------------------------------------------------------
        !             2: # TclInit.tcl -- Extended Tcl initialization.
        !             3: #-----------------------------------------------------------------------------
        !             4: # $Id: TclInit.tcl,v 2.0 1992/10/16 04:51:37 markd Rel $
        !             5: #-----------------------------------------------------------------------------
        !             6: 
        !             7: global env TCLENV
        !             8: set TCLENV(inUnknown) 0
        !             9: 
        !            10: #
        !            11: # Unknown command trap handler.
        !            12: #
        !            13: proc unknown {cmdName args} {
        !            14:     global TCLENV
        !            15:     if $TCLENV(inUnknown) {
        !            16:         error "recursive unknown command trap: \"$cmdName\""}
        !            17:     set TCLENV(inUnknown) 1
        !            18:     
        !            19:     set stat [catch {demand_load $cmdName} ret]
        !            20:     if {$stat == 0 && $ret} {
        !            21:         set TCLENV(inUnknown) 0
        !            22:         return [uplevel 1 [list eval $cmdName $args]]
        !            23:     }
        !            24: 
        !            25:     if {$stat != 0} {
        !            26:         global errorInfo errorCode
        !            27:         set TCLENV(inUnknown) 0
        !            28:         error $ret $errorInfo $errorCode
        !            29:     }
        !            30: 
        !            31:     global env interactiveSession noAutoExec
        !            32: 
        !            33:     if {$interactiveSession && ([info level] == 1) && ([info script] == "") &&
        !            34:             (!([info exists noAutoExec] && [set noAutoExec]))} {
        !            35:         if {[file rootname $cmdName] == "$cmdName"} {
        !            36:             if [info exists env(PATH)] {
        !            37:                 set binpath [searchpath [split $env(PATH) :] $cmdName]
        !            38:             } else {
        !            39:                 set binpath [searchpath "." $cmdName]
        !            40:             }
        !            41:         } else {
        !            42:             set binpath $cmdName
        !            43:         }
        !            44:         if {[file executable $binpath]} {
        !            45:             set TCLENV(inUnknown) 0
        !            46:             uplevel 1 [list system [concat $cmdName $args]]
        !            47:             return
        !            48:         }
        !            49:     }
        !            50:     set TCLENV(inUnknown) 0
        !            51:     error "invalid command name: \"$cmdName\""
        !            52: }
        !            53: 
        !            54: #
        !            55: # Search a path list for a file. (catch is for bad ~user)
        !            56: #
        !            57: proc searchpath {pathlist file} {
        !            58:     foreach dir $pathlist {
        !            59:         if {$dir == ""} {set dir .}
        !            60:         if {[catch {file exists $dir/$file} result] == 0 && $result}  {
        !            61:             return $dir/$file
        !            62:         }
        !            63:     }
        !            64:     return {}
        !            65: }
        !            66: 
        !            67: #
        !            68: # Define a proc to be available for demand_load.
        !            69: #
        !            70: proc autoload {filenam args} {
        !            71:     global TCLENV
        !            72:     foreach i $args {
        !            73:         set TCLENV(PROC:$i) [list F $filenam]
        !            74:     }
        !            75: }
        !            76: 
        !            77: #
        !            78: # Search TCLPATH for a file to source.
        !            79: #
        !            80: proc load {name} {
        !            81:     global TCLPATH errorCode
        !            82:     if {[string first / $name] >= 0} {
        !            83:         return  [uplevel #0 source $name]
        !            84:     }
        !            85:     set where [searchpath $TCLPATH $name]
        !            86:     if [lempty $where] {
        !            87:         error "couldn't find $name in Tcl search path" "" "TCLSH FILE_NOT_FOUND"
        !            88:     }
        !            89:     uplevel #0 source $where
        !            90: }
        !            91: 
        !            92: autoload buildidx.tcl buildpackageindex
        !            93: 
        !            94: # == Put any code you want all Tcl programs to include here. ==
        !            95: 
        !            96: if !$interactiveSession return
        !            97: 
        !            98: # == Interactive Tcl session initialization ==
        !            99: 
        !           100: set TCLENV(topLevelPromptHook) {global programName; concat "$programName>" }
        !           101: set TCLENV(downLevelPromptHook) {concat "=>"}
        !           102: 
        !           103: if [file readable ~/.tclrc] {source ~/.tclrc}
        !           104: 

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.