From: Jeff Hobbs <hobbs@users.sourceforge.net>
Date: Tue, 19 Sep 2000 18:31:00 +0000 (+0000)
Subject: 	* tkcon.tcl: updated v0.52 to v0.63 version
X-Git-Tag: tkcon-0-63
X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=88870ef7333ee66bda161a8dd9c369a3493a4264;p=tkcon

	* tkcon.tcl: updated v0.52 to v0.63 version
	* ChangeLog: added a ChangeLog
---

diff --git a/ChangeLog b/ChangeLog
new file mode 100644
index 0000000..5de9ee8
--- /dev/null
+++ b/ChangeLog
@@ -0,0 +1,4 @@
+2000-09-19  Jeff Hobbs  <hobbs@scriptics.com>
+
+	* tkcon.tcl: updated v0.52 to v0.63 version
+	* ChangeLog: added a ChangeLog
diff --git a/tkcon.tcl b/tkcon.tcl
index 53091e7..ac0d6f2 100755
--- a/tkcon.tcl
+++ b/tkcon.tcl
@@ -1,38 +1,33 @@
 #!/bin/sh
-# The wish executable needs to be Tk4.1+ \
+# \
 exec wish "$0" ${1+"$@"}
 
 #
 ## tkcon.tcl
-## Tk Console Widget, part of the VerTcl system
+## Enhanced Tk Console, part of the VerTcl system
 ##
-## Based (loosely) off Brent Welch's Tcl Shell Widget
+## Originally based off Brent Welch's Tcl Shell Widget
+## (from "Practical Programming in Tcl and Tk")
 ##
 ## Thanks especially to the following for bug reports & code ideas:
-## Steven Wahl <steven@indra.com>
-## Jan Nijtmans <nijtmans@nici.kun.nl>
-## Crimmins < @umich.edu somewhere >
+## Steven Wahl <steven@indra.com>, Jan Nijtmans <nijtmans@nici.kun.nl>
+## Crimmins <markcrim@umich.edu>, Wart <wart@ugcs.caltech.edu>
 ##
-## Copyright 1995,1996 Jeffrey Hobbs.  All rights reserved.
+## Copyright 1995,1996 Jeffrey Hobbs
 ## Initiated: Thu Aug 17 15:36:47 PDT 1995
 ##
 ## jhobbs@cs.uoregon.edu, http://www.cs.uoregon.edu/~jhobbs/
 ##
 ## source standard_disclaimer.tcl
+## source beer_ware.tcl
+##
 
 if [catch {package require Tk 4.1}] {
-  error "TkCon requires at least the stable version of tcl7.5/tk4.1"
+  return -code error \
+      "TkCon requires at least the stable version of tcl7.5/tk4.1"
 }
 package ifneeded Tk $tk_version {load {} Tk}
 
-## warn - little helper proc to pop up a tk_dialog warning message
-# ARGS:	msg	- message you want to display to user
-##
-proc warn { msg } {
-  bell
-  tk_dialog ._warning Warning $msg warning 0 OK
-}
-
 ## tkConInit - inits tkCon
 # ARGS:	root	- widget pathname of the tkCon console root
 #	title	- title for the console root and main (.) windows
@@ -60,16 +55,17 @@ proc tkConInit {} {
     color,stderr	red
 
     blinktime		500
+    debugPrompt		{(level \#[expr [info level]-1]) debug > }
     font		fixed
     history		32
+    dead		{}
     library		{}
     lightbrace		1
-    lightcmd		0
-    loadTk		0
+    lightcmd		1
+    autoload		{}
     maineval		{}
     nontcl		0
     prompt1		{([file tail [pwd]]) [history nextid] % }
-    prompt2		{[history nextid] cont > }
     rcfile		.tkconrc
     scrollypos		left
     showmultiple	1
@@ -78,12 +74,14 @@ proc tkConInit {} {
     subhistory		1
 
     exec slave app {} appname {} apptype slave cmd {} cmdbuf {} cmdsave {}
-    event 1 svnt 1 cols 80 rows 24 deadapp 0
-    errorInfo		{}
-    slavealias		{ tkcon warn }
-    slaveprocs		{ alias clear dir dump lremove puts tclindex \
-			      auto_execpath unknown unalias which }
-    version	0.52
+    event 1 svnt 1 cols 80 rows 24 deadapp 0 debugging 0
+    find {} find,case 0 find,reg 0
+    errorInfo	{}
+    slavealias	{ tkcon warn }
+    slaveprocs	{ alias clear dir dump lremove puts echo tclindex idebug \
+	auto_execpath unknown tcl_unknown unalias which observe observe_var }
+    version	0.63
+    release	{September 1996}
     root	.
   }
 
@@ -122,8 +120,15 @@ proc tkConInit {} {
     eval lappend auto_path $tkCon(library)
   }
 
-  set dir [file dir [info nameofexec]]
-  foreach dir [list $dir [file join [file dir $dir] lib]] {
+  set dir [file dirname [info nameofexec]]
+  ## Change to work with IncrTcl
+  ##foreach dir [list $dir [file join [file dirname $dir] lib]]
+  if [string comp {} [info commands ensemble]] {
+    set lib [file join lib itcl]
+  } else {
+    set lib lib
+  }
+  foreach dir [list $dir [file join [file dirname $dir] $lib]] {
     if [file exists [file join $dir pkgIndex.tcl]] {
       if {[lsearch -exact $auto_path $dir] < 0} {
 	lappend auto_path $dir
@@ -141,21 +146,25 @@ proc tkConInit {} {
   ## and slave is created, but before initializing UI or setting packages.
   set slaveargs {}
   set slavefiles {}
+  set truth {^(1|yes|true|on)$}
   for {set i 0} {$i < $argc} {incr i} {
     set arg [lindex $argv $i]
     if [regexp -- {-.+} $arg] {
+      set val [lindex $argv [incr i]]
       ## Handle arg based options
       switch -- $arg {
-	-rcfile		{ incr i }
-	-maineval - -e -
-	-eval		{ append tkCon(maineval) [lindex $argv [incr i]]\n }
-	-slave - -slavescript -
-	-slaveeval	{ append tkCon(slaveeval) [lindex $argv [incr i]]\n }
-	-package - -pkg -
-	-load		{ set tkCon(load[lindex $argv [incr i]]) 1 }
-	-nontcl		{ set tkCon(nontcl) 0 }
-	-root		{ set tkCon(root) [lindex $argv [incr i]] }
-	default		{ lappend slaveargs $arg }
+	-- - -argv	{
+	  set argv [concat -- [lrange $argv $i end]]
+	  set argc [llength $argv]
+	  break
+	}
+	-main - -e - -eval	{ append tkCon(maineval) $val\n }
+	-package - -load	{ lappend tkCon(autoload) $val }
+	-slave	{ append tkCon(slaveeval) $val\n }
+	-nontcl	{ set tkCon(nontcl) [regexp -nocase $truth $val] }
+	-root	{ set tkCon(root) $val }
+	-rcfile	{}
+	default	{ lappend slaveargs $arg; incr i -1 }
       }
     } elseif {[file isfile $arg]} {
       lappend slavefiles $arg
@@ -169,11 +178,22 @@ proc tkConInit {} {
     eval tkConInitSlave $tkCon(exec) $slaveargs
   }
 
+  ## Attach to the slave, tkConEvalAttached will then be effective
   tkConAttach $tkCon(appname) $tkCon(apptype)
   tkConInitUI $title
 
-  ## Set up package info for the slave
-  tkConCheckPackages
+  ## Autoload specified packages in slave
+  set pkgs [tkConEvalSlave package names]
+  foreach pkg $tkCon(autoload) {
+    puts -nonewline "autoloading package \"$pkg\" ... "
+    if {[lsearch -exact $pkgs $pkg]>-1} {
+      if [catch {tkConEvalSlave package require $pkg} pkgerr] {
+	puts stderr "error:\n$pkgerr"
+      } else { puts "OK" }
+    } else {
+      puts stderr "error: package does not exist"
+    }
+  }
 
   ## Evaluate maineval in slave
   if {[string comp {} $tkCon(maineval)] &&
@@ -183,22 +203,16 @@ proc tkConInit {} {
 
   ## Source extra command line argument files into slave executable
   foreach fn $slavefiles {
-    puts -nonewline "slave sourcing $fn ... "
+    puts -nonewline "slave sourcing \"$fn\" ... "
     if {[catch {tkConEvalSlave source $fn} fnerr]} {
       puts stderr "error:\n$fnerr"
-    } else {
-      puts "OK"
-    }
+    } else { puts "OK" }
   }
 
-  interp alias {} ls {} dir
-  #interp alias $tkCon(exec) clean {} tkConStateRevert tkCon
-  #tkConStateCheckpoint tkCon
-
   ## Evaluate slaveeval in slave
   if {[string comp {} $tkCon(slaveeval)] &&
       [catch {interp eval $tkCon(exec) $tkCon(slaveeval)} serr]} {
-    puts stderr "error in slave script:\n$serr"
+    puts stderr "error in slave eval:\n$serr"
   }
   ## Output any error/output that may have been returned from rcfile
   if {[info exists code] && [string comp {} $err]} {
@@ -219,19 +233,28 @@ proc tkConInit {} {
 proc tkConInitSlave {slave args} {
   global tkCon argv0 tcl_interactive
   if [string match {} $slave] {
-    error "Don't init the master interpreter, goofball"
+    return -code error "Don't init the master interpreter, goofball"
   }
   if ![interp exists $slave] { interp create $slave }
-  if {[string match {} [$slave eval info command tcl_puts]]} {
-    interp eval $slave rename puts tcl_puts
-  }
+  interp eval $slave {catch {rename puts tcl_puts}}
   foreach cmd $tkCon(slaveprocs) { interp eval $slave [dump proc $cmd] }
   foreach cmd $tkCon(slavealias) { interp alias $slave $cmd {} $cmd }
   interp alias $slave ls $slave dir
   interp eval $slave set tcl_interactive $tcl_interactive \; \
       set argv0 [list $argv0] \; set argc [llength $args] \; \
-      set argv  [list $args] \; history keep $tkCon(history)
-  
+      set argv  [list $args] \; history keep $tkCon(history) \; {
+    if {[string match {} [info command bgerror]]} {
+      proc bgerror err {
+	global errorInfo
+	set body [info body bgerror]
+	rename bgerror {}
+	if [auto_load bgerror] { return [bgerror $err] }
+	proc bgerror err $body
+	tkcon bgerror $err $errorInfo
+      }
+    }
+  }
+
   foreach pkg [lremove [package names] Tcl] {
     foreach v [package versions $pkg] {
       interp eval $slave [list package ifneeded $pkg $v \
@@ -240,6 +263,39 @@ proc tkConInitSlave {slave args} {
   }
 }
 
+## tkConInitInterp - inits an interpreter by placing key
+## procs and aliases in it.
+# ARGS: name	- interp name
+#	type	- interp type (slave|interp)
+##
+proc tkConInitInterp {name type} {
+  global tkCon
+  ## Don't allow messing up a local master interpreter
+  if {[string match slave $type] && \
+      [regexp {^([Mm]ain|Slave[0-9]+)$} $name]} return
+  set old [tkConAttach]
+  catch {
+    tkConAttach $name $type
+    tkConEvalAttached {catch {rename puts tcl_puts}}
+    foreach cmd $tkCon(slaveprocs) { tkConEvalAttached [dump proc $cmd] }
+    if [string match slave $type] {
+      foreach cmd $tkCon(slavealias) {
+	tkConMain interp alias $name $cmd $tkCon(name) $cmd
+      }
+    } else {
+      set name [tk appname]
+      foreach cmd $tkCon(slavealias) {
+	tkConEvalAttached "proc $cmd args { send [list $name] $cmd \$args }"
+      }
+    }
+    ## Catch in case it's a 7.4 (no 'interp alias') interp
+    tkConEvalAttached {catch {interp alias {} ls {} dir}}
+    return
+  } err
+  eval tkConAttach $old
+  if [string comp {} $err] { return -code error $err }
+}
+
 ## tkConInitUI - inits UI portion (console) of tkCon
 ## Creates all elements of the console window and sets up the text tags
 # ARGS:	root	- widget pathname of the tkCon console root
@@ -254,6 +310,7 @@ proc tkConInitUI {title} {
   set tkCon(base) $w
   wm withdraw $root
 
+  option add *Menu.font $tkCon(font) widgetDefault
   set tkCon(menubar) [frame $w.mbar -relief raised -bd 2]
   set tkCon(console) [text $w.text -font $tkCon(font) -wrap char \
       -yscrollcommand "$w.sy set" -setgrid 1 -foreground $tkCon(color,stdin)]
@@ -261,7 +318,8 @@ proc tkConInitUI {title} {
   set tkCon(scrolly) [scrollbar $w.sy -takefocus 0 -bd 1 \
 			  -command "$w.text yview"]
 
-  tkConInitMenus $tkCon(menubar)
+  tkConInitMenus $tkCon(menubar) $title
+  tkConBindings
 
   if $tkCon(showmenu) { pack $tkCon(menubar) -fill x }
   pack $tkCon(scrolly) -side $tkCon(scrollypos) -fill y
@@ -273,6 +331,7 @@ proc tkConInitUI {title} {
     $w.text tag configure $col -foreground $tkCon(color,$col)
   }
   $w.text tag configure blink -background $tkCon(color,blink)
+  $w.text tag configure find -background $tkCon(color,blink)
 
   bind $w.text <Configure> {
     scan [wm geometry [winfo toplevel %W]] "%%dx%%d" tkCon(cols) tkCon(rows)
@@ -280,7 +339,7 @@ proc tkConInitUI {title} {
 
   wm title $root "tkCon $tkCon(version) $title"
   wm deiconify $root
-  focus $w.text
+  focus -force $w.text
 }
 
 ## tkConEval - evaluates commands input into console window
@@ -322,11 +381,14 @@ proc tkConEvalCmd {w cmd} {
       incr ev -1
       if {[string match !! $cmd]} {
 	set err [catch {tkConEvalSlave history event $ev} cmd]
+	if !$err {$w insert output $cmd\n stdin}
       } elseif [regexp {^!(.+)$} $cmd dummy event] {
 	set err [catch {tkConEvalSlave history event $event} cmd]
+	if !$err {$w insert output $cmd\n stdin}
       } elseif [regexp {^\^([^^]*)\^([^^]*)\^?$} $cmd dummy old new] {
 	if ![set err [catch {tkConEvalSlave history event $ev} cmd]] {
 	  regsub -all -- $old $cmd $new cmd
+	  $w insert output $cmd\n stdin
 	}
       }
     }
@@ -346,7 +408,11 @@ proc tkConEvalCmd {w cmd} {
 	  }
 	} else {
 	  if [catch [list tkConEvalAttached $cmd] res] {
-	    set tkCon(errorInfo) [tkConEvalAttached set errorInfo]
+	    if [catch {tkConEvalAttached set errorInfo} err] {
+	      set tkCon(errorInfo) {Error attempting to retrieve errorInfo}
+	    } else {
+	      set tkCon(errorInfo) $err
+	    }
 	    set err 1
 	  }
 	}
@@ -360,10 +426,12 @@ proc tkConEvalCmd {w cmd} {
     }
   }
   tkConPrompt
-  set tkCon(svnt) [set tkCon(event) [tkConEvalSlave history nextid]]
+  set tkCon(event) [tkConEvalSlave history nextid]
 }
 
 ## tkConEvalSlave - evaluates the args in the associated slave
+## args should be passed to this procedure like they would be at
+## the command line (not like to 'eval').
 # ARGS:	args	- the command and args to evaluate
 ##
 proc tkConEvalSlave args {
@@ -371,6 +439,20 @@ proc tkConEvalSlave args {
   interp eval $tkCon(exec) $args
 }
 
+## tkConEvalOther - evaluate a command in a foreign interp or slave
+## without attaching to it.  No check for existence is made.
+# ARGS:	app	- interp/slave name
+#	type	- (slave|interp)
+##
+proc tkConEvalOther {app type args} {
+  if [string match slave $type] {
+    if [string match Main $app] { set app {} }
+    tkConMain interp eval $app $args
+  } else {
+    eval send [list $app] $args
+  }
+}
+
 ## tkConEvalSend - sends the args to the attached interpreter
 ## Varies from 'send' by determining whether attachment is dead
 ## when an error is received
@@ -391,13 +473,17 @@ proc tkConEvalSend args {
   set code [catch {eval send [list $tkCon(app)] $args} result]
   if {$code && [lsearch -exact [winfo interps] $tkCon(app)]<0} {
     ## Interpreter disappeared
-    if [tk_dialog $tkCon(base).dead "Dead Attachment" \
-	    "\"$tkCon(app)\" appears to have died.\nReturn to primary slave interpreter?" questhead 0 OK No] {
+    if {[string compare leave $tkCon(dead)] && \
+	([string match ignore $tkCon(dead)] || \
+	[tk_dialog $tkCon(base).dead "Dead Attachment" \
+	"\"$tkCon(app)\" appears to have died.\
+	\nReturn to primary slave interpreter?" questhead 0 OK No])} {
       set tkCon(appname) "DEAD:$tkCon(appname)"
       set tkCon(deadapp) 1
     } else {
       set err "Attached Tk interpreter \"$tkCon(app)\" died."
       tkConAttach {}
+      set tkCon(deadapp) 0
       tkConEvalSlave set errorInfo $err
     }
     tkConPrompt \n [tkConCmdGet $tkCon(console)]
@@ -448,7 +534,7 @@ proc tkConCmdSep {cmd ls rmd} {
 # ARGS:	w	- console text widget
 # Outputs:	prompt (specified in tkCon(prompt1)) to console
 ## 
-proc tkConPrompt {{pre {}} {post {}}} {
+proc tkConPrompt {{pre {}} {post {}} {prompt {}}} {
   global tkCon
   set w $tkCon(console)
   if [string comp {} $pre] { $w insert end $pre stdout }
@@ -456,8 +542,13 @@ proc tkConPrompt {{pre {}} {post {}}} {
   if [string comp {} $tkCon(appname)] {
     $w insert end ">$tkCon(appname)< " prompt
   }
-  $w insert end [tkConEvalSlave subst $tkCon(prompt1)] prompt
+  if [string comp {} $prompt] {
+    $w insert end $prompt prompt
+  } else {
+    $w insert end [tkConEvalSlave subst $tkCon(prompt1)] prompt
+  }
   $w mark set output $i
+  $w mark set insert end
   $w mark set limit insert
   $w mark gravity limit left
   if [string comp {} $post] { $w insert end $post stdin }
@@ -470,49 +561,64 @@ proc tkConAbout {} {
   global tkCon
   tk_dialog $tkCon(base).about "About TkCon v$tkCon(version)" \
       "Jeffrey Hobbs, Copyright 1995-96\njhobbs@cs.uoregon.edu\
-	\nhttp://www.cs.uoregon.edu/~jhobbs/" questhead 0 OK
+	\nhttp://www.cs.uoregon.edu/~jhobbs/\
+	\nRelease Date: $tkCon(release)" questhead 0 OK
 }
 
 ## tkConHelp - gives help info for tkCon
-## 
+##
 proc tkConHelp {} {
   global tkCon
-  tk_dialog $tkCon(base).help "Help on TkCon v$tkCon(version)" \
-      "Jeffrey Hobbs, jhobbs@cs.uoregon.edu\nHelp available at:\
-      http://www.cs.uoregon.edu/~jhobbs/work/tkcon/" questhead 0 OK
+  set page	"http://www.cs.uoregon.edu/~jhobbs/work/tkcon/"
+  set email	"jhobbs@cs.uoregon.edu"
+  if [tk_dialog $tkCon(base).help "Help on TkCon v$tkCon(version)" \
+	  "Jeffrey Hobbs, $email\nHelp available at:\n$page" \
+	  questhead 0 OK "Load into Netscape"] {
+    update
+    if {[catch {exec netscape -remote "openURL($page)"}]
+	&& [catch {exec netscape $page &}]} {
+      warn "Couldn't launch Netscape.\nSorry."
+    }
+  }
 }
 
-## tkConInitMenus - inits the menus for the console
+## tkConInitMenus - inits the menubar and popup for the console
 # ARGS:	w	- console text widget
 ## 
-proc tkConInitMenus w {
+proc tkConInitMenus {w title} {
   global tkCon
 
-  pack [menubutton $w.con  -text Console  -un 0 -menu $w.con.m] -side left
-  pack [menubutton $w.edit -text Edit     -un 0 -menu $w.edit.m] -side left
-  #pack [menubutton $w.insp -text Inspect  -un 0 -menu $w.insp.m] -side left
-  pack [menubutton $w.pkgs -text Packages -un 0 -menu $w.pkgs.m] -side left
-  pack [menubutton $w.pref -text Prefs    -un 0 -menu $w.pref.m] -side left
-  pack [menubutton $w.help -text Help     -un 0 -menu $w.help.m] -side right
-
   menu $w.pop -tearoff 0
-  $w.pop add cascade -label Console  -un 0 -menu $w.pop.con
-  $w.pop add cascade -label Edit     -un 0 -menu $w.pop.edit
-  #$w.pop add cascade -label Inspect  -un 0 -menu $w.pop.insp
-  $w.pop add cascade -label Packages -un 0 -menu $w.pop.pkgs
-  $w.pop add cascade -label Prefs    -un 0 -menu $w.pop.pref
-  $w.pop add cascade -label Help     -un 0 -menu $w.pop.help
   bind [winfo toplevel $w] <Button-3> "tk_popup $w.pop %X %Y"
 
+  pack [menubutton $w.con  -text "Console"  -un 0 -menu $w.con.m] -side left
+  $w.pop add cascade -label "Console" -un 0 -menu $w.pop.con
+
+  pack [menubutton $w.edit -text "Edit"     -un 0 -menu $w.edit.m] -side left
+  $w.pop add cascade -label "Edit"    -un 0 -menu $w.pop.edit
+
+  pack [menubutton $w.int -text "Interp"    -un 0 -menu $w.int.m] -side left
+  $w.pop add cascade -label "Interp"  -un 0 -menu $w.pop.int
+
+  pack [menubutton $w.pref -text "Prefs"    -un 0 -menu $w.pref.m] -side left
+  $w.pop add cascade -label "Prefs"   -un 0 -menu $w.pop.pref
+
+  pack [menubutton $w.help -text "Help"     -un 0 -menu $w.help.m] -side right
+  $w.pop add cascade -label "Help"    -un 0 -menu $w.pop.help
+
   ## Console Menu
   ##
-  foreach m [list [menu $w.con.m] [menu $w.pop.con]] {
+  foreach m [list [menu $w.con.m -disabledfore $tkCon(color,prompt)] \
+		 [menu $w.pop.con -disabledfore $tkCon(color,prompt)]] {
+    $m add command -label "$title Console" -state disabled
     $m add command -label "New Console" -un 0 -acc Ctrl-N -com tkConNew
     $m add command -label "Close Console " -un 0 -acc Ctrl-w -com tkConDestroy
+    $m add command -label "Clear Console " -un 1 -acc Ctrl-l \
+	-com { clear; tkConPrompt }
     $m add separator
     $m add cascade -label "Attach Console " -un 0 -menu $m.apps
     $m add separator
-    $m add command -label Quit -un 0 -acc Ctrl-q -command exit
+    $m add command -label "Quit" -un 0 -acc Ctrl-q -command exit
 
     ## Attach Console Menu
     ##
@@ -524,31 +630,19 @@ proc tkConInitMenus w {
   ##
   set text $tkCon(console)
   foreach m [list [menu $w.edit.m] [menu $w.pop.edit]] {
-    $m add command -label Cut   -un 1 -acc Ctrl-x -command "tkConCut $text"
-    $m add command -label Copy  -un 1 -acc Ctrl-c -command "tkConCopy $text"
-    $m add command -label Paste -un 0 -acc Ctrl-v -command "tkConPaste $text"
-  }
-
-  ## Inspect Menu
-  ## Currently disabled
-  foreach m {} {
-    $m add command -label Procedures       -command "tkConInspect procs"
-    $m add command -label "Global Vars"    -command "tkConInspect vars"
-    $m add command -label Interpreters     -command "tkConInspect interps"
-    $m add command -label Aliases          -command "tkConInspect aliases"
-    $m add command -label Images           -command "tkConInspect images"
-    $m add command -label "All Widgets"    -command "tkConInspect widgets"
-    $m add command -label "Canvas Widgets" -command "tkConInspect canvases"
-    $m add command -label "Menu Widgets"   -command "tkConInspect menus"
-    $m add command -label "Text Widgets"   -command "tkConInspect texts"
-  }
-
-  ## Packages Menu
+    $m add command -label "Cut"   -un 1 -acc Ctrl-x -command "tkConCut $text"
+    $m add command -label "Copy"  -un 1 -acc Ctrl-c -command "tkConCopy $text"
+    $m add command -label "Paste" -un 0 -acc Ctrl-v -command "tkConPaste $text"
+    $m add separator
+    $m add command -label "Find"  -un 0 -acc Ctrl-F \
+	-command "tkConFindBox $text"
+  }
+
+  ## Interp Menu
   ##
-  menu $w.pkgs.m -disabledforeground $tkCon(color,prompt) \
-      -postcommand "tkConCheckPackages $w.pkgs.m"
-  menu $w.pop.pkgs -disabledforeground $tkCon(color,prompt) \
-      -postcommand "tkConCheckPackages $w.pop.pkgs"
+  foreach m [list $w.int.m $w.pop.int] {
+    menu $m -disabledfore $tkCon(color,prompt) -postcom "tkConInterpMenu $m"
+  }
 
   ## Prefs Menu
   ##
@@ -567,10 +661,10 @@ proc tkConInitMenus w {
     ## Scrollbar Menu
     ##
     set m [menu $m.scroll -tearoff 0]
-    $m add radio -label Left -var tkCon(scrollypos) -value left -command {
+    $m add radio -label "Left" -var tkCon(scrollypos) -value left -command {
       pack config $tkCon(scrolly) -side left
     }
-    $m add radio -label Right -var tkCon(scrollypos) -value right -command {
+    $m add radio -label "Right" -var tkCon(scrollypos) -value right -command {
       pack config $tkCon(scrolly) -side right
     }
   }
@@ -580,62 +674,121 @@ proc tkConInitMenus w {
   foreach m [list [menu $w.help.m] [menu $w.pop.help]] {
     $m add command -label "About " -un 0 -acc Ctrl-A -command tkConAbout
     $m add separator
-    $m add command -label Help -un 0 -acc Ctrl-H -command tkConHelp
+    $m add command -label "Help" -un 0 -acc Ctrl-H -command tkConHelp
   }
+}
 
-  ## It's OK to bind to all because it's specific to each interpreter
-  bind all <Control-q> exit
-  bind all <Control-N> tkConNew
-  bind all <Control-w> tkConDestroy
-  bind all <Control-A> tkConAbout
-  bind all <Control-H> tkConHelp
-  bind all <Control-Key-1> {
-    tkConAttach {}
-    tkConPrompt \n [tkConCmdGet $tkCon(console)]
+## tkConInterpMenu - dynamically build the menu for attached interpreters
+##
+# ARGS:	w	- menu widget
+##
+proc tkConInterpMenu w {
+  global tkCon
+
+  if ![winfo exists $w] return
+  set i [tkConAttach]
+  set app  [lindex $i 0]
+  set type [lindex $i 1]
+  $w delete 0 end
+  $w add command -label "[string toup $type]: $app" -state disabled
+  $w add separator
+  if {($tkCon(nontcl) && [string match interp $type]) || $tkCon(deadapp)} {
+    $w add command -state disabled -label "Communication disabled to"
+    $w add command -state disabled -label "dead or non-Tcl interps"
+    return
   }
-  bind all <Control-Key-2> {
-    if [string comp {} $tkCon(name)] {
-      tkConAttach $tkCon(name)
-    } else {
-      tkConAttach Main
+  $w add cascade -label Inspect -un 0 -menu $w.ins
+  $w add cascade -label Packages -un 0 -menu $w.pkg
+
+  set isnew [tkConEvalAttached expr \[info tclversion\]>7.4]
+  set hastk [tkConEvalAttached info exists tk_library]
+
+  ## Inspect Cascaded Menu
+  set m $w.ins
+  if [winfo exists $m] {
+    $m delete 0 end
+  } else {
+    menu $m -tearoff no -disabledfore $tkCon(color,prompt)
+  }
+  if [string comp {} [package provide TkConInspect]] {
+    $m add command -label "Procedures" \
+	-command [list tkConInspect $app $type procs]
+    $m add command -label "Global Vars" \
+	-command [list tkConInspect $app $type vars]
+    if $isnew {
+      $m add command -label "Interpreters" \
+	  -command [list tkConInspect $app $type interps]
+      $m add command -label "Aliases" \
+	  -command [list tkConInspect $app $type aliases]
+    }
+    if $hastk {
+      $m add separator
+      $m add command -label "All Widgets" \
+	  -command [list tkConInspect $app $type widgets]
+      $m add command -label "Canvas Widgets" \
+	  -command [list tkConInspect $app $type canvases]
+      $m add command -label "Menu Widgets" \
+	  -command [list tkConInspect $app $type menus]
+      $m add command -label "Text Widgets" \
+	  -command [list tkConInspect $app $type texts]
+      if $isnew {
+	$m add command -label "Images" \
+	    -command [list tkConInspect $app $type images]
+      }
     }
-    tkConPrompt \n [tkConCmdGet $tkCon(console)]
   }
-  bind all <Control-Key-3> {
-    tkConAttach Main
-    tkConPrompt \n [tkConCmdGet $tkCon(console)]
+
+  ## Packages Cascaded Menu
+  ##
+  set m $w.pkg
+  if [winfo exists $m] { $m delete 0 end } else {
+    menu $m -tearoff no -disabledfore $tkCon(color,prompt)
   }
-}
 
-## tkConCheckPackages - checks which packages are currently loaded
-## Requires two loops to make sure that packages which auto-load Tk
-## set everything properly.
-# ARGS:	w	- menu name
-##
-proc tkConCheckPackages {{w {}}} {
-  global tkCon
-  foreach pkg [lsort [lremove [package names] Tcl]] {
-    if {![info exists tkCon(load$pkg)]} { set tkCon(load$pkg) 0 }
-    if {$tkCon(load$pkg)==1} {
-      if [catch {tkConEvalSlave package require $pkg}] {
-	bgerror "$pkg cannot be loaded.  Check your pkgIndex.tcl file!!!"
-	set tkCon(load$pkg) -1
-      }
+  foreach pkg [tkConEvalAttached [list info loaded {}]] {
+    set loaded([lindex $pkg 1]) {}
+  }
+  foreach pkg [info loaded] {
+    set pkg [lindex $pkg 1]
+    if ![info exists loaded($pkg)] {
+      set loadable($pkg) [list load {} $pkg]
     }
   }
-  if [string comp {} [tkConEvalSlave info commands .]] { set tkCon(loadTk) 1 }
-  if ![winfo exists $w] return
-  $w delete 0 end
-  foreach pkg [lsort [lremove [package names] Tcl]] {
-    if {$tkCon(load$pkg)==-1} {
-      $w add command -label "$pkg Load Failed" -state disabled
-    } elseif $tkCon(load$pkg) {
-      $w add command -label "$pkg Loaded" -state disabled
-    } else {
-      $w add checkbutton -label "Load $pkg" -var tkCon(load$pkg) \
-	  -command "tkConCheckPackages"
+  foreach pkg [lremove [tkConEvalAttached package names] Tcl] {
+    if ![info exists loaded($pkg)] {
+      set loadable($pkg) [list package require $pkg]
     }
   }
+  foreach pkg [array names loadable] {
+    $m add command -label "Load $pkg" \
+	-command "tkConEvalOther [list $app] $type $loadable($pkg)"
+  }
+  if {[info exists loaded] && [info exists loadable]} { $m add separator }
+  foreach pkg [array names loaded] {
+    $m add command -label "$pkg Loaded" -state disabled
+  }
+
+  ## Show Last Error
+  ##
+  $w add separator
+  $w add command -label "Show Last Error" \
+      -command "tkcon error [list $app] $type"
+
+  ## State Checkpoint/Revert
+  ##
+  $w add separator
+  $w add command -label "Checkpoint State" \
+      -command [list tkConStateCheckpoint $app $type]
+  $w add command -label "Revert State" \
+      -command [list tkConStateRevert $app $type]
+  $w add command -label "View State Change" \
+      -command [list tkConStateCompare $app $type]
+
+  ## Init Interp
+  ##
+  $w add separator
+  $w add command -label "Send TkCon Commands" \
+      -command [list tkConInitInterp $app $type]
 }
 
 ## tkConFillAppsMenu - fill in  in the applications sub-menu
@@ -644,29 +797,17 @@ proc tkConCheckPackages {{w {}}} {
 proc tkConFillAppsMenu {m} {
   global tkCon
 
-  set self	[tk appname]
-  set masters	[tkConMain set tkCon(interps)]
-  set masternm	[tkConSlave]
-  foreach i $masternm {
-    if [tkConSlave $i set tkCon(loadTk)] {
-      lappend slaves [tkConSlave $i tkConEvalSlave tk appname]
-    } else {
-      lappend slaves "no Tk"
-    }
-  }
-  set path [concat $tkCon(name) $tkCon(exec)]
-  set tmp [tkConInterps]
-  array set interps $tmp
-  array set tknames [concat [lrange $tmp 1 end] [list [lindex $tmp 0]]]
+  array set interps [set tmp [tkConInterps]]
+  foreach {i j} $tmp { set tknames($j) {} }
 
   catch {$m delete 0 last}
   set cmd {tkConPrompt \n [tkConCmdGet $tkCon(console)]}
-  $m add radio -label {None (use local slave) } -var tkCon(app) -value $path \
-      -command "tkConAttach {}; $cmd" -acc Ctrl-1
+  $m add radio -label {None (use local slave) } -var tkCon(app) \
+      -value [concat $tkCon(name) $tkCon(exec)] -acc Ctrl-1 \
+      -command "tkConAttach {}; $cmd"
   $m add separator
   $m add command -label "Foreign Tk Interpreters" -state disabled
-  foreach i [lsort [lremove [winfo interps] \
-			[concat $masters $slaves [array names tknames]]]] {
+  foreach i [lsort [lremove [winfo interps] [array names tknames]]] {
     $m add radio -label $i -var tkCon(app) -value $i \
 	-command "tkConAttach [list $i] interp; $cmd"
   }
@@ -676,14 +817,10 @@ proc tkConFillAppsMenu {m} {
   foreach i [lsort [array names interps]] {
     if [string match {} $interps($i)] { set interps($i) "no Tk" }
     if [regexp {^Slave[0-9]+} $i] {
-      if [string comp $tkCon(name) $i] {
-	$m add radio -label "$i ($interps($i))" -var tkCon(app) -value $i \
-	    -command "tkConAttach [list $i] slave; $cmd"
-      } else {
-	$m add radio -label "$i ($interps($i))" -var tkCon(app) -value $i \
-	    -acc Ctrl-2 \
-	    -command "tkConAttach [list $i] slave; $cmd"
-      }
+      set opts [list -label "$i ($interps($i))" -var tkCon(app) -value $i \
+	  -command "tkConAttach [list $i] slave; $cmd"]
+      if [string match $tkCon(name) $i] { append opts " -acc Ctrl-2" }
+      eval $m add radio $opts
     } else {
       set name [concat Main $i]
       if [string match Main $name] {
@@ -698,6 +835,81 @@ proc tkConFillAppsMenu {m} {
   }
 }
 
+## tkConFindBox - creates minimal dialog interface to tkConFind
+# ARGS:	w	- text widget
+#	str	- optional seed string for tkCon(find)
+##
+proc tkConFindBox {w {str {}}} {
+  global tkCon
+
+  set base $tkCon(base).find
+  if ![winfo exists $base] {
+    toplevel $base
+    wm withdraw $base
+    wm title $base "TkCon Find"
+
+    pack [frame $base.f] -fill x -expand 1
+    label $base.f.l -text "Find:"
+    entry $base.f.e -textvar tkCon(find)
+    pack [frame $base.opt] -fill x
+    checkbutton $base.opt.c -text "Case Sensitive" -variable tkCon(find,case)
+    checkbutton $base.opt.r -text "Use Regexp" -variable tkCon(find,reg)
+    pack $base.f.l -side left
+    pack $base.f.e $base.opt.c $base.opt.r -side left -fill both -expand 1
+    pack [frame $base.sep -bd 2 -relief sunken -height 4] -fill x
+    pack [frame $base.btn] -fill both
+    button $base.btn.fnd -text "Find" -width 6
+    button $base.btn.clr -text "Clear" -width 6
+    button $base.btn.dis -text "Dismiss" -width 6
+    eval pack [winfo children $base.btn] -padx 4 -pady 2 -side left -fill both
+
+    focus $base.f.e
+
+    bind $base.f.e <Return> [list $base.btn.fnd invoke]
+    bind $base.f.e <Escape> [list $base.btn.dis invoke]
+  }
+  $base.btn.fnd config -command "tkConFind $w \$tkCon(find)"
+  $base.btn.clr config -command "
+  $w tag remove find 1.0 end
+  set tkCon(find) {}
+  "
+  $base.btn.dis config -command "
+  $w tag remove find 1.0 end
+  wm withdraw $base
+  "
+  if [string comp {} $str] {
+    set tkCon(find) $str
+    $base.btn.fnd invoke
+  }
+
+  if {[string comp normal [wm state $base]]} {
+    wm deiconify $base
+  } else { raise $base }
+  $base.f.e select range 0 end
+}
+
+## tkConFind - searches in text widget $w for $str and highlights it
+## If $str is empty, it just deletes any highlighting
+# ARGS: w	- text widget
+#	str	- string to search for
+##
+proc tkConFind {w str} {
+  global tkCon
+  $w tag remove find 1.0 end
+  ## FIX ; should accept -case and -regexp switches
+  if [string match {} $str] { return } else { set tkCon(find) $str }
+  $w mark set findmark 1.0
+  if $tkCon(find,case) { append opts {} } else { set opts {-nocase } }
+  if $tkCon(find,reg) { append opts -regexp } else { append opts -exact }
+  while {[string comp {} [set ix [eval $w search $opts -count numc -- \
+      [list $str] findmark end]]]} {
+    $w tag add find $ix ${ix}+${numc}c
+    $w mark set findmark ${ix}+1c
+  }
+  catch {$w see find.first}
+  return [expr [llength [$w tag ranges find]]/2]
+}
+
 ## tkConAttach - called to attach tkCon to an interpreter
 # ARGS:	an	- application name to which tkCon sends commands
 #		  This is either a slave interperter name or tk appname.
@@ -707,8 +919,15 @@ proc tkConFillAppsMenu {m} {
 # Results:	tkConEvalAttached is recreated to evaluate in the
 #		appropriate interpreter
 ##
-proc tkConAttach {an {type slave}} {
+proc tkConAttach {{an <NONE>} {type slave}} {
   global tkCon
+  if [string match <NONE> $an] {
+    if [string match {} $tkCon(appname)] {
+      return [list [concat $tkCon(name) $tkCon(exec)] $tkCon(apptype)]
+    } else {
+      return [list $tkCon(appname) $tkCon(apptype)]
+    }
+  }
   set app -
   set path [concat $tkCon(name) $tkCon(exec)]
   if [string comp {} $an] {
@@ -728,7 +947,8 @@ proc tkConAttach {an {type slave}} {
       set an [concat $path $an]
       set type slave
     } elseif {[lsearch [winfo interps] $an] > -1} {
-      if {$tkCon(loadTk) && [string match $an [tkConEvalSlave tk appname]]} {
+      if {[tkConEvalSlave info exists tk_library]
+	  && [string match $an [tkConEvalSlave tk appname]]} {
 	set an {}
 	set app $path
 	set type slave
@@ -740,7 +960,7 @@ proc tkConAttach {an {type slave}} {
 	set type interp
       }
     } else {
-      error "No known interpreter \"$an\""
+      return -code error "No known interpreter \"$an\""
     }
   } else {
     set app $path
@@ -749,16 +969,18 @@ proc tkConAttach {an {type slave}} {
   set tkCon(app)     $app
   set tkCon(appname) $an
   set tkCon(apptype) $type
+  set tkCon(deadapp) 0
 
-  ## tkConEvalAttached - evaluates the args in the attached interpreter
-  ## This procedure is dynamic.  It is rewritten by the proc tkConAttach
-  ## to ensure it evals in the right place.
+  ## tkConEvalAttached - evaluates the args in the attached interp
+  ## args should be passed to this procedure as if they were being
+  ## passed to the 'eval' procedure.  This procedure is dynamic to
+  ## ensure evaluation occurs in the right interp.
   # ARGS:	args	- the command and args to evaluate
   ##
   switch $type {
     slave {
       if [string match {} $an] {
-	interp alias {} tkConEvalAttached {} tkConEvalSlave
+	interp alias {} tkConEvalAttached {} tkConEvalSlave eval
       } elseif [string match Main $tkCon(app)] {
 	interp alias {} tkConEvalAttached {} tkConMain eval
       } elseif [string match $tkCon(name) $tkCon(app)] {
@@ -774,7 +996,10 @@ proc tkConAttach {an {type slave}} {
 	interp alias {} tkConEvalAttached {} tkConEvalSend
       }
     }
-    default { error "[lindex [info level 0] 0] did not specify type" }
+    default {
+      return -code error "[lindex [info level 0] 0] did not specify\
+	a valid type: must be slave or interp"
+    }
   }
   return
 }
@@ -786,8 +1011,8 @@ proc tkConAttach {an {type slave}} {
 proc tkConLoad {{fn {}}} {
   global tkCon
   if {[string match {} $fn] &&
-      ([catch {tkFileSelect} fn] || [string match {} $fn])} return
-  tkConEvalAttached source $fn
+      ([catch {tk_getOpenFile} fn] || [string match {} $fn])} return
+  tkConEvalAttached [list source $fn]
 }
 
 ## tkConSave - saves the console buffer to a file
@@ -798,25 +1023,14 @@ proc tkConLoad {{fn {}}} {
 proc tkConSave {{fn {}}} {
   global tkCon
   if {[string match {} $fn] &&
-      ([catch {tkFileSelect} fn] || [string match {} $fn])} return
+      ([catch {tk_getSaveFile} fn] || [string match {} $fn])} return
   if [catch {open $fn w} fid] {
-    error "Save Error: Unable to open '$fn' for writing\n$fid"
+    return -code error "Save Error: Unable to open '$fn' for writing\n$fid"
   }
   puts $fid [$tkCon(console) get 1.0 end-1c]
   close $fid
 }
 
-## tkConResource - re'source's this script into current console
-## Meant primarily for my development of this program.  It's seems loopy
-## due to quirks in Tcl on windows.
-## 
-set tkCon(SCRIPT) [info script]
-if [string match relative [file pathtype [info script]]] {
-  set tkCon(SCRIPT) [file join [pwd] [info script]]
-}
-set tkCon(SCRIPT) [eval file join [file split $tkCon(SCRIPT)]]
-proc tkConResource {} "uplevel \#0 [list source $tkCon(SCRIPT)]; return"
-
 ## tkConMainInit
 ## This is only called for the main interpreter to include certain procs
 ## that we don't want to include (or rather, just alias) in slave interps.
@@ -845,11 +1059,14 @@ proc tkConMainInit {} {
 	set argv0 [list $argv0]
     $tmp eval [list set tkCon(name) $tmp]
     $tmp eval [list source $tkCon(SCRIPT)]
-    $tmp alias tkConDestroy tkConDestroy $tmp
-    $tmp alias tkConNew	    tkConNew
-    $tmp alias tkConMain    tkConInterpEval Main
-    $tmp alias tkConSlave   tkConInterpEval
-    $tmp alias tkConInterps tkConInterps
+    $tmp alias tkConDestroy		tkConDestroy $tmp
+    $tmp alias tkConNew			tkConNew
+    $tmp alias tkConMain		tkConInterpEval Main
+    $tmp alias tkConSlave		tkConInterpEval
+    $tmp alias tkConInterps		tkConInterps
+    $tmp alias tkConStateCheckpoint	tkConStateCheckpoint
+    $tmp alias tkConStateCompare	tkConStateCompare
+    $tmp alias tkConStateRevert		tkConStateRevert
     return $tmp
   }
 
@@ -893,143 +1110,311 @@ proc tkConMainInit {} {
   }
 
   proc tkConInterps {{ls {}} {interp {}}} {
-    if [string match {} $interp] { lappend ls {} [list [tk appname]] }
+    if [string match {} $interp] { lappend ls {} [tk appname] }
     foreach i [interp slaves $interp] {
       if [string comp {} $interp] { set i "$interp $i" }
-      if [catch "interp eval [list $i] tk appname" name] {
-	lappend ls $i {}
+      if [string comp {} [interp eval $i package provide Tk]] {
+	lappend ls $i [interp eval $i tk appname]
       } else {
-	lappend ls $i $name
+	lappend ls $i {}
       }
       set ls [tkConInterps $ls $i]
     }
     return $ls
   }
-}
 
+  ##
+  ## The following state checkpoint/revert procedures are very sketchy
+  ## and prone to problems.  They do not track modifications to currently
+  ## existing procedures/variables, and they can really screw things up
+  ## if you load in libraries (especially Tk) between checkpoint and
+  ## revert.  Only with this knowledge in mind should you use these.
+  ##
 
-## tkConStateCheckpoint - checkpoints the current state of the system
-## This allows you to return to this state with tkConStateRevert
-# ARGS:	ary	- an array into which several elements are stored:
-#			commands  - the currently defined commands
-#			variables - the current global vars
-#		This is the array you would pass to tkConRevertState
-##
-proc tkConStateCheckpoint {ary} {
-  global tkCon
-  upvar $ary a
-  set a(commands)  [tkConEvalAttached info commands *]
-  set a(variables) [tkConEvalAttached info vars *]
-  return
-}
+  ## FIX ; cleanup state data when attached app is deleted
 
-## tkConStateCompare - compare two states and output difference
-# ARGS:	ary1	- an array with checkpointed state
-#	ary2	- a second array with checkpointed state
-# Outputs:
-##
-proc tkConStateCompare {ary1 ary2} {
-  upvar $ary1 a1 $ary2 a2
-  puts "Commands unique to $ary1:\n[lremove $a1(commands) $a2(commands)]"
-  puts "Commands unique to $ary2:\n[lremove $a2(commands) $a1(commands)]"
-  puts "Variables unique to $ary1:\n[lremove $a1(variables) $a2(variables)]"
-  puts "Variables unique to $ary2:\n[lremove $a2(variables) $a1(variables)]"
-}
+  ## tkConStateCheckpoint - checkpoints the current state of the system
+  ## This allows you to return to this state with tkConStateRevert
+  # ARGS:
+  ##
+  proc tkConStateCheckpoint {app type} {
+    global tkCon
+    upvar \#0 tkCon($type,$app) a
+    if {[array exists a] &&
+	[tk_dialog $tkCon(base).warning "Overwrite Previous State?" \
+	     "Are you sure you want to lose previously checkpointed state of $type \"$app\"?" \
+	     questhead 1 "Do It" "Cancel"]} return
+    set a(cmd) [tkConEvalOther $app $type info comm *]
+    set a(var) [tkConEvalOther $app $type info vars *]
+    return
+  }
 
-## tkConStateRevert - reverts interpreter to a previous state
-# ARGS:	ary	- an array with checkpointed state
-##
-proc tkConStateRevert {ary} {
-  upvar $ary a
-  foreach i [lremove [tkConEvalAttached info commands *] $a(commands)] {
-    catch "tkConEvalAttached rename $i {}"
+  ## tkConStateCompare - compare two states and output difference
+  # ARGS:
+  ##
+  proc tkConStateCompare {app type {verbose 0}} {
+    global tkCon
+    upvar \#0 tkCon($type,$app) a
+    if ![array exists a] {
+      return -code error "No previously checkpointed state for $type \"$app\""
+    }
+    set w $tkCon(base).compare
+    if [winfo exists $w] {
+      $w.text config -state normal
+      $w.text delete 1.0 end
+    } else {
+      toplevel $w
+      frame $w.btn
+      scrollbar $w.sy -takefocus 0 -bd 1 -command [list $w.text yview]
+      text $w.text -font $tkCon(font) -yscrollcommand [list $w.sy set] \
+	  -height 12
+      pack $w.btn -side bottom -fill x
+      pack $w.sy -side right -fill y
+      pack $w.text -fill both -expand 1
+      button $w.btn.close -text Dismiss -width 11 -command [list destroy $w]
+      button $w.btn.check -text Recheckpoint -width 11
+      button $w.btn.revert -text Revert -width 11
+      button $w.btn.expand -text Verbose -width 11
+      button $w.btn.update -text Update -width 11
+      pack $w.btn.check $w.btn.revert $w.btn.expand $w.btn.update \
+	  $w.btn.close -side left -fill x -padx 4 -pady 2 -expand 1
+      $w.text tag config red -foreground red
+    }
+    wm title $w "Compare State: $type [list $app]"
+
+    $w.btn.check config -command "tkConStateCheckpoint [list $app] $type; \
+	tkConStateCompare [list $app] $type $verbose"
+    $w.btn.revert config -command "tkConStateRevert [list $app] $type; \
+	tkConStateCompare [list $app] $type $verbose"
+    $w.btn.update config -command [info level 0]
+    if $verbose {
+      $w.btn.expand config -text Brief \
+	  -command [list tkConStateCompare $app $type 0]
+    } else {
+      $w.btn.expand config -text Verbose \
+	  -command [list tkConStateCompare $app $type 1]
+    }
+    ## Don't allow verbose mode unless 'dump' exists in $app
+    ## We're assuming this is TkCon's dump command
+    set hasdump [string comp {} [tkConEvalOther $app $type info comm dump]]
+    if $hasdump {
+      $w.btn.expand config -state normal
+    } else {
+      $w.btn.expand config -state disabled
+    }
+
+    set cmds [lremove [tkConEvalOther $app $type info comm *] $a(cmd)]
+    set vars [lremove [tkConEvalOther $app $type info vars *] $a(var)]
+
+    if {$hasdump && $verbose} {
+      set cmds [tkConEvalOther $app $type eval dump c -nocomplain $cmds]
+      set vars [tkConEvalOther $app $type eval dump v -nocomplain $vars]
+    }
+    $w.text insert 1.0 "NEW COMMANDS IN \"$app\":\n" red \
+	$cmds {} "\n\nNEW VARIABLES IN \"$app\":\n" red $vars {}
+
+    raise $w
+    $w.text config -state disabled
   }
-  foreach i [lremove [tkConEvalAttached info vars *] $a(variables)] {
-    catch "tkConEvalAttached unset $i"
+
+  ## tkConStateRevert - reverts interpreter to previous state
+  # ARGS:
+  ##
+  proc tkConStateRevert {app type} {
+    global tkCon
+    upvar \#0 tkCon($type,$app) a
+    if ![array exists a] {
+      return -code error "No previously checkpointed state for $type \"$app\""
+    }
+    if {![tk_dialog $tkCon(base).warning "Revert State?" \
+	      "Are you sure you want to revert the state in $type \"$app\"?" \
+	      questhead 1 "Do It" "Cancel"]} {
+      foreach i [lremove [tkConEvalOther $app $type info comm *] $a(cmd)] {
+	catch {tkConEvalOther $app $type rename $i {}}
+      }
+      foreach i [lremove [tkConEvalOther $app $type info vars *] $a(var)] {
+	catch {tkConEvalOther $app $type unset $i}
+      }
+    }
   }
 }
 
+## warn - little helper proc to pop up a tk_dialog warning message
+# ARGS:	msg	- message you want to display to user
+##
+proc warn { msg } {
+  bell
+  tk_dialog ._warning Warning $msg warning 0 OK
+}
 
 ## tkcon - command that allows control over the console
 # ARGS:	totally variable, see internal comments
 ## 
-proc tkcon {args} {
-  global tkCon
-  switch -- [lindex $args 0] {
-    close {
-      ## Closes the console
+proc tkcon {cmd args} {
+  global tkCon errorInfo
+  switch -glob -- $cmd {
+    bg* {
+      ## 'bgerror' Brings up an error dialog
+      set errorInfo [lindex $args 1]
+      bgerror [lindex $args 0]
+    }
+    cl* {
+      ## 'close' Closes the console
       tkConDestroy
     }
-    clean {
-      ## 'cleans' the interpreter - reverting to original tkCon state
-      ## FIX
-      ## tkConStateRevert tkCon
+    con* {
+      ## 'console' - passes the args to the text widget of the console.
+      eval $tkCon(console) $args
     }
-    console {
-      ## Passes the args to the text widget of the console.
-      eval $tkCon(console) [lreplace $args 0 0]
-    }
-    error {
+    err* {
       ## Outputs stack caused by last error.
-      if [string match {} $tkCon(errorInfo)] {
-	set tkCon(errorInfo) {errorInfo empty}
-      }
+      if {[llength $args]==2} {
+	set app  [lindex $args 0]
+	set type [lindex $args 1]
+	if [catch {tkConEvalOther $app $type set errorInfo} info] {
+	  set info "error getting info from $type $app:\n$info"
+	}
+      } else { set info $tkCon(errorInfo) }
+      if [string match {} $info] { set info {errorInfo empty} }
       catch {destroy $tkCon(base).error}
       set w [toplevel $tkCon(base).error]
-      button $w.close -text Dismiss -command "destroy $w"
-      scrollbar $w.sy -takefocus 0 -bd 1 -command "$w.text yview"
-      text $w.text -font $tkCon(font) -yscrollcommand "$w.sy set"
+      wm title $w "TkCon Last Error"
+      button $w.close -text Dismiss -command [list destroy $w]
+      scrollbar $w.sy -takefocus 0 -bd 1 -command [list $w.text yview]
+      text $w.text -font $tkCon(font) -yscrollcommand [list $w.sy set]
       pack $w.close -side bottom -fill x
       pack $w.sy -side right -fill y
       pack $w.text -fill both -expand 1
-      $w.text insert 1.0 $tkCon(errorInfo)
+      $w.text insert 1.0 $info
       $w.text config -state disabled
     }
-    eval {
-      ## evals contents in master interpreter
-      eval [lreplace $args 0 0]
+    fi* {
+      ## 'find' string
+      tkConFind $tkCon(console) $args
     }
-    font {
-      ## "tkcon font ?fontname?".  Sets the font of the console
-      if [string comp {} [lindex $args 1]] {
-	return [$tkCon(console) config -font [lindex $args 1]]
+    fo* {
+      ## 'font' ?fontname? - gets/sets the font of the console
+      if [string comp {} $args] {
+	return [$tkCon(console) config -font $args]
       } else {
 	return [$tkCon(console) config -font]
       }
     }
-    hide {
-      ## Hides the console with 'withdraw'.
+    get* {
+      ## 'gets' a replacement for [gets stdin varname]
+      ## This forces a complete command to be input though
+      set old [bind Console <Return>]
+      bind Console <Return> { set tkCon(wait) 0 }
+      bind Console <KP_Enter> { set tkCon(wait) 0 }
+      set w $tkCon(console)
+      vwait tkCon(wait)
+      set line [tkConCmdGet $tkCon(console)]
+      $w insert end \n
+      while {![info complete $line]} {
+	vwait tkCon(wait)
+	set line [tkConCmdGet $tkCon(console)]
+	$w insert end \n
+      }
+      bind Console <Return> $old
+      bind Console <KP_Enter> $old
+      if [string match {} $args] {
+	return $line
+      } else {
+	upvar [lindex $args 0] data
+	set data $line
+	return [string length $line]
+      }
+    }
+    hid* {
+      ## 'hide' - hides the console with 'withdraw'.
       wm withdraw $tkCon(root)
     }
-    iconify {
-      ## Iconifies the console with 'iconify'.
+    his* {
+      ## 'history'
+      set sub {\2}
+      if [string match -n* $args] { append sub "\n" }
+      set h [tkConEvalSlave history]
+      regsub -all "( *\[0-9\]+  |\t)(\[^\n\]*\n?)" $h $sub h
+      return $h
+    }
+    ico* {
+      ## 'iconify' - iconifies the console with 'iconify'.
       wm iconify $tkCon(root)
     }
-    show - deiconify {
-      ## "tkcon show|deiconify".  Deiconifies the console.
+    mas* - eval {
+      ## 'master' - evals contents in master interpreter
+      uplevel \#0 $args
+    }
+    set {
+      ## 'set' - set (or get, or unset) simple variables (not whole arrays)
+      ## from the master console interpreter
+      ## possible formats:
+      ##    tkcon set <var>
+      ##    tkcon set <var> <value>
+      ##    tkcon set <var> <interp> <var1> <var2> w
+      ##    tkcon set <var> <interp> <var1> <var2> u
+      ##    tkcon set <var> <interp> <var1> <var2> r
+      if {[llength $args]==5} {
+	## This is for use with 'tkcon upvar' and only works with slaves
+	set var [lindex $args 0]
+	set i [lindex $args 1]
+	set var1 [lindex $args 2]
+	set var2 [lindex $args 3]
+	if [string compare {} $var2] { append var1 "($var2)" }
+	set op [lindex $args 4]
+	switch $op {
+	  u { uplevel \#0 [list unset $var] }
+	  w {
+	    return [uplevel \#0 set \{$var\} [interp eval $i set \{$var1\}]]
+	  }
+	  r {
+	    return [interp eval $i set \{$var1\} [uplevel \#0 set \{$var\}]]
+	  }
+	}
+      }
+      return [uplevel \#0 set $args]
+    }
+    sh* - dei* {
+      ## 'show|deiconify' - deiconifies the console.
       wm deiconify $tkCon(root)
+      raise $tkCon(root)
     }
-    title {
-      ## "tkcon title ?title?".  Retitles the console
-      if [string comp {} [lindex $args 1]] {
-	return [wm title $tkCon(root) [lindex $args 1]]
+    ti* {
+      ## 'title' ?title? - gets/sets the console's title
+      if [string comp {} $args] {
+	return [wm title $tkCon(root) $args]
       } else {
 	return [wm title $tkCon(root)]
       }
     }
-    version {
+    u* {
+      ## 'upvar' masterVar slaveVar
+      ## link slave variable slaveVar to the master variable masterVar
+      ## only works masters<->slave
+      set masterVar [lindex $args 0]
+      set slaveVar  [lindex $args 1]
+      if [info exists $masterVar] {
+	interp eval $tkCon(exec) [list set $myVar [set $masterVar]]
+      } else {
+	catch {interp eval $tkCon(exec) [list unset $myVar]}
+      }
+      interp eval $tkCon(exec) [list trace variable $myVar rwu \
+	  [list tkcon set $masterVar $tkCon(exec)]]
+      return
+    }
+    v* {
       return $tkCon(version)
     }
     default {
       ## tries to determine if the command exists, otherwise throws error
-      set cmd [lindex $args 0]
-      set cmd tkCon[string toup [string index $cmd 0]][string range $cmd 1 end]
-      if [string match $cmd [info command $cmd]] {
-	eval $cmd [lreplace $args 0 0]
+      set new tkCon[string toup [string index $cmd 0]][string range $cmd 1 end]
+      if [string comp {} [info command $new]] {
+	uplevel \#0 $new $args
       } else {
-	error "bad option \"[lindex $args 0]\": must be attach, close,\
-		console, destroy, eval, font, hide, iconify,\
-		load, main, new, save, show, slave, deiconify, title"
+	return -code error "bad option \"$cmd\": must be\
+	    [join [lsort [list attach close console destroy font hide \
+	    iconify load main master new save show slave deiconify \
+	    version title bgerror]] {, }]"
       }
     }
   }
@@ -1044,39 +1429,47 @@ proc tkcon {args} {
 # ARGS:	same as usual	
 # Outputs:	the string with a color-coded text tag
 ## 
-catch {rename puts tcl_puts}
-proc puts args {
-  set len [llength $args]
-  if {$len==1} {
-    eval tkcon console insert output $args stdout {\n} stdout
-    tkcon console see output
-  } elseif {$len==2 &&
-    [regexp {(stdout|stderr|-nonewline)} [lindex $args 0] junk tmp]} {
-    if [string comp $tmp -nonewline] {
-      eval tkcon console insert output [lreplace $args 0 0] $tmp {\n} $tmp
-    } else {
-      eval tkcon console insert output [lreplace $args 0 0] stdout
-    }
-    tkcon console see output
-  } elseif {$len==3 &&
-    [regexp {(stdout|stderr)} [lreplace $args 2 2] junk tmp]} {
-    if [string comp [lreplace $args 1 2] -nonewline] {
-      eval tkcon console insert output [lrange $args 1 1] $tmp
+if ![catch {rename puts tcl_puts}] {
+  proc puts args {
+    set len [llength $args]
+    if {$len==1} {
+      eval tkcon console insert output $args stdout {\n} stdout
+      tkcon console see output
+    } elseif {$len==2 && \
+	[regexp {(stdout|stderr|-nonewline)} [lindex $args 0] junk tmp]} {
+      if [string comp $tmp -nonewline] {
+	eval tkcon console insert output [lreplace $args 0 0] $tmp {\n} $tmp
+      } else {
+	eval tkcon console insert output [lreplace $args 0 0] stdout
+      }
+      tkcon console see output
+    } elseif {$len==3 && \
+	[regexp {(stdout|stderr)} [lreplace $args 2 2] junk tmp]} {
+      if [string comp [lreplace $args 1 2] -nonewline] {
+	eval tkcon console insert output [lrange $args 1 1] $tmp
+      } else {
+	eval tkcon console insert output [lreplace $args 0 1] $tmp
+      }
+      tkcon console see output
     } else {
-      eval tkcon console insert output [lreplace $args 0 1] $tmp
+      eval tcl_puts $args
     }
-    tkcon console see output
-  } else {
-    eval tcl_puts $args
   }
 }
 
+## echo
+## Relaxes the one string restriction of 'puts'
+# ARGS:	any number of strings to output to stdout
+##
+proc echo args { puts [concat $args] }
+
 ## clear - clears the buffer of the console (not the history though)
 ## This is executed in the parent interpreter
 ## 
 proc clear {{pcnt 100}} {
   if {![regexp {^[0-9]*$} $pcnt] || $pcnt < 1 || $pcnt > 100} {
-    error "invalid percentage to clear: must be 1-100 (100 default)"
+    return -code error \
+	"invalid percentage to clear: must be 1-100 (100 default)"
   } elseif {$pcnt == 100} {
     tkcon console delete 1.0 end
   } else {
@@ -1095,13 +1488,13 @@ proc alias {{newcmd {}} args} {
   if [string match {} $newcmd] {
     set res {}
     foreach a [interp aliases] {
-      lappend res [list $a: [interp alias {} $a]]
+      lappend res [list $a -> [interp alias {} $a]]
     }
     return [join $res \n]
   } elseif {[string match {} $args]} {
     interp alias {} $newcmd
   } else {
-    eval interp alias {{}} $newcmd {{}} $args
+    eval interp alias [list {} $newcmd {}] $args
   }
 }
 
@@ -1126,10 +1519,33 @@ proc dump {type args} {
     set args [lreplace $args 0 0]
   }
   if {$whine && [string match {} $args]} {
-    error "wrong \# args: [lindex [info level 0] 0] ?-nocomplain? pattern ?pattern ...?"
+    return -code error "wrong \# args:\
+	[lindex [info level 0] 0] ?-nocomplain? pattern ?pattern ...?"
   }
   set res {}
   switch -glob -- $type {
+    c* {
+      # command
+      # outpus commands by figuring out, as well as possible, what it is
+      # this does not attempt to auto-load anything
+      foreach arg $args {
+	if [string comp {} [set cmds [info comm $arg]]] {
+	  foreach cmd [lsort $cmds] {
+	    if {[lsearch -exact [interp aliases] $cmd] > -1} {
+	      append res "\#\# ALIAS:   $cmd => [interp alias {} $cmd]\n"
+	    } elseif [string comp {} [info procs $cmd]] {
+	      if {[catch {dump p $cmd} msg] && $whine} { set code error }
+	      append res $msg\n
+	    } else {
+	      append res "\#\# COMMAND: $cmd\n"
+	    }
+	  }
+	} elseif $whine {
+	  append res "\#\# No known command $arg\n"
+	  set code error
+	}
+      }
+    }
     v* {
       # variable
       # outputs variables value(s), whether array or simple.
@@ -1146,17 +1562,19 @@ proc dump {type args} {
 	foreach var [lsort $vars] {
 	  upvar $var v
 	  if {[array exists v]} {
+	    set nest {}
 	    append res "array set $var \{\n"
 	    foreach i [lsort [array names v]] {
-	      upvar 0 v\($i\) w
-	      if {[array exists w]} {
-		append res "    [list $i {NESTED VAR ERROR}]\n"
-		if $whine { set code error }
+	      upvar 0 v\($i\) __ary
+	      if {[array exists __ary]} {
+		append nest "\#\# NESTED ARRAY ELEMENT: $i\n"
+		append nest "upvar 0 $var\($i\) __ary; [dump v __ary]\n"
+		#if $whine { set code error }
 	      } else {
 		append res "    [list $i $v($i)]\n"
 	      }
 	    }
-	    append res "\}\n"
+	    append res "\}\n$nest"
 	  } else {
 	    append res [list set $var $v]\n
 	  }
@@ -1166,7 +1584,9 @@ proc dump {type args} {
     p* {
       # procedure
       foreach arg $args {
-	if {[string comp {} [set ps [info proc $arg]]]} {
+	if {[string comp {} [set ps [info proc $arg]]] ||
+	    ([auto_load $arg] &&
+	     [string comp {} [set ps [info proc $arg]]])} {
 	  foreach p [lsort $ps] {
 	    set as {}
 	    foreach a [info args $p] {
@@ -1180,26 +1600,329 @@ proc dump {type args} {
 	  }
 	} elseif $whine {
 	  append res "\#\# No known proc $arg\n"
+	  set code error
 	}
       }
     }
     w* {
       # widget
+      ## The user should have Tk loaded
+      if [string match {} [info command winfo]] {
+	return -code error "winfo not present, cannot dump widgets"
+      }
+      foreach arg $args {
+	if [string comp {} [set ws [info command $arg]]] {
+	  foreach w [lsort $ws] {
+	    if [winfo exists $w] {
+	      if [catch {$w configure} cfg] {
+		append res "\#\# Widget $w does not support configure method"
+		set code error
+	      } else {
+		append res "\#\# [winfo class $w] $w\n$w configure"
+		foreach c $cfg {
+		  if {[llength $c] != 5} continue
+		  append res " \\\n\t[list [lindex $c 0] [lindex $c 4]]"
+		}
+		append res \n
+	      }
+	    }
+	  }
+	} elseif $whine {
+	  append res "\#\# No known widget $arg\n"
+	  set code error
+	}
+      }
     }
     default {
       return -code error "bad [lindex [info level 0] 0] option\
-	\"[lindex $args 0]\":\ must be procedure, variable, widget"
+	\"$type\":\ must be procedure, variable, widget"
     }
   }
   return -code $code [string trimr $res \n]
 }
 
+## idebug - interactive debugger
+# ARGS:	opt
+#
+##
+proc idebug {opt args} {
+  global IDEBUG
+
+  if ![info exists IDEBUG(on)] { array set IDEBUG { on 0 id * debugging 0 } }
+  set level [expr [info level]-1]
+  switch -glob -- $opt {
+    on	{
+      if [string comp {} $args] { set IDEBUG(id) $args }
+      return [set IDEBUG(on) 1]
+    }
+    off	{ return [set IDEBUG(on) 0] }
+    id  {
+      if [string match {} $args] {
+	return $IDEBUG(id)
+      } else { return [set IDEBUG(id) $args] }
+    }
+    break {
+      if {!$IDEBUG(on) || $IDEBUG(debugging) || ([string comp {} $args] \
+	  && ![string match $IDEBUG(id) $args]) || [info level]<1} return
+      set IDEBUG(debugging) 1
+      puts stderr "idebug at level \#$level: [lindex [info level -1] 0]"
+      set tkcon [string comp {} [info command tkcon]]
+      if $tkcon {
+	tkcon show
+	set prompt [tkcon set tkCon(debugPrompt)]
+	set slave  [tkcon set tkCon(exec)]
+	set event  [tkcon set tkCon(event)]
+	tkcon set tkCon(exec) [tkcon master interp create debugger]
+	tkcon set tkCon(event) 1
+      }
+      set max $level
+      while 1 {
+	set err {}
+	if $tkcon {
+	  tkcon prompt {} {} [subst $prompt]
+	  set line [tkcon gets]
+	  tkcon console mark set output end
+	} else {
+	  puts -nonewline stderr "(level \#$level) debug > "
+	  gets stdin line
+	  while {![info complete $line]} {
+	    puts -nonewline "> "
+	    append line "\n[gets stdin]"
+	  }
+	}
+	if [string match {} $line] continue
+	set key [lindex $line 0]
+	if ![regexp {^([\#-]?[0-9]+)} [lreplace $line 0 0] lvl] {
+	  set lvl \#$level
+	}
+	set res {}; set c 0
+	switch -- $key {
+	  + {
+	    ## Allow for jumping multiple levels
+	    if {$level < $max} { idebug trace [incr level] $level 0 VERBOSE }
+	  }
+	  - {
+	    ## Allow for jumping multiple levels
+	    if {$level > 1} { idebug trace [incr level -1] $level 0 VERBOSE }
+	  }
+	  . { set c [catch { idebug trace $level $level 0 VERBOSE } res] }
+	  v { set c [catch { idebug show vars $lvl } res] }
+	  V { set c [catch { idebug show vars $lvl VERBOSE } res] }
+	  l { set c [catch { idebug show locals $lvl } res] }
+	  L { set c [catch { idebug show locals $lvl VERBOSE } res] }
+	  g { set c [catch { idebug show globals $lvl } res] }
+	  G { set c [catch { idebug show globals $lvl VERBOSE } res] }
+	  t { set c [catch { idebug trace 1 $max $level } res] }
+	  T { set c [catch { idebug trace 1 $max $level VERBOSE } res] }
+	  b { set c [catch { idebug body $lvl } res] }
+	  o { set res [set IDEBUG(on) [expr !$IDEBUG(on)]] }
+	  h - ?	{
+	    puts stderr "    +		Move down in call stack
+    -		Move up in call stack
+    .		Show current proc name and params
+
+    v		Show names of variables currently in scope
+    V		Show names of variables currently in scope with values
+    l		Show names of local (transient) variables
+    L		Show names of local (transient) variables with values
+    g		Show names of declared global variables
+    G		Show names of declared global variables with values
+    t		Show a stack trace
+    T		Show a verbose stack trace
+
+    b		Show body of current proc
+    o		Toggle on/off any further debugging
+    c,q		Continue regular execution (Quit debugger)
+    h,?		Print this help
+    default	Evaluate line at current level (\#$level)"
+	  }
+	  c - q break
+	  default { set c [catch {uplevel \#$level $line} res] }
+	}
+	if $tkcon {
+	  tkcon set tkCon(event) \
+	      [tkcon evalSlave eval history add [list $line] \; history nextid]
+	}
+	if $c { puts stderr $res } elseif {[string comp {} $res]} { puts $res }
+      }
+      set IDEBUG(debugging) 0
+      if $tkcon {
+	tkcon master interp delete debugger
+	tkcon set tkCon(exec) $slave
+	tkcon set tkCon(event) $event
+      }
+    }
+    bo* {
+      if [regexp {^([\#-]?[0-9]+)} $args level] {
+	return [uplevel $level { dump com -no [lindex [info level 0] 0] }]
+      }
+    }
+    t* {
+      if {[llength $args]<2} return
+      set min [set max [set lvl $level]]
+      if ![regexp {^\#?([0-9]+)? ?\#?([0-9]+) ?\#?([0-9]+)? ?(VERBOSE)?} \
+	  $args junk min max lvl verbose] return
+      for {set i $max} {
+	$i>=$min && ![catch {uplevel \#$i info level 0} info]
+      } {incr i -1} {
+	if {$i==$lvl} {
+	  puts -nonewline stderr "* \#$i:\t"
+	} else {
+	  puts -nonewline stderr "  \#$i:\t"
+	}
+	set name [lindex $info 0]
+	if {[string comp VERBOSE $verbose] || \
+	    [string match {} [info procs $name]]} {
+	  puts $info
+	} else {
+	  puts "proc $name {[info args $name]} { ... }"
+	  set idx 0
+	  foreach arg [info args $name] {
+	    if [string match args $arg] {
+	      puts "\t$arg = [lrange $info [incr idx] end]"; break
+	    } else {
+	      puts "\t$arg = [lindex $info [incr idx]]"
+	    }
+	  }
+	}
+      }
+    }
+    s* {
+      #var, local, global
+      set level \#$level
+      if ![regexp {^([vgl][^ ]*) ?([\#-]?[0-9]+)? ?(VERBOSE)?} \
+	  $args junk type level verbose] return
+      switch -glob -- $type {
+	v* { set vars [uplevel $level {lsort [info vars]}] }
+	l* { set vars [uplevel $level {lsort [info locals]}] }
+	g* { set vars [lremove [uplevel $level {info vars}] \
+	    [uplevel $level {info locals}]] }
+      }
+      if [string match VERBOSE $verbose] {
+	return [uplevel $level dump var -nocomplain $vars]
+      } else {
+	return $vars
+      }
+    }
+    e* - pu* {
+      if {[llength $opt]==1 && [catch {lindex [info level -1] 0} id]} {
+	set id [lindex [info level 0] 0]
+      } else {
+	set id [lindex $opt 1]
+      }
+      if {$IDEBUG(on) && [string match $IDEBUG(id) $id]} {
+	if [string match e* $opt] {
+	  puts [concat $args]
+	} else { eval puts $args }
+      }
+    }
+    default {
+      return -code error "bad [lindex [info level 0] 0] option \"$opt\":\
+	  must be [join [lsort [list on off id break print body trace \
+	  show puts echo]] {, }]"
+    }
+  }
+}
+
+## observe - like trace, but not
+# ARGS:	opt	- option
+#	name	- name of variable or command
+##
+proc observe {opt name args} {
+  global tcl_observe
+  switch -glob -- $opt {
+    co* {
+      if [regexp {^(set|puts|for|incr|info|uplevel)$} $name] {
+	return -code error \
+	    "cannot observe \"$name\": infinite eval loop will occur"
+      }
+      set old ${name}@
+      while {[string comp {} [info command $old]]} { append old @ }
+      rename $name $old
+      set max 4
+      regexp {^[0-9]+} $args max
+      ## idebug trace could be used here
+      proc $name args "
+      for {set i \[info level\]; set max \[expr \[info level\]-$max\]} {
+	\$i>=\$max && !\[catch {uplevel \#\$i info level 0} info\]
+      } {incr i -1} {
+	puts -nonewline stderr \"  \#\$i:\t\"
+	puts \$info
+      }
+      uplevel \[lreplace \[info level 0\] 0 0 $old\]
+      "
+      set tcl_observe($name) $old
+    }
+    cd* {
+      if {[info exists tcl_observe($name)] && [catch {
+	rename $name {}
+	rename $tcl_observe($name) $name
+	unset tcl_observe($name)
+      } err]} { return -code error $err }
+    }
+    ci* {
+      ## What a useless method...
+      if [info exists tcl_observe($name)] {
+	set i $tcl_observe($name)
+	set res "\"$name\" observes true command \"$i\""
+	while {[info exists tcl_observe($i)]} {
+	  append res "\n\"$name\" observes true command \"$i\""
+	  set i $tcl_observe($name)
+	}
+	return $res
+      }
+    }
+    va* - vd* {
+      set type [lindex $args 0]
+      set args [lrange $args 1 end]
+      if ![regexp {^[rwu]} $type type] {
+	return -code error "bad [lindex [info level 0] 0] $opt type\
+	    \"$type\": must be read, write or unset"
+      }
+      if [string match {} $args] { set args observe_var }
+      uplevel [list trace $opt $name $type $args]
+    }
+    vi* {
+      uplevel [list trace vinfo $name]
+    }
+    default {
+      return -code error "bad [lindex [info level 0] 0] option\
+	 \"[lindex $args 0]\": must be [join [lsort [list procedure \
+	 pdelete pinfo variable vdelete vinfo]] {, }]"
+    }
+  }
+}
+
+## observe_var - auxilary function for observing vars, called by trace
+## via observe
+# ARGS:	name	- variable name
+#	el	- array element name, if any
+#	op	- operation type (rwu)
+##
+proc observe_var {name el op} {
+  if [string match u $op] {
+    if [string comp {} $el] {
+      puts "unset \"$name\($el\)\""
+    } else {
+      puts "unset \"$name\""
+    }
+  } else {
+    upvar \#0 $name $name
+    if [info exists $name\($el\)] {
+      puts [dump v $name\($el\)]
+    } else {
+      puts [dump v $name]
+    }
+  }
+}
+
 ## which - tells you where a command is found
 # ARGS:	cmd	- command name
 # Returns:	where command is found (internal / external / unknown)
 ## 
 proc which cmd {
-  if [string comp {} [info commands $cmd]] {
+  if {[string comp {} [info commands $cmd]] ||
+      ([auto_load $cmd] && [string comp {} [info commands $cmd]])} {
     if {[lsearch -exact [interp aliases] $cmd] > -1} {
       return "$cmd:\taliased to [alias $cmd]"
     } elseif [string comp {} [info procs $cmd]] {
@@ -1210,7 +1933,7 @@ proc which cmd {
   } elseif [auto_execok $cmd] {
     return [auto_execpath $cmd]
   } else {
-    return "$cmd:\tunknown command"
+    return -code error "$cmd:\tunknown command"
   }
 }
 
@@ -1288,15 +2011,18 @@ if {[string match windows $tcl_platform(platform)]} {
 ## 
 proc dir {args} {
   array set s {
-    all 0 full 0 long 0 0 --- 1 --x 2 -w- 3 -wx 4 r-- 5 r-x 6 rw- 7 rwx
+    all 0 full 0 long 0
+    0 --- 1 --x 2 -w- 3 -wx 4 r-- 5 r-x 6 rw- 7 rwx
   }
   while {[string match \-* [lindex $args 0]]} {
     set str [lindex $args 0]
     set args [lreplace $args 0 0]
     switch -glob -- $str {
-      -a* {set s(all) 1} -f* {set s(full) 1} -l* {set s(long) 1} -- break
+      -a* {set s(all) 1} -f* {set s(full) 1}
+      -l* {set s(long) 1} -- break
       default {
-	error "Passed unknown arg $str, should be one of: -all, -full, -long"
+	return -code error \
+	    "unknown option \"$str\", should be one of: -all, -full, -long"
       }
     }
   }
@@ -1360,7 +2086,8 @@ proc dir {args} {
 	}
       }
       set i [expr $i+2+$s(full)]
-      set j [expr [tkcon eval set tkCon(cols)]/$i]
+      ## This gets the number of cols in the TkCon console widget
+      set j [expr [tkcon master set tkCon(cols)]/$i]
       set k 0
       foreach f [lindex $o 1] {
 	set f [file tail $f]
@@ -1379,24 +2106,51 @@ proc dir {args} {
   }
   return [string trimr $res]
 }
-
+interp alias {} ls {} dir
 
 ## tclindex - creates the tclIndex file
 # OPTS:	-ext	- extensions to auto index (defaults to *.tcl)
+#	-pkg	- whether to create a pkgIndex.tcl file
+#	-idx	- whether to create a tclIndex file
 # ARGS:	args	- directories to auto index (defaults to pwd)
 # Outputs:	tclIndex file to each directory
 ##
 proc tclindex args {
-  set ext {*.tcl}
-  if [string match \-e* [lindex $args 0]] {
-    set ext  [lindex $args 1]
-    set args [lreplace $args 0 1]
+  set truth {^(1|yes|true|on)$}; set pkg 0; set idx 1;
+  while {[regexp -- {^-[^ ]+} $args opt] && [string comp {} $args]} {
+    switch -glob -- $opt {
+      --  { set args [lreplace $args 0 0]; break }
+      -e* {
+	set ext [lindex $args 1]
+	set args [lreplace $args 0 1]
+      }
+      -p* {
+	set pkg [regexp -nocase $truth [lindex $args 1]]
+	set args [lreplace $args 0 1]
+      }
+      -i* {
+	set idx [regexp -nocase $truth [lindex $args 1]]
+	set args [lreplace $args 0 1]
+      }
+      default {
+	return -code error "bad option \"$opt\": must be one of\
+	    [join [lsort [list -- -extension -package -index]] {, }]"
+      }
+    }
+  }
+  if ![info exists ext] {
+    set ext {*.tcl}
+    if $pkg { lappend ext *[info sharedlibextension] }
   }
   if [string match {} $args] {
-    eval auto_mkindex [list [pwd]] $ext
+    if $idx { eval auto_mkindex [list [pwd]] $ext }
+    if $pkg { eval pkg_mkIndex [list [pwd]] $ext }
   } else {
     foreach dir $args {
-      if [file isdir $dir] { eval auto_mkindex [list $dir] $ext }
+      if [file isdir $dir] {
+	if $idx { eval auto_mkindex [list [pwd]] $ext }
+	if $pkg { eval pkg_mkIndex [list [pwd]] $ext }
+      }
     }
   }
 }
@@ -1404,7 +2158,7 @@ proc tclindex args {
 ## lremove - remove items from a list
 # OPTS:	-all	remove all instances of each item
 # ARGS:	l	a list to remove items from
-#	is	a list of items to remove
+#	args	items to remove
 ##
 proc lremove {args} {
   set all 0
@@ -1419,16 +2173,72 @@ proc lremove {args} {
     set l [lreplace $l $ix $ix]
     if $all {
       while {[set ix [lsearch -exact $l $i]] != -1} {
-	set l [lreplace $l $i $i]
+	set l [lreplace $l $ix $ix]
       }
     }
   }
+  idebug break
   return $l
 }
 
-
 ## Unknown changed to get output into tkCon window
 # unknown:
+# Invoked automatically whenever an unknown command is encountered.
+# Works through a list of "unknown handlers" that have been registered
+# to deal with unknown commands.  Extensions can integrate their own
+# handlers into the "unknown" facility via "unknown_handle".
+#
+# If a handler exists that recognizes the command, then it will
+# take care of the command action and return a valid result or a
+# Tcl error.  Otherwise, it should return "-code continue" (=2)
+# and responsibility for the command is passed to the next handler.
+#
+# Arguments:
+# args -	A list whose elements are the words of the original
+#		command, including the command name.
+
+proc unknown args {
+    global unknown_handler_order unknown_handlers errorInfo errorCode
+
+    #
+    # Be careful to save error info now, and restore it later
+    # for each handler.  Some handlers generate their own errors
+    # and disrupt handling.
+    #
+    set savedErrorCode $errorCode
+    set savedErrorInfo $errorInfo
+
+    if {![info exists unknown_handler_order] || ![info exists unknown_handlers]} {
+	set unknown_handlers(tcl) tcl_unknown
+	set unknown_handler_order tcl
+    }
+
+    foreach handler $unknown_handler_order {
+        set status [catch {uplevel $unknown_handlers($handler) $args} result]
+
+        if {$status == 1} {
+            #
+            # Strip the last five lines off the error stack (they're
+            # from the "uplevel" command).
+            #
+            set new [split $errorInfo \n]
+            set new [join [lrange $new 0 [expr [llength $new] - 6]] \n]
+            return -code $status -errorcode $errorCode \
+                -errorinfo $new $result
+
+        } elseif {$status != 4} {
+            return -code $status $result
+        }
+
+        set errorCode $savedErrorCode
+        set errorInfo $savedErrorInfo
+    }
+
+    set name [lindex $args 0]
+    return -code error "invalid command name \"$name\""
+}
+
+# tcl_unknown:
 # Invoked when a Tcl command is invoked that doesn't exist in the
 # interpreter:
 #
@@ -1447,7 +2257,7 @@ proc lremove {args} {
 # args -	A list whose elements are the words of the original
 #		command, including the command name.
 
-proc unknown args {
+proc tcl_unknown args {
   global auto_noexec auto_noload env unknown_pending tcl_interactive tkCon
   global errorCode errorInfo
 
@@ -1472,7 +2282,7 @@ proc unknown args {
     set unknown_pending($name) pending;
     set ret [catch {auto_load $name} msg]
     unset unknown_pending($name);
-    if {$ret != 0} {
+    if $ret {
       return -code $ret -errorcode $errorCode \
 	  "error while autoloading \"$name\": $msg"
     }
@@ -1526,336 +2336,416 @@ proc unknown args {
       }
     }
   }
-  return -code error "invalid command name \"$name\""
-}
-
-
-#-------------------------------------------------------------------------
-# Elements of tkPriv that are used in this file:
-#
-# char -		Character position on the line;  kept in order
-#			to allow moving up or down past short lines while
-#			still remembering the desired position.
-# mouseMoved -		Non-zero means the mouse has moved a significant
-#			amount since the button went down (so, for example,
-#			start dragging out a selection).
-# prevPos -		Used when moving up or down lines via the keyboard.
-#			Keeps track of the previous insert position, so
-#			we can distinguish a series of ups and downs, all
-#			in a row, from a new up or down.
-# selectMode -		The style of selection currently underway:
-#			char, word, or line.
-# x, y -		Last known mouse coordinates for scanning
-#			and auto-scanning.
-#-------------------------------------------------------------------------
-
-# tkConClipboardKeysyms --
-# This procedure is invoked to identify the keys that correspond to
-# the "copy", "cut", and "paste" functions for the clipboard.
-#
-# Arguments:
-# copy -	Name of the key (keysym name plus modifiers, if any,
-#		such as "Meta-y") used for the copy operation.
-# cut -		Name of the key used for the cut operation.
-# paste -	Name of the key used for the paste operation.
-
-proc tkConClipboardKeysyms {copy cut paste} {
-  bind Console <$copy>	{tkConCopy %W}
-  bind Console <$cut>	{tkConCut %W}
-  bind Console <$paste>	{tkConPaste %W}
-}
+  return -code continue
+}
+
+proc tkConBindings {} {
+  global tkCon tcl_platform
+
+  ## FIX ; rewrite so that virtual events are used as well as preventing
+  ## the overwriting of user events
+
+  #-----------------------------------------------------------------------
+  # Elements of tkPriv that are used in this file:
+  #
+  # char -		Character position on the line;  kept in order
+  #			to allow moving up or down past short lines while
+  #			still remembering the desired position.
+  # mouseMoved -	Non-zero means the mouse has moved a significant
+  #			amount since the button went down (so, for example,
+  #			start dragging out a selection).
+  # prevPos -		Used when moving up or down lines via the keyboard.
+  #			Keeps track of the previous insert position, so
+  #			we can distinguish a series of ups and downs, all
+  #			in a row, from a new up or down.
+  # selectMode -	The style of selection currently underway:
+  #			char, word, or line.
+  # x, y -		Last known mouse coordinates for scanning
+  #			and auto-scanning.
+  #-----------------------------------------------------------------------
+
+  switch -glob $tcl_platform(platform) {
+    win* { set tkCon(meta) Alt }
+    mac* { set tkCon(meta) Command }
+    default { set tkCon(meta) Meta }
+  }
+
+  ## <<TkCon_Exit>>
+  bind $tkCon(root) <Control-q> exit
+  ## <<TkCon_New>>
+  bind $tkCon(root) <Control-N> { tkConNew }
+  ## <<TkCon_Close>>
+  bind $tkCon(root) <Control-w> { tkConDestroy }
+  ## <<TkCon_About>>
+  bind $tkCon(root) <Control-A> { tkConAbout }
+  ## <<TkCon_Help>>
+  bind $tkCon(root) <Control-H> { tkConHelp }
+  ## <<TkCon_Find>>
+  bind $tkCon(root) <Control-F> { tkConFindBox $tkCon(console) }
+  ## <<TkCon_Slave>>
+  bind $tkCon(root) <Control-Key-1> {
+    tkConAttach {}
+    tkConPrompt "\n" [tkConCmdGet $tkCon(console)]
+  }
+  ## <<TkCon_Master>>
+  bind $tkCon(root) <Control-Key-2> {
+    if [string comp {} $tkCon(name)] {
+      tkConAttach $tkCon(name)
+    } else {
+      tkConAttach Main
+    }
+    tkConPrompt "\n" [tkConCmdGet $tkCon(console)]
+  }
+  ## <<TkCon_Main>>
+  bind $tkCon(root) <Control-Key-3> {
+    tkConAttach Main
+    tkConPrompt "\n" [tkConCmdGet $tkCon(console)]
+  }
 
-proc tkConCut w {
-  if [string match $w [selection own -displayof $w]] {
-    clipboard clear -displayof $w
-    catch {
-      clipboard append -displayof $w [selection get -displayof $w]
-      if [$w compare sel.first >= limit] {$w delete sel.first sel.last}
+  ## Menu items need null PostCon bindings to avoid the TagProc
+  ##
+  foreach ev [bind $tkCon(root)] {
+    bind PostCon $ev {
+      # empty
+    }
+  }
+
+  # tkConClipboardKeysyms --
+  # This procedure is invoked to identify the keys that correspond to
+  # the "copy", "cut", and "paste" functions for the clipboard.
+  #
+  # Arguments:
+  # copy -	Name of the key (keysym name plus modifiers, if any,
+  #		such as "Meta-y") used for the copy operation.
+  # cut -		Name of the key used for the cut operation.
+  # paste -	Name of the key used for the paste operation.
+
+  proc tkConClipboardKeysyms {copy cut paste} {
+    bind Console <$copy>	{tkConCopy %W}
+    bind Console <$cut>		{tkConCut %W}
+    bind Console <$paste>	{tkConPaste %W}
+  }
+
+  proc tkConCut w {
+    if [string match $w [selection own -displayof $w]] {
+      clipboard clear -displayof $w
+      catch {
+	clipboard append -displayof $w [selection get -displayof $w]
+	if [$w compare sel.first >= limit] {$w delete sel.first sel.last}
+      }
     }
   }
-}
-proc tkConCopy w {
-  if [string match $w [selection own -displayof $w]] {
-    clipboard clear -displayof $w
-    catch {clipboard append -displayof $w [selection get -displayof $w]}
+  proc tkConCopy w {
+    if [string match $w [selection own -displayof $w]] {
+      clipboard clear -displayof $w
+      catch {clipboard append -displayof $w [selection get -displayof $w]}
+    }
   }
-}
 
-proc tkConPaste w {
-  if ![catch {selection get -displayof $w -selection CLIPBOARD} tmp] {
-    if [$w compare insert < limit] {$w mark set insert end}
-    $w insert insert $tmp
-    $w see insert
-    if [string match *\n* $tmp] {tkConEval $w}
+  proc tkConPaste w {
+    if ![catch {selection get -displayof $w -selection CLIPBOARD} tmp] {
+      if [$w compare insert < limit] {$w mark set insert end}
+      $w insert insert $tmp
+      $w see insert
+      if [string match *\n* $tmp] {tkConEval $w}
+    }
   }
-}
 
-## Get all Text bindings into Console except Unix cut/copy/paste
-## and newline insertion
-foreach ev [lremove [bind Text] {<Control-Key-y> <Control-Key-w> \
-				     <Meta-Key-w> <Control-Key-o>}] {
-  bind Console $ev [bind Text $ev]
-}
-unset ev
+  ## Get all Text bindings into Console except Unix cut/copy/paste
+  ## and newline insertion
+  foreach ev [lremove [bind Text] {<Control-Key-y> <Control-Key-w> \
+				       <Meta-Key-w> <Control-Key-o>}] {
+    bind Console $ev [bind Text $ev]
+  }
 
-## Redefine for Console what we need
-##
-tkConClipboardKeysyms F16 F20 F18
-tkConClipboardKeysyms Control-c Control-x Control-v
+  ## Redefine for Console what we need
+  ##
+  tkConClipboardKeysyms F16 F20 F18
+  tkConClipboardKeysyms Control-c Control-x Control-v
 
-bind Console <Insert> {catch {tkConInsert %W [selection get -displayof %W]}}
+  bind Console <Insert> {catch {tkConInsert %W [selection get -displayof %W]}}
 
-bind Console <Up> {
-  if [%W compare {insert linestart} != {limit linestart}] {
-    tkTextSetCursor %W [tkTextUpDownLine %W -1]
-  } else {
-    if {$tkCon(event) == [tkConEvalSlave history nextid]} {
-      set tkCon(cmdbuf) [tkConCmdGet %W]
+  bind Console <Triple-1> {+
+    catch {
+      eval %W tag remove sel [%W tag nextrange prompt sel.first sel.last]
+      %W mark set insert sel.first
     }
-    if [catch {tkConEvalSlave \
-		   history event [incr tkCon(event) -1]} tkCon(tmp)] {
-      incr tkCon(event)
+  }
+
+  ## binding editor needed
+  ## binding <events> for .tkconrc
+
+  ## <<TkCon_Previous>>
+  bind Console <Up> {
+    if [%W compare {insert linestart} != {limit linestart}] {
+      tkTextSetCursor %W [tkTextUpDownLine %W -1]
     } else {
-      %W delete limit end
-      %W insert limit $tkCon(tmp)
-      %W see end
+      if {$tkCon(event) == [tkConEvalSlave history nextid]} {
+	set tkCon(cmdbuf) [tkConCmdGet %W]
+      }
+      if [catch {tkConEvalSlave \
+		     history event [incr tkCon(event) -1]} tkCon(tmp)] {
+	incr tkCon(event)
+      } else {
+	%W delete limit end
+	%W insert limit $tkCon(tmp)
+	%W see end
+      }
     }
   }
-}
-bind Console <Down> {
-  if [%W compare {insert linestart} != {end-1c linestart}] {
-    tkTextSetCursor %W [tkTextUpDownLine %W 1]
-  } else {
-    if {$tkCon(event) < [tkConEvalSlave history nextid]} {
-      %W delete limit end
-      if {[incr tkCon(event)] == [tkConEvalSlave history nextid]} {
-	%W insert limit $tkCon(cmdbuf)
-      } else {
-	%W insert limit [tkConEvalSlave history event $tkCon(event)]
+  ## <<TkCon_Next>>
+  bind Console <Down> {
+    if [%W compare {insert linestart} != {end-1c linestart}] {
+      tkTextSetCursor %W [tkTextUpDownLine %W 1]
+    } else {
+      if {$tkCon(event) < [tkConEvalSlave history nextid]} {
+	%W delete limit end
+	if {[incr tkCon(event)] == [tkConEvalSlave history nextid]} {
+	  %W insert limit $tkCon(cmdbuf)
+	} else {
+	  %W insert limit [tkConEvalSlave history event $tkCon(event)]
+	}
+	%W see end
       }
-      %W see end
     }
   }
-}
-bind Console <Tab> {
-  if [%W compare insert > limit] {tkConExpand %W path}
-}
-bind Console <Control-P> {
-  if [%W compare insert > limit] {tkConExpand %W proc}
-}
-bind Console <Control-V> {
-  if [%W compare insert > limit] {tkConExpand %W var}
-}
-bind Console <Control-i> {
-  if [%W compare insert >= limit] {
-    tkConInsert %W \t
+  ## <<TkCon_ExpandFile>>
+  bind Console <Tab> {
+    if [%W compare insert > limit] {tkConExpand %W path}
   }
-}
-bind Console <Return> {
-  tkConEval %W
-}
-bind Console <KP_Enter> [bind Console <Return>]
-bind Console <Delete> {
-  if {[string comp {} [%W tag nextrange sel 1.0 end]] \
-	  && [%W compare sel.first >= limit]} {
-    %W delete sel.first sel.last
-  } elseif [%W compare insert >= limit] {
-    %W delete insert
-    %W see insert
+  ## <<TkCon_ExpandProc>>
+  bind Console <Control-P> {
+    if [%W compare insert > limit] {tkConExpand %W proc}
   }
-}
-bind Console <BackSpace> {
-  if {[string comp {} [%W tag nextrange sel 1.0 end]] \
-	  && [%W compare sel.first >= limit]} {
-    %W delete sel.first sel.last
-  } elseif {[%W compare insert != 1.0] && [%W compare insert > limit]} {
-    %W delete insert-1c
-    %W see insert
+  ## <<TkCon_ExpandVar>>
+  bind Console <Control-V> {
+    if [%W compare insert > limit] {tkConExpand %W var}
   }
-}
-bind Console <Control-h> [bind Console <BackSpace>]
+  ## <<TkCon_Tab>>
+  bind Console <Control-i> {
+    if [%W compare insert >= limit] {
+      tkConInsert %W \t
+    }
+  }
+  ## <<TkCon_Eval>> - no mod
+  bind Console <Return> {
+    tkConEval %W
+  }
+  bind Console <KP_Enter> [bind Console <Return>]
+  bind Console <Delete> {
+    if {[string comp {} [%W tag nextrange sel 1.0 end]] \
+	    && [%W compare sel.first >= limit]} {
+      %W delete sel.first sel.last
+    } elseif [%W compare insert >= limit] {
+      %W delete insert
+      %W see insert
+    }
+  }
+  bind Console <BackSpace> {
+    if {[string comp {} [%W tag nextrange sel 1.0 end]] \
+	    && [%W compare sel.first >= limit]} {
+      %W delete sel.first sel.last
+    } elseif {[%W compare insert != 1.0] && [%W compare insert > limit]} {
+      %W delete insert-1c
+      %W see insert
+    }
+  }
+  bind Console <Control-h> [bind Console <BackSpace>]
 
-bind Console <KeyPress> {
-  tkConInsert %W %A
-}
+  bind Console <KeyPress> {
+    tkConInsert %W %A
+  }
 
-bind Console <Control-a> {
-  if [%W compare {limit linestart} == {insert linestart}] {
-    tkTextSetCursor %W limit
-  } else {
-    tkTextSetCursor %W {insert linestart}
+  bind Console <Control-a> {
+    if [%W compare {limit linestart} == {insert linestart}] {
+      tkTextSetCursor %W limit
+    } else {
+      tkTextSetCursor %W {insert linestart}
+    }
   }
-}
-bind Console <Control-d> {
-  if [%W compare insert < limit] break
-  %W delete insert
-}
-bind Console <Control-k> {
-  if [%W compare insert < limit] break
-  if [%W compare insert == {insert lineend}] {
+  bind Console <Control-d> {
+    if [%W compare insert < limit] break
     %W delete insert
-  } else {
-    %W delete insert {insert lineend}
   }
-}
-bind Console <Control-l> {
-  ## Clear console buffer, without losing current command line input
-  set tkCon(tmp) [tkConCmdGet %W]
-  clear
-  tkConPrompt {} $tkCon(tmp)
-}
-bind Console <Control-n> {
-  ## Goto next command in history
-  if {$tkCon(event) < [tkConEvalSlave history nextid]} {
-    %W delete limit end
-    if {[incr tkCon(event)] == [tkConEvalSlave history nextid]} {
-      %W insert limit $tkCon(cmdbuf)
+  bind Console <Control-k> {
+    if [%W compare insert < limit] break
+    if [%W compare insert == {insert lineend}] {
+      %W delete insert
     } else {
-      %W insert limit [tkConEvalSlave history event $tkCon(event)]
+      %W delete insert {insert lineend}
     }
-    %W see end
-  }
-}
-bind Console <Control-p> {
-  ## Goto previous command in history
-  if {$tkCon(event) == [tkConEvalSlave history nextid]} {
-    set tkCon(cmdbuf) [tkConCmdGet %W]
   }
-  if [catch {tkConEvalSlave history event [incr tkCon(event) -1]} tkCon(tmp)] {
-    incr tkCon(event)
-  } else {
-    %W delete limit end
-    %W insert limit $tkCon(tmp)
-    %W see end
+  ## <<TkCon_Clear>>
+  bind Console <Control-l> {
+    ## Clear console buffer, without losing current command line input
+    set tkCon(tmp) [tkConCmdGet %W]
+    clear
+    tkConPrompt {} $tkCon(tmp)
   }
-}
-bind Console <Control-r> {
-  ## Search history reverse
-  if {$tkCon(svnt) == [tkConEvalSlave history nextid]} {
-    set tkCon(cmdbuf) [tkConCmdGet %W]
-  }
-  set tkCon(tmp1) [string len $tkCon(cmdbuf)]
-  incr tkCon(tmp1) -1
-  while 1 {
-    if {[catch {tkConEvalSlave \
-	history event [incr tkCon(svnt) -1]} tkCon(tmp)]} {
-      incr tkCon(svnt)
-      break
-    } elseif {![string comp $tkCon(cmdbuf) \
-	[string range $tkCon(tmp) 0 $tkCon(tmp1)]]} {
+  ## <<TkCon_NextImmediate>>
+  bind Console <Control-n> {
+    ## Goto next command in history
+    if {$tkCon(event) < [tkConEvalSlave history nextid]} {
       %W delete limit end
-      %W insert limit $tkCon(tmp)
-      break
+      if {[incr tkCon(event)] == [tkConEvalSlave history nextid]} {
+	%W insert limit $tkCon(cmdbuf)
+      } else {
+	%W insert limit [tkConEvalSlave history event $tkCon(event)]
+      }
+      %W see end
     }
   }
-  %W see end
-}
-bind Console <Control-s> {
-  ## Search history forward
-  set tkCon(tmp1) [string len $tkCon(cmdbuf)]
-  incr tkCon(tmp1) -1
-  while {$tkCon(svnt) < [tkConEvalSlave history nextid]} {
-    if {[incr tkCon(svnt)] == [tkConEvalSlave history nextid]} {
-      %W delete limit end
-      %W insert limit $tkCon(cmdbuf)
-      break
-    } elseif {![catch {tkConEvalSlave history event $tkCon(svnt)} tkCon(tmp)] \
-	&& ![string comp $tkCon(cmdbuf) \
-	[string range $tkCon(tmp) 0 $tkCon(tmp1)]]} {
+  ## <<TkCon_PreviousImmediate>>
+  bind Console <Control-p> {
+    ## Goto previous command in history
+    if {$tkCon(event) == [tkConEvalSlave history nextid]} {
+      set tkCon(cmdbuf) [tkConCmdGet %W]
+    }
+    if [catch {tkConEvalSlave history event \
+		   [incr tkCon(event) -1]} tkCon(tmp)] {
+      incr tkCon(event)
+    } else {
       %W delete limit end
       %W insert limit $tkCon(tmp)
-      break
+      %W see end
     }
   }
-  %W see end
-}
-bind Console <Control-t> {
-  ## Transpose current and previous chars
-  if [%W compare insert > limit] {
-    tkTextTranspose %W
-  }
-}
-bind Console <Control-u> {
-  ## Clear command line (Unix shell staple)
-  %W delete limit end
-}
-bind Console <Control-z> {
-  ## Save command buffer
-  set tkCon(tmp) $tkCon(cmdsave)
-  set tkCon(cmdsave) [tkConCmdGet %W]
-  if {[string match {} $tkCon(cmdsave)]} {
-    set tkCon(cmdsave) $tkCon(tmp)
-  } else {
-    %W delete limit end-1c
+  ## <<TkCon_PreviousSearch>>
+  bind Console <Control-r> {
+    ## Search history reverse
+    if {$tkCon(event) == [tkConEvalSlave history nextid]} {
+      set tkCon(cmdbuf) [tkConCmdGet %W]
+    } elseif 0 {
+      ## FIX
+      ## event ids get confusing (to user) when they 'cancel' a history
+      ## search.  This should reassign the event id properly.
+    }
+    set tkCon(tmp1) [string len $tkCon(cmdbuf)]
+    incr tkCon(tmp1) -1
+    while 1 {
+      if {[catch {tkConEvalSlave history event \
+		      [incr tkCon(event) -1]} tkCon(tmp)]} {
+	incr tkCon(event)
+	break
+      } elseif {![string comp $tkCon(cmdbuf) \
+		      [string range $tkCon(tmp) 0 $tkCon(tmp1)]]} {
+	%W delete limit end
+	%W insert limit $tkCon(tmp)
+	break
+      }
+    }
+    %W see end
   }
-  tkConInsert %W $tkCon(tmp)
-  %W see end
-}
-catch {bind Console <Key-Page_Up>   { tkTextScrollPages %W -1 }}
-catch {bind Console <Key-Prior>     { tkTextScrollPages %W -1 }}
-catch {bind Console <Key-Page_Down> { tkTextScrollPages %W 1 }}
-catch {bind Console <Key-Next>      { tkTextScrollPages %W 1 }}
-bind Console <Meta-d> {
-  if [%W compare insert >= limit] {
-    %W delete insert {insert wordend}
+  ## <<TkCon_NextSearch>>
+  bind Console <Control-s> {
+    ## Search history forward
+    set tkCon(tmp1) [string len $tkCon(cmdbuf)]
+    incr tkCon(tmp1) -1
+    while {$tkCon(event) < [tkConEvalSlave history nextid]} {
+      if {[incr tkCon(event)] == [tkConEvalSlave history nextid]} {
+	%W delete limit end
+	%W insert limit $tkCon(cmdbuf)
+	break
+      } elseif {![catch {tkConEvalSlave history event \
+			     $tkCon(event)} tkCon(tmp)]
+		&& ![string comp $tkCon(cmdbuf) \
+			 [string range $tkCon(tmp) 0 $tkCon(tmp1)]]} {
+	%W delete limit end
+	%W insert limit $tkCon(tmp)
+	break
+      }
+    }
+    %W see end
   }
-}
-bind Console <Meta-BackSpace> {
-  if [%W compare {insert -1c wordstart} >= limit] {
-    %W delete {insert -1c wordstart} insert
+  ## <<TkCon_Transpose>>
+  bind Console <Control-t> {
+    ## Transpose current and previous chars
+    if [%W compare insert > limit] { tkTextTranspose %W }
   }
-}
-bind Console <Meta-Delete> {
-  if [%W compare insert >= limit] {
-    %W delete insert {insert wordend}
+  ## <<TkCon_ClearLine>>
+  bind Console <Control-u> {
+    ## Clear command line (Unix shell staple)
+    %W delete limit end
   }
-}
-bind Console <ButtonRelease-2> {
-  if {(!$tkPriv(mouseMoved) || $tk_strictMotif) \
-	  && ![catch {selection get -displayof %W} tkCon(tmp)]} {
-    if [%W compare @%x,%y < limit] {
-      %W insert end $tkCon(tmp)
+  ## <<TkCon_SaveCommand>>
+  bind Console <Control-z> {
+    ## Save command buffer (swaps with current command)
+    set tkCon(tmp) $tkCon(cmdsave)
+    set tkCon(cmdsave) [tkConCmdGet %W]
+    if {[string match {} $tkCon(cmdsave)]} {
+      set tkCon(cmdsave) $tkCon(tmp)
     } else {
-      %W insert @%x,%y $tkCon(tmp)
+      %W delete limit end-1c
+    }
+    tkConInsert %W $tkCon(tmp)
+    %W see end
+  }
+  catch {bind Console <Key-Page_Up>   { tkTextScrollPages %W -1 }}
+  catch {bind Console <Key-Prior>     { tkTextScrollPages %W -1 }}
+  catch {bind Console <Key-Page_Down> { tkTextScrollPages %W 1 }}
+  catch {bind Console <Key-Next>      { tkTextScrollPages %W 1 }}
+  bind Console <$tkCon(meta)-d> {
+    if [%W compare insert >= limit] {
+      %W delete insert {insert wordend}
+    }
+  }
+  bind Console <$tkCon(meta)-BackSpace> {
+    if [%W compare {insert -1c wordstart} >= limit] {
+      %W delete {insert -1c wordstart} insert
+    }
+  }
+  bind Console <$tkCon(meta)-Delete> {
+    if [%W compare insert >= limit] {
+      %W delete insert {insert wordend}
+    }
+  }
+  bind Console <ButtonRelease-2> {
+    if {(!$tkPriv(mouseMoved) || $tk_strictMotif) \
+	    && ![catch {selection get -displayof %W} tkCon(tmp)]} {
+      if [%W compare @%x,%y < limit] {
+	%W insert end $tkCon(tmp)
+      } else {
+	%W insert @%x,%y $tkCon(tmp)
+      }
+      if [string match *\n* $tkCon(tmp)] {tkConEval %W}
     }
-    if [string match *\n* $tkCon(tmp)] {tkConEval %W}
   }
-}
 
-##
-## End weird bindings
-##
+  ##
+  ## End Console bindings
+  ##
 
-##
-## Bindings for doing special things based on certain keys
-##
-bind PostCon <Key-parenright> {
-  if {$tkCon(lightbrace) && $tkCon(blinktime)>99 &&
-      [string comp \\ [%W get insert-2c]]} {
-    tkConMatchPair %W \( \) limit
+  ##
+  ## Bindings for doing special things based on certain keys
+  ##
+  bind PostCon <Key-parenright> {
+    if {$tkCon(lightbrace) && $tkCon(blinktime)>99 &&
+	[string comp \\ [%W get insert-2c]]} {
+      tkConMatchPair %W \( \) limit
+    }
   }
-}
-bind PostCon <Key-bracketright> {
-  if {$tkCon(lightbrace) && $tkCon(blinktime)>99 &&
-      [string comp \\ [%W get insert-2c]]} {
-    tkConMatchPair %W \[ \] limit
+  bind PostCon <Key-bracketright> {
+    if {$tkCon(lightbrace) && $tkCon(blinktime)>99 &&
+	[string comp \\ [%W get insert-2c]]} {
+      tkConMatchPair %W \[ \] limit
+    }
   }
-}
-bind PostCon <Key-braceright> {
-  if {$tkCon(lightbrace) && $tkCon(blinktime)>99 &&
-      [string comp \\ [%W get insert-2c]]} {
-    tkConMatchPair %W \{ \} limit
+  bind PostCon <Key-braceright> {
+    if {$tkCon(lightbrace) && $tkCon(blinktime)>99 &&
+	[string comp \\ [%W get insert-2c]]} {
+      tkConMatchPair %W \{ \} limit
+    }
   }
-}
-bind PostCon <Key-quotedbl> {
-  if {$tkCon(lightbrace) && $tkCon(blinktime)>99 &&
-      [string comp \\ [%W get insert-2c]]} {
-    tkConMatchQuote %W limit
+  bind PostCon <Key-quotedbl> {
+    if {$tkCon(lightbrace) && $tkCon(blinktime)>99 &&
+	[string comp \\ [%W get insert-2c]]} {
+      tkConMatchQuote %W limit
+    }
   }
-}
 
-bind PostCon <KeyPress> {
-  if {$tkCon(lightcmd) && [string comp {} %A]} { tkConTagProc %W }
+  bind PostCon <KeyPress> {
+    if {$tkCon(lightcmd) && [string comp {} %A]} { tkConTagProc %W }
+  }
 }
 
 ## tkConTagProc - tags a procedure in the console if it's recognized
@@ -1984,7 +2874,7 @@ proc tkConInsert {w s} {
 ## 
 proc tkConExpand {w type} {
   set exp "\[^\\]\[ \t\n\r\[\{\"\$]"
-  set tmp [$w search -back -regexp $exp insert limit]
+  set tmp [$w search -back -regexp $exp insert-1c limit-1c]
   if [string compare {} $tmp] {append tmp +2c} else {set tmp limit}
   if [$w compare $tmp >= insert] return
   set str [$w get $tmp insert]
@@ -2000,7 +2890,7 @@ proc tkConExpand {w type} {
     $w insert $tmp [lindex $res 0]
     if {$len > 1} {
       global tkCon
-      if {$tkCon(showmultiple) && [string match [lindex $res 0] $str]} {
+      if {$tkCon(showmultiple) && ![string comp [lindex $res 0] $str]} {
 	puts stdout [lreplace $res 0 0]
       }
     }
@@ -2017,7 +2907,7 @@ proc tkConExpand {w type} {
 ## 
 proc tkConExpandPathname str {
   set pwd [tkConEvalAttached pwd]
-  if [catch {tkConEvalAttached cd [file dir $str]} err] {
+  if [catch {tkConEvalAttached [list cd [file dirname $str]]} err] {
     return -code error $err
   }
   if [catch {lsort [tkConEvalAttached glob [file tail $str]*]} m] {
@@ -2026,7 +2916,7 @@ proc tkConExpandPathname str {
     if {[llength $m] > 1} {
       set tmp [tkConExpandBestMatch $m [file tail $str]]
       if [string match ?*/* $str] {
-	set tmp [file dir $str]/$tmp
+	set tmp [file dirname $str]/$tmp
       } elseif [string match /* $str] {
 	set tmp /$tmp
       }
@@ -2037,7 +2927,7 @@ proc tkConExpandPathname str {
       eval append match $m
       if [file isdir $match] {append match /}
       if [string match ?*/* $str] {
-	set match [file dir $str]/$match
+	set match [file dirname $str]/$match
       } elseif [string match /* $str] {
 	set match /$match
       }
@@ -2046,7 +2936,7 @@ proc tkConExpandPathname str {
       set match [list $match]
     }
   }
-  tkConEvalAttached cd $pwd
+  tkConEvalAttached [list cd $pwd]
   return $match
 }
 
@@ -2135,6 +3025,28 @@ proc tkConExpandBestMatch {l {e {}}} {
   return $ec
 }
 
+## tkConResource - re'source's this script into current console
+## Meant primarily for my development of this program.  It follows
+## links until the ultimate source is found.
+## 
+set tkCon(SCRIPT) [info script]
+while {[string match link [file type $tkCon(SCRIPT)]]} {
+  set link [file readlink $tkCon(SCRIPT)]
+  if [string match relative [file pathtype $link]] {
+    set tkCon(SCRIPT) [file join [file dirname $tkCon(SCRIPT)] $link]
+  } else {
+    set tkCon(SCRIPT) $link
+  }
+}
+if [string match relative [file pathtype $tkCon(SCRIPT)]] {
+  set tkCon(SCRIPT) [file join [pwd] $tkCon(SCRIPT)]
+}
+proc tkConResource {} {
+  global tkCon
+  uplevel \#0 [list source $tkCon(SCRIPT)]
+  tkConBindings
+  tkConInitSlave $tkCon(exec)
+}
 
 ## Initialize only if we haven't yet
 ##