summaryrefslogtreecommitdiffstats
path: root/library/init.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'library/init.tcl')
-rw-r--r--library/init.tcl123
1 files changed, 72 insertions, 51 deletions
diff --git a/library/init.tcl b/library/init.tcl
index b062650..f1d6a64 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -15,7 +15,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.5.9
+package require -exact Tcl 8.6b1.2
# Compute the auto path to use in this interpreter.
# The values on the path come from several locations:
@@ -76,7 +76,7 @@ namespace eval tcl {
# TIP #255 min and max functions
namespace eval mathfunc {
proc min {args} {
- if {[llength $args] == 0} {
+ if {![llength $args]} {
return -code error \
"too few arguments to math function \"min\""
}
@@ -87,12 +87,12 @@ namespace eval tcl {
if {[catch {expr {double($arg)}} err]} {
return -code error $err
}
- if {$arg < $val} { set val $arg }
+ if {$arg < $val} {set val $arg}
}
return $val
}
proc max {args} {
- if {[llength $args] == 0} {
+ if {![llength $args]} {
return -code error \
"too few arguments to math function \"max\""
}
@@ -103,7 +103,7 @@ namespace eval tcl {
if {[catch {expr {double($arg)}} err]} {
return -code error $err
}
- if {$arg > $val} { set val $arg }
+ if {$arg > $val} {set val $arg}
}
return $val
}
@@ -177,9 +177,9 @@ if {[interp issafe]} {
-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
@@ -216,11 +216,9 @@ if {[namespace which -command tclLog] eq ""} {
# exist in the interpreter. It takes the following steps to make the
# command available:
#
-# 1. See if the command has the form "namespace inscope ns cmd" and
-# if so, concatenate its arguments onto the end and evaluate it.
-# 2. See if the autoload facility can locate the command in a
+# 1. See if the autoload facility can locate the command in a
# Tcl script file. If so, load it and execute it.
-# 3. If the command was invoked interactively at top-level:
+# 2. If the command was invoked interactively at top-level:
# (a) see if the command exists as an executable UNIX program.
# If so, "exec" the command.
# (b) see if the command requests csh-like history substitution
@@ -237,35 +235,28 @@ proc unknown args {
variable ::tcl::UnknownPending
global auto_noexec auto_noload env tcl_interactive
- # If the command word has the form "namespace inscope ns cmd"
- # then concatenate its arguments onto the end and evaluate it.
- set cmd [lindex $args 0]
- if {[regexp "^:*namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} {
- #return -code error "You need an {*}"
- set arglist [lrange $args 1 end]
- set ret [catch {uplevel 1 ::$cmd $arglist} result opts]
- dict unset opts -errorinfo
- dict incr opts -level
- return -options $opts $result
+ if {[info exists ::errorInfo]} {
+ set savedErrorInfo $::errorInfo
+ }
+ if {[info exists ::errorCode]} {
+ set savedErrorCode $::errorCode
}
- catch {set savedErrorInfo $::errorInfo}
- catch {set savedErrorCode $::errorCode}
- set name $cmd
+ set name [lindex $args 0]
if {![info exists auto_noload]} {
#
# Make sure we're not trying to load the same proc twice.
#
if {[info exists UnknownPending($name)]} {
return -code error "self-referential recursion\
- in \"unknown\" for command \"$name\"";
+ in \"unknown\" for command \"$name\""
}
- set UnknownPending($name) pending;
+ set UnknownPending($name) pending
set ret [catch {
auto_load $name [uplevel 1 {::namespace current}]
} msg opts]
- unset UnknownPending($name);
+ unset UnknownPending($name)
if {$ret != 0} {
dict append opts -errorinfo "\n (autoloading \"$name\")"
return -options $opts $msg
@@ -288,7 +279,7 @@ proc unknown args {
if {$code == 1} {
#
# Compute stack trace contribution from the [uplevel].
- # Note the dependence on how Tcl_AddErrorInfo, etc.
+ # Note the dependence on how Tcl_AddErrorInfo, etc.
# construct the stack trace.
#
set errorInfo [dict get $opts -errorinfo]
@@ -419,7 +410,7 @@ proc unknown args {
# library file to create the procedure. Returns 1 if it successfully
# loaded the procedure, 0 otherwise.
#
-# Arguments:
+# Arguments:
# cmd - Name of the command to find and load.
# namespace (optional) The namespace where the command is being used - must be
# a canonical namespace as returned [namespace current]
@@ -443,7 +434,7 @@ proc auto_load {cmd {namespace {}}} {
# info commands $name
# Unfortunately, if the name has glob-magic chars in it like *
# or [], it may not match. For our purposes here, a better
- # route is to use
+ # route is to use
# namespace which -command $name
if {[namespace which -command $name] ne ""} {
return 1
@@ -474,7 +465,7 @@ proc auto_load {cmd {namespace {}}} {
# of available commands. Returns 1 if the index is loaded, and 0 if
# the index is already loaded and up to date.
#
-# Arguments:
+# Arguments:
# None.
proc auto_load_index {} {
@@ -553,34 +544,34 @@ proc auto_qualify {cmd namespace} {
# Before each return case we give an example of which category it is
# with the following form :
- # ( inputCmd, inputNameSpace) -> output
+ # (inputCmd, inputNameSpace) -> output
if {[string match ::* $cmd]} {
if {$n > 1} {
- # ( ::foo::bar , * ) -> ::foo::bar
+ # (::foo::bar , *) -> ::foo::bar
return [list $cmd]
} else {
- # ( ::global , * ) -> global
+ # (::global , *) -> global
return [list [string range $cmd 2 end]]
}
}
-
+
# Potentially returning 2 elements to try :
# (if the current namespace is not the global one)
if {$n == 0} {
if {$namespace eq "::"} {
- # ( nocolons , :: ) -> nocolons
+ # (nocolons , ::) -> nocolons
return [list $cmd]
} else {
- # ( nocolons , ::sub ) -> ::sub::nocolons nocolons
+ # (nocolons , ::sub) -> ::sub::nocolons nocolons
return [list ${namespace}::$cmd $cmd]
}
} elseif {$namespace eq "::"} {
- # ( foo::bar , :: ) -> ::foo::bar
+ # (foo::bar , ::) -> ::foo::bar
return [list ::$cmd]
} else {
- # ( foo::bar , ::sub ) -> ::sub::foo::bar ::foo::bar
+ # (foo::bar , ::sub) -> ::sub::foo::bar ::foo::bar
return [list ${namespace}::$cmd ::$cmd]
}
}
@@ -622,13 +613,13 @@ proc auto_import {pattern} {
# auto_execok --
#
-# Returns string that indicates name of program to execute if
+# Returns string that indicates name of program to execute if
# name corresponds to a shell builtin or an executable in the
-# Windows search path, or "" otherwise. Builds an associative
-# array auto_execs that caches information about previous checks,
+# Windows search path, or "" otherwise. Builds an associative
+# array auto_execs that caches information about previous checks,
# for speed.
#
-# Arguments:
+# Arguments:
# name - Name of a command.
if {$tcl_platform(platform) eq "windows"} {
@@ -683,7 +674,7 @@ proc auto_execok name {
set path "[file dirname [info nameof]];.;"
if {[info exists env(WINDIR)]} {
- set windir $env(WINDIR)
+ set windir $env(WINDIR)
}
if {[info exists windir]} {
if {$tcl_platform(os) eq "Windows NT"} {
@@ -700,7 +691,9 @@ proc auto_execok name {
foreach dir [split $path {;}] {
# Skip already checked directories
- if {[info exists checked($dir)] || ($dir eq {})} { continue }
+ if {[info exists checked($dir)] || ($dir eq "")} {
+ continue
+ }
set checked($dir) {}
foreach ext $execExtensions {
set file [file join $dir ${name}${ext}]
@@ -748,13 +741,13 @@ proc auto_execok name {
# This procedure is called by Tcl's core when attempts to call the
# filesystem's copydirectory function fail. The semantics of the call
# are that 'dest' does not yet exist, i.e. dest should become the exact
-# image of src. If dest does exist, we throw an error.
-#
+# image of src. If dest does exist, we throw an error.
+#
# Note that making changes to this procedure can change the results
# of running Tcl's tests.
#
-# Arguments:
-# action - "renaming" or "copying"
+# Arguments:
+# action - "renaming" or "copying"
# src - source directory
# dest - destination directory
proc tcl::CopyDirectory {action src dest} {
@@ -782,7 +775,7 @@ proc tcl::CopyDirectory {action src dest} {
# exists, then we should only call this function if -force
# is true, which means we just want to over-write. So,
# the following code is now commented out.
- #
+ #
# return -code error "error $action \"$src\" to\
# \"$dest\": file already exists"
} else {
@@ -815,7 +808,7 @@ proc tcl::CopyDirectory {action src dest} {
# Have to be careful to capture both visible and hidden files.
# We will also be more generous to the file system and not
# assume the hidden and non-hidden lists are non-overlapping.
- #
+ #
# On Unix 'hidden' files begin with '.'. On other platforms
# or filesystems hidden files may have other interpretations.
set filelist [concat [glob -nocomplain -directory $src *] \
@@ -828,3 +821,31 @@ proc tcl::CopyDirectory {action src dest} {
}
return
}
+
+# TIP 131
+if 0 {
+proc tcl::rmmadwiw {} {
+ set magic {
+ 42 83 fe f6 ff f8 f1 e5 c6 f9 eb fd ff fb f1 e5 cc f5 ec f5 e3 fd fe
+ ff f5 fa f3 e1 c7 f9 f2 fd ff f9 fe f9 ed f4 fa f6 e6 f9 f2 e6 fd f9
+ ff f9 f6 e6 fa fd ff fc fb fc f9 f1 ed
+ }
+ foreach mystic [lassign $magic tragic] {
+ set comic [expr (0x$mystic ^ 0x$tragic) - 255 + 0x$tragic]
+ append logic [format %x $comic]
+ set tragic $mystic
+ }
+ binary format H* $logic
+}
+
+proc tcl::mathfunc::rmmadwiw {} {
+ set age [expr {9*6}]
+ set mind ""
+ while {$age} {
+ lappend mind [expr {$age%13}]
+ set age [expr {$age/13}]
+ }
+ set matter [lreverse $mind]
+ return [join $matter ""]
+}
+}
generated by cgit v0.12 at 2024-07-15 19:52:42 (GMT)