]> git.zerfleddert.de Git - micropolis/blame - res/tclinit.tcl
src/tk/makefile: Micropolis build fixes for recent macOS
[micropolis] / res / tclinit.tcl
CommitLineData
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
7global env TCLENV
8set TCLENV(inUnknown) 0
9
10#
11# Unknown command trap handler.
12#
13proc 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#
57proc 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#
70proc 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#
80proc 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
92autoload buildidx.tcl buildpackageindex
93
94# == Put any code you want all Tcl programs to include here. ==
95
96if !$interactiveSession return
97
98# == Interactive Tcl session initialization ==
99
100set TCLENV(topLevelPromptHook) {global programName; concat "$programName>" }
101set TCLENV(downLevelPromptHook) {concat "=>"}
102
103if [file readable ~/.tclrc] {source ~/.tclrc}
104
Impressum, Datenschutz