* generic/tkCmds.c:

	* generic/tkWindow.c: made 'tk' available in safe interpreters,
	but only the caret and windowingsystem subcommands may be called.
	* tests/safe.test (safe-1.2): noted that tk is now available in
	safe interps, but not the appname/scaling subcommands.

3 files changed, 56 insertions, 13 deletions

diff --git a/generic/tkCmds.c b/generic/tkCmds.c
index 28da6e4..e84ba83 100644
--- a/generic/tkCmds.c
+++ b/generic/tkCmds.c
@@ -11,14 +11,14 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkCmds.c,v 1.30 2002/08/31 06:12:20 das Exp $
+ * RCS: @(#) $Id: tkCmds.c,v 1.31 2002/09/02 19:16:23 hobbs Exp $
  */
 
 #include "tkPort.h"
 #include "tkInt.h"
 #include <errno.h>
 
-#if defined(__WIN32__)
+#if defined(WIN32)
 #include "tkWinInt.h"
 #elif defined(MAC_TCL)
 #include "tkMacInt.h"
@@ -644,6 +644,13 @@ Tk_TkObjCmd(clientData, interp, objc, objv)
 	    TkWindow *winPtr;
 	    char *string;
 
+	    if (Tcl_IsSafe(interp)) {
+		Tcl_SetResult(interp,
+			"appname not accessible in a safe interpreter",
+			TCL_STATIC);
+		return TCL_ERROR;
+	    }
+
 	    winPtr = (TkWindow *) tkwin;
 
 	    if (objc > 3) {
@@ -741,6 +748,13 @@ Tk_TkObjCmd(clientData, interp, objc, objv)
 	    int skip, width, height;
 	    double d;
 
+	    if (Tcl_IsSafe(interp)) {
+		Tcl_SetResult(interp,
+			"scaling not accessible in a safe interpreter",
+			TCL_STATIC);
+		return TCL_ERROR;
+	    }
+
 	    screenPtr = Tk_Screen(tkwin);
 
 	    skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
@@ -778,6 +792,13 @@ Tk_TkObjCmd(clientData, interp, objc, objv)
 	    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
 	    int skip;
 
+	    if (Tcl_IsSafe(interp)) {
+		Tcl_SetResult(interp,
+			"useinputmethods not accessible in a safe interpreter",
+			TCL_STATIC);
+		return TCL_ERROR;
+	    }
+
 	    skip = TkGetDisplayOf(interp, objc-2, objv+2, &tkwin);
 	    if (skip < 0) {
 		return TCL_ERROR;
@@ -819,15 +840,15 @@ Tk_TkObjCmd(clientData, interp, objc, objv)
 	        Tcl_WrongNumArgs(interp, 2, objv, NULL);
 		return TCL_ERROR;
 	    }
-	    #if defined(__WIN32__) || defined(_WIN32)	    
+#if defined(WIN32)
 	    windowingsystem = "win32";
-	    #elif defined(MAC_TCL)
+#elif defined(MAC_TCL)
 	    windowingsystem = "classic";
-	    #elif defined(MAC_OSX_TK)
+#elif defined(MAC_OSX_TK)
 	    windowingsystem = "aqua";
-	    #else
+#else
 	    windowingsystem = "x11";
-	    #endif
+#endif
 	    Tcl_SetStringObj(Tcl_GetObjResult(interp), windowingsystem, -1);
 	    break;
 	}
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index a69c681..d358cbf 100644
--- a/generic/tkWindow.c
+++ b/generic/tkWindow.c
@@ -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: tkWindow.c,v 1.53 2002/08/31 06:12:28 das Exp $
+ * RCS: @(#) $Id: tkWindow.c,v 1.54 2002/09/02 19:16:23 hobbs Exp $
  */
 
 #include "tkPort.h"
@@ -114,7 +114,7 @@ static TkCmd commands[] = {
     {"place",		NULL,			Tk_PlaceObjCmd,		1, 0},
     {"raise",		NULL,			Tk_RaiseObjCmd,		1, 1},
     {"selection",	NULL,			Tk_SelectionObjCmd,	0, 1},
-    {"tk",		NULL,			Tk_TkObjCmd,		0, 1},
+    {"tk",		NULL,			Tk_TkObjCmd,		1, 1},
     {"tkwait",		NULL,			Tk_TkwaitObjCmd,	1, 1},
 #if defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)
     {"tk_chooseColor",  NULL,			Tk_ChooseColorObjCmd,	0, 1},
diff --git a/tests/safe.test b/tests/safe.test
index ba483dc..060a1e1 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: safe.test,v 1.9 2002/07/13 20:28:35 dgp Exp $
+# RCS: @(#) $Id: safe.test,v 1.10 2002/09/02 19:16:24 hobbs Exp $
 
 package require tcltest 2.1
 namespace import -force tcltest::configure
@@ -38,11 +38,11 @@ tcltest::loadTestedCommands
 # The set of hidden commands is platform dependent:
 
 if {"$tcl_platform(platform)" == "macintosh"} {
-    set hidden_cmds {beep bell cd clipboard echo encoding exit fconfigure file glob grab load ls menu open pwd selection send socket source tk tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile toplevel wm}
+    set hidden_cmds {beep bell cd clipboard echo encoding exit fconfigure file glob grab load ls menu open pwd selection send socket source tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile toplevel wm}
 } elseif {"$tcl_platform(platform)" == "windows"} {
-    set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection socket source tk tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
+    set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection socket source tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
 } else {
-    set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection send socket source tk toplevel wm}
+    set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection send socket source toplevel wm}
 }
 
 test safe-1.1 {Safe Tk loading into an interpreter} {
@@ -91,6 +91,28 @@ test safe-2.2 {Unsafe commands not available} {
     safe::interpDelete a
     set status
 } ok
+test safe-2.3 {Unsafe subcommands not available} {
+    catch {safe::interpDelete a}
+    safe::interpCreate a
+    safe::loadTk a
+    set status broken
+    if {[catch {interp eval a {tk appname}} msg]} {
+	set status ok
+    }
+    safe::interpDelete a
+    list $status $msg
+} {ok {appname not accessible in a safe interpreter}}
+test safe-2.4 {Unsafe subcommands not available} {
+    catch {safe::interpDelete a}
+    safe::interpCreate a
+    safe::loadTk a
+    set status broken
+    if {[catch {interp eval a {tk scaling}} msg]} {
+	set status ok
+    }
+    safe::interpDelete a
+    list $status $msg
+} {ok {scaling not accessible in a safe interpreter}}
 
 test safe-3.1 {Unsafe commands are available hidden} {
     catch {safe::interpDelete a}