From f3db0a4fe9d14d328b4695b9323aa52281c6b7d6 Mon Sep 17 00:00:00 2001 From: andreas_kupries Date: Thu, 10 Dec 2009 00:34:11 +0000 Subject: * library/safetk.tcl (::safe::loadTk): [Bug 2902573]: Fixed access to the cleanupHook of the safe base. The code used the old internal commands which have been removed since 2009-12-09. See Tcl's ChangeLog. --- ChangeLog | 7 +++++++ library/safetk.tcl | 10 +++++++--- 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/ChangeLog b/ChangeLog index 59b6a50..89cc0b2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2009-12-09 Andreas Kupries + + * library/safetk.tcl (::safe::loadTk): [Bug 2902573]: Fixed access + to the cleanupHook of the safe base. The code used the old + internal commands which have been removed since 2009-12-09. See + Tcl's ChangeLog. + 2009-12-09 Donal K. Fellows * generic/tkColor.c (Tk_GetColorByValue): [Bug 2911570]: Ensure that diff --git a/library/safetk.tcl b/library/safetk.tcl index 58cb954..ae198d9 100644 --- a/library/safetk.tcl +++ b/library/safetk.tcl @@ -2,7 +2,7 @@ # # Support procs to use Tk in safe interpreters. # -# RCS: @(#) $Id: safetk.tcl,v 1.12 2008/03/27 21:05:09 hobbs Exp $ +# RCS: @(#) $Id: safetk.tcl,v 1.12.2.1 2009/12/10 00:34:12 andreas_kupries Exp $ # # Copyright (c) 1997 Sun Microsystems, Inc. # @@ -81,19 +81,23 @@ proc ::safe::loadTk {} {} } } } + + # Get state for access to the cleanupHook. + namespace upvar ::safe S$slave state + if {![::tcl::OptProcArgGiven "-use"]} { # create a decorated toplevel ::tcl::Lassign [tkTopLevel $slave $display] w use # set our delete hook (slave arg is added by interpDelete) # to clean up both window related code and tkInit(slave) - Set [DeleteHookName $slave] [list tkDelete {} $w] + set state(cleanupHook) [list tkDelete {} $w] } else { # set our delete hook (slave arg is added by interpDelete) # to clean up tkInit(slave) - Set [DeleteHookName $slave] [list disallowTk] + set state(cleanupHook) [list disallowTk] # Let's be nice and also accept tk window names instead of ids if {[string match ".*" $use]} { -- cgit v0.12