* library/console.tcl: added more smarts extracted from tkcon to

	the default console.

1 files changed, 566 insertions, 125 deletions

diff --git a/library/console.tcl b/library/console.tcl
index 170d898..6375648 100644
--- a/library/console.tcl
+++ b/library/console.tcl
@@ -4,7 +4,7 @@
 # can be used by non-unix systems that do not have built-in support
 # for shells.
 #
-# RCS: @(#) $Id: console.tcl,v 1.12 2001/08/01 16:21:11 dgp Exp $
+# RCS: @(#) $Id: console.tcl,v 1.13 2001/10/09 23:11:02 hobbs Exp $
 #
 # Copyright (c) 1995-1997 Sun Microsystems, Inc.
 # Copyright (c) 1998-2000 Ajuba Solutions.
@@ -14,6 +14,27 @@
 #
 
 # TODO: history - remember partially written command
+package require msgcat
+
+namespace eval ::tk::console {
+    variable blinkTime   500 ; # msecs to blink braced range for
+    variable blinkRange  1   ; # enable blinking of the entire braced range
+    variable magicKeys   1   ; # enable brace matching and proc/var recognition
+    variable maxLines    600 ; # maximum # of lines buffered in console
+    variable showMatches 1   ; # show multiple expand matches
+
+    variable inPlugin [info exists embed_args]
+    variable defaultPrompt  ; # default prompt if tcl_prompt1 isn't used
+
+    if {$inPlugin} {
+	set defaultPrompt {subst "[history nextid] % "}
+    } else {
+	set defaultPrompt {subst "([file tail [pwd]]) [history nextid] % "}
+    }
+}
+
+# simple compat function for tkcon code added for this console
+interp alias {} EvalAttached {} consoleinterp eval
 
 # ::tk::ConsoleInit --
 # This procedure constructs and configures the console windows.
@@ -34,7 +55,7 @@ proc ::tk::ConsoleInit {} {
 	set mod "Cmd"
     }
 
-    menu .menubar
+    if {[catch {menu .menubar} err]} { bgerror "INIT: $err" }
     .menubar add cascade -label File -menu .menubar.file -underline 0
     .menubar add cascade -label Edit -menu .menubar.edit -underline 0
 
@@ -42,7 +63,9 @@ proc ::tk::ConsoleInit {} {
     .menubar.file add command -label [::msgcat::mc "Source..."] \
 	    -underline 0 -command tk::ConsoleSource
     .menubar.file add command -label [::msgcat::mc "Hide Console"] \
-	    -underline 0  -command {wm withdraw .}
+	    -underline 0 -command {wm withdraw .}
+    .menubar.file add command -label [::msgcat::mc "Clear Console"] \
+	    -underline 0 -command {.console delete 1.0 "promptEnd linestart"}
     if {[string compare $tcl_platform(platform) "macintosh"]} {
 	.menubar.file add command -label [::msgcat::mc "Exit"] \
 		-underline 1 -command exit
@@ -74,33 +97,39 @@ proc ::tk::ConsoleInit {} {
 
     . configure -menu .menubar
 
-    text .console  -yscrollcommand ".sb set" -setgrid true 
-    scrollbar .sb -command ".console yview"
+    set con [text .console  -yscrollcommand [list .sb set] -setgrid true]
+    scrollbar .sb -command [list $con yview]
     pack .sb -side right -fill both
-    pack .console -fill both -expand 1 -side left
+    pack $con -fill both -expand 1 -side left
     switch -exact $tcl_platform(platform) {
 	"macintosh" {
-	    .console configure -font {Monaco 9 normal} -highlightthickness 0
+	    $con configure -font {Monaco 9 normal} -highlightthickness 0
 	}
 	"windows" {
-	    .console configure -font systemfixed
+	    $con configure -font systemfixed
 	}
     }
 
-    ConsoleBind .console
+    ConsoleBind $con
+
+    $con tag configure stderr	-foreground red
+    $con tag configure stdin	-foreground blue
+    $con tag configure prompt	-foreground \#8F4433
+    $con tag configure proc	-foreground \#008800
+    $con tag configure var	-background \#FFC0D0
+    $con tag raise sel
+    $con tag configure blink	-background \#FFFF00
+    $con tag configure find	-background \#FFFF00
 
-    .console tag configure stderr -foreground red
-    .console tag configure stdin -foreground blue
+    focus $con
 
-    focus .console
-    
     wm protocol . WM_DELETE_WINDOW { wm withdraw . }
     wm title . [::msgcat::mc "Console"]
     flush stdout
-    .console mark set output [.console index "end - 1 char"]
-    tk::TextSetCursor .console end
-    .console mark set promptEnd insert
-    .console mark gravity promptEnd left
+    $con mark set output [$con index "end - 1 char"]
+    tk::TextSetCursor $con end
+    $con mark set promptEnd insert
+    $con mark gravity promptEnd left
 }
 
 # ::tk::ConsoleSource --
@@ -112,10 +141,10 @@ proc ::tk::ConsoleInit {} {
 
 proc ::tk::ConsoleSource {} {
     set filename [tk_getOpenFile -defaultextension .tcl -parent . \
-		      -title [::msgcat::mc "Select a file to source"] \
-		      -filetypes [list \
-			  [list [::msgcat::mc "Tcl Scripts"] .tcl] \
-			  [list [::msgcat::mc "All Files"] *]]]
+	    -title [::msgcat::mc "Select a file to source"] \
+	    -filetypes [list \
+	    [list [::msgcat::mc "Tcl Scripts"] .tcl] \
+	    [list [::msgcat::mc "All Files"] *]]]
     if {[string compare $filename ""]} {
     	set cmd [list source $filename]
 	if {[catch {consoleinterp eval $cmd} result]} {
@@ -173,7 +202,7 @@ proc ::tk::ConsoleInvoke {args} {
 set ::tk::HistNum 1
 proc ::tk::ConsoleHistory {cmd} {
     variable HistNum
-    
+
     switch $cmd {
     	prev {
 	    incr HistNum -1
@@ -220,17 +249,18 @@ proc ::tk::ConsoleHistory {cmd} {
 # partial -	Flag to specify which prompt to print.
 
 proc ::tk::ConsolePrompt {{partial normal}} {
+    set w .console
     if {[string equal $partial "normal"]} {
-	set temp [.console index "end - 1 char"]
-	.console mark set output end
+	set temp [$w index "end - 1 char"]
+	$w mark set output end
     	if {[consoleinterp eval "info exists tcl_prompt1"]} {
     	    consoleinterp eval "eval \[set tcl_prompt1\]"
     	} else {
-    	    puts -nonewline "% "
+    	    puts -nonewline [EvalAttached $::tk::console::defaultPrompt]
     	}
     } else {
-	set temp [.console index output]
-	.console mark set output end
+	set temp [$w index output]
+	$w mark set output end
     	if {[consoleinterp eval "info exists tcl_prompt2"]} {
     	    consoleinterp eval "eval \[set tcl_prompt2\]"
     	} else {
@@ -238,10 +268,12 @@ proc ::tk::ConsolePrompt {{partial normal}} {
     	}
     }
     flush stdout
-    .console mark set output $temp
-    ::tk::TextSetCursor .console end
-    .console mark set promptEnd insert
-    .console mark gravity promptEnd left
+    $w mark set output $temp
+    ::tk::TextSetCursor $w end
+    $w mark set promptEnd insert
+    $w mark gravity promptEnd left
+    ::tk::console::ConstrainBuffer $w $::tk::console::maxLines
+    $w see end
 }
 
 # ::tk::ConsoleBind --
@@ -252,127 +284,166 @@ proc ::tk::ConsolePrompt {{partial normal}} {
 # Arguments:
 # None.
 
-proc ::tk::ConsoleBind {win} {
-    bindtags $win "$win Text . all"
+proc ::tk::ConsoleBind {w} {
+    bindtags $w [list $w Console PostConsole [winfo toplevel $w] all]
+
+    ## Get all Text bindings into Console
+    foreach ev [bind Text] { bind Console $ev [bind Text $ev] }	
+    ## We really didn't want the newline insertion
+    bind Console <Control-Key-o> {}
 
     # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
     # Otherwise, if a widget binding for one of these is defined, the
-    # <KeyPress> class binding will also fire and insert the character,
-    # which is wrong.  Ditto for <Escape>.
-
-    bind $win <Alt-KeyPress> {# nothing }
-    bind $win <Meta-KeyPress> {# nothing}
-    bind $win <Control-KeyPress> {# nothing}
-    bind $win <Escape> {# nothing}
-    bind $win <KP_Enter> {# nothing}
 
-    bind $win <Tab> {
+    bind Console <Alt-KeyPress> {# nothing }
+    bind Console <Meta-KeyPress> {# nothing}
+    bind Console <Control-KeyPress> {# nothing}
+
+    foreach {ev key} {
+	<<Console_Prev>>		<Key-Up>
+	<<Console_Next>>		<Key-Down>
+	<<Console_NextImmediate>>	<Control-Key-n>
+	<<Console_PrevImmediate>>	<Control-Key-p>
+	<<Console_PrevSearch>>		<Control-Key-r>
+	<<Console_NextSearch>>		<Control-Key-s>
+
+	<<Console_Expand>>		<Key-Escape>
+	<<Console_ExpandFile>>		<Control-Shift-Key-F>
+	<<Console_ExpandProc>>		<Control-Shift-Key-P>
+	<<Console_ExpandVar>>		<Control-Shift-Key-V>
+	<<Console_Tab>>			<Control-Key-i>
+	<<Console_Tab>>			<Meta-Key-i>
+	<<Console_Eval>>		<Key-Return>
+	<<Console_Eval>>		<Key-KP_Enter>
+
+	<<Console_Clear>>		<Control-Key-l>
+	<<Console_KillLine>>		<Control-Key-k>
+	<<Console_Transpose>>		<Control-Key-t>
+	<<Console_ClearLine>>		<Control-Key-u>
+	<<Console_SaveCommand>>		<Control-Key-z>
+    } {
+	event add $ev $key
+	bind Console $key {}
+    }
+
+    bind Console <Tab> {
 	tk::ConsoleInsert %W \t
 	focus %W
 	break
     }
-    bind $win <Return> {
+    bind Console <<Console_Expand>> {
+	if {[%W compare insert > promptEnd]} {::tk::console::Expand %W}
+    }
+    bind Console <<Console_ExpandFile>> {
+	if {[%W compare insert > promptEnd]} {::tk::console::Expand %W path}
+    }
+    bind Console <<Console_ExpandProc>> {
+	if {[%W compare insert > promptEnd]} {::tk::console::Expand %W proc}
+    }
+    bind Console <<Console_ExpandVar>> {
+	if {[%W compare insert > promptEnd]} {::tk::console::Expand %W var}
+    }
+    bind Console <<Console_Eval>> {
 	%W mark set insert {end - 1c}
 	tk::ConsoleInsert %W "\n"
 	tk::ConsoleInvoke
 	break
     }
-    bind $win <Delete> {
-	if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
-	    %W tag remove sel sel.first promptEnd
-	} elseif {[%W compare insert < promptEnd]} {
-	    break
+    bind Console <Delete> {
+	if {[string compare {} [%W tag nextrange sel 1.0 end]] \
+		&& [%W compare sel.first >= promptEnd]} {
+	    %W delete sel.first sel.last
+	} elseif {[%W compare insert >= promptEnd]} {
+	    %W delete insert
+	    %W see insert
 	}
     }
-    bind $win <BackSpace> {
-	if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
-	    %W tag remove sel sel.first promptEnd
-	} elseif {[%W compare insert <= promptEnd]} {
-	    break
+    bind Console <BackSpace> {
+	if {[string compare {} [%W tag nextrange sel 1.0 end]] \
+		&& [%W compare sel.first >= promptEnd]} {
+	    %W delete sel.first sel.last
+	} elseif {[%W compare insert != 1.0] && \
+		[%W compare insert > promptEnd]} {
+	    %W delete insert-1c
+	    %W see insert
 	}
     }
-    foreach left {Control-a Home} {
-	bind $win <$left> {
-	    if {[%W compare insert < promptEnd]} {
-		tk::TextSetCursor %W {insert linestart}
-	    } else {
-		tk::TextSetCursor %W promptEnd
-            }
-	    break
+    bind Console <Control-h> [bind Console <BackSpace>]
+
+    bind Console <Home> {
+	if {[%W compare insert < promptEnd]} {
+	    tk::TextSetCursor %W {insert linestart}
+	} else {
+	    tk::TextSetCursor %W promptEnd
 	}
     }
-    foreach right {Control-e End} {
-	bind $win <$right> {
-	    tk::TextSetCursor %W {insert lineend}
-	    break
-	}
+    bind Console <Control-a> [bind Console <Home>]
+    bind Console <End> {
+	tk::TextSetCursor %W {insert lineend}
     }
-    bind $win <Control-d> {
-	if {[%W compare insert < promptEnd]} {
-	    break
-	}
+    bind Console <Control-e> [bind Console <End>]
+    bind Console <Control-d> {
+	if {[%W compare insert < promptEnd]} break
+	%W delete insert
     }
-    bind $win <Control-k> {
-	if {[%W compare insert < promptEnd]} {
-	    %W mark set insert promptEnd
+    bind Console <<Console_KillLine>> {
+	if {[%W compare insert < promptEnd]} break
+	if {[%W compare insert == {insert lineend}]} {
+	    %W delete insert
+	} else {
+	    %W delete insert {insert lineend}
 	}
     }
-    bind $win <Control-t> {
-	if {[%W compare insert < promptEnd]} {
-	    break
-	}
+    bind Console <<Console_Transpose>> {
+	## Transpose current and previous chars
+	if {[%W compare insert > promptEnd]} { ::tk::TextTranspose %W }
     }
-    bind $win <Meta-d> {
-	if {[%W compare insert < promptEnd]} {
-	    break
+    bind Console <<Console_Clear>> {
+	## Clear console display
+	%W delete 1.0 "promptEnd linestart"
+    }
+    bind Console <<Console_ClearLine>> {
+	## Clear command line (Unix shell staple)
+	%W delete promptEnd end
+    }
+    bind Console <Meta-d> {
+	if {[%W compare insert >= promptEnd]} {
+	    %W delete insert {insert wordend}
 	}
     }
-    bind $win <Meta-BackSpace> {
-	if {[%W compare insert <= promptEnd]} {
-	    break
+    bind Console <Meta-BackSpace> {
+	if {[%W compare {insert -1c wordstart} >= promptEnd]} {
+	    %W delete {insert -1c wordstart} insert
 	}
     }
-    bind $win <Control-h> {
-	if {[%W compare insert <= promptEnd]} {
-	    break
+    bind Console <Meta-d> {
+	if {[%W compare insert >= promptEnd]} {
+	    %W delete insert {insert wordend}
 	}
     }
-    foreach prev {Control-p Up} {
-	bind $win <$prev> {
-	    tk::ConsoleHistory prev
-	    break
+    bind Console <Meta-BackSpace> {
+	if {[%W compare {insert -1c wordstart} >= promptEnd]} {
+	    %W delete {insert -1c wordstart} insert
 	}
     }
-    foreach prev {Control-n Down} {
-	bind $win <$prev> {
-	    tk::ConsoleHistory next
-	    break
+    bind Console <Meta-Delete> {
+	if {[%W compare insert >= promptEnd]} {
+	    %W delete insert {insert wordend}
 	}
     }
-    bind $win <Insert> {
-	catch {tk::ConsoleInsert %W [::tk::GetSelection %W PRIMARY]}
-	break
+    bind Console <<Console_Prev>> {
+	tk::ConsoleHistory prev
     }
-    bind $win <KeyPress> {
-	tk::ConsoleInsert %W %A
-	break
+    bind Console <<Console_Next>> {
+	tk::ConsoleHistory next
     }
-    foreach left {Control-b Left} {
-	bind $win <$left> {
-	    if {[%W compare insert == promptEnd]} {
-		break
-	    }
-	    tk::TextSetCursor %W insert-1c
-	    break
-	}
+    bind Console <Insert> {
+	catch {tk::ConsoleInsert %W [::tk::GetSelection %W PRIMARY]}
     }
-    foreach right {Control-f Right} {
-	bind $win <$right> {
-	    tk::TextSetCursor %W insert+1c
-	    break
-	}
+    bind Console <KeyPress> {
+	tk::ConsoleInsert %W %A
     }
-    bind $win <F9> {
+    bind Console <F9> {
 	eval destroy [winfo child .]
 	if {[string equal $tcl_platform(platform) "macintosh"]} {
 	    source -rsrc Console
@@ -380,22 +451,20 @@ proc ::tk::ConsoleBind {win} {
 	    source [file join $tk_library console.tcl]
 	}
     }
-    bind $win <<Cut>> {
+    bind Console <<Cut>> {
         # Same as the copy event
  	if {![catch {set data [%W get sel.first sel.last]}]} {
 	    clipboard clear -displayof %W
 	    clipboard append -displayof %W $data
 	}
-	break
     }
-    bind $win <<Copy>> {
+    bind Console <<Copy>> {
  	if {![catch {set data [%W get sel.first sel.last]}]} {
 	    clipboard clear -displayof %W
 	    clipboard append -displayof %W $data
 	}
-	break
     }
-    bind $win <<Paste>> {
+    bind Console <<Paste>> {
 	catch {
 	    set clip [::tk::GetSelection %W CLIPBOARD]
 	    set list [split $clip \n\r]
@@ -407,6 +476,36 @@ proc ::tk::ConsoleBind {win} {
 		tk::ConsoleInsert %W $x
 	    }
 	}
+    }
+
+    ##
+    ## Bindings for doing special things based on certain keys
+    ##
+    bind PostConsole <Key-parenright> {
+	if {[string compare \\ [%W get insert-2c]]} {
+	    ::tk::console::MatchPair %W \( \) promptEnd
+	}
+    }
+    bind PostConsole <Key-bracketright> {
+	if {[string compare \\ [%W get insert-2c]]} {
+	    ::tk::console::MatchPair %W \[ \] promptEnd
+	}
+    }
+    bind PostConsole <Key-braceright> {
+	if {[string compare \\ [%W get insert-2c]]} {
+	    ::tk::console::MatchPair %W \{ \} promptEnd
+	}
+    }
+    bind PostConsole <Key-quotedbl> {
+	if {[string compare \\ [%W get insert-2c]]} {
+	    ::tk::console::MatchQuote %W promptEnd
+	}
+    }
+
+    bind PostConsole <KeyPress> {
+	if {"%A" != ""} {
+	    ::tk::console::TagProc %W
+	}
 	break
     }
 }
@@ -433,7 +532,7 @@ proc ::tk::ConsoleInsert {w s} {
 	}
     }
     if {[$w compare insert < promptEnd]} {
-	$w mark set insert end	
+	$w mark set insert end
     }
     $w insert insert $s {input stdin}
     $w see insert
@@ -450,6 +549,7 @@ proc ::tk::ConsoleInsert {w s} {
 
 proc ::tk::ConsoleOutput {dest string} {
     .console insert output $string $dest
+    ::tk::console::ConstrainBuffer $w $::tk::console::maxLines
     .console see insert
 }
 
@@ -474,14 +574,355 @@ proc ::tk::ConsoleExit {} {
 # None.
 
 proc ::tk::ConsoleAbout {} {
-    global tk_patchLevel
     tk_messageBox -type ok -message "[::msgcat::mc {Tcl for Windows}]
-Copyright \251 2000 Ajuba Solutions
 
-Tcl [info patchlevel]
-Tk $tk_patchLevel"
+Tcl $::tcl_patchLevel
+Tk $::tk_patchLevel"
 }
 
-# now initialize the console
+# ::tk::console::TagProc --
+#
+# Tags a procedure in the console if it's recognized
+# This procedure is not perfect.  However, making it perfect wastes
+# too much CPU time...
+#
+# Arguments:
+#	w	- console text widget
+
+proc ::tk::console::TagProc w {
+    if {!$::tk::console::magicKeys} { return }
+    set exp "\[^\\\\\]\[\[ \t\n\r\;{}\"\$\]"
+    set i [$w search -backwards -regexp $exp insert-1c promptEnd-1c]
+    if {$i == ""} {set i promptEnd} else {append i +2c}
+    regsub -all "\[\[\\\\\\?\\*\]" [$w get $i "insert-1c wordend"] {\\\0} c
+    if {[llength [EvalAttached [list info commands $c]]]} {
+	$w tag add proc $i "insert-1c wordend"
+    } else {
+	$w tag remove proc $i "insert-1c wordend"
+    }
+    if {[llength [EvalAttached [list info vars $c]]]} {
+	$w tag add var $i "insert-1c wordend"
+    } else {
+	$w tag remove var $i "insert-1c wordend"
+    }
+}
+
+# ::tk::console::MatchPair --
+#
+# Blinks a matching pair of characters
+# c2 is assumed to be at the text index 'insert'.
+# This proc is really loopy and took me an hour to figure out given
+# all possible combinations with escaping except for escaped \'s.
+# It doesn't take into account possible commenting... Oh well.  If
+# anyone has something better, I'd like to see/use it.  This is really
+# only efficient for small contexts.
+#
+# Arguments:
+#	w	- console text widget
+# 	c1	- first char of pair
+# 	c2	- second char of pair
+#
+# Calls:	::tk::console::Blink
+ 
+proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} {
+    if {!$::tk::console::magicKeys} { return }
+    if {[string compare {} [set ix [$w search -back $c1 insert $lim]]]} {
+	while {
+	    [string match {\\} [$w get $ix-1c]] &&
+	    [string compare {} [set ix [$w search -back $c1 $ix-1c $lim]]]
+	} {}
+	set i1 insert-1c
+	while {[string compare {} $ix]} {
+	    set i0 $ix
+	    set j 0
+	    while {[string compare {} [set i0 [$w search $c2 $i0 $i1]]]} {
+		append i0 +1c
+		if {[string match {\\} [$w get $i0-2c]]} continue
+		incr j
+	    }
+	    if {!$j} break
+	    set i1 $ix
+	    while {$j && [string compare {} \
+		    [set ix [$w search -back $c1 $ix $lim]]]} {
+		if {[string match {\\} [$w get $ix-1c]]} continue
+		incr j -1
+	    }
+	}
+	if {[string match {} $ix]} { set ix [$w index $lim] }
+    } else { set ix [$w index $lim] }
+    if {$::tk::console::blinkRange} {
+	Blink $w $ix [$w index insert]
+    } else {
+	Blink $w $ix $ix+1c [$w index insert-1c] [$w index insert]
+    }
+}
+
+# ::tk::console::MatchQuote --
+#
+# Blinks between matching quotes.
+# Blinks just the quote if it's unmatched, otherwise blinks quoted string
+# The quote to match is assumed to be at the text index 'insert'.
+#
+# Arguments:
+#	w	- console text widget
+#
+# Calls:	::tk::console::Blink
+ 
+proc ::tk::console::MatchQuote {w {lim 1.0}} {
+    if {!$::tk::console::magicKeys} { return }
+    set i insert-1c
+    set j 0
+    while {[string compare [set i [$w search -back \" $i $lim]] {}]} {
+	if {[string match {\\} [$w get $i-1c]]} continue
+	if {!$j} {set i0 $i}
+	incr j
+    }
+    if {$j&1} {
+	if {$::tk::console::blinkRange} {
+	    Blink $w $i0 [$w index insert]
+	} else {
+	    Blink $w $i0 $i0+1c [$w index insert-1c] [$w index insert]
+	}
+    } else {
+	Blink $w [$w index insert-1c] [$w index insert]
+    }
+}
+
+# ::tk::console::Blink --
+#
+# Blinks between n index pairs for a specified duration.
+#
+# Arguments:
+#	w	- console text widget
+# 	i1	- start index to blink region
+# 	i2	- end index of blink region
+# 	dur	- duration in usecs to blink for
+#
+# Outputs:
+#	blinks selected characters in $w
+
+proc ::tk::console::Blink {w args} {
+    eval [list $w tag add blink] $args
+    after $::tk::console::blinkTime [list $w] tag remove blink $args
+}
+
+# ::tk::console::ConstrainBuffer --
+#
+# This limits the amount of data in the text widget
+# Called by Prompt and ConsoleOutput
+#
+# Arguments:
+#	w	- console text widget
+#	size	- # of lines to constrain to
+#
+# Outputs:
+#	may delete data in console widget
+
+proc ::tk::console::ConstrainBuffer {w size} {
+    if {[$w index end] > $size} {
+	$w delete 1.0 [expr {int([$w index end])-$size}].0
+    }
+}
 
+# ::tk::console::Expand --
+#
+# Arguments:
+# ARGS:	w	- text widget in which to expand str
+# 	type	- type of expansion (path / proc / variable)
+#
+# Calls:	::tk::console::Expand(Pathname|Procname|Variable)
+#
+# Outputs:	The string to match is expanded to the longest possible match.
+#		If ::tk::console::showMatches is non-zero and the longest match
+#		equaled the string to expand, then all possible matches are
+#		output to stdout.  Triggers bell if no matches are found.
+#
+# Returns:	number of matches found
+
+proc ::tk::console::Expand {w {type ""}} {
+    set exp "\[^\\\\\]\[\[ \t\n\r\\\{\"\\\\\$\]"
+    set tmp [$w search -backwards -regexp $exp insert-1c promptEnd-1c]
+    if {$tmp == ""} {set tmp promptEnd} else {append tmp +2c}
+    if {[$w compare $tmp >= insert]} { return }
+    set str [$w get $tmp insert]
+    switch -glob $type {
+	path* { set res [ExpandPathname $str] }
+	proc* { set res [ExpandProcname $str] }
+	var*  { set res [ExpandVariable $str] }
+	default {
+	    set res {}
+	    foreach t {Pathname Procname Variable} {
+		if {![catch {Expand$t $str} res] && ($res != "")} { break }
+	    }
+	}
+    }
+    set len [llength $res]
+    if {$len} {
+	set repl [lindex $res 0]
+	$w delete $tmp insert
+	$w insert $tmp $repl {input stdin}
+	if {($len > 1) && $::tk::console::showMatches \
+		&& [string equal $repl $str]} {
+	    puts stdout [lsort [lreplace $res 0 0]]
+	}
+    } else { bell }
+    return [incr len -1]
+}
+
+# ::tk::console::ExpandPathname --
+#
+# Expand a file pathname based on $str
+# This is based on UNIX file name conventions
+#
+# Arguments:
+#	str	- partial file pathname to expand
+#
+# Calls:	::tk::console::ExpandBestMatch
+#
+# Returns:	list containing longest unique match followed by all the
+#		possible further matches
+ 
+proc ::tk::console::ExpandPathname str {
+    set pwd [EvalAttached pwd]
+    if {[catch {EvalAttached [list cd [file dirname $str]]} err]} {
+	return -code error $err
+    }
+    set dir [file tail $str]
+    ## Check to see if it was known to be a directory and keep the trailing
+    ## slash if so (file tail cuts it off)
+    if {[string match */ $str]} { append dir / }
+    if {[catch {lsort [EvalAttached [list glob $dir*]]} m]} {
+	set match {}
+    } else {
+	if {[llength $m] > 1} {
+	    global tcl_platform
+	    if {[string match windows $tcl_platform(platform)]} {
+		## Windows is screwy because it's case insensitive
+		set tmp [ExpandBestMatch [string tolower $m] \
+			[string tolower $dir]]
+		## Don't change case if we haven't changed the word
+		if {[string length $dir]==[string length $tmp]} {
+		    set tmp $dir
+		}
+	    } else {
+		set tmp [ExpandBestMatch $m $dir]
+	    }
+	    if {[string match ?*/* $str]} {
+		set tmp [file dirname $str]/$tmp
+	    } elseif {[string match /* $str]} {
+		set tmp /$tmp
+	    }
+	    regsub -all { } $tmp {\\ } tmp
+	    set match [linsert $m 0 $tmp]
+	} else {
+	    ## This may look goofy, but it handles spaces in path names
+	    eval append match $m
+	    if {[file isdir $match]} {append match /}
+	    if {[string match ?*/* $str]} {
+		set match [file dirname $str]/$match
+	    } elseif {[string match /* $str]} {
+		set match /$match
+	    }
+	    regsub -all { } $match {\\ } match
+	    ## Why is this one needed and the ones below aren't!!
+	    set match [list $match]
+	}
+    }
+    EvalAttached [list cd $pwd]
+    return $match
+}
+
+# ::tk::console::ExpandProcname --
+#
+# Expand a tcl proc name based on $str
+#
+# Arguments:
+#	str	- partial proc name to expand
+#
+# Calls:	::tk::console::ExpandBestMatch
+#
+# Returns:	list containing longest unique match followed by all the
+#		possible further matches
+
+proc ::tk::console::ExpandProcname str {
+    set match [EvalAttached [list info commands $str*]]
+    if {[llength $match] == 0} {
+	set ns [EvalAttached \
+		"namespace children \[namespace current\] [list $str*]"]
+	if {[llength $ns]==1} {
+	    set match [EvalAttached [list info commands ${ns}::*]]
+	} else {
+	    set match $ns
+	}
+    }
+    if {[llength $match] > 1} {
+	regsub -all { } [ExpandBestMatch $match $str] {\\ } str
+	set match [linsert $match 0 $str]
+    } else {
+	regsub -all { } $match {\\ } match
+    }
+    return $match
+}
+
+# ::tk::console::ExpandVariable --
+#
+# Expand a tcl variable name based on $str
+#
+# Arguments:
+#	str	- partial tcl var name to expand
+#
+# Calls:	::tk::console::ExpandBestMatch
+#
+# Returns:	list containing longest unique match followed by all the
+#		possible further matches
+
+proc ::tk::console::ExpandVariable str {
+    if {[regexp {([^\(]*)\((.*)} $str junk ary str]} {
+	## Looks like they're trying to expand an array.
+	set match [EvalAttached [list array names $ary $str*]]
+	if {[llength $match] > 1} {
+	    set vars $ary\([ExpandBestMatch $match $str]
+	    foreach var $match {lappend vars $ary\($var\)}
+	    return $vars
+	} else {set match $ary\($match\)}
+	## Space transformation avoided for array names.
+    } else {
+	set match [EvalAttached [list info vars $str*]]
+	if {[llength $match] > 1} {
+	    regsub -all { } [ExpandBestMatch $match $str] {\\ } str
+	    set match [linsert $match 0 $str]
+	} else {
+	    regsub -all { } $match {\\ } match
+	}
+    }
+    return $match
+}
+
+# ::tk::console::ExpandBestMatch --
+#
+# Finds the best unique match in a list of names.
+# The extra $e in this argument allows us to limit the innermost loop a little
+# further.  This improves speed as $l becomes large or $e becomes long.
+#
+# Arguments:
+#	l	- list to find best unique match in
+# 	e	- currently best known unique match
+#
+# Returns:	longest unique match in the list
+
+proc ::tk::console::ExpandBestMatch {l {e {}}} {
+    set ec [lindex $l 0]
+    if {[llength $l]>1} {
+	set e  [string length $e]; incr e -1
+	set ei [string length $ec]; incr ei -1
+	foreach l $l {
+	    while {$ei>=$e && [string first $ec $l]} {
+		set ec [string range $ec 0 [incr ei -1]]
+	    }
+	}
+    }
+    return $ec
+}
+
+# now initialize the console
 ::tk::ConsoleInit