[Poet-commit] SF.net SVN: poet:[42] trunk

[<mer...@us...>]

Revision: 42
          http://poet.svn.sourceforge.net/poet/?rev=42&view=rev
Author:   mercurio
Date:     2008-10-25 18:32:17 +0000 (Sat, 25 Oct 2008)

Log Message:
-----------
Fixed installer to do better job of setting permissions
when installed by root on Unix machines.

Minor changes to types to make default parameters 
accessible.

Modified Paths:
--------------
    trunk/instlib/installer.tcl
    trunk/lib/Poet.tcl
    trunk/lib/tier1/tier1-object.tcl
    trunk/lib/tier3/tier3-type.tcl
    trunk/lib/tier3/tier3-type_boolean.tcl
    trunk/lib/tier3/tier3-type_choice.tcl
    trunk/lib/tier3/tier3-type_integer.tcl
    trunk/lib/tier3/tier3-type_pixels.tcl
    trunk/lib/tier3/tier3-type_real.tcl

Added Paths:
-----------
    trunk/unix/tools/
    trunk/unix/tools/ReadMe.txt
    trunk/unix/tools/poetAppInit.c
    trunk/unix/tools/runme
    trunk/unix/tools/t2.tcl
    trunk/unix/tools/test.tcl
    trunk/unix/tools/tkcon.tcl

Modified: trunk/instlib/installer.tcl
===================================================================
--- trunk/instlib/installer.tcl	2008-10-21 02:08:44 UTC (rev 41)
+++ trunk/instlib/installer.tcl	2008-10-25 18:32:17 UTC (rev 42)
@@ -258,13 +258,23 @@
 # readonly, or not. 
 #
 proc setReadonly {dir ro} {
+	if {$::tcl_platform(platform) eq "unix"} {
+		if {$ro} {
+			file attributes $dir -permissions "ugo+rx,go-w"
+		} else {
+			file attributes $dir -permissions "ugo+rwx"
+		}
+	} else {
+		file attributes $dir -readonly $ro
+	}
+
 	foreach f [glob [file join $dir *]] {
 		if {[file isfile $f]} {
 			if {$::tcl_platform(platform) eq "unix"} {
 				if {$ro} {
-					file attributes $f -permissions "ugo-w"
+					file attributes $f -permissions "ugo+r,ugo-w"
 				} else {
-					file attributes $f -permissions "ugo+w"
+					file attributes $f -permissions "ugo+rw"
 				}
 			} else {
 				file attributes $f -readonly $ro

Modified: trunk/lib/Poet.tcl
===================================================================
--- trunk/lib/Poet.tcl	2008-10-21 02:08:44 UTC (rev 41)
+++ trunk/lib/Poet.tcl	2008-10-25 18:32:17 UTC (rev 42)
@@ -230,6 +230,7 @@
 # prints out stack trace
 #
 proc ::Poet::enterWhere {cmd op} {
+	puts stderr ""
 	puts stderr [::Poet::stackTrace]
 	puts stderr " => [::Poet::parseLevelInfo $cmd]"
 }
@@ -898,6 +899,8 @@
 	set ps(0) 0
 
 	foreach pathlist [::Poet::findfiles {} $fileRE] {
+		if {$pathlist eq "pkgIndex.tcl"} continue
+
 		set f ""
 		set comment ""
 		set headcomment ""

Modified: trunk/lib/tier1/tier1-object.tcl
===================================================================
--- trunk/lib/tier1/tier1-object.tcl	2008-10-21 02:08:44 UTC (rev 41)
+++ trunk/lib/tier1/tier1-object.tcl	2008-10-25 18:32:17 UTC (rev 42)
@@ -1333,6 +1333,10 @@
 # is confusing.  Don't use this if possible, it's not
 # compatible with the non-dict version below.
 #
+# Note: this uses the dictionaryVariable, dict commands
+# use either the var or the value. Another reason not
+# to use this.
+#
 Object method array {ra op args} {
 	return [eval dict $op ::_os_${self}($ra) $args]
 }
@@ -1394,6 +1398,12 @@
 	set ::_os_${self}($ra) ""
 }
 
+# Return a list of the keys in this array (dict only)
+#
+Object method arrayKeys {ra {pat *}} {
+	return [dict keys [set ::_os_${self}($ra)] $pat]
+}
+
 ## This is the non-dict version, where the contents
 ## of the slot is the name of an array.  Indented
 ## so it doesn't show up in the docs.  This is 

Modified: trunk/lib/tier3/tier3-type.tcl
===================================================================
--- trunk/lib/tier3/tier3-type.tcl	2008-10-21 02:08:44 UTC (rev 41)
+++ trunk/lib/tier3/tier3-type.tcl	2008-10-25 18:32:17 UTC (rev 42)
@@ -107,6 +107,26 @@
 	return [eval [Type getTypeObj $ty] image [lrange $ty 1 end]]
 }
 
+# Given a full parameterized type string, return the
+# params. Any missing params should be filled in with 
+# the defaults for this type. 
+#
+Type method getParams {ty} {
+	set t [Type getTypeObj $ty]
+	return [$t getParams_sub $ty]
+}
+
+# Given a full parameterized type string, return the
+# params. Any missing params should be filled in with 
+# the defaults for this type. 
+#
+# This should be overridden by each Type that uses params.
+# It should also not be called by outside code, use ``getParams``
+#
+Type method getParams_sub {ty} {
+	return ""
+}
+
 # Validate a sign value (verify that it can be interpreted as this type).
 # If ty is given it's a type string, as in 
 #	Type validate $sv <integer>

Modified: trunk/lib/tier3/tier3-type_boolean.tcl
===================================================================
--- trunk/lib/tier3/tier3-type_boolean.tcl	2008-10-21 02:08:44 UTC (rev 41)
+++ trunk/lib/tier3/tier3-type_boolean.tcl	2008-10-25 18:32:17 UTC (rev 42)
@@ -20,16 +20,26 @@
 	return 1
 }
 
-# Return an IconCycle for editing a boolean
+# Given a full parameterized type string, return the
+# params. Any missing params should be filled in with 
+# the defaults for this type. 
 #
-Type_boolean method cellEditor {table ty} {
+Type_boolean method getParams_sub {ty} {
 	set t 1
 	set f 0
 
 	set len [llength $ty]
 	if {$len > 1} {set t [lindex $ty 1]}
 	if {$len > 2} {set f [lindex $ty 2]}
+	
+	return [list $t $f]
+}
 
+# Return an IconCycle for editing a boolean
+#
+Type_boolean method cellEditor {table ty} {
+	lassign [$self getParams_sub $ty] t f
+
 	set ce [SignCellBoolean construct * $table -values [list $t $f]]
 
 	return $ce

Modified: trunk/lib/tier3/tier3-type_choice.tcl
===================================================================
--- trunk/lib/tier3/tier3-type_choice.tcl	2008-10-21 02:08:44 UTC (rev 41)
+++ trunk/lib/tier3/tier3-type_choice.tcl	2008-10-25 18:32:17 UTC (rev 42)
@@ -21,12 +21,19 @@
 	return [lindex $ty 1]
 }
 
+# Given a full parameterized type string, return the
+# params. Any missing params should be filled in with 
+# the defaults for this type. 
+#
+Type_choice method getParams_sub {ty} {
+	return [lrange $ty 1 end]
+}
 
 # Return a SignCellChoice to edit this type of slot.  The args in the
 # type string are the options to display.
 #
 Type_choice method cellEditor {table ty} {
-	return [SignCellChoice construct * $table -values [lrange $ty 1 end]]
+	return [SignCellChoice construct * $table -values [$self getParams_sub $ty]]
 }
 
 # Validate a sign value (verify that it can be interpreted as this type).

Modified: trunk/lib/tier3/tier3-type_integer.tcl
===================================================================
--- trunk/lib/tier3/tier3-type_integer.tcl	2008-10-21 02:08:44 UTC (rev 41)
+++ trunk/lib/tier3/tier3-type_integer.tcl	2008-10-25 18:32:17 UTC (rev 42)
@@ -20,9 +20,11 @@
 	return 0
 }
 
-# Return a SpinBox for editing a slot of this type in a cell of a table.
+# Given a full parameterized type string, return the
+# params. Any missing params should be filled in with 
+# the defaults for this type. 
 #
-Type_integer method cellEditor {table ty} {
+Type_integer method getParams_sub {ty} {
 	set lo -2147483648 
 	set hi 2147483647
 	set step 1
@@ -32,6 +34,14 @@
 	if {$len > 2} {set hi [lindex $ty 2]}
 	if {$len > 3} {set step [lindex $ty 3]}
 
+	return [list $lo $hi $step]
+}
+
+# Return a SpinBox for editing a slot of this type in a cell of a table.
+#
+Type_integer method cellEditor {table ty} {
+	lassign [$self getParams_sub $ty] lo hi step
+
 	return [SignCellInteger construct * $table -from $lo -to $hi -increment $step]
 }
 

Modified: trunk/lib/tier3/tier3-type_pixels.tcl
===================================================================
--- trunk/lib/tier3/tier3-type_pixels.tcl	2008-10-21 02:08:44 UTC (rev 41)
+++ trunk/lib/tier3/tier3-type_pixels.tcl	2008-10-25 18:32:17 UTC (rev 42)
@@ -19,9 +19,11 @@
 	return 10
 }
 
-# Return a SpinBox for editing slot as this type in a cell of a table.
+# Given a full parameterized type string, return the
+# params. Any missing params should be filled in with 
+# the defaults for this type. 
 #
-Type_pixels method cellEditor {table ty} {
+Type_pixels method getParams_sub {ty} {
 	set lo 0
 	set hi 2147483647
 	set step 1
@@ -31,6 +33,14 @@
 	if {$len > 2} {set hi [lindex $ty 2]}
 	if {$len > 3} {set step [lindex $ty 3]}
 
+	return [list $lo $hi $step]
+}
+
+# Return a SpinBox for editing slot as this type in a cell of a table.
+#
+Type_pixels method cellEditor {table ty} {
+	lassign [$self getParams_sub $ty] lo hi step
+
 	return [SignCellPixels construct * $table -from $lo -to $hi -increment $step]
 }
 

Modified: trunk/lib/tier3/tier3-type_real.tcl
===================================================================
--- trunk/lib/tier3/tier3-type_real.tcl	2008-10-21 02:08:44 UTC (rev 41)
+++ trunk/lib/tier3/tier3-type_real.tcl	2008-10-25 18:32:17 UTC (rev 42)
@@ -20,9 +20,11 @@
 	return 1.0
 }
 
-# Return a SpinBox for editing slot as this type in a cell of a table.
+# Given a full parameterized type string, return the
+# params. Any missing params should be filled in with 
+# the defaults for this type. 
 #
-Type_real method cellEditor {table ty} {
+Type_real method getParams_sub {ty} {
 	set lo -1
 	set hi 1
 	set step .1
@@ -32,6 +34,15 @@
 	if {$len > 2} {set hi [lindex $ty 2]}
 	if {$len > 3} {set step [lindex $ty 3]}
 
+	return [list $lo $hi $step]
+}
+
+
+# Return a SpinBox for editing slot as this type in a cell of a table.
+#
+Type_real method cellEditor {table ty} {
+	lassign [$self getParams_sub $ty] lo hi step
+
 	return [SignCellReal construct * $table -from $lo -to $hi -increment $step]
 }
 

Added: trunk/unix/tools/ReadMe.txt
===================================================================
--- trunk/unix/tools/ReadMe.txt	                        (rev 0)
+++ trunk/unix/tools/ReadMe.txt	2008-10-25 18:32:17 UTC (rev 42)
@@ -0,0 +1,9 @@
+Handy stuff to have in your tk/unix directory
+when debugging tier 0. Build poet as described
+in ../ReadMe.txt.
+
+poetAppInit.c	fragment showing where to modify tkAppInit.c
+runme			sample linking command
+t2.tcl			start up in tier2
+test.tcl		start up in tier3	
+tkcon.tcl		tkcon

Added: trunk/unix/tools/poetAppInit.c
===================================================================
--- trunk/unix/tools/poetAppInit.c	                        (rev 0)
+++ trunk/unix/tools/poetAppInit.c	2008-10-25 18:32:17 UTC (rev 42)
@@ -0,0 +1,24 @@
+int
+Tcl_AppInit(
+    Tcl_Interp *interp)		/* Interpreter for application. */
+{
+    if (Tcl_Init(interp) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+    if (Tk_Init(interp) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+    Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
+
+    if (Poet_Init(interp) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+#ifdef TK_TEST
+    if (Tktest_Init(interp) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+    Tcl_StaticPackage(interp, "Tktest", Tktest_Init,
+            (Tcl_PackageInitProc *) NULL);
+#endif /* TK_TEST */
+
+...

Added: trunk/unix/tools/runme
===================================================================
--- trunk/unix/tools/runme	                        (rev 0)
+++ trunk/unix/tools/runme	2008-10-25 18:32:17 UTC (rev 42)
@@ -0,0 +1,4 @@
+gcc -g  -pipe    -Wl,--export-dynamic  tkAppInit.o \
+		/prog/poet/unix/poet.o /prog/poet/unix/network.o \
+		-L/opt/ActiveTcl/src/tk8.5b1/unix -ltk8.5 -ltkstub8.5 \
+		-L/opt/ActiveTcl/src/tcl8.5b1/unix -ltcl8.5 -ltclstub8.5  -lX11  -ldl  -lieee -lm  -Wl,-rpath,/usr/local/lib -o poet

Added: trunk/unix/tools/t2.tcl
===================================================================
--- trunk/unix/tools/t2.tcl	                        (rev 0)
+++ trunk/unix/tools/t2.tcl	2008-10-25 18:32:17 UTC (rev 42)
@@ -0,0 +1,3 @@
+set ::env(POET_LIBRARY) /prog/poet/lib
+source /prog/poet/lib/Poet.tcl
+::Poet::unsplash

Added: trunk/unix/tools/test.tcl
===================================================================
--- trunk/unix/tools/test.tcl	                        (rev 0)
+++ trunk/unix/tools/test.tcl	2008-10-25 18:32:17 UTC (rev 42)
@@ -0,0 +1,6 @@
+set env(TKCON_FILE) /dev/null
+set env(POET_LIBRARY) /prog/poet/lib
+set env(POET_TIER) 3
+source /prog/poet/lib/Poet.tcl
+ProtoWidget demo takeover
+cd /prog/poet/testing

Added: trunk/unix/tools/tkcon.tcl
===================================================================
--- trunk/unix/tools/tkcon.tcl	                        (rev 0)
+++ trunk/unix/tools/tkcon.tcl	2008-10-25 18:32:17 UTC (rev 42)
@@ -0,0 +1,6398 @@
+#!/bin/sh
+# \
+exec wish "$0" ${1+"$@"}
+
+# @@ Meta Begin
+# Application tkcon 2.5
+# Meta platform     tcl
+# Meta summary      Enhanced Tk Console
+# Meta description  Enhanced Tk Console
+# Meta description  Originally based off Brent Welch's
+# Meta description  Tcl Shell Widget
+# Meta category     Shell
+# Meta subject      console tk remote
+# Meta require      {Tk 8} {Tcl 8} {http 2}
+# Meta recommend    ctext base64 Trf ActiveTcl
+# Meta author       Jeff Hobbs
+# Meta license      Tcl (+ bourbonware clause).
+# @@ Meta End
+
+#
+## tkcon.tcl
+## Enhanced Tk Console, part of the VerTcl system
+##
+## Originally based off Brent Welch's Tcl Shell Widget
+## (from "Practical Programming in Tcl and Tk")
+##
+## Thanks to the following (among many) for early bug reports & code ideas:
+## Steven Wahl, Jan Nijtmans, Mark Crimmins, Wart
+##
+## Copyright (c) 1995-2004 Jeffrey Hobbs, jeff(a)hobbs(.)org
+## Initiated: Thu Aug 17 15:36:47 PDT 1995
+##
+## source standard_disclaimer.tcl
+## source bourbon_ware.tcl
+##
+
+# Proxy support for retrieving the current version of Tkcon.
+#
+# Mon Jun 25 12:19:56 2001 - Pat Thoyts
+#
+# In your tkcon.cfg or .tkconrc file put your proxy details into the
+# `proxy' member of the `PRIV' array. e.g.:
+#
+#    set ::tkcon::PRIV(proxy) wwwproxy:8080
+#
+# If you want to be prompted for proxy authentication details (eg for
+# an NT proxy server) make the second element of this variable non-nil - eg:
+#
+#    set ::tkcon::PRIV(proxy) {wwwproxy:8080 1}
+#
+# Or you can set the above variable from within tkcon by calling 
+#
+#    tkcon master set ::tkcon:PRIV(proxy) wwwproxy:8080
+#
+
+if {$tcl_version < 8.0} {
+    return -code error "tkcon requires at least Tcl/Tk8"
+} else {
+    package require Tk
+}
+
+# We need to load some package to get what's available, and we
+# choose ctext because we'll use it if its available in the editor
+catch {package require ctext}
+foreach pkg [info loaded {}] {
+    set file [lindex $pkg 0]
+    set name [lindex $pkg 1]
+    if {![catch {set version [package require $name]}]} {
+	if {[string match {} [package ifneeded $name $version]]} {
+	    package ifneeded $name $version [list load $file $name]
+	}
+    }
+}
+catch {unset pkg file name version}
+
+# Tk 8.4 makes previously exposed stuff private.
+# FIX: Update tkcon to not rely on the private Tk code.
+#
+if {![llength [info globals tkPriv]]} {
+    ::tk::unsupported::ExposePrivateVariable tkPriv
+}
+foreach cmd {SetCursor UpDownLine Transpose ScrollPages} {
+    if {![llength [info commands tkText$cmd]]} {
+        ::tk::unsupported::ExposePrivateCommand tkText$cmd
+    }
+}
+
+# Initialize the ::tkcon namespace
+#
+namespace eval ::tkcon {
+    # when modifying this line, make sure that the auto-upgrade check
+    # for version still works.
+    variable VERSION "2.5"
+    # The OPT variable is an array containing most of the optional
+    # info to configure.  COLOR has the color data.
+    variable OPT
+    variable COLOR
+
+    # PRIV is used for internal data that only tkcon should fiddle with.
+    variable PRIV
+    set PRIV(WWW) [info exists embed_args]
+
+    variable EXPECT 0
+}
+
+## ::tkcon::Init - inits tkcon
+#
+# Calls:	::tkcon::InitUI
+# Outputs:	errors found in tkcon's resource file
+##
+proc ::tkcon::Init {args} {
+    variable VERSION
+    variable OPT
+    variable COLOR
+    variable PRIV
+    global tcl_platform env tcl_interactive errorInfo
+
+    set tcl_interactive 1
+    set argc [llength $args]
+
+    ##
+    ## When setting up all the default values, we always check for
+    ## prior existence.  This allows users who embed tkcon to modify
+    ## the initial state before tkcon initializes itself.
+    ##
+
+    # bg == {} will get bg color from the main toplevel (in InitUI)
+    foreach {key default} {
+	bg		{}
+	blink		\#FFFF00
+	cursor		\#000000
+	disabled	\#4D4D4D
+	proc		\#008800
+	var		\#FFC0D0
+	prompt		\#8F4433
+	stdin		\#000000
+	stdout		\#0000FF
+	stderr		\#FF0000
+    } {
+	if {![info exists COLOR($key)]} { set COLOR($key) $default }
+    }
+
+    # expandorder could also include 'Xotcl' (before Procname)
+    foreach {key default} {
+	autoload	{}
+	blinktime	500
+	blinkrange	1
+	buffer		512
+	maxlinelen	0
+	calcmode	0
+	cols		80
+	debugPrompt	{(level \#$level) debug [history nextid] > }
+	dead		{}
+	edit		edit
+	expandorder	{Pathname Variable Procname}
+	font		{}
+	history		48
+	hoterrors	1
+	library		{}
+	lightbrace	1
+	lightcmd	1
+	maineval	{}
+	maxmenu		18
+	nontcl		0
+	prompt1		{ignore this, it's set below}
+	rows		20
+	scrollypos	right
+	showmenu	1
+	showmultiple	1
+	showstatusbar	1
+	slaveeval	{}
+	slaveexit	close
+	subhistory	1
+	gc-delay	60000
+	gets		{congets}
+	overrideexit	1
+	usehistory	1
+	resultfilter	{}
+
+	exec		slave
+    } {
+	if {![info exists OPT($key)]} { set OPT($key) $default }
+    }
+
+    foreach {key default} {
+	app		{}
+	appname		{}
+	apptype		slave
+	namesp		::
+	cmd		{}
+	cmdbuf		{}
+	cmdsave		{}
+	event		1
+	deadapp		0
+	deadsock	0
+	debugging	0
+	displayWin	.
+	histid		0
+	find		{}
+	find,case	0
+	find,reg	0
+	errorInfo	{}
+	protocol	exit
+	showOnStartup	1
+	slaveprocs	{
+	    alias clear dir dump echo idebug lremove
+	    tkcon_puts tkcon_gets observe observe_var unalias which what
+	}
+	RCS		{RCS: @(#) $Id: tkcon.tcl,v 1.101 2007/06/23 00:53:41 hobbs Exp $}
+	HEADURL		{http://tkcon.cvs.sourceforge.net/tkcon/tkcon/tkcon.tcl?rev=HEAD}
+
+	docs		"http://tkcon.sourceforge.net/"
+	email		{jeff(a)hobbs(.)org}
+	root		.
+	uid		0
+	tabs		{}
+    } {
+	if {![info exists PRIV($key)]} { set PRIV($key) $default }
+    }
+    foreach {key default} {
+	slavealias	{ $OPT(edit) more less tkcon }
+    } {
+	if {![info exists PRIV($key)]} { set PRIV($key) [subst $default] }
+    }
+    set PRIV(version) $VERSION
+
+    if {[info exists PRIV(name)]} {
+	set title $PRIV(name)
+    } else {
+	MainInit
+	# some main initialization occurs later in this proc,
+	# to go after the UI init
+	set MainInit 1
+	set title Main
+    }
+
+    ## NOTES FOR STAYING IN PRIMARY INTERPRETER:
+    ##
+    ## If you set ::tkcon::OPT(exec) to {}, then instead of a multiple
+    ## interp model, you get tkcon operating in the main interp by default.
+    ## This can be useful when attaching to programs that like to operate
+    ## in the main interpter (for example, based on special wish'es).
+    ## You can set this from the command line with -exec ""
+    ## A side effect is that all tkcon command line args will be used
+    ## by the first console only.
+    #set OPT(exec) {}
+
+    if {$PRIV(WWW)} {
+	lappend PRIV(slavealias) history
+	set OPT(prompt1) {[history nextid] % }
+    } else {
+	lappend PRIV(slaveprocs) tcl_unknown unknown
+	set OPT(prompt1) {([file tail [pwd]]) [history nextid] % }
+    }
+
+    ## If we are using the default '.' toplevel, and there appear to be
+    ## children of '.', then make sure we use a disassociated toplevel.
+    if {$PRIV(root) == "." && [llength [winfo children .]]} {
+	set PRIV(root) .tkcon
+    }
+
+    ## Do platform specific configuration here, other than defaults
+    ### Use tkcon.cfg filename for resource filename on non-unix systems
+    ### Determine what directory the resource file should be in
+    switch $tcl_platform(platform) {
+	macintosh	{
+	    if {![interp issafe]} {cd [file dirname [info script]]}
+	    set envHome		PREF_FOLDER
+	    set rcfile		tkcon.cfg
+	    set histfile	tkcon.hst
+	    catch {console hide}
+	}
+	windows		{
+	    set envHome		HOME
+	    set rcfile		tkcon.cfg
+	    set histfile	tkcon.hst
+	}
+	unix		{
+	    set envHome		HOME
+	    set rcfile		.tkconrc
+	    set histfile	.tkcon_history
+	}
+    }
+    if {[info exists env($envHome)]} {
+	set home $env($envHome)
+	if {[file pathtype $home] == "volumerelative"} {
+	    # Convert 'C:' to 'C:/' if necessary, innocuous otherwise
+	    append home /
+	}
+	if {![info exists PRIV(rcfile)]} {
+	    set PRIV(rcfile)	[file join $home $rcfile]
+	}
+	if {![info exists PRIV(histfile)]} {
+	    set PRIV(histfile)	[file join $home $histfile]
+	}
+    }
+
+    ## Handle command line arguments before sourcing resource file to
+    ## find if resource file is being specified (let other args pass).
+    if {[set i [lsearch -exact $args -rcfile]] != -1} {
+	set PRIV(rcfile) [lindex $args [incr i]]
+    }
+
+    if {!$PRIV(WWW) && [file exists $PRIV(rcfile)]} {
+	set code [catch {uplevel \#0 [list source $PRIV(rcfile)]} err]
+    }
+
+    if {[info exists env(TK_CON_LIBRARY)]} {
+	lappend ::auto_path $env(TK_CON_LIBRARY)
+    } elseif {$OPT(library) != ""} {
+	lappend ::auto_path $OPT(library)
+    }
+
+    if {![info exists ::tcl_pkgPath]} {
+	set dir [file join [file dirname [info nameofexec]] lib]
+	if {[llength [info commands @scope]]} {
+	    set dir [file join $dir itcl]
+	}
+	catch {source [file join $dir pkgIndex.tcl]}
+    }
+    catch {tclPkgUnknown dummy-name dummy-version}
+
+    ## Handle rest of command line arguments after sourcing resource file
+    ## and slave is created, but before initializing UI or setting packages.
+    set slaveargs {}
+    set slavefiles {}
+    set slaveargv0 {}
+    set truth {^(1|yes|true|on)$}
+    for {set i 0} {$i < $argc} {incr i} {
+	set arg [lindex $args $i]
+	if {[string match {-*} $arg]} {
+	    set val [lindex $args [incr i]]
+	    ## Handle arg based options
+	    switch -glob -- $arg {
+		-- - -argv - -args {
+		    set slaveargs [concat $slaveargs [lrange $args $i end]]
+		    set ::argv $slaveargs
+		    set ::argc [llength $::argv]
+		    break
+		}
+		-color-*	{ set COLOR([string range $arg 7 end]) $val }
+		-exec		{ set OPT(exec) $val }
+		-main - -e - -eval	{ append OPT(maineval) \n$val\n }
+		-package - -load	{ lappend OPT(autoload) $val }
+		-slave		{ append OPT(slaveeval) \n$val\n }
+		-nontcl		{ set OPT(nontcl) [regexp -nocase $truth $val]}
+		-root		{ set PRIV(root) $val }
+		-font		{ set OPT(font) $val }
+		-rcfile	{}
+		default	{ lappend slaveargs $arg; incr i -1 }
+	    }
+	} elseif {[file isfile $arg]} {
+	    if {$i == 0} {
+		set slaveargv0 $arg
+	    }
+	    lappend slavefiles $arg
+	} else {
+	    lappend slaveargs $arg
+	}
+    }
+
+    ## Create slave executable
+    if {"" != $OPT(exec)} {
+	InitSlave $OPT(exec) $slaveargs $slaveargv0
+    } else {
+	set argc [llength $slaveargs]
+	set args $slaveargs
+	uplevel \#0 $slaveargs
+    }
+
+    # Try not to make tkcon override too many standard defaults, and only
+    # do it for the tkcon bits
+    set optclass [tk appname]$PRIV(root)
+    option add $optclass*Menu.tearOff 0
+    option add $optclass*Menu.borderWidth 1
+    option add $optclass*Menu.activeBorderWidth 1
+    if {$::tcl_version >= 8.4 && [tk windowingsystem] != "aqua"} {
+	option add $optclass*Scrollbar.borderWidth 1
+    }
+
+    ## Attach to the slave, EvalAttached will then be effective
+    Attach $PRIV(appname) $PRIV(apptype)
+    InitUI $title
+    if {"" != $OPT(exec)} {
+	# override exit to DeleteTab now that tab has been created
+	$OPT(exec) alias exit ::tkcon::DeleteTab $PRIV(curtab) $OPT(exec)
+    }
+
+    ## swap puts and gets with the tkcon versions to make sure all
+    ## input and output is handled by tkcon
+    if {![catch {rename ::puts ::tkcon_tcl_puts}]} {
+	interp alias {} ::puts {} ::tkcon_puts
+    }
+    if {($OPT(gets) != "") && ![catch {rename ::gets ::tkcon_tcl_gets}]} {
+	interp alias {} ::gets {} ::tkcon_gets
+    }
+
+    EvalSlave history keep $OPT(history)
+    if {[info exists MainInit]} {
+	# Source history file only for the main console, as all slave
+	# consoles will adopt from the main's history, but still
+	# keep separate histories
+	if {!$PRIV(WWW) && $OPT(usehistory) && [file exists $PRIV(histfile)]} {
+	    puts -nonewline "loading history file ... "
+	    # The history file is built to be loaded in and
+	    # understood by tkcon
+	    if {[catch {uplevel \#0 [list source $PRIV(histfile)]} herr]} {
+		puts stderr "error:\n$herr"
+		append PRIV(errorInfo) $errorInfo\n
+	    }
+	    set PRIV(event) [EvalSlave history nextid]
+	    puts "[expr {$PRIV(event)-1}] events added"
+	}
+    }
+
+    ## Autoload specified packages in slave
+    set pkgs [EvalSlave package names]
+    foreach pkg $OPT(autoload) {
+	puts -nonewline "autoloading package \"$pkg\" ... "
+	if {[lsearch -exact $pkgs $pkg]>-1} {
+	    if {[catch {EvalSlave package require [list $pkg]} pkgerr]} {
+		puts stderr "error:\n$pkgerr"
+		append PRIV(errorInfo) $errorInfo\n
+	    } else { puts "OK" }
+	} else {
+	    puts stderr "error: package does not exist"
+	}
+    }
+
+    ## Evaluate maineval in slave
+    if {[string compare {} $OPT(maineval)] && \
+	    [catch {uplevel \#0 $OPT(maineval)} merr]} {
+	puts stderr "error in eval:\n$merr"
+	append PRIV(errorInfo) $errorInfo\n
+    }
+
+    ## Source extra command line argument files into slave executable
+    foreach fn $slavefiles {
+	puts -nonewline "slave sourcing \"$fn\" ... "
+	if {[catch {EvalSlave uplevel \#0 [list source $fn]} fnerr]} {
+	    puts stderr "error:\n$fnerr"
+	    append PRIV(errorInfo) $errorInfo\n
+	} else { puts "OK" }
+    }
+
+    ## Evaluate slaveeval in slave
+    if {[string compare {} $OPT(slaveeval)] && \
+	    [catch {interp eval $OPT(exec) $OPT(slaveeval)} serr]} {
+	puts stderr "error in slave eval:\n$serr"
+	append PRIV(errorInfo) $errorInfo\n
+    }
+    ## Output any error/output that may have been returned from rcfile
+    if {[info exists code] && $code && [string compare {} $err]} {
+	puts stderr "error in $PRIV(rcfile):\n$err"
+	append PRIV(errorInfo) $errorInfo
+    }
+    if {[string compare {} $OPT(exec)]} {
+	StateCheckpoint [concat $PRIV(name) $OPT(exec)] slave
+    }
+    StateCheckpoint $PRIV(name) slave
+
+    puts "buffer line limit:\
+	[expr {$OPT(buffer)?$OPT(buffer):{unlimited}}]  \
+	max line length:\
+	[expr {$OPT(maxlinelen)?$OPT(maxlinelen):{unlimited}}]"
+
+    Prompt "$title console display active (Tcl$::tcl_patchLevel / Tk$::tk_patchLevel)\n"
+}
+
+## ::tkcon::InitSlave - inits the slave by placing key procs and aliases in it
+## It's arg[cv] are based on passed in options, while argv0 is the same as
+## the master.  tcl_interactive is the same as the master as well.
+# ARGS:	slave	- name of slave to init.  If it does not exist, it is created.
+#	args	- args to pass to a slave as argv/argc
+##
+proc ::tkcon::InitSlave {slave {slaveargs {}} {slaveargv0 {}}} {
+    variable OPT
+    variable COLOR
+    variable PRIV
+    global argv0 tcl_interactive tcl_library env auto_path tk_library
+
+    if {[string match {} $slave]} {
+	return -code error "Don't init the master interpreter, goofball"
+    }
+    if {![interp exists $slave]} { interp create $slave }
+    if {[interp eval $slave info command source] == ""} {
+	$slave alias source SafeSource $slave
+	$slave alias load SafeLoad $slave
+	$slave alias open SafeOpen $slave
+	$slave alias file file
+	interp eval $slave \
+	    [list set auto_path [lremove $auto_path $tk_library]]
+	interp eval $slave [dump var -nocomplain tcl_library env]
+	interp eval $slave { catch {source [file join $tcl_library init.tcl]} }
+	interp eval $slave { catch unknown }
+    }
+    # This will likely be overridden to call DeleteTab where possible
+    $slave alias exit exit
+    interp eval $slave {
+	# Do package require before changing around puts/gets
+	catch {set __tkcon_error ""; set __tkcon_error $errorInfo}
+	catch {package require bogus-package-name}
+	catch {rename ::puts ::tkcon_tcl_puts}
+	set errorInfo ${__tkcon_error}
+	unset __tkcon_error
+    }
+    foreach cmd $PRIV(slaveprocs) { $slave eval [dump proc $cmd] }
+    foreach cmd $PRIV(slavealias) { $slave alias $cmd $cmd }
+    interp alias $slave ::ls $slave ::dir -full
+    interp alias $slave ::puts $slave ::tkcon_puts
+    if {$OPT(gets) != ""} {
+	interp eval $slave { catch {rename ::gets ::tkcon_tcl_gets} }
+	interp alias $slave ::gets $slave ::tkcon_gets
+    }
+    if {$slaveargv0 != ""} {
+	# If tkcon was invoked with 1 or more filenames, then make the
+	# first filename argv0 in the slave, as tclsh/wish would do it.
+	interp eval $slave [list set argv0 $slaveargv0]
+    } else {
+	if {[info exists argv0]} {interp eval $slave [list set argv0 $argv0]}
+    }
+    interp eval $slave set tcl_interactive $tcl_interactive \; \
+	    set auto_path [list [lremove $auto_path $tk_library]] \; \
+	    set argc [llength $slaveargs] \; \
+	    set argv  [list $slaveargs] \; {
+	if {![llength [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 \
+		    [package ifneeded $pkg $v]]
+	}
+    }
+}
+
+## ::tkcon::InitInterp - inits an interpreter by placing key
+## procs and aliases in it.
+# ARGS: name	- interp name
+#	type	- interp type (slave|interp)
+##
+proc ::tkcon::InitInterp {name type} {
+    variable OPT
+    variable PRIV
+
+    ## Don't allow messing up a local master interpreter
+    if {[string match namespace $type] || ([string match slave $type] && \
+	    [regexp {^([Mm]ain|Slave[0-9]+)$} $name])} return
+    set old [Attach]
+    set oldname $PRIV(namesp)
+    catch {
+	Attach $name $type
+	EvalAttached { catch {rename ::puts ::tkcon_tcl_puts} }
+	foreach cmd $PRIV(slaveprocs) { EvalAttached [dump proc $cmd] }
+	switch -exact $type {
+	    slave {
+		foreach cmd $PRIV(slavealias) {
+		    Main interp alias $name ::$cmd $PRIV(name) ::$cmd
+		}
+	    }
+	    interp {
+		set thistkcon [::send::appname]
+		foreach cmd $PRIV(slavealias) {
+		    EvalAttached "proc $cmd args { ::send::send [list $thistkcon] $cmd \$args }"
+		}
+	    }
+	}
+	## Catch in case it's a 7.4 (no 'interp alias') interp
+	EvalAttached {
+	    catch {interp alias {} ::ls {} ::dir -full}
+	    if {[catch {interp alias {} ::puts {} ::tkcon_puts}]} {
+		catch {rename ::tkcon_puts ::puts}
+	    }
+	}
+	if {$OPT(gets) != ""} {
+	    EvalAttached {
+		catch {rename ::gets ::tkcon_tcl_gets}
+		if {[catch {interp alias {} ::gets {} ::tkcon_gets}]} {
+		    catch {rename ::tkcon_gets ::gets}
+		}
+	    }
+	}
+	return
+    } {err}
+    eval Attach $old
+    AttachNamespace $oldname
+    if {[string compare {} $err]} { return -code error $err }
+}
+
+## ::tkcon::InitUI - 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
+#	title	- title for the console root and main (.) windows
+# Calls:	::tkcon::InitMenus, ::tkcon::Prompt
+##
+proc ::tkcon::InitUI {title} {
+    variable OPT
+    variable PRIV
+    variable COLOR
+
+    set root $PRIV(root)
+    if {[string match . $root]} { set w {} } else { set w [toplevel $root] }
+    if {!$PRIV(WWW)} {
+	wm withdraw $root
+	wm protocol $root WM_DELETE_WINDOW $PRIV(protocol)
+    }
+    set PRIV(base) $w
+
+    catch {font create tkconfixed -family Courier -size -12}
+    catch {font create tkconfixedbold -family Courier -size -12 -weight bold}
+
+    set PRIV(statusbar) [set sbar [frame $w.fstatus]]
+    set PRIV(tabframe)  [frame $sbar.tabs]
+    set PRIV(X) [button $sbar.deltab -text "X" -command ::tkcon::DeleteTab \
+		     -activeforeground red -fg red -font tkconfixedbold \
+		     -highlightthickness 0 -padx 2 -pady 0 -borderwidth 1 \
+		     -state disabled -relief flat -takefocus 0]
+    catch {$PRIV(X) configure -overrelief raised}
+    label $sbar.cursor -relief sunken -borderwidth 1 -anchor e -width 6 \
+	    -textvariable ::tkcon::PRIV(StatusCursor)
+    set padx [expr {![info exists ::tcl_platform(os)]
+		    || ![string match "Windows CE" $::tcl_platform(os)]}]
+    grid $PRIV(X) $PRIV(tabframe) $sbar.cursor -sticky news -padx $padx
+    grid configure $PRIV(tabframe) -sticky nsw
+    grid configure $PRIV(X) -pady 0 -padx 0
+    grid columnconfigure $sbar 1 -weight 1
+    grid rowconfigure $sbar 0 -weight 1
+    grid rowconfigure $PRIV(tabframe) 0 -weight 1
+    if {$::tcl_version >= 8.4 && [tk windowingsystem] == "aqua"} {
+	# resize control space
+	grid columnconfigure $sbar [lindex [grid size $sbar] 0] -minsize 16
+    }
+
+    ## Create console tab
+    set con [InitTab $w]
+    set PRIV(curtab) $con
+
+    # Only apply this for the first console
+    $con configure -setgrid 1 -width $OPT(cols) -height $OPT(rows)
+    bind $PRIV(root) <Configure> {
+	if {"%W" == $::tkcon::PRIV(root)} {
+	    scan [wm geometry [winfo toplevel %W]] "%%dx%%d" \
+		::tkcon::OPT(cols) ::tkcon::OPT(rows)
+	    if {[info exists ::tkcon::EXP(spawn_id)]} {
+		catch {stty rows $::tkcon::OPT(rows) columns \
+			   $::tkcon::OPT(cols) < $::tkcon::EXP(slave,name)}
+	    }
+	}
+    }
+
+    # scrollbar
+    set sy [scrollbar $w.sy -takefocus 0 -command [list $con yview]]
+    if {!$PRIV(WWW) && [string match "Windows CE" $::tcl_platform(os)]} {
+	$w.sy configure -width 10
+    }
+
+    $con configure -yscrollcommand [list $sy set]
+    set PRIV(console) $con
+    set PRIV(scrolly) $sy
+
+    ## Menus
+    ## catch against use in plugin
+    if {[catch {menu $w.mbar} PRIV(menubar)]} {
+	set PRIV(menubar) [frame $w.mbar -relief raised -borderwidth 1]
+    }
+
+    InitMenus $PRIV(menubar) $title
+    Bindings
+
+    if {$OPT(showmenu)} {
+	$root configure -menu $PRIV(menubar)
+    }
+
+    grid $con  -row 1 -column 1 -sticky news
+    grid $sy   -row 1 -column [expr {$OPT(scrollypos)=="left"?0:2}] -sticky ns
+    grid $sbar -row 2 -column 0 -columnspan 3 -sticky ew
+
+    grid columnconfigure $root 1 -weight 1
+    grid rowconfigure    $root 1 -weight 1
+
+    if {!$OPT(showstatusbar)} {
+	grid remove $sbar
+    }
+
+    if {!$PRIV(WWW)} {
+	wm title $root "tkcon $PRIV(version) $title"
+	if {$PRIV(showOnStartup)} { wm deiconify $root }
+    }
+    if {$PRIV(showOnStartup)} { focus -force $PRIV(console) }
+    if {$OPT(gc-delay)} {
+	after $OPT(gc-delay) ::tkcon::GarbageCollect
+    }
+}
+
+proc ::tkcon::InitTab {w} {
+    variable OPT
+    variable PRIV
+    variable COLOR
+    variable ATTACH
+
+    # text console
+    set con $w.tab[incr PRIV(uid)]
+    text $con -wrap char -foreground $COLOR(stdin) \
+	-insertbackground $COLOR(cursor) -borderwidth 1 -highlightthickness 0
+    $con mark set output 1.0
+    $con mark set limit 1.0
+    if {[string compare {} $COLOR(bg)]} {
+	$con configure -background $COLOR(bg)
+    }
+    set COLOR(bg) [$con cget -background]
+    if {[string compare {} $OPT(font)]} {
+	## Set user-requested font, if any
+	$con configure -font $OPT(font)
+    } elseif {[string compare unix $::tcl_platform(platform)]} {
+	## otherwise make sure the font is monospace
+	set font [$con cget -font]
+	if {![font metrics $font -fixed]} {
+	    $con configure -font tkconfixed
+	}
+    } else {
+	$con configure -font tkconfixed
+    }
+    set OPT(font) [$con cget -font]
+    bindtags $con [list $con TkConsole TkConsolePost $PRIV(root) all]
+
+    # scrollbar
+    if {!$PRIV(WWW)} {
+	if {[string match "Windows CE" $::tcl_platform(os)]} {
+	    font configure tkconfixed -family Tahoma -size 8
+	    $con configure -font tkconfixed -borderwidth 0 -padx 0 -pady 0
+	    set cw [font measure tkconfixed "0"]
+	    set ch [font metrics tkconfixed -linespace]
+	    set sw [winfo screenwidth $con]
+	    set sh [winfo screenheight $con]
+	    # We need the magic hard offsets until I find a way to
+	    # correctly assume size
+	    if {$cw*($OPT(cols)+2) > $sw} {
+		set OPT(cols) [expr {($sw / $cw) - 2}]
+	    }
+	    if {$ch*($OPT(rows)+3) > $sh} {
+		set OPT(rows) [expr {($sh / $ch) - 3}]
+	    }
+	    # Place it so that the titlebar underlaps the CE titlebar
+	    wm geometry $PRIV(root) +0+0
+	}
+    }
+    $con configure -height $OPT(rows) -width $OPT(cols)
+
+    foreach col {prompt stdout stderr stdin proc} {
+	$con tag configure $col -foreground $COLOR($col)
+    }
+    $con tag configure var -background $COLOR(var)
+    $con tag raise sel
+    $con tag configure blink -background $COLOR(blink)
+    $con tag configure find -background $COLOR(blink)
+
+    set ATTACH($con) [Attach]
+    set rb [radiobutton $PRIV(tabframe).cb[winfo name $con] -takefocus 0 \
+		-textvariable ::tkcon::ATTACH($con) \
+		-selectcolor white -relief sunken \
+		-indicatoron 0 -padx 0 -pady 0 -borderwidth 1 \
+		-variable ::tkcon::PRIV(curtab) -value $con \
+		-command [list ::tkcon::GotoTab $con]]
+    if {$::tcl_version >= 8.4} {
+	$rb configure -offrelief flat -overrelief raised
+    }
+    grid $rb -row 0 -column [lindex [grid size $PRIV(tabframe)] 0] -sticky ns
+    grid $con -row 1 -column 1 -sticky news
+
+    lappend PRIV(tabs) $con
+    return $con
+}
+
+proc ::tkcon::GotoTab {con} {
+    variable PRIV
+    variable ATTACH
+
+    set numtabs [llength $PRIV(tabs)]
+    #if {$numtabs == 1} { return }
+
+    if {[regexp {^[0-9]+$} $con]} {
+	set curtab [lsearch -exact $PRIV(tabs) $PRIV(console)]
+	set nexttab [expr {$curtab + $con}]
+	if {$nexttab >= $numtabs} {
+	    set nexttab 0
+	} elseif {$nexttab < 0} {
+	    set nexttab "end"
+	}
+	set con [lindex $PRIV(tabs) $nexttab]
+    } elseif {$con == $PRIV(console)} {
+	return
+    }
+
+    # adjust console
+    if {[winfo exists $PRIV(console)]} {
+	lower $PRIV(console)
+	$PRIV(console) configure -yscrollcommand {}
+	set ATTACH($PRIV(console)) [Attach]
+    }
+    set PRIV(console) $con
+    $con configure -yscrollcommand [list $PRIV(scrolly) set]
+    $PRIV(scrolly) configure -command [list $con yview]
+
+    # adjust attach
+    eval [linsert $ATTACH($con) 0 Attach]
+
+    set PRIV(curtab) $con
+
+    raise $con
+
+    if {[$con compare 1.0 == end-1c]} {
+	Prompt
+    }
+
+    # set StatusCursor
+    set PRIV(StatusCursor) [$con index insert]
+
+    focus -force $con
+}
+
+proc ::tkcon::NewTab {{con {}}} {
+    variable PRIV
+    variable ATTACH
+
+    set con   [InitTab $PRIV(base)]
+    set slave [GetSlave]
+    InitSlave $slave
+    $slave alias exit ::tkcon::DeleteTab $con $slave
+    if {$PRIV(name) != ""} {
+	set ATTACH($con) [list [list $PRIV(name) $slave] slave]
+    } else {
+	set ATTACH($con) [list $slave slave]
+    }
+    $PRIV(X) configure -state normal
+    MenuConfigure Console "Delete Tab" -state normal
+    GotoTab $con
+}
+
+# The extra code arg is for the alias of exit to this function
+proc ::tkcon::DeleteTab {{con {}} {slave {}} {code 0}} {
+    variable PRIV
+
+    set numtabs [llength $PRIV(tabs)]
+    if {$numtabs <= 2} {
+	$PRIV(X) configure -state disabled
+	MenuConfigure Console "Delete Tab" -state disabled
+    }
+    if {$numtabs == 1} {
+	# in the master, it should do the right thing
+	# currently the first master still exists - need rearch to fix
+	exit
+	# we might end up here, depending on how exit is rerouted
+	return
+    }
+
+    if {$con == ""} {
+	set con $PRIV(console)
+    }
+    catch {unset ATTACH($con)}
+    set curtab  [lsearch -exact $PRIV(tabs) $con]
+    set PRIV(tabs) [lreplace $PRIV(tabs) $curtab $curtab]
+
+    set numtabs [llength $PRIV(tabs)]
+    set nexttab $curtab
+    if {$nexttab >= $numtabs} {
+	set nexttab end
+    }
+    set nexttab [lindex $PRIV(tabs) $nexttab]
+
+    GotoTab $nexttab
+
+    if {$slave != "" && $slave != $::tkcon::OPT(exec)} {
+	interp delete $slave
+    }
+    destroy $PRIV(tabframe).cb[winfo name $con]
+    destroy $con
+}
+
+## ::tkcon::GarbageCollect - do various cleanup ops periodically to our setup
+##
+proc ::tkcon::GarbageCollect {} {
+    variable OPT
+    variable PRIV
+
+    foreach w $PRIV(tabs) {
+	if {[winfo exists $w]} {
+	    ## Remove error tags that no longer span anything
+	    ## Make sure the tag pattern matches the unique tag prefix
+	    foreach tag [$w tag names] {
+		if {[string match _tag* $tag]
+		    && ![llength [$w tag ranges $tag]]} {
+		    $w tag delete $tag
+		}
+	    }
+	}
+    }
+    if {$OPT(gc-delay)} {
+	after $OPT(gc-delay) ::tkcon::GarbageCollect
+    }
+}
+
+## ::tkcon::Eval - evaluates commands input into console window
+## This is the first stage of the evaluating commands in the console.
+## They need to be broken up into consituent commands (by ::tkcon::CmdSep) in
+## case a multiple commands were pasted in, then each is eval'ed (by
+## ::tkcon::EvalCmd) in turn.  Any uncompleted command will not be eval'ed.
+# ARGS:	w	- console text widget
+# Calls:	::tkcon::CmdGet, ::tkcon::CmdSep, ::tkcon::EvalCmd
+## 
+proc ::tkcon::Eval {w} {
+    set incomplete [CmdSep [CmdGet $w] cmds last]
+    $w mark set insert end-1c
+    $w insert end \n
+    if {[llength $cmds]} {
+	foreach c $cmds {EvalCmd $w $c}
+	$w insert insert $last {}
+    } elseif {!$incomplete} {
+	EvalCmd $w $last
+    }
+    if {[winfo exists $w]} {
+	$w see insert
+    }
+}
+
+## ::tkcon::EvalCmd - evaluates a single command, adding it to history
+# ARGS:	w	- console text widget
+# 	cmd	- the command to evaluate
+# Calls:	::tkcon::Prompt
+# Outputs:	result of command to stdout (or stderr if error occured)
+# Returns:	next event number
+## 
+proc ::tkcon::EvalCmd {w cmd} {
+    variable OPT
+    variable PRIV
+
+    $w mark set output end
+    if {[string compare {} $cmd]} {
+	set code 0
+	if {$OPT(subhistory)} {
+	    set ev [EvalSlave history nextid]
+	    incr ev -1
+	    ## FIX: calcmode doesn't work with requesting history events
+	    if {[string match !! $cmd]} {
+		set code [catch {EvalSlave history event $ev} cmd]
+		if {!$code} {$w insert output $cmd\n stdin}
+	    } elseif {[regexp {^!(.+)$} $cmd dummy event]} {
+		## Check last event because history event is broken
+		set code [catch {EvalSlave history event $ev} cmd]
+		if {!$code && ![string match ${event}* $cmd]} {
+		    set code [catch {EvalSlave history event $event} cmd]
+		}
+		if {!$code} {$w insert output $cmd\n stdin}
+	    } elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $cmd dummy old new]} {
+		set code [catch {EvalSlave history event $ev} cmd]
+		if {!$code} {
+		    regsub -all -- $old $cmd $new cmd
+		    $w insert output $cmd\n stdin
+		}
+	    } elseif {$OPT(calcmode) && ![catch {expr $cmd} err]} {
+		AddSlaveHistory $cmd
+		set cmd $err
+		set code -1
+	    }
+	}
+	if {$code} {
+	    $w insert output $cmd\n stderr
+	} else {
+	    ## We are about to evaluate the command, so move the limit
+	    ## mark to ensure that further <Return>s don't cause double
+	    ## evaluation of this command - for cases like the command
+	    ## has a vwait or something in it
+	    $w mark set limit end
+	    if {$OPT(nontcl) && [string match interp $PRIV(apptype)]} {
+		set code [catch {EvalSend $cmd} res]
+		if {$code == 1} {
+		    set PRIV(errorInfo) "Non-Tcl errorInfo not available"
+		}
+	    } elseif {[string match socket $PRIV(apptype)]} {
+		set code [catch {EvalSocket $cmd} res]
+		if {$code == 1} {
+		    set PRIV(errorInfo) "Socket-based errorInfo not available"
+		}
+	    } else {
+		set code [catch {EvalAttached $cmd} res]
+		if {$code == 1} {
+		    if {[catch {EvalAttached [list set errorInfo]} err]} {
+			set PRIV(errorInfo) "Error getting errorInfo:\n$err"
+		    } else {
+			set PRIV(errorInfo) $err
+		    }
+		}
+	    }
+	    if {![winfo exists $w]} {
+		# early abort - must be a deleted tab
+		return
+	    }
+	    AddSlaveHistory $cmd
+	    # Run any user defined result filter command.  The command is
+	    # passed result code and data.
+	    if {[llength $OPT(resultfilter)]} {
+		set cmd [concat $OPT(resultfilter) [list $code $res]]
+		if {[catch {EvalAttached $cmd} res2]} {
+		    $w insert output "Filter failed: $res2" stderr \n stdout
+		} else {
+		    set res $res2
+		}
+	    }
+	    catch {EvalAttached [list set _ $res]}
+	    set maxlen $OPT(maxlinelen)
+	    set trailer ""
+	    if {($maxlen > 0) && ([string length $res] > $maxlen)} {
+		# If we exceed maximum desired output line length, truncate
+		# the result and add "...+${num}b" in error coloring
+		set trailer ...+[expr {[string length $res]-$maxlen}]b
+		set res [string range $res 0 $maxlen]
+	    }
+	    if {$code} {
+		if {$OPT(hoterrors)} {
+		    set tag [UniqueTag $w]
+		    $w insert output $res [list stderr $tag] \n$trailer stderr
+		    $w tag bind $tag <Enter> \
+			    [list $w tag configure $tag -under 1]
+		    $w tag bind $tag <Leave> \
+			    [list $w tag configure $tag -under 0]
+		    $w tag bind $tag <ButtonRelease-1> \
+			    "if {!\[info exists tkPriv(mouseMoved)\] || !\$tkPriv(mouseMoved)} \
+			    {[list $OPT(edit) -attach [Attach] -type error -- $PRIV(errorInfo)]}"
+		} else {
+		    $w insert output $res\n$trailer stderr
+		}
+	    } elseif {[string compare {} $res]} {
+		$w insert output $res stdout $trailer stderr \n stdout
+	    }
+	}
+    }
+    Prompt
+    set PRIV(event) [EvalSlave history nextid]
+}
+
+## ::tkcon::EvalSlave - 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 ::tkcon::EvalSlave args {
+    interp eval $::tkcon::OPT(exec) $args
+}
+
+## ::tkcon::EvalOther - 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 ::tkcon::EvalOther { app type args } {
+    if {[string compare slave $type]==0} {
+	return [Slave $app $args]
+    } else {
+	return [uplevel 1 ::send::send [list $app] $args]
+    }
+}
+
+## ::tkcon::AddSlaveHistory - 
+## Command is added to history only if different from previous command.
+## This also doesn't cause the history id to be incremented, although the
+## command will be evaluated.
+# ARGS: cmd	- command to add
+##
+proc ::tkcon::AddSlaveHistory cmd {
+    set ev [EvalSlave history nextid]
+    incr ev -1
+    set code [catch {EvalSlave history event $ev} lastCmd]
+    if {$code || [string compare $cmd $lastCmd]} {
+	EvalSlave history add $cmd
+    }
+}
+
+## ::tkcon::EvalSend - sends the args to the attached interpreter
+## Varies from 'send' by determining whether attachment is dead
+## when an error is received
+# ARGS:	cmd	- the command string to send across
+# Returns:	the result of the command
+##
+proc ::tkcon::EvalSend cmd {
+    variable OPT
+    variable PRIV
+
+    if {$PRIV(deadapp)} {
+	if {[lsearch -exact [::send::interps] $PRIV(app)]<0} {
+	    return
+	} else {
+	    set PRIV(appname) [string range $PRIV(appname) 5 end]
+	    set PRIV(deadapp) 0
+	    Prompt "\n\"$PRIV(app)\" alive\n" [CmdGet $PRIV(console)]
+	}
+    }
+    set code [catch {::send::send -displayof $PRIV(displayWin) $PRIV(app) $cmd} result]
+    if {$code && [lsearch -exact [::send::interps] $PRIV(app)]<0} {
+	## Interpreter disappeared
+	if {[string compare leave $OPT(dead)] && \
+		([string match ignore $OPT(dead)] || \
+		     [tk_messageBox -title "Dead Attachment" -type yesno \
+			  -icon info -message \
+			  "\"$PRIV(app)\" appears to have died.\
+		\nReturn to primary slave interpreter?"]=="no")} {
+	    set PRIV(appname) "DEAD:$PRIV(appname)"
+	    set PRIV(deadapp) 1
+	} else {
+	    set err "Attached Tk interpreter \"$PRIV(app)\" died."
+	    Attach {}
+	    set PRIV(deadapp) 0
+	    EvalSlave set errorInfo $err
+	}
+	Prompt \n [CmdGet $PRIV(console)]
+    }
+    return -code $code $result
+}
+
+## ::tkcon::EvalSocket - sends the string to an interpreter attached via
+## a tcp/ip socket
+##
+## In the EvalSocket case, ::tkcon::PRIV(app) is the socket id
+##
+## Must determine whether socket is dead when an error is received
+# ARGS:	cmd	- the data string to send across
+# Returns:	the result of the command
+##
+proc ::tkcon::EvalSocket cmd {
+    variable OPT
+    variable PRIV
+    global tcl_version
+
+    if {$PRIV(deadapp)} {
+	if {![info exists PRIV(app)] || \
+		[catch {eof $PRIV(app)} eof] || $eof} {
+	    return
+	} else {
+	    set PRIV(appname) [string range $PRIV(appname) 5 end]
+	    set PRIV(deadapp) 0
+	    Prompt "\n\"$PRIV(app)\" alive\n" [CmdGet $PRIV(console)]
+	}
+    }
+    # Sockets get \'s interpreted, so that users can
+    # send things like \n\r or explicit hex values
+    set cmd [subst -novariables -nocommands $cmd]
+    #puts [list $PRIV(app) $cmd]
+    set code [catch {puts $PRIV(app) $cmd ; flush $PRIV(app)} result]
+    if {$code && [eof $PRIV(app)]} {
+	## Interpreter died or disappeared
+	puts "$code eof [eof $PRIV(app)]"
+	EvalSocketClosed $PRIV(app)
+    }
+    return -code $code $result
+}
+
+## ::tkcon::EvalSocketEvent - fileevent command for an interpreter attached
+## via a tcp/ip socket
+## Must determine whether socket is dead when an error is received
+# ARGS:	args	- the args to send across
+# Returns:	the result of the command
+##
+proc ::tkcon::EvalSocketEvent {sock} {
+    variable PRIV
+
+    if {[gets $sock line] == -1} {
+	if {[eof $sock]} {
+	    EvalSocketClosed $sock
+	}
+	return
+    }
+    puts $line
+}
+
+## ::tkcon::EvalSocketClosed - takes care of handling a closed eval socket
+##
+# ARGS:	args	- the args to send across
+# Returns:	the result of the command
+##
+proc ::tkcon::EvalSocketClosed {sock} {
+    variable OPT
+    variable PRIV
+
+    catch {close $sock}
+    if {![string match $sock $PRIV(app)]} {
+	# If we are not still attached to that socket, just return.
+	# Might be nice to tell the user the socket closed ...
+	return
+    }
+    if {[string compare leave $OPT(dead)] && \
+	    ([string match ignore $OPT(dead)] || \
+		 [tk_messageBox -title "Dead Attachment" -type yesno \
+		      -icon question \
+		      -message "\"$PRIV(app)\" appears to have died.\
+	    \nReturn to primary slave interpreter?"] == "no")} {
+	set PRIV(appname) "DEAD:$PRIV(appname)"
+	set PRIV(deadapp) 1
+    } else {
+	set err "Attached Tk interpreter \"$PRIV(app)\" died."
+	Attach {}
+	set PRIV(deadapp) 0
+	EvalSlave set errorInfo $err
+    }
+    Prompt \n [CmdGet $PRIV(console)]
+}
+
+## ::tkcon::EvalNamespace - evaluates the args in a particular namespace
+## This is an override for ::tkcon::EvalAttached for when the user wants
+## to attach to a particular namespace of the attached interp
+# ARGS:	attached	
+#	namespace	the namespace to evaluate in
+#	args		the args to evaluate
+# RETURNS:	the result of the command
+##
+proc ::tkcon::EvalNamespace { attached namespace args } {
+    if {[llength $args]} {
+	uplevel \#0 $attached \
+		[list [concat [list namespace eval $namespace] $args]]
+    }
+}
+
+
+## ::tkcon::Namespaces - return all the namespaces descendent from $ns
+##
+#
+##
+proc ::tkcon::Namespaces {{ns ::} {l {}}} {
+    if {[string compare {} $ns]} { lappend l $ns }
+    foreach i [EvalAttached [list namespace children $ns]] {
+	set l [Namespaces $i $l]
+    }
+    return $l
+}
+
+## ::tkcon::CmdGet - gets the current command from the console widget
+# ARGS:	w	- console text widget
+# Returns:	text which compromises current command line
+## 
+proc ::tkcon::CmdGet w {
+    if {![llength [$w tag nextrange prompt limit end]]} {
+	$w tag add stdin limit end-1c
+	return [$w get limit end-1c]
+    }
+}
+
+## ::tkcon::CmdSep - separates multiple commands into a list and remainder
+# ARGS:	cmd	- (possible) multiple command to separate
+# 	list	- varname for the list of commands that were separated.
+#	last	- varname of any remainder (like an incomplete final command).
+#		If there is only one command, it's placed in this var.
+# Returns:	constituent command info in varnames specified by list & rmd.
+## 
+proc ::tkcon::CmdSep {cmd list last} {
+    upvar 1 $list cmds $last inc
+    set inc {}
+    set cmds {}
+    foreach c [split [string trimleft $cmd] \n] {
+	if {[string compare $inc {}]} {
+	    append inc \n$c
+	} else {
+	    append inc [string trimleft $c]
+	}
+	if {[info complete $inc] && ![regexp {[^\\]\\$} $inc]} {
+	    if {[regexp "^\[^#\]" $inc]} {lappend cmds $inc}
+	    set inc {}
+	}
+    }
+    set i [string compare $inc {}]
+    if {!$i && [string compare $cmds {}] && ![string match *\n $cmd]} {
+	set inc [lindex $cmds end]
+	set cmds [lreplace $cmds end end]
+    }
+    return $i
+}
+
+## ::tkcon::CmdSplit - splits multiple commands into a list
+# ARGS:	cmd	- (possible) multiple command to separate
+# Returns:	constituent commands in a list
+## 
+proc ::tkcon::CmdSplit {cmd} {
+    set inc {}
+    set cmds {}
+    foreach cmd [split [string trimleft $cmd] \n] {
+	if {[string compare {} $inc]} {
+	    append inc \n$cmd
+	} else {
+	    append inc [string trimleft $cmd]
+	}
+	if {[info complete $inc] && ![regexp {[^\\]\\$} $inc]} {
+	    #set inc [string trimright $inc]
+	    if {[regexp "^\[^#\]" $inc]} {lappend cmds $inc}
+	    set inc {}
+	}
+    }
+    if {[regexp "^\[^#\]" $inc]} {lappend cmds $inc}
+    return $cmds
+}
+
+## ::tkcon::UniqueTag - creates a uniquely named tag, reusing names
+## Called by ::tkcon::EvalCmd
+# ARGS:	w	- text widget
+# Outputs:	tag name guaranteed unique in the widget
+## 
+proc ::tkcon::UniqueTag {w} {
+    set tags [$w tag names]
+    set idx 0
+    while {[lsearch -exact $tags _tag[incr idx]] != -1} {}
+    return _tag$idx
+}
+
+## ::tkcon::ConstrainBuffer - This limits the amount of data in the text widget
+## Called by ::tkcon::Prompt and in tkcon proc buffer/console switch cases
+# ARGS:	w	- console text widget
+#	size	- # of lines to constrain to
+# Outputs:	may delete data in console widget
+## 
+proc ::tkcon::ConstrainBuffer {w size} {
+    if {$size && ([$w index end] > $size)} {
+	$w delete 1.0 [expr {int([$w index end])-$size}].0
+    }
+}
+
+## ::tkcon::Prompt - displays the prompt in the console widget
+# ARGS:	w	- console text widget
+# Outputs:	prompt (specified in ::tkcon::OPT(prompt1)) to console
+## 
+proc ::tkcon::Prompt {{pre {}} {post {}} {prompt {}}} {
+    variable OPT
+    variable PRIV
+
+    set w $PRIV(console)
+    if {![winfo exists $w]} { return }
+    if {[string compare {} $pre]} { $w insert end $pre stdout }
+    set i [$w index end-1c]
+    if {!$OPT(showstatusbar)} {
+	if {[string compare {} $PRIV(appname)]} {
+	    $w insert end ">$PRIV(appname)< " prompt
+	}
+	if {[string compare :: $PRIV(namesp)]} {
+	    $w insert end "<$PRIV(namesp)> " prompt
+	}
+    }
+    if {[string compare {} $prompt]} {
+	$w insert end $prompt prompt
+    } else {
+	$w insert end [EvalSlave subst $OPT(prompt1)] prompt
+    }
+    $w mark set output $i
+    $w mark set insert end
+    $w mark set limit insert
+    $w mark gravity limit left
+    if {[string compare {} $post]} { $w insert end $post stdin }
+    ConstrainBuffer $w $OPT(buffer)
+    set ::tkcon::PRIV(StatusCursor) [$w index insert]
+    $w see end
+}
+proc ::tkcon::RePrompt {{pre {}} {post {}} {prompt {}}} {
+    # same as prompt, but does nothing for those actions where we
+    # only wanted to refresh the prompt on attach change when the
+    # statusbar is showing (which carries that info instead)
+    variable OPT
+    if {!$OPT(showstatusbar)} {
+	Prompt $pre $post $prompt
+    }
+}
+
+## ::tkcon::About - gives about info for tkcon
+## 
+proc ::tkcon::About {} {
+    variable OPT
+    variable PRIV
+    variable COLOR
+
+    set w $PRIV(base).about
+    if {![winfo exists $w]} {
+	global tk_patchLevel tcl_patchLevel tcl_version
+	toplevel $w
+	wm withdraw $w
+	wm transient $w $PRIV(root)
+	wm group $w $PRIV(root)
+	wm title $w "About tkcon v$PRIV(version)"
+	wm resizable $w 0 0
+	button $w.b -text Dismiss -command [list wm withdraw $w]
+	text $w.text -height 9 -width 60 \
+		-foreground $COLOR(stdin) \
+		-background $COLOR(bg) \
+		-font $OPT(font) -borderwidth 1 -highlightthickness 0
+	grid $w.text -sticky news
+	grid $w.b -sticky se -padx 6 -pady 4
+	$w.text tag config center -justify center
+	$w.text tag config title -justify center -font {Courier -18 bold}
+	# strip down the RCS info displayed in the about box
+	regexp {,v ([0-9\./: ]*)} $PRIV(RCS) -> RCS
+	$w.text insert 1.0 "About tkcon v$PRIV(version)" title \
+		"\n\nCopyright 1995-2002 Jeffrey Hobbs, $PRIV(email)\
+		\nRelease Info: v$PRIV(version), CVS v$RCS\
+		\nDocumentation available at:\n$PRIV(docs)\
+		\nUsing: Tcl v$tcl_patchLevel / Tk v$tk_patchLevel" center
+	$w.text config -state disabled
+	bind $w <Escape> [list destroy $w]
+    }
+    wm deiconify $w
+}
+
+## ::tkcon::InitMenus - inits the menubar and popup for the console
+# ARGS:	w	- console text widget
+## 
+proc ::tkcon::InitMenus {w title} {
+    variable OPT
+    variable PRIV
+    variable COLOR
+    global tcl_platform
+
+    if {[catch {menu $w.pop}]} {
+	label $w.label -text "Menus not available in plugin mode"
+	grid $w.label -sticky ew
+	return
+    }
+    menu $w.context -disabledforeground $COLOR(disabled)
+    set PRIV(context) $w.context
+    set PRIV(popup) $w.pop
+
+    proc MenuButton {w m l} {
+	$w add cascade -label $m -underline 0 -menu $w.$l
+	return $w.$l
+    }
+    proc MenuConfigure {m l args} {
+	variable PRIV
+	eval [list $PRIV(menubar).[string tolower $m] entryconfigure $l] $args
+	eval [list $PRIV(popup).[string tolower $m] entryconfigure $l] $args
+    }
+
+    foreach m [list File Console Edit Interp Prefs History Help] {
+ 	set l [string tolower $m]
+ 	MenuButton $w $m $l
+ 	$w.pop add cascade -label $m -underline 0 -menu $w.pop.$l
+    }
+
+    ## File Menu
+    ##
+    foreach m [list [menu $w.file -disabledforeground $COLOR(disabled)] \
+	    [menu $w.pop.file -disabledforeground $COLOR(disabled)]] {
+	$m add command -label "Load File" -underline 0 -command ::tkcon::Load
+	$m add cascade -label "Save ..."  -underline 0 -menu $m.save
+	$m add separator
+	$m add command -label "Quit" -underline 0 -accel Ctrl-q -command exit
+
+	## Save Menu
+	##
+	set s $m.save
+	menu $s -disabledforeground $COLOR(disabled)
+	$s add command -label "All"	-underline 0 \
+		-command {::tkcon::Save {} all}
+	$s add command -label "History"	-underline 0 \
+		-command {::tkcon::Save {} history}
+	$s add command -label "Stdin"	-underline 3 \
+		-command {::tkcon::Save {} stdin}
+	$s add command -label "Stdout"	-underline 3 \
+		-command {::tkcon::Save {} stdout}
+	$s add command -label "Stderr"	-underline 3 \
+		-command {::tkcon::Save {} stderr}
+    }
+
+    ## Console Menu
+    ##
+    foreach m [list [menu $w.console -disabledfore $COLOR(disabled)] \
+	    [menu $w.pop.console -disabledfore $COLOR(disabled)]] {
+	$m add command -label "$title Console"	-state disabled
+	$m add command -label "New Console"	-underline 0 -accel Ctrl-N \
+		-command ::tkcon::New
+	$m add command -label "New Tab"		-underline 4 -accel Ctrl-T \
+		-command ::tkcon::NewTab
+	$m add command -label "Delete Tab"	-underline 0 \
+		-command ::tkcon::DeleteTab -state disabled
+	$m add command -label "Close Console"	-underline 0 -accel Ctrl-w \
+		-command ::tkcon::Destroy
+	$m add command -label "Clear Console"	-underline 1 -accel Ctrl-l \
+		-command { clear; ::tkcon::Prompt }
+	if {[string match unix $tcl_platform(platform)]} {
+	    $m add separator
+	    $m add command -label "Make Xauth Secure" -und 5 \
+		    -command ::tkcon::XauthSecure
+	}
+	$m add separator
+	$m add cascade -label "Attach To ..." -underline 0 -menu $m.attach
+
+	## Attach Console Menu
+	##
+	set sub [menu $m.attach -disabledforeground $COLOR(disabled)]
+	$sub add cascade -label "Interpreter" -underline 0 -menu $sub.apps
+	$sub add cascade -label "Namespace"   -underline 0 -menu $sub.name
+
+	## Attach Console Menu
+	##
+	menu $sub.apps -disabledforeground $COLOR(disabled) \
+		-postcommand [list ::tkcon::AttachMenu $sub.apps]
+
+	## Attach Namespace Menu
+	##
+	menu $sub.name -disabledforeground $COLOR(disabled) \
+		-postcommand [list ::tkcon::NamespaceMenu $sub.name]
+
+	if {$::tcl_version >= 8.3} {
+	    ## Attach Socket Menu
+	    ##
+	    # This uses [file channels] to create the menu, so we only
+	    # want it for newer versions of Tcl.
+	    $sub add cascade -label "Socket" -underline 0 -menu $sub.sock
+	    menu $sub.sock -disabledforeground $COLOR(disabled) \
+		    -postcommand [list ::tkcon::SocketMenu $sub.sock]
+	}
+
+	if {![string compare "unix" $tcl_platform(platform)]} {
+	    ## Attach Display Menu
+	    ##
+	    $sub add cascade -label "Display" -underline 0 -menu $sub.disp
+	    menu $sub.disp -disabledforeground $COLOR(disabled) \
+		    -postcommand [list ::tkcon::DisplayMenu $sub.disp]
+	}
+    }
+
+    ## Edit Menu
+    ##
+    set...
 
[truncated message content]