Return to tclinit.tcl CVS log

Up to [Micropolis - Activity] / micropolis / res

Annotation of micropolis/res/tclinit.tcl, revision 1.1.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.