From 4e674e6b1ec465975a7138542ed175cc6f9acda3 Mon Sep 17 00:00:00 2001
From: patthoyts <patthoyts@users.sourceforge.net>
Date: Fri, 3 Nov 2006 15:58:51 +0000
Subject: Theme it

---
 ChangeLog          |  2 ++
 library/safetk.tcl | 20 +++++++++++---------
 2 files changed, 13 insertions(+), 9 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 2e36836..2280ab7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,7 @@
 2006-11-03  Pat Thoyts  <patthoyts@users.sourceforge.net>
 
+	* library/safetk.tcl (::safe::tkTopLevel): Theme it.
+
 	* generic/ttk/ttkLayout.c:     We do not want to require tkInt in
 	* generic/ttk/ttkMananager.h:  all the ttk files so added the
 	* generic/ttk/ttkTheme.h:      definition of MODULE_SCOPE to 
diff --git a/library/safetk.tcl b/library/safetk.tcl
index 5a14dde..4ad1418 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.9 2005/07/25 09:06:00 dkf Exp $
+# RCS: @(#) $Id: safetk.tcl,v 1.10 2006/11/03 15:58:51 patthoyts Exp $
 #
 # Copyright (c) 1997 Sun Microsystems, Inc.
 #
@@ -242,28 +242,30 @@ proc ::safe::tkTopLevel {slave display} {
     set msg "Untrusted Tcl applet ($slave)"
     wm title $w $msg
 
-    # Control frame
+    # Control frame (we must create a style for it)
+    ttk::style layout TWarningFrame {WarningFrame.border -sticky nswe}
+    ttk::style configure TWarningFrame -background red
+
     set wc $w.fc
-    frame $wc -bg red -borderwidth 3 -relief ridge
+    ttk::frame $wc -relief ridge -borderwidth 4 -style TWarningFrame
 
     # We will destroy the interp when the window is destroyed
     bindtags $wc [concat Safe$wc [bindtags $wc]]
     bind Safe$wc <Destroy> [list ::safe::tkDelete %W $w $slave]
 
-    label $wc.l -text $msg -padx 2 -pady 0 -anchor w
+    ttk::label $wc.l -text $msg -anchor w
 
     # We want the button to be the last visible item
     # (so be packed first) and at the right and not resizing horizontally
 
     # frame the button so it does not expand horizontally
     # but still have the default background instead of red one from the parent
-    frame  $wc.fb -bd 0
-    button $wc.fb.b -text "Delete" \
-	    -bd 1  -padx 2 -pady 0 -highlightthickness 0 \
+    ttk::frame  $wc.fb -borderwidth 0
+    ttk::button $wc.fb.b -text "Delete" \
 	    -command [list ::safe::tkDelete $w $w $slave]
     pack $wc.fb.b -side right -fill both
     pack $wc.fb -side right -fill both -expand 1
-    pack $wc.l -side left  -fill both -expand 1
+    pack $wc.l -side left -fill both -expand 1 -ipady 2
     pack $wc -side bottom -fill x
 
     # Container frame
@@ -274,4 +276,4 @@ proc ::safe::tkTopLevel {slave display} {
     list $w [winfo id $w.c]
 }
 
-}
+}
\ No newline at end of file
-- 
cgit v0.12