Tcl Source Code

Artifact [ff44224c9e]
Login

Artifact ff44224c9e81abd96f9d1f8029625c8d236798c5:

Attachment "None" to ticket [402545ffff] added by dgp 2000-11-27 23:06:55.
? patch
Index: init.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/init.tcl,v
retrieving revision 1.42
diff -c -r1.42 init.tcl
*** init.tcl	2000/11/23 14:21:59	1.42
--- init.tcl	2000/11/27 15:55:23
***************
*** 165,171 ****
      set cmd [lindex $args 0]
      if {[regexp "^namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} {
          set arglist [lrange $args 1 end]
! 	set ret [catch {uplevel 1 $cmd $arglist} result]
          if {$ret == 0} {
              return $result
          } else {
--- 165,171 ----
      set cmd [lindex $args 0]
      if {[regexp "^namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} {
          set arglist [lrange $args 1 end]
! 	set ret [catch {uplevel 1 ::$cmd $arglist} result]
          if {$ret == 0} {
              return $result
          } else {
***************
*** 188,194 ****
  	    return -code error "self-referential recursion in \"unknown\" for command \"$name\"";
  	}
  	set unknown_pending($name) pending;
! 	set ret [catch {auto_load $name [uplevel 1 {namespace current}]} msg]
  	unset unknown_pending($name);
  	if {$ret != 0} {
  	    append errorInfo "\n    (autoloading \"$name\")"
--- 188,194 ----
  	    return -code error "self-referential recursion in \"unknown\" for command \"$name\"";
  	}
  	set unknown_pending($name) pending;
! 	set ret [catch {auto_load $name [uplevel 1 {::namespace current}]} msg]
  	unset unknown_pending($name);
  	if {$ret != 0} {
  	    append errorInfo "\n    (autoloading \"$name\")"
***************
*** 286,292 ****
      global auto_index auto_oldpath auto_path
  
      if {[string length $namespace] == 0} {
! 	set namespace [uplevel 1 [list namespace current]]
      }
      set nameList [auto_qualify $cmd $namespace]
      # workaround non canonical auto_index entries that might be around
--- 286,292 ----
      global auto_index auto_oldpath auto_path
  
      if {[string length $namespace] == 0} {
! 	set namespace [uplevel 1 [list ::namespace current]]
      }
      set nameList [auto_qualify $cmd $namespace]
      # workaround non canonical auto_index entries that might be around
***************
*** 461,467 ****
  	return
      }
  
!     set ns [uplevel 1 [list namespace current]]
      set patternList [auto_qualify $pattern $ns]
  
      auto_load_index
--- 461,467 ----
  	return
      }
  
!     set ns [uplevel 1 [list ::namespace current]]
      set patternList [auto_qualify $pattern $ns]
  
      auto_load_index
Index: msgcat/msgcat.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/msgcat/msgcat.tcl,v
retrieving revision 1.9
diff -c -r1.9 msgcat.tcl
*** msgcat/msgcat.tcl	2000/08/11 00:45:32	1.9
--- msgcat/msgcat.tcl	2000/11/27 15:55:23
***************
*** 12,18 ****
  # 
  # RCS: @(#) $Id: msgcat.tcl,v 1.9 2000/08/11 00:45:32 ericm Exp $
  
! package provide msgcat 1.2
  
  namespace eval msgcat {
      namespace export mc mcset mcmset mclocale mcpreferences mcunknown mcmax
--- 12,18 ----
  # 
  # RCS: @(#) $Id: msgcat.tcl,v 1.9 2000/08/11 00:45:32 ericm Exp $
  
! package provide msgcat 1.2.1
  
  namespace eval msgcat {
      namespace export mc mcset mcmset mclocale mcpreferences mcunknown mcmax
***************
*** 49,55 ****
      # Check for the src in each namespace starting from the local and
      # ending in the global.
  
!     set ns [uplevel {namespace current}]
      
      while {$ns != ""} {
  	foreach loc $::msgcat::loclist {
--- 49,55 ----
      # Check for the src in each namespace starting from the local and
      # ending in the global.
  
!     set ns [uplevel 1 [list ::namespace current]]
      
      while {$ns != ""} {
  	foreach loc $::msgcat::loclist {
***************
*** 66,72 ****
  	set ns [namespace parent $ns]
      }
      # we have not found the translation
!     return [uplevel 1 [list [namespace origin mcunknown] \
  	    $::msgcat::locale $src] $args]
  }
  
--- 66,72 ----
  	set ns [namespace parent $ns]
      }
      # we have not found the translation
!     return [uplevel 1 [list [::namespace origin mcunknown] \
  	    $::msgcat::locale $src] $args]
  }
  
***************
*** 136,142 ****
  	    incr x
  	    set fid [open $langfile "r"]
  	    fconfigure $fid -encoding utf-8
!             uplevel [list eval [read $fid]]
  	    close $fid
  	}
      }
--- 136,142 ----
  	    incr x
  	    set fid [open $langfile "r"]
  	    fconfigure $fid -encoding utf-8
!             uplevel 1 [read $fid]
  	    close $fid
  	}
      }
***************
*** 161,167 ****
  	set dest $src
      }
  
!     set ns [uplevel {namespace current}]
  
      set ::msgcat::msgs([string tolower $locale],$ns,$src) $dest
      return $dest
--- 161,167 ----
  	set dest $src
      }
  
!     set ns [uplevel 1 [list ::namespace current]]
  
      set ::msgcat::msgs([string tolower $locale],$ns,$src) $dest
      return $dest
***************
*** 186,192 ****
      }
      
      set locale [string tolower $locale]
!     set ns [uplevel {namespace current}]
      
      foreach {src dest} $pairs {
          set ::msgcat::msgs($locale,$ns,$src) $dest
--- 186,192 ----
      }
      
      set locale [string tolower $locale]
!     set ns [uplevel 1 [list ::namespace current]]
      
      foreach {src dest} $pairs {
          set ::msgcat::msgs($locale,$ns,$src) $dest
Index: msgcat/pkgIndex.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/msgcat/pkgIndex.tcl,v
retrieving revision 1.3
diff -c -r1.3 pkgIndex.tcl
*** msgcat/pkgIndex.tcl	2000/08/11 00:45:32	1.3
--- msgcat/pkgIndex.tcl	2000/11/27 15:55:23
***************
*** 1 ****
! package ifneeded msgcat 1.2 [list source [file join $dir msgcat.tcl]]
--- 1 ----
! package ifneeded msgcat 1.2.1 [list source [file join $dir msgcat.tcl]]
Index: opt/optparse.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/opt/optparse.tcl,v
retrieving revision 1.4
diff -c -r1.4 optparse.tcl
*** opt/optparse.tcl	2000/07/18 21:30:41	1.4
--- opt/optparse.tcl	2000/11/27 15:55:24
***************
*** 10,16 ****
  #
  # RCS: @(#) $Id: optparse.tcl,v 1.4 2000/07/18 21:30:41 ericm Exp $
  
! package provide opt 0.4.1
  
  namespace eval ::tcl {
  
--- 10,16 ----
  #
  # RCS: @(#) $Id: optparse.tcl,v 1.4 2000/07/18 21:30:41 ericm Exp $
  
! package provide opt 0.4.2
  
  namespace eval ::tcl {
  
***************
*** 239,245 ****
  # Assign a temporary key, call OptKeyParse and then free the storage
  proc ::tcl::OptParse {desc arglist} {
      set tempkey [OptKeyRegister $desc];
!     set ret [catch {uplevel [list ::tcl::OptKeyParse $tempkey $arglist]} res];
      OptKeyDelete $tempkey;
      return -code $ret $res;
  }
--- 239,245 ----
  # Assign a temporary key, call OptKeyParse and then free the storage
  proc ::tcl::OptParse {desc arglist} {
      set tempkey [OptKeyRegister $desc];
!     set ret [catch {uplevel 1 [list ::tcl::OptKeyParse $tempkey $arglist]} res];
      OptKeyDelete $tempkey;
      return -code $ret $res;
  }
***************
*** 252,258 ****
  # (the other will be sets to their default value)
  # into local variable named "Args".
  proc ::tcl::OptProc {name desc body} {
!     set namespace [uplevel namespace current];
      if {   ([string match "::*" $name]) 
          || ([string compare $namespace "::"]==0)} {
          # absolute name or global namespace, name is the key
--- 252,258 ----
  # (the other will be sets to their default value)
  # into local variable named "Args".
  proc ::tcl::OptProc {name desc body} {
!     set namespace [uplevel 1 [list ::namespace current]];
      if {   ([string match "::*" $name]) 
          || ([string compare $namespace "::"]==0)} {
          # absolute name or global namespace, name is the key
***************
*** 262,268 ****
          set key "${namespace}::${name}";
      }
      OptKeyRegister $desc $key;
!     uplevel [list proc $name args "set Args \[::tcl::OptKeyParse $key \$args\]\n$body"];
      return $key;
  }
  # Check that a argument has been given
--- 262,268 ----
          set key "${namespace}::${name}";
      }
      OptKeyRegister $desc $key;
!     uplevel 1 [list ::proc $name args "set Args \[::tcl::OptKeyParse $key \$args\]\n$body"];
      return $key;
  }
  # Check that a argument has been given
***************
*** 307,313 ****
  
      # Advance to next description
      proc OptNextDesc {descName} {
!         uplevel [list Lvarincr $descName {0 1}];
      }
  
      # Get the current description, eventually descend
--- 307,313 ----
  
      # Advance to next description
      proc OptNextDesc {descName} {
!         uplevel 1 [list Lvarincr $descName {0 1}];
      }
  
      # Get the current description, eventually descend
***************
*** 365,371 ****
      }
      # Advance to next argument
      proc OptNextArg {argsName} {
!         uplevel [list Lvarpop1 $argsName];
      }
      #######
  
--- 365,371 ----
      }
      # Advance to next argument
      proc OptNextArg {argsName} {
!         uplevel 1 [list Lvarpop1 $argsName];
      }
      #######
  
***************
*** 1055,1061 ****
      set lg [llength $list];
      foreach vname $args {
          if {$i>=$lg} break
!         uplevel [list set $vname [lindex $list $i]];
          incr i;
      }
      return $lg;
--- 1055,1061 ----
      set lg [llength $list];
      foreach vname $args {
          if {$i>=$lg} break
!         uplevel 1 [list ::set $vname [lindex $list $i]];
          incr i;
      }
      return $lg;
Index: opt/pkgIndex.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/opt/pkgIndex.tcl,v
retrieving revision 1.2
diff -c -r1.2 pkgIndex.tcl
*** opt/pkgIndex.tcl	1999/04/16 00:47:19	1.2
--- opt/pkgIndex.tcl	2000/11/27 15:55:24
***************
*** 8,11 ****
  # script is sourced, the variable $dir must contain the
  # full path name of this file's directory.
  
! package ifneeded opt 0.4.1 [list source [file join $dir optparse.tcl]]
--- 8,11 ----
  # script is sourced, the variable $dir must contain the
  # full path name of this file's directory.
  
! package ifneeded opt 0.4.2 [list source [file join $dir optparse.tcl]]