cvs.zerfleddert.de Git - micropolis/blob - res/tclinit.tcl

   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