From: Jeff Hobbs Date: Fri, 21 Feb 2003 00:45:30 +0000 (+0000) Subject: * tkcon.tcl (EvalCmd): set $:: (aka ${}) var to last command result. X-Git-Tag: tkcon-2-4~22 X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=f926ca2f933cc95cc8695f643fdd19ac32739bf9;p=tkcon * tkcon.tcl (EvalCmd): set $:: (aka ${}) var to last command result. (EvalOther): use tk_messageBox instead of tk_dialog (Init): allow 'edit' to be overridden using OPT(edit) --- diff --git a/ChangeLog b/ChangeLog index b777464..659a96e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2003-02-20 Jeff Hobbs + + * tkcon.tcl (EvalCmd): set $:: (aka ${}) var to last command result. + (EvalOther): use tk_messageBox instead of tk_dialog + (Init): allow 'edit' to be overridden using OPT(edit) + +2003-01-13 Jeff Hobbs + + * tkcon.tcl: add tk appname alias in WWW plugin case. + 2002-10-08 Jeff Hobbs * tkcon.tcl (tcl_unknown): allow ::namespace (:'s) to be diff --git a/tkcon.tcl b/tkcon.tcl index a996f82..7b9b2b9 100755 --- a/tkcon.tcl +++ b/tkcon.tcl @@ -131,6 +131,7 @@ proc ::tkcon::Init {args} { cols 80 debugPrompt {(level \#$level) debug [history nextid] > } dead {} + edit edit expandorder {Pathname Variable Procname} font {} history 48 @@ -180,7 +181,6 @@ proc ::tkcon::Init {args} { errorInfo {} protocol exit showOnStartup 1 - slavealias { edit more less tkcon } slaveprocs { alias clear dir dump echo idebug lremove tkcon_puts tkcon_gets observe observe_var unalias which what @@ -193,6 +193,11 @@ proc ::tkcon::Init {args} { } { if {![info exists PRIV($key)]} { set PRIV($key) $default } } + foreach {key default} { + slavealias { $OPT(edit) more less tkcon } + } { + if {![info exists PRIV($key)]} { set PRIV($key) [subst $default] } + } set PRIV(version) $VERSION if {[info exists PRIV(name)]} { @@ -642,11 +647,13 @@ proc ::tkcon::GarbageCollect {} { variable PRIV set w $PRIV(console) - ## Remove error tags that no longer span anything - ## Make sure the tag pattern matches the unique tag prefix - foreach tag [$w tag names] { - if {[string match _tag* $tag] && ![llength [$w tag ranges $tag]]} { - $w tag delete $tag + if {[winfo exists $w]} { + ## Remove error tags that no longer span anything + ## Make sure the tag pattern matches the unique tag prefix + foreach tag [$w tag names] { + if {[string match _tag* $tag] && ![llength [$w tag ranges $tag]]} { + $w tag delete $tag + } } } if {$OPT(gc-delay)} { @@ -743,6 +750,7 @@ proc ::tkcon::EvalCmd {w cmd} { } } AddSlaveHistory $cmd + catch {EvalAttached [list set {} $res]} if {$code} { if {$OPT(hoterrors)} { set tag [UniqueTag $w] @@ -753,7 +761,7 @@ proc ::tkcon::EvalCmd {w cmd} { [list $w tag configure $tag -under 0] $w tag bind $tag \ "if {!\[info exists tkPriv(mouseMoved)\] || !\$tkPriv(mouseMoved)} \ - {[list edit -attach [Attach] -type error -- $PRIV(errorInfo)]}" + {[list $OPT(edit) -attach [Attach] -type error -- $PRIV(errorInfo)]}" } else { $w insert output $res\n stderr } @@ -827,9 +835,10 @@ proc ::tkcon::EvalSend cmd { ## Interpreter disappeared if {[string compare leave $OPT(dead)] && \ ([string match ignore $OPT(dead)] || \ - [tk_dialog $PRIV(base).dead "Dead Attachment" \ - "\"$PRIV(app)\" appears to have died.\ - \nReturn to primary slave interpreter?" questhead 0 OK No])} { + [tk_messageBox -title "Dead Attachment" -type yesno \ + -icon info -message \ + "\"$PRIV(app)\" appears to have died.\ + \nReturn to primary slave interpreter?"]=="no")} { set PRIV(appname) "DEAD:$PRIV(appname)" set PRIV(deadapp) 1 } else { @@ -2509,7 +2518,7 @@ proc ::tkcon::ErrorHighlight w { $w tag bind $tag [list $w tag configure $tag -under 1] $w tag bind $tag [list $w tag configure $tag -under 0] $w tag bind $tag "if {!\$tkPriv(mouseMoved)} \ - {[list edit -attach $app -type proc -find $what -- $cmd]}" + {[list $OPT(edit) -attach $app -type proc -find $what -- $cmd]}" } set info [string range $info $c1 end] set start [$w index $start+${c1}c] @@ -2538,7 +2547,7 @@ proc ::tkcon::ErrorHighlight w { $w tag bind $tag [list $w tag configure $tag -under 1] $w tag bind $tag [list $w tag configure $tag -under 0] $w tag bind $tag "if {!\$tkPriv(mouseMoved)} \ - {[list edit -attach $app -type proc -- $cmd]}" + {[list $OPT(edit) -attach $app -type proc -- $cmd]}" } } } @@ -2687,7 +2696,7 @@ proc tkcon {cmd args} { } if {[string match {} $info]} { set info "errorInfo empty" } ## If args is empty, the -attach switch just ignores it - edit -attach $args -type error -- $info + $OPT(edit) -attach $args -type error -- $info } fi* { ## 'find' string @@ -2964,10 +2973,10 @@ proc edit {args} { append w $i toplevel $w wm withdraw $w - if {[string length $word] > 12} { - wm title $w "tkcon Edit: [string range $word 0 9]..." + if {[string length $word] > 20} { + wm title $w "[string range $word 0 16]... - tkcon Edit" } else { - wm title $w "tkcon Edit: $word" + wm title $w "$word - tkcon Edit" } text $w.text -wrap none \ @@ -4594,15 +4603,15 @@ proc ::tkcon::PopupMenu {X Y} { set app [Attach] if {[lsearch $type proc] != -1} { $PRIV(context) add command -label "View Procedure" \ - -command [list edit -attach $app -type proc -- $word] + -command [list $OPT(edit) -attach $app -type proc -- $word] } if {[lsearch $type var] != -1} { $PRIV(context) add command -label "View Variable" \ - -command [list edit -attach $app -type var -- $word] + -command [list $OPT(edit) -attach $app -type var -- $word] } if {[lsearch $type file] != -1} { $PRIV(context) add command -label "View File" \ - -command [list edit -attach $app -type file -- $word] + -command [list $OPT(edit) -attach $app -type file -- $word] } tk_popup $PRIV(context) $X $Y }