From 45939ff7994ae9bbf48347c88a86c7682b2bdeff Mon Sep 17 00:00:00 2001 From: Jeff Hobbs Date: Fri, 13 Feb 2004 00:03:24 +0000 Subject: [PATCH] (::tkcon::InterpEval, Interps): beware safe interps with Tk --- ChangeLog | 3 ++- tkcon.tcl | 47 +++++++++++++++++++++++++++-------------------- 2 files changed, 29 insertions(+), 21 deletions(-) diff --git a/ChangeLog b/ChangeLog index 06b24de..120c391 100644 --- a/ChangeLog +++ b/ChangeLog @@ -4,7 +4,8 @@ as it doesn't exist in the Tcl plugin. Show Attach info in tab text, maintain namespace attachment between console switches. - + (::tkcon::InterpEval, Interps): beware safe interps with Tk + 2004-02-05 Jeff Hobbs * tkcon.tcl: brought code back to 8.0 compatability. diff --git a/tkcon.tcl b/tkcon.tcl index a252894..84bb200 100755 --- a/tkcon.tcl +++ b/tkcon.tcl @@ -1302,12 +1302,12 @@ proc ::tkcon::InitMenus {w title} { variable COLOR global tcl_platform - if {[catch {menu $w.pop -tearoff 0}]} { + if {[catch {menu $w.pop}]} { label $w.label -text "Menus not available in plugin mode" grid $w.label -sticky ew return } - menu $w.context -tearoff 0 -disabledforeground $COLOR(disabled) + menu $w.context -disabledforeground $COLOR(disabled) set PRIV(context) $w.context set PRIV(popup) $w.pop @@ -1334,7 +1334,7 @@ proc ::tkcon::InitMenus {w title} { ## Save Menu ## set s $m.save - menu $s -disabledforeground $COLOR(disabled) -tearoff 0 + menu $s -disabledforeground $COLOR(disabled) $s add command -label "All" -underline 0 \ -command {::tkcon::Save {} all} $s add command -label "History" -underline 0 \ @@ -1366,15 +1366,13 @@ proc ::tkcon::InitMenus {w title} { -command ::tkcon::XauthSecure } $m add separator - $m add cascade -label "Attach To ..." -underline 0 -menu $m.attach + $m add cascade -label "Attach To ..." -underline 0 -menu $m.attach ## Attach Console Menu ## set sub [menu $m.attach -disabledforeground $COLOR(disabled)] - $sub add cascade -label "Interpreter" -underline 0 -menu $sub.apps - $sub add cascade -label "Namespace" -underline 1 -menu $sub.name - $sub add cascade -label "Socket" -underline 1 -menu $sub.sock \ - -state [expr {([info tclversion] < 8.3)?"disabled":"normal"}] + $sub add cascade -label "Interpreter" -underline 0 -menu $sub.apps + $sub add cascade -label "Namespace" -underline 0 -menu $sub.name ## Attach Console Menu ## @@ -1383,25 +1381,24 @@ proc ::tkcon::InitMenus {w title} { ## Attach Namespace Menu ## - menu $sub.name -disabledforeground $COLOR(disabled) -tearoff 0 \ + menu $sub.name -disabledforeground $COLOR(disabled) \ -postcommand [list ::tkcon::NamespaceMenu $sub.name] if {$::tcl_version >= 8.3} { - # This uses [file channels] to create the menu, so we only - # want it for newer versions of Tcl. - ## Attach Socket Menu ## - menu $sub.sock -disabledforeground $COLOR(disabled) -tearoff 0 \ + # This uses [file channels] to create the menu, so we only + # want it for newer versions of Tcl. + $sub add cascade -label "Socket" -underline 0 -menu $sub.sock + menu $sub.sock -disabledforeground $COLOR(disabled) \ -postcommand [list ::tkcon::SocketMenu $sub.sock] } - ## Attach Display Menu - ## if {![string compare "unix" $tcl_platform(platform)]} { - $sub add cascade -label "Display" -und 1 -menu $sub.disp + ## Attach Display Menu + ## + $sub add cascade -label "Display" -underline 0 -menu $sub.disp menu $sub.disp -disabledforeground $COLOR(disabled) \ - -tearoff 0 \ -postcommand [list ::tkcon::DisplayMenu $sub.disp] } } @@ -1460,7 +1457,7 @@ proc ::tkcon::InitMenus {w title} { ## Scrollbar Menu ## - set m [menu $m.scroll -tearoff 0] + set m [menu $m.scroll] $m add radio -label "Left" -value left \ -variable ::tkcon::OPT(scrollypos) \ -command { grid configure $::tkcon::PRIV(scrolly) -column 0 } @@ -2401,7 +2398,13 @@ proc ::tkcon::MainInit {} { if {[llength $args]} { return [interp eval $slave uplevel \#0 $args] } else { - return [interp eval $slave tk appname] + # beware safe interps with Tk + if {[interp eval $slave {llength [info commands tk]}]} { + if {[catch {interp eval $slave tk appname} name]} { + return "safetk" + } + return $name + } } } @@ -2412,7 +2415,11 @@ proc ::tkcon::MainInit {} { foreach i [interp slaves $interp] { if {[string compare {} $interp]} { set i "$interp $i" } if {[string compare {} [interp eval $i package provide Tk]]} { - lappend ls $i [interp eval $i tk appname] + # beware safe interps with Tk + if {[catch {interp eval $i tk appname} name]} { + set name {} + } + lappend ls $i $name } else { lappend ls $i {} } -- 2.23.0