File: tclinit.tcl

package info (click to toggle)
micropolis-activity 0.0.20071228-7
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 24,856 kB
  • ctags: 10,179
  • sloc: ansic: 84,390; tcl: 12,083; makefile: 678; cpp: 541; yacc: 490; csh: 234; python: 190; sed: 32; sh: 23
file content (104 lines) | stat: -rw-r--r-- 2,850 bytes parent folder | download | duplicates (10)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
#-----------------------------------------------------------------------------
# TclInit.tcl -- Extended Tcl initialization.
#-----------------------------------------------------------------------------
# $Id: TclInit.tcl,v 2.0 1992/10/16 04:51:37 markd Rel $
#-----------------------------------------------------------------------------

global env TCLENV
set TCLENV(inUnknown) 0

#
# Unknown command trap handler.
#
proc unknown {cmdName args} {
    global TCLENV
    if $TCLENV(inUnknown) {
        error "recursive unknown command trap: \"$cmdName\""}
    set TCLENV(inUnknown) 1
    
    set stat [catch {demand_load $cmdName} ret]
    if {$stat == 0 && $ret} {
        set TCLENV(inUnknown) 0
        return [uplevel 1 [list eval $cmdName $args]]
    }

    if {$stat != 0} {
        global errorInfo errorCode
        set TCLENV(inUnknown) 0
        error $ret $errorInfo $errorCode
    }

    global env interactiveSession noAutoExec

    if {$interactiveSession && ([info level] == 1) && ([info script] == "") &&
            (!([info exists noAutoExec] && [set noAutoExec]))} {
        if {[file rootname $cmdName] == "$cmdName"} {
            if [info exists env(PATH)] {
                set binpath [searchpath [split $env(PATH) :] $cmdName]
            } else {
                set binpath [searchpath "." $cmdName]
            }
        } else {
            set binpath $cmdName
        }
        if {[file executable $binpath]} {
            set TCLENV(inUnknown) 0
            uplevel 1 [list system [concat $cmdName $args]]
            return
        }
    }
    set TCLENV(inUnknown) 0
    error "invalid command name: \"$cmdName\""
}

#
# Search a path list for a file. (catch is for bad ~user)
#
proc searchpath {pathlist file} {
    foreach dir $pathlist {
        if {$dir == ""} {set dir .}
        if {[catch {file exists $dir/$file} result] == 0 && $result}  {
            return $dir/$file
        }
    }
    return {}
}

#
# Define a proc to be available for demand_load.
#
proc autoload {filenam args} {
    global TCLENV
    foreach i $args {
        set TCLENV(PROC:$i) [list F $filenam]
    }
}

#
# Search TCLPATH for a file to source.
#
proc load {name} {
    global TCLPATH errorCode
    if {[string first / $name] >= 0} {
        return  [uplevel #0 source $name]
    }
    set where [searchpath $TCLPATH $name]
    if [lempty $where] {
        error "couldn't find $name in Tcl search path" "" "TCLSH FILE_NOT_FOUND"
    }
    uplevel #0 source $where
}

autoload buildidx.tcl buildpackageindex

# == Put any code you want all Tcl programs to include here. ==

if !$interactiveSession return

# == Interactive Tcl session initialization ==

set TCLENV(topLevelPromptHook) {global programName; concat "$programName>" }
set TCLENV(downLevelPromptHook) {concat "=>"}

if [file readable ~/.tclrc] {source ~/.tclrc}