Allow "tk scaling" in safe interpreters, but not when they try to set the scaling factor

3 files changed, 14 insertions, 232 deletions

diff --git a/generic/tkCmds.c b/generic/tkCmds.c
index c5f0a50..b9e07e7 100644
--- a/generic/tkCmds.c
+++ b/generic/tkCmds.c
@@ -774,7 +774,8 @@ CaretCmd(
 	}
 	Tcl_SetObjResult(interp, Tcl_NewIntObj(value));
     } else {
-	int i, value, x = 0, y = 0, height = -1;
+	int i;
+	int value, x = 0, y = 0, height = -1;
 
 	for (i = 2; i < objc; i += 2) {
 	    if ((Tcl_GetIndexFromObj(interp, objv[i], caretStrings,
@@ -810,13 +811,6 @@ ScalingCmd(
     int skip, width, height;
     double d;
 
-    if (Tcl_IsSafe(interp)) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		"scaling not accessible in a safe interpreter", -1));
-	Tcl_SetErrorCode(interp, "TK", "SAFE", "SCALING", NULL);
-	return TCL_ERROR;
-    }
-
     skip = TkGetDisplayOf(interp, objc - 1, objv + 1, &tkwin);
     if (skip < 0) {
 	return TCL_ERROR;
@@ -827,6 +821,11 @@ ScalingCmd(
 	d *= WidthOfScreen(screenPtr);
 	d /= WidthMMOfScreen(screenPtr);
 	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(d));
+    } else if (Tcl_IsSafe(interp)) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"setting the scaling not accessible in a safe interpreter", -1));
+	Tcl_SetErrorCode(interp, "TK", "SAFE", "SCALING", NULL);
+	return TCL_ERROR;
     } else if (objc - skip == 2) {
 	if (Tcl_GetDoubleFromObj(interp, objv[1+skip], &d) != TCL_OK) {
 	    return TCL_ERROR;
@@ -940,11 +939,11 @@ InactiveCmd(
 	return TCL_ERROR;
     }
     if (objc - skip == 1) {
-	long inactive;
+	Tcl_WideInt inactive;
 
 	inactive = (Tcl_IsSafe(interp) ? -1 :
 		Tk_GetUserInactiveTime(Tk_Display(tkwin)));
-	Tcl_SetObjResult(interp, Tcl_NewLongObj(inactive));
+	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(inactive));
     } else if (objc - skip == 2) {
 	const char *string;
 
@@ -1824,224 +1823,7 @@ Tk_WinfoObjCmd(
     return TCL_OK;
 }
 
-#if 0
-/*
- *----------------------------------------------------------------------
- *
- * Tk_WmObjCmd --
- *
- *	This function is invoked to process the "wm" Tcl command. See the user
- *	documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-	/* ARGSUSED */
-int
-Tk_WmObjCmd(
-    ClientData clientData,	/* Main window associated with interpreter. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Tk_Window tkwin;
-    TkWindow *winPtr;
-
-    static const char *const optionStrings[] = {
-	"aspect",	"client",	"command",	"deiconify",
-	"focusmodel",	"frame",	"geometry",	"grid",
-	"group",	"iconbitmap",	"iconify",	"iconmask",
-	"iconname",	"iconposition",	"iconwindow",	"maxsize",
-	"minsize",	"overrideredirect",	"positionfrom",	"protocol",
-	"resizable",	"sizefrom",	"state",	"title",
-	"tracing",	"transient",	"withdraw",	NULL
-    };
-    enum options {
-	TKWM_ASPECT,	TKWM_CLIENT,	TKWM_COMMAND,	TKWM_DEICONIFY,
-	TKWM_FOCUSMOD,	TKWM_FRAME,	TKWM_GEOMETRY,	TKWM_GRID,
-	TKWM_GROUP,	TKWM_ICONBMP,	TKWM_ICONIFY,	TKWM_ICONMASK,
-	TKWM_ICONNAME,	TKWM_ICONPOS,	TKWM_ICONWIN,	TKWM_MAXSIZE,
-	TKWM_MINSIZE,	TKWM_OVERRIDE,	TKWM_POSFROM,	TKWM_PROTOCOL,
-	TKWM_RESIZABLE,	TKWM_SIZEFROM,	TKWM_STATE,	TKWM_TITLE,
-	TKWM_TRACING,	TKWM_TRANSIENT,	TKWM_WITHDRAW
-    };
-
-    tkwin = (Tk_Window) clientData;
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "option window ?arg?");
-	return TCL_ERROR;
-    }
-    if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
-	    &index) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    if (index == TKWM_TRACING) {
-	int wmTracing;
-	TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
-
-	if ((objc != 2) && (objc != 3)) {
-	    Tcl_WrongNumArgs(interp, 1, objv, "tracing ?boolean?");
-	    return TCL_ERROR;
-	}
-	if (objc == 2) {
-	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
-		    dispPtr->flags & TK_DISPLAY_WM_TRACING));
-	    return TCL_OK;
-	}
-	if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (wmTracing) {
-	    dispPtr->flags |= TK_DISPLAY_WM_TRACING;
-	} else {
-	    dispPtr->flags &= ~TK_DISPLAY_WM_TRACING;
-	}
-	return TCL_OK;
-    }
-
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 2, objv, "window ?arg?");
-	return TCL_ERROR;
-    }
 
-    winPtr = (TkWindow *) Tk_NameToWindow(interp,
-	    Tcl_GetString(objv[2]), tkwin);
-    if (winPtr == NULL) {
-	return TCL_ERROR;
-    }
-    if (!(winPtr->flags & TK_TOP_LEVEL)) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"window \"%s\" isn't a top-level window", winPtr->pathName));
-	Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TOPLEVEL", winPtr->pathName,
-		NULL);
-	return TCL_ERROR;
-    }
-
-    switch ((enum options) index) {
-    case TKWM_ASPECT:
-	TkpWmAspectCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_CLIENT:
-	TkpWmClientCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_COMMAND:
-	TkpWmCommandCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_DEICONIFY:
-	TkpWmDeiconifyCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_FOCUSMOD:
-	TkpWmFocusmodCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_FRAME:
-	TkpWmFrameCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_GEOMETRY:
-	TkpWmGeometryCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_GRID:
-	TkpWmGridCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_GROUP:
-	TkpWmGroupCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_ICONBMP:
-	TkpWmIconbitmapCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_ICONIFY:
-	TkpWmIconifyCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_ICONMASK:
-	TkpWmIconmaskCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_ICONNAME:
-	/*
-	 * Slight Unix variation.
-	 */
-	TkpWmIconnameCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_ICONPOS:
-	/*
-	 * nearly same - 1 line more on Unix.
-	 */
-	TkpWmIconpositionCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_ICONWIN:
-	TkpWmIconwindowCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_MAXSIZE:
-	/*
-	 * Nearly same, win diffs.
-	 */
-	TkpWmMaxsizeCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_MINSIZE:
-	/*
-	 * Nearly same, win diffs
-	 */
-	TkpWmMinsizeCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_OVERRIDE:
-	/*
-	 * Almost same.
-	 */
-	TkpWmOverrideCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_POSFROM:
-	/*
-	 * Equal across platforms
-	 */
-	TkpWmPositionfromCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_PROTOCOL:
-	/*
-	 * Equal across platforms
-	 */
-	TkpWmProtocolCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_RESIZABLE:
-	/*
-	 * Almost same
-	 */
-	TkpWmResizableCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_SIZEFROM:
-	/*
-	 * Equal across platforms
-	 */
-	TkpWmSizefromCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_STATE:
-	TkpWmStateCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_TITLE:
-	TkpWmTitleCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_TRANSIENT:
-	TkpWmTransientCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    case TKWM_WITHDRAW:
-	TkpWmWithdrawCmd(interp, tkwin, winPtr, objc, objv);
-	break;
-    }
-
-  updateGeom:
-    if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
-	Tcl_DoWhenIdle(UpdateGeometryInfo, winPtr);
-	wmPtr->flags |= WM_UPDATE_PENDING;
-    }
-    return TCL_OK;
-}
-#endif
-
 /*
  *----------------------------------------------------------------------
  *
diff --git a/tests/safe.test b/tests/safe.test
index 31cb1b7..d00f7c1 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -3,7 +3,7 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1995 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-1999 Scriptics Corporation.
 # All rights reserved.
 
 package require tcltest 2.2
@@ -141,13 +141,13 @@ test safe-2.4 {Unsafe subcommands not available} -setup {
     safe::interpCreate a
     safe::loadTk a
     set status broken
-    if {[catch {interp eval a {tk scaling}} msg]} {
+    if {[catch {interp eval a {tk scaling 1}} msg]} {
 	set status ok
     }
     list $status $msg
 } -cleanup {
     safe::interpDelete a
-} -result {ok {scaling not accessible in a safe interpreter}}
+} -result {ok {setting the scaling not accessible in a safe interpreter}}
 
 test safe-3.1 {Unsafe commands are available hidden} -setup {
     catch {safe::interpDelete a}
diff --git a/unix/Makefile.in b/unix/Makefile.in
index e98070e..77589ba 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -112,7 +112,7 @@ TCL_PLATFORM_DIR	= $(TCLDIR)/unix
 # for this version of Tk:
 TCL_BIN_DIR		= @TCL_BIN_DIR@
 
-# The linker flags needed to link in the Tcl library (ex: -ltcl8.2)
+# The linker flags needed to link in the Tcl library (ex: -ltcl8.6)
 TCL_LIB_FLAG		= @TCL_LIB_FLAG@
 
 # Flag, 1: we're building a shared lib, 0 we're not
@@ -190,7 +190,7 @@ KEYSYM_FLAGS		=
 # compile fine with -DTCL_NO_DEPRECATED. To remove its own
 # set of deprecated code uncomment the second line.
 NO_DEPRECATED_FLAGS	=
-#NO_DEPRECATED_FLAGS	= -DTK_NO_DEPRECATED
+#NO_DEPRECATED_FLAGS	= -DTCL_NO_DEPRECATED -DTK_NO_DEPRECATED
 
 # Some versions of make, like SGI's, use the following variable to
 # determine which shell to use for executing commands: