diff options
Diffstat (limited to 'library')
| -rw-r--r-- | library/clock.tcl | 60 | ||||
| -rw-r--r-- | library/init.tcl | 28 | ||||
| -rw-r--r-- | library/package.tcl | 6 | ||||
| -rw-r--r-- | library/tclIndex | 132 | ||||
| -rw-r--r-- | library/word.tcl | 24 |
5 files changed, 156 insertions, 94 deletions
diff --git a/library/clock.tcl b/library/clock.tcl index 8e4b657..535a67d 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -4248,7 +4248,7 @@ proc ::tcl::clock::add { clockval args } { ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?\"" } if { [catch { expr {wide($clockval)} } result] } { - return -code error $result + return -code error "expected integer but got \"$clockval\"" } set offsets {} @@ -4287,9 +4287,6 @@ proc ::tcl::clock::add { clockval args } { -errorcode [list CLOCK gmtWithTimezone] \ "cannot use -gmt and -timezone in same call" } - if { [catch { expr { wide($clockval) } } result] } { - return -code error "expected integer but got \"$clockval\"" - } if { ![string is boolean -strict $gmt] } { return -code error "expected boolean value but got \"$gmt\"" } elseif { $gmt } { @@ -4326,6 +4323,11 @@ proc ::tcl::clock::add { clockval args } { $changeover] } + weekdays - weekday { + set clockval [AddWeekDays $quantity $clockval $timezone \ + $changeover] + } + hours - hour { set clockval [expr { 3600 * $quantity + $clockval }] } @@ -4425,6 +4427,56 @@ proc ::tcl::clock::AddMonths { months clockval timezone changeover } { #---------------------------------------------------------------------- # +# AddWeekDays -- +# +# Add a given number of week days (skipping Saturdays and Sundays) +# to a given clock value in a given time zone. +# +# Parameters: +# days - Number of days to add (may be negative) +# clockval - Seconds since the epoch before the operation +# timezone - Time zone in which the operation is to be performed +# changeover - Julian Day on which the Gregorian calendar was adopted +# in the target locale. +# +# Results: +# Returns the new clock value as a number of seconds since the epoch. +# +# Side effects: +# None. +# +#---------------------------------------------------------------------- + +proc ::tcl::clock::AddWeekDays { days clockval timezone changeover } { + + if {$days == 0} { + return $clockval + } + + set day [format $clockval -format %u] + + set weeks [expr {$days / 5}] + set rdays [expr {$days % 5}] + set toAdd [expr {7 * $weeks + $rdays}] + set resDay [expr {$day + ($toAdd % 7)}] + + # Adjust if we start from a weekend + if {$day > 5} { + set adj [expr {5 - $day}] + incr toAdd $adj + incr resDay $adj + } + + # Adjust if we end up on a weekend + if {$resDay > 5} { + incr toAdd 2 + } + + AddDays $toAdd $clockval $timezone $changeover +} + +#---------------------------------------------------------------------- +# # AddDays -- # # Add a given number of days to a given clock value in a given time diff --git a/library/init.tcl b/library/init.tcl index a202054..8a680f1 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -16,7 +16,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.6 +package require -exact Tcl 8.7a0 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: @@ -45,6 +45,7 @@ if {![info exists auto_path]} { set auto_path "" } } + namespace eval tcl { variable Dir foreach Dir [list $::tcl_library [file dirname $::tcl_library]] { @@ -112,6 +113,8 @@ namespace eval tcl { } } +namespace eval tcl::Pkg {} + # Windows specific end of initialization if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} { @@ -452,6 +455,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 @@ -494,7 +513,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" @@ -631,8 +650,9 @@ proc auto_execok name { } set auto_execs($name) "" - set shellBuiltins [list cls copy date del dir echo erase md mkdir \ - mklink rd ren rename rmdir start time type ver vol] + set shellBuiltins [list assoc cls copy date del dir echo erase ftype \ + md mkdir mklink move rd ren rename rmdir start \ + time type ver vol] if {[info exists env(PATHEXT)]} { # Add an initial ; to have the {} extension check first. set execExtensions [split ";$env(PATHEXT)" ";"] diff --git a/library/package.tcl b/library/package.tcl index 44e3b28..c72fbfb 100644 --- a/library/package.tcl +++ b/library/package.tcl @@ -488,7 +488,7 @@ proc tclPkgUnknown {name args} { set dir [file dirname $file] if {![info exists procdDirs($dir)]} { try { - source $file + ::tcl::Pkg::source $file } trap {POSIX EACCES} {} { # $file was not readable; silently ignore continue @@ -506,7 +506,7 @@ proc tclPkgUnknown {name args} { # safe interps usually don't have "file exists", if {([interp issafe] || [file exists $file])} { try { - source $file + ::tcl::Pkg::source $file } trap {POSIX EACCES} {} { # $file was not readable; silently ignore continue @@ -590,7 +590,7 @@ proc tcl::MacOSXPkgUnknown {original name args} { set dir [file dirname $file] if {![info exists procdDirs($dir)]} { try { - source $file + ::tcl::Pkg::source $file } trap {POSIX EACCES} {} { # $file was not readable; silently ignore continue diff --git a/library/tclIndex b/library/tclIndex index 26603c1..87a2814 100644 --- a/library/tclIndex +++ b/library/tclIndex @@ -7,69 +7,69 @@ # element name is the name of a command and the value is # a script that loads the command. -set auto_index(auto_reset) [list source [file join $dir auto.tcl]] -set auto_index(tcl_findLibrary) [list source [file join $dir auto.tcl]] -set auto_index(auto_mkindex) [list source [file join $dir auto.tcl]] -set auto_index(auto_mkindex_old) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::init) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::cleanup) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::mkindex) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::hook) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::slavehook) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::command) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::commandInit) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::fullname) [list source [file join $dir auto.tcl]] -set auto_index(history) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistAdd) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistKeep) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistClear) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistInfo) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistRedo) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistIndex) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistEvent) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistChange) [list source [file join $dir history.tcl]] -set auto_index(pkg_mkIndex) [list source [file join $dir package.tcl]] -set auto_index(tclPkgSetup) [list source [file join $dir package.tcl]] -set auto_index(tclPkgUnknown) [list source [file join $dir package.tcl]] -set auto_index(::tcl::MacOSXPkgUnknown) [list source [file join $dir package.tcl]] -set auto_index(::pkg::create) [list source [file join $dir package.tcl]] -set auto_index(parray) [list source [file join $dir parray.tcl]] -set auto_index(::safe::InterpStatics) [list source [file join $dir safe.tcl]] -set auto_index(::safe::InterpNested) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpCreate) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpInit) [list source [file join $dir safe.tcl]] -set auto_index(::safe::CheckInterp) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpConfigure) [list source [file join $dir safe.tcl]] -set auto_index(::safe::InterpCreate) [list source [file join $dir safe.tcl]] -set auto_index(::safe::InterpSetConfig) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpFindInAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpAddToAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::InterpInit) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AddSubDirs) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpDelete) [list source [file join $dir safe.tcl]] -set auto_index(::safe::setLogCmd) [list source [file join $dir safe.tcl]] -set auto_index(::safe::SyncAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::PathToken) [list source [file join $dir safe.tcl]] -set auto_index(::safe::TranslatePath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::Log) [list source [file join $dir safe.tcl]] -set auto_index(::safe::CheckFileName) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasGlob) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasSource) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasLoad) [list source [file join $dir safe.tcl]] -set auto_index(::safe::FileInAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::DirInAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::Subset) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasSubset) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasEncoding) [list source [file join $dir safe.tcl]] -set auto_index(tcl_wordBreakAfter) [list source [file join $dir word.tcl]] -set auto_index(tcl_wordBreakBefore) [list source [file join $dir word.tcl]] -set auto_index(tcl_endOfWord) [list source [file join $dir word.tcl]] -set auto_index(tcl_startOfNextWord) [list source [file join $dir word.tcl]] -set auto_index(tcl_startOfPreviousWord) [list source [file join $dir word.tcl]] -set auto_index(::tcl::tm::add) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::remove) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::list) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::Defaults) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::UnknownHandler) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::roots) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::path) [list source [file join $dir tm.tcl]] +set auto_index(auto_reset) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(tcl_findLibrary) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(auto_mkindex) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(auto_mkindex_old) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::init) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::cleanup) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::mkindex) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::hook) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::slavehook) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::command) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::commandInit) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::fullname) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(history) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistAdd) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistKeep) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistClear) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistInfo) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistRedo) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistIndex) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistEvent) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistChange) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(pkg_mkIndex) [list ::tcl::Pkg::source [file join $dir package.tcl]] +set auto_index(tclPkgSetup) [list ::tcl::Pkg::source [file join $dir package.tcl]] +set auto_index(tclPkgUnknown) [list ::tcl::Pkg::source [file join $dir package.tcl]] +set auto_index(::tcl::MacOSXPkgUnknown) [list ::tcl::Pkg::source [file join $dir package.tcl]] +set auto_index(::pkg::create) [list ::tcl::Pkg::source [file join $dir package.tcl]] +set auto_index(parray) [list ::tcl::Pkg::source [file join $dir parray.tcl]] +set auto_index(::safe::InterpStatics) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::InterpNested) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpCreate) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpInit) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::CheckInterp) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpConfigure) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::InterpCreate) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::InterpSetConfig) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpFindInAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpAddToAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::InterpInit) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AddSubDirs) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpDelete) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::setLogCmd) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::SyncAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::PathToken) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::TranslatePath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::Log) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::CheckFileName) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AliasGlob) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AliasSource) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AliasLoad) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::FileInAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::DirInAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::Subset) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AliasSubset) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AliasEncoding) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(tcl_wordBreakAfter) [list ::tcl::Pkg::source [file join $dir word.tcl]] +set auto_index(tcl_wordBreakBefore) [list ::tcl::Pkg::source [file join $dir word.tcl]] +set auto_index(tcl_endOfWord) [list ::tcl::Pkg::source [file join $dir word.tcl]] +set auto_index(tcl_startOfNextWord) [list ::tcl::Pkg::source [file join $dir word.tcl]] +set auto_index(tcl_startOfPreviousWord) [list ::tcl::Pkg::source [file join $dir word.tcl]] +set auto_index(::tcl::tm::add) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::remove) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::list) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::Defaults) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::UnknownHandler) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::roots) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::path) [list ::tcl::Pkg::source [file join $dir tm.tcl]] diff --git a/library/word.tcl b/library/word.tcl index 3e4bc3a..0246530 100644 --- a/library/word.tcl +++ b/library/word.tcl @@ -11,24 +11,14 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # The following variables are used to determine which characters are -# interpreted as white space. +# interpreted as word characters. See bug [f1253530cdd8]. Will +# probably be removed in Tcl 9. -if {$::tcl_platform(platform) eq "windows"} { - # Windows style - any but a unicode space char - if {![info exists ::tcl_wordchars]} { - set ::tcl_wordchars {\S} - } - if {![info exists ::tcl_nonwordchars]} { - set ::tcl_nonwordchars {\s} - } -} else { - # Motif style - any unicode word char (number, letter, or underscore) - if {![info exists ::tcl_wordchars]} { - set ::tcl_wordchars {\w} - } - if {![info exists ::tcl_nonwordchars]} { - set ::tcl_nonwordchars {\W} - } +if {![info exists ::tcl_wordchars]} { + set ::tcl_wordchars {\w} +} +if {![info exists ::tcl_nonwordchars]} { + set ::tcl_nonwordchars {\W} } # Arrange for caches of the real matcher REs to be kept, which enables the REs |