summaryrefslogtreecommitdiffstats
path: root/library/safe.tcl
diff options
context:
space:
mode:
authorstanton <stanton>1999-04-16 00:46:29 (GMT)
committerstanton <stanton>1999-04-16 00:46:29 (GMT)
commit97464e6cba8eb0008cf2727c15718671992b913f (patch)
treece9959f2747257d98d52ec8d18bf3b0de99b9535 /library/safe.tcl
parenta8c96ddb94d1483a9de5e340b740cb74ef6cafa7 (diff)
downloadtcl-97464e6cba8eb0008cf2727c15718671992b913f.zip
tcl-97464e6cba8eb0008cf2727c15718671992b913f.tar.gz
tcl-97464e6cba8eb0008cf2727c15718671992b913f.tar.bz2
merged tcl 8.1 branch back into the main trunk
Diffstat (limited to 'library/safe.tcl')
-rw-r--r--library/safe.tcl48
1 files changed, 46 insertions, 2 deletions
diff --git a/library/safe.tcl b/library/safe.tcl
index 44def92..3be7739 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -12,7 +12,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: safe.tcl,v 1.4 1998/11/11 02:39:31 welch Exp $
+# RCS: @(#) $Id: safe.tcl,v 1.5 1999/04/16 00:46:57 stanton Exp $
#
# The implementation is based on namespaces. These naming conventions
@@ -22,7 +22,7 @@
#
# Needed utilities package
-package require opt 0.2;
+package require opt 0.4.1;
# Create the safe namespace
namespace eval ::safe {
@@ -440,6 +440,13 @@ proc ::safe::interpAddToAccessPath {slave path} {
::interp alias $slave source {} [namespace current]::AliasSource $slave
::interp alias $slave load {} [namespace current]::AliasLoad $slave
+ # This alias lets the slave use the encoding names, convertfrom,
+ # convertto, and system, but not "encoding system <name>" to set
+ # the system encoding.
+
+ ::interp alias $slave encoding {} [namespace current]::AliasEncoding \
+ $slave
+
# This alias lets the slave have access to a subset of the 'file'
# command functionality.
@@ -884,4 +891,41 @@ proc ::safe::setLogCmd {args} {
[namespace current]::Subset $slave $target $pat
}
+ # AliasEncoding is the target of the "encoding" alias in safe interpreters.
+
+ proc AliasEncoding {slave args} {
+
+ set argc [llength $args];
+
+ set okpat "^(name.*|convert.*)\$"
+ set subcommand [lindex $args 0]
+
+ if {[regexp $okpat $subcommand]} {
+ return [eval ::interp invokehidden $slave encoding $subcommand \
+ [lrange $args 1 end]]
+ }
+
+ if {[string match $subcommand system]} {
+ if {$argc == 1} {
+ # passed all the tests , lets source it:
+ if {[catch {::interp invokehidden \
+ $slave encoding system} msg]} {
+ Log $slave $msg;
+ return -code error "script error";
+ }
+ } else {
+ set msg "wrong # args: should be \"encoding system\"";
+ Log $slave $msg;
+ error $msg;
+ }
+ } else {
+ set msg "wrong # args: should be \"encoding option ?arg ...?\"";
+ Log $slave $msg;
+ error $msg;
+ }
+
+
+ return $msg
+ }
+
}