]> cvs.zerfleddert.de Git - micropolis/blob - res/tclinit.tcl
XINCLUDE: use /usr/X11R6/include everywhere
[micropolis] / 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
Impressum, Datenschutz