diff options
Diffstat (limited to 'library/init.tcl')
| -rw-r--r-- | library/init.tcl | 105 |
1 files changed, 25 insertions, 80 deletions
diff --git a/library/init.tcl b/library/init.tcl index 8952172..d5b9c03 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -6,7 +6,10 @@ # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. -# Copyright (c) 2004 by Kevin B. Kenny. All rights reserved. +# Copyright (c) 2004 by Kevin B. Kenny. +# Copyright (c) 2018 by Sean Woods +# +# All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -16,7 +19,7 @@ if {[info commands package] == ""} { error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" } -package require -exact Tcl 8.6.9 +package require -exact Tcl 8.7a2 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: @@ -73,81 +76,10 @@ namespace eval tcl { encoding dirs $Path } } - - # TIP #255 min and max functions - namespace eval mathfunc { - proc min {args} { - if {![llength $args]} { - return -code error \ - "too few arguments to math function \"min\"" - } - set val Inf - foreach arg $args { - # This will handle forcing the numeric value without - # ruining the internal type of a numeric object - if {[catch {expr {double($arg)}} err]} { - return -code error $err - } - if {$arg < $val} {set val $arg} - } - return $val - } - proc max {args} { - if {![llength $args]} { - return -code error \ - "too few arguments to math function \"max\"" - } - set val -Inf - foreach arg $args { - # This will handle forcing the numeric value without - # ruining the internal type of a numeric object - if {[catch {expr {double($arg)}} err]} { - return -code error $err - } - if {$arg > $val} {set val $arg} - } - return $val - } - namespace export min max - } } -# Windows specific end of initialization - -if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} { - namespace eval tcl { - proc EnvTraceProc {lo n1 n2 op} { - global env - set x $env($n2) - set env($lo) $x - set env([string toupper $lo]) $x - } - proc InitWinEnv {} { - global env tcl_platform - foreach p [array names env] { - set u [string toupper $p] - if {$u ne $p} { - switch -- $u { - COMSPEC - - PATH { - set temp $env($p) - unset env($p) - set env($u) $temp - trace add variable env($p) write \ - [namespace code [list EnvTraceProc $p]] - trace add variable env($u) write \ - [namespace code [list EnvTraceProc $p]] - } - } - } - } - if {![info exists env(COMSPEC)]} { - set env(COMSPEC) cmd.exe - } - } - InitWinEnv - } -} +namespace eval tcl::Pkg {} + # Setup the unknown package handler @@ -458,6 +390,22 @@ proc auto_load {cmd {namespace {}}} { return 0 } +# ::tcl::Pkg::source -- +# This procedure provides an alternative "source" command, which doesn't +# register the file for the "package files" command. Safe interpreters +# don't have to do anything special. +# +# Arguments: +# filename + +proc ::tcl::Pkg::source {filename} { + if {[interp issafe]} { + uplevel 1 [list ::source $filename] + } else { + uplevel 1 [list ::source -nopkg $filename] + } +} + # auto_load_index -- # Loads the contents of tclIndex files on the auto_path directory # list. This is usually invoked within auto_load to load the index @@ -500,7 +448,7 @@ proc auto_load_index {} { } set name [lindex $line 0] set auto_index($name) \ - "source [file join $dir [lindex $line 1]]" + "::tcl::Pkg::source [file join $dir [lindex $line 1]]" } } else { error "[file join $dir tclIndex] isn't a proper Tcl index file" @@ -672,10 +620,7 @@ proc auto_execok name { set windir $env(WINDIR) } if {[info exists windir]} { - if {$tcl_platform(os) eq "Windows NT"} { - append path "$windir/system32;" - } - append path "$windir/system;$windir;" + append path "$windir/system32;$windir/system;$windir;" } foreach var {PATH Path path} { |