projects / micropolis / blame
| Commit | Line | Data |
|---|---|---|
| 6a5fa4e0 MG |
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 |