diff options
Diffstat (limited to 'library/init.tcl')
| -rw-r--r-- | library/init.tcl | 155 |
1 files changed, 73 insertions, 82 deletions
diff --git a/library/init.tcl b/library/init.tcl index 9fef16f..9536b7e 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -3,7 +3,7 @@ # Default system startup file for Tcl-based applications. Defines # "unknown" procedure and auto-load facilities. # -# RCS: @(#) $Id: init.tcl,v 1.69 2004/11/30 22:19:21 dgp Exp $ +# RCS: @(#) $Id: init.tcl,v 1.69.2.1 2005/04/25 21:37:23 kennykb Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -48,30 +48,35 @@ if {![info exists auto_path]} { } namespace eval tcl { variable Dir - if {[info library] != ""} { - foreach Dir [list [info library] [file dirname [info library]]] { - if {[lsearch -exact $::auto_path $Dir] < 0} { - lappend ::auto_path $Dir - } + foreach Dir [list $::tcl_library [file dirname $::tcl_library]] { + if {$Dir ni $::auto_path} { + lappend ::auto_path $Dir } } set Dir [file join [file dirname [file dirname \ [info nameofexecutable]]] lib] - if {[lsearch -exact $::auto_path $Dir] < 0} { + if {$Dir ni $::auto_path} { lappend ::auto_path $Dir } - if {[info exists ::tcl_pkgPath]} { + catch { foreach Dir $::tcl_pkgPath { - if {[lsearch -exact $::auto_path $Dir] < 0} { + if {$Dir ni $::auto_path} { lappend ::auto_path $Dir } } } + + variable Path [unsupported::EncodingDirs] + set Dir [file join $::tcl_library encoding] + if {$Dir ni $Path} { + lappend Path $Dir + unsupported::EncodingDirs $Path + } } - + # Windows specific end of initialization -if {(![interp issafe]) && [string equal $tcl_platform(platform) "windows"]} { +if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} { namespace eval tcl { proc EnvTraceProc {lo n1 n2 op} { set x $::env($n2) @@ -82,7 +87,7 @@ if {(![interp issafe]) && [string equal $tcl_platform(platform) "windows"]} { global env tcl_platform foreach p [array names env] { set u [string toupper $p] - if {![string equal $u $p]} { + if {$u ne $p} { switch -- $u { COMSPEC - PATH { @@ -98,7 +103,7 @@ if {(![interp issafe]) && [string equal $tcl_platform(platform) "windows"]} { } } if {![info exists env(COMSPEC)]} { - if {[string equal $tcl_platform(os) "Windows NT"]} { + if {$tcl_platform(os) eq "Windows NT"} { set env(COMSPEC) cmd.exe } else { set env(COMSPEC) command.com @@ -111,13 +116,42 @@ if {(![interp issafe]) && [string equal $tcl_platform(platform) "windows"]} { # Setup the unknown package handler -package unknown tclPkgUnknown -if {![interp issafe]} { - # setup platform specific unknown package handlers - if {[string equal $::tcl_platform(platform) "unix"] && \ - [string equal $::tcl_platform(os) "Darwin"]} { - package unknown [list tcl::MacOSXPkgUnknown [package unknown]] +if {[interp issafe]} { + package unknown ::tclPkgUnknown +} else { + # Set up search for Tcl Modules (TIP #189). + # and setup platform specific unknown package handlers + if {$::tcl_platform(os) eq "Darwin" + && $::tcl_platform(platform) eq "unix"} { + package unknown {::tcl::tm::UnknownHandler \ + {::tcl::MacOSXPkgUnknown ::tclPkgUnknown}} + } else { + package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown} + } + + # Set up the 'clock' ensemble + + namespace eval ::tcl::clock [list variable TclLibDir $::tcl_library] + + proc clock args { + namespace eval ::tcl::clock [list namespace ensemble create -command \ + [uplevel 1 [list namespace origin [lindex [info level 0] 0]]] \ + -subcommands { + add clicks format microseconds milliseconds scan seconds + }] + + # Auto-loading stubs for 'clock.tcl' + + foreach cmd {add format scan} { + proc ::tcl::clock::$cmd args { + variable TclLibDir + source -encoding utf-8 [file join $TclLibDir clock.tcl] + return [uplevel 1 [info level 0]] + } + } + + return [uplevel 1 [info level 0]] } } @@ -264,19 +298,19 @@ proc unknown args { } } - if {([info level] == 1) && [string equal [info script] ""] \ + if {([info level] == 1) && ([info script] eq "") \ && [info exists tcl_interactive] && $tcl_interactive} { if {![info exists auto_noexec]} { set new [auto_execok $name] if {$new != ""} { set redir "" - if {[string equal [info commands console] ""]} { + if {[info commands console] eq ""} { set redir ">&@stdout <@stdin" } return [uplevel 1 exec $redir $new [lrange $args 1 end]] } } - if {[string equal $name "!!"]} { + if {$name eq "!!"} { set newcmd [history event] } elseif {[regexp {^!(.+)$} $name dummy event]} { set newcmd [history event $event] @@ -291,7 +325,7 @@ proc unknown args { } set ret [catch {set candidates [info commands $name*]} msg] - if {[string equal $name "::"]} { + if {$name eq "::"} { set name "" } if {$ret != 0} { @@ -311,7 +345,7 @@ proc unknown args { return [uplevel 1 [lreplace $args 0 0 $cmds]] } if {[llength $cmds]} { - if {[string equal $name ""]} { + if {$name eq ""} { return -code error "empty command name \"\"" } else { return -code error \ @@ -390,8 +424,7 @@ proc auto_load_index {} { variable ::tcl::auto_oldpath global auto_index auto_path - if {[info exists auto_oldpath] && \ - [string equal $auto_oldpath $auto_path]} { + if {[info exists auto_oldpath] && ($auto_oldpath eq $auto_path)} { return 0 } set auto_oldpath $auto_path @@ -410,12 +443,11 @@ proc auto_load_index {} { } else { set error [catch { set id [gets $f] - if {[string equal $id \ - "# Tcl autoload index file, version 2.0"]} { + if {$id eq "# Tcl autoload index file, version 2.0"} { eval [read $f] - } elseif {[string equal $id "# Tcl autoload index file: each line identifies a Tcl"]} { + } elseif {$id eq "# Tcl autoload index file: each line identifies a Tcl"]} { while {[gets $f line] >= 0} { - if {[string equal [string index $line 0] "#"] \ + if {([string index $line 0] eq "#") \ || ([llength $line] != 2)} { continue } @@ -480,14 +512,14 @@ proc auto_qualify {cmd namespace} { # (if the current namespace is not the global one) if {$n == 0} { - if {[string equal $namespace ::]} { + if {$namespace eq "::"} { # ( nocolons , :: ) -> nocolons return [list $cmd] } else { # ( nocolons , ::sub ) -> ::sub::nocolons nocolons return [list ${namespace}::$cmd $cmd] } - } elseif {[string equal $namespace ::]} { + } elseif {$namespace eq "::"} { # ( foo::bar , :: ) -> ::foo::bar return [list ::$cmd] } else { @@ -542,7 +574,7 @@ proc auto_import {pattern} { # Arguments: # name - Name of a command. -if {[string equal windows $tcl_platform(platform)]} { +if {$tcl_platform(platform) eq "windows"} { # Windows version. # # Note that info executable doesn't work under Windows, so we have to @@ -560,7 +592,7 @@ proc auto_execok name { set shellBuiltins [list cls copy date del erase dir echo mkdir \ md rename ren rmdir rd time type ver vol] - if {[string equal $tcl_platform(os) "Windows NT"]} { + if {$tcl_platform(os) eq "Windows NT"} { # NT includes the 'start' built-in lappend shellBuiltins "start" } @@ -571,7 +603,7 @@ proc auto_execok name { set execExtensions [list {} .com .exe .bat] } - if {[lsearch -exact $shellBuiltins $name] != -1} { + if {$name in $shellBuiltins} { # When this is command.com for some reason on Win2K, Tcl won't # exec it unless the case is right, which this corrects. COMSPEC # may not point to a real file, so do the check. @@ -597,7 +629,7 @@ proc auto_execok name { set windir $env(WINDIR) } if {[info exists windir]} { - if {[string equal $tcl_platform(os) "Windows NT"]} { + if {$tcl_platform(os) eq "Windows NT"} { append path "$windir/system32;" } append path "$windir/system;$windir;" @@ -611,7 +643,7 @@ proc auto_execok name { foreach dir [split $path {;}] { # Skip already checked directories - if {[info exists checked($dir)] || [string equal {} $dir]} { continue } + if {[info exists checked($dir)] || ($dir eq {})} { continue } set checked($dir) {} foreach ext $execExtensions { set file [file join $dir ${name}${ext}] @@ -640,7 +672,7 @@ proc auto_execok name { return $auto_execs($name) } foreach dir [split $env(PATH) :] { - if {[string equal $dir ""]} { + if {$dir eq ""} { set dir . } set file [file join $dir $name] @@ -672,10 +704,10 @@ proc tcl::CopyDirectory {action src dest} { set nsrc [file normalize $src] set ndest [file normalize $dest] - if {[string equal $action "renaming"]} { + if {$action eq "renaming"} { # Can't rename volumes. We could give a more precise # error message here, but that would break the test suite. - if {[lsearch -exact [file volumes] $nsrc] != -1} { + if {$nsrc in [file volumes]} { return -code error "error $action \"$src\" to\ \"$dest\": trying to rename a volume or move a directory\ into itself" @@ -687,7 +719,7 @@ proc tcl::CopyDirectory {action src dest} { \"$dest\": trying to rename a volume or move a directory\ into itself" } - if {[string equal $action "copying"]} { + if {$action eq "copying"} { # We used to throw an error here, but, looking more closely # at the core copy code in tclFCmd.c, if the destination # exists, then we should only call this function if -force @@ -739,44 +771,3 @@ proc tcl::CopyDirectory {action src dest} { } return } - -# Set up the 'clock' ensemble - -if { ![interp issafe] } { - - namespace eval ::tcl::clock \ - [list variable TclLibDir [file dirname [info script]]] - - namespace eval ::tcl::clock { - namespace ensemble create -command ::clock \ - -subcommands { - add clicks format - microseconds milliseconds - scan seconds - } - - # Auto-loading stub for 'clock.tcl' - - proc add args { - variable TclLibDir - source -encoding utf-8 [file join $TclLibDir clock.tcl] - return [uplevel 1 [info level 0]] - } - proc format args { - variable TclLibDir - source -encoding utf-8 [file join $TclLibDir clock.tcl] - return [uplevel 1 [info level 0]] - } - proc scan args { - variable TclLibDir - source -encoding utf-8 [file join $TclLibDir clock.tcl] - return [uplevel 1 [info level 0]] - } - } -} - -# Set up search for Tcl Modules (TIP #189). - -if { ![interp issafe] } { - source [file join [file dirname [info script]] tm.tcl] -} |