From: Jeff Hobbs <hobbs@users.sourceforge.net>
Date: Tue, 8 Oct 2002 18:51:00 +0000 (+0000)
Subject: 	* tkcon.tcl (tcl_unknown): allow ::namespace (:'s) to be
X-Git-Tag: tkcon-2-4~24
X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=e3e4b23bc593efbdcd72872578a84179805eceaf;p=tkcon

	* tkcon.tcl (tcl_unknown): allow ::namespace (:'s) to be
	recognized. (koloska)
	(MainInit): add option for overriding exit command.
	(InitUI): add option to control the wm protocol for WM_DELETE_WINDOW.
---

diff --git a/ChangeLog b/ChangeLog
index 08c490b..b777464 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2002-10-08  Jeff Hobbs  <jeffh@ActiveState.com>
+
+	* tkcon.tcl (tcl_unknown): allow ::namespace (:'s) to be
+	recognized. (koloska)
+	(MainInit): add option for overriding exit command.
+	(InitUI): add option to control the wm protocol for WM_DELETE_WINDOW.
+
 2002-10-01  Jeff Hobbs  <jeffh@ActiveState.com>
 
 	* tkcon.tcl (InterpEval): correctly handle no args case.
diff --git a/tkcon.tcl b/tkcon.tcl
index 55c099d..82874f7 100755
--- a/tkcon.tcl
+++ b/tkcon.tcl
@@ -100,16 +100,6 @@ proc ::tkcon::Init {args} {
     set tcl_interactive 1
     set argc [llength $args]
 
-    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
-    }
-
     ##
     ## When setting up all the default values, we always check for
     ## prior existence.  This allows users who embed tkcon to modify
@@ -162,6 +152,7 @@ proc ::tkcon::Init {args} {
 	subhistory	1
 	gc-delay	60000
 	gets		{congets}
+	overrideexit	1
 	usehistory	1
 
 	exec		slave
@@ -187,6 +178,7 @@ proc ::tkcon::Init {args} {
 	find,case	0
 	find,reg	0
 	errorInfo	{}
+	protocol	exit
 	showOnStartup	1
 	slavealias	{ edit more less tkcon }
 	slaveprocs	{
@@ -203,6 +195,16 @@ proc ::tkcon::Init {args} {
     }
     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
@@ -544,7 +546,7 @@ proc ::tkcon::InitUI {title} {
     if {[string match . $root]} { set w {} } else { set w [toplevel $root] }
     if {!$PRIV(WWW)} {
 	wm withdraw $root
-	wm protocol $root WM_DELETE_WINDOW exit
+	wm protocol $root WM_DELETE_WINDOW $PRIV(protocol)
     }
     set PRIV(base) $w
 
@@ -1985,6 +1987,7 @@ proc ::tkcon::Save { {fn ""} {type ""} {opt ""} {mode w} } {
 ##
 proc ::tkcon::MainInit {} {
     variable PRIV
+    variable OPT
 
     if {![info exists PRIV(slaves)]} {
 	array set PRIV [list slave 0 slaves Main name {} \
@@ -2088,32 +2091,35 @@ proc ::tkcon::MainInit {} {
 	return
     }
 
-    ## We want to do a couple things before exiting...
-    if {[catch {rename ::exit ::tkcon::FinalExit} err]} {
-	puts stderr "tkcon might panic:\n$err"
-    }
-    proc ::exit args {
-	if {$::tkcon::OPT(usehistory)} {
-	    if {[catch {open $::tkcon::PRIV(histfile) w} fid]} {
-		puts stderr "unable to save history file:\n$fid"
-		# pause a moment, because we are about to die finally...
-		after 1000
-	    } else {
-		set max [::tkcon::EvalSlave history nextid]
-		set id [expr {$max - $::tkcon::OPT(history)}]
-		if {$id < 1} { set id 1 }
-		## FIX: This puts history in backwards!!
-		while {($id < $max) && \
-			![catch {::tkcon::EvalSlave history event $id} cmd]} {
-		    if {[string compare {} $cmd]} {
-			puts $fid "::tkcon::EvalSlave history add [list $cmd]"
+    if {$OPT(overrideexit)} {
+	## We want to do a couple things before exiting...
+	if {[catch {rename ::exit ::tkcon::FinalExit} err]} {
+	    puts stderr "tkcon might panic:\n$err"
+	}
+	proc ::exit args {
+	    if {$::tkcon::OPT(usehistory)} {
+		if {[catch {open $::tkcon::PRIV(histfile) w} fid]} {
+		    puts stderr "unable to save history file:\n$fid"
+		    # pause a moment, because we are about to die finally...
+		    after 1000
+		} else {
+		    set max [::tkcon::EvalSlave history nextid]
+		    set id [expr {$max - $::tkcon::OPT(history)}]
+		    if {$id < 1} { set id 1 }
+		    ## FIX: This puts history in backwards!!
+		    while {($id < $max) && ![catch \
+			    {::tkcon::EvalSlave history event $id} cmd]} {
+			if {[string compare {} $cmd]} {
+			    puts $fid "::tkcon::EvalSlave\
+				    history add [list $cmd]"
+			}
+			incr id
 		    }
-		    incr id
+		    close $fid
 		}
-		close $fid
 	    }
+	    uplevel 1 ::tkcon::FinalExit $args
 	}
-	uplevel 1 ::tkcon::FinalExit $args
     }
 
     ## ::tkcon::InterpEval - passes evaluation to another named interpreter
@@ -3210,7 +3216,8 @@ proc dump {type args} {
 			set nst {}
 			append res "array set [list $var] \{\n"
 			if {[array size v]} {
-			    foreach i [lsort [array names v $fltr]] {
+			    foreach i \
+				    [lsort -dictionary [array names v $fltr]] {
 				upvar 0 v\($i\) __a
 				if {[array exists __a]} {
 				    append nst "\#\# NESTED ARRAY ELEM: $i\n"
@@ -4019,7 +4026,8 @@ proc tcl_unknown args {
     # then concatenate its arguments onto the end and evaluate it.
 
     set cmd [lindex $args 0]
-    if {[regexp "^namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} {
+    if {[regexp "^:*namespace\[ \t\n\]+inscope" $cmd] \
+	    && [llength $cmd] == 4} {
         set arglist [lrange $args 1 end]
 	set ret [catch {uplevel 1 $cmd $arglist} result]
         if {$ret == 0} {