# -*- tclsh -*-
# FILE: "/home/joze/src/tclreadline/tclreadlineCompleter.tcl"
# LAST MODIFICATION: "Wed Sep 15 02:59:18 1999 (joze)"
# FILE: "/disk01/home/joze/src/tclreadline/tclreadlineCompleter.tcl"
# LAST MODIFICATION: "Wed Sep 15 18:18:13 1999 (joze)"
# (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
# Copyright (C) 1999  Johannes Zellner
#

# ================================================================== 


# TODO:
#
#     - tcltest is missing
#
#     - last try: as for widgets
#



namespace eval tclreadline {

namespace export \

# @param cmd
# @return list of options for cmd
# @date Sep-14-1999
#
proc TrySubCmds {cmd} {
	set trystring ____
	set result ""
	if [catch {set result [${cmd} ${trystring}]} msg] {
	if [catch {set result [eval ${cmd} ${trystring}]} msg] {
		set tcmd [string trim ${cmd}]
		if {[regexp {bad *option.*____.*: *must *be( .*$)} ${msg} all raw]} {
			regsub -all -- , ${raw} { } raw
			set len [llength ${raw}]
			set len_2 [expr ${len} - 2]
			for {set i 0} {${i} < ${len}} {incr i} {
				set word [lindex ${raw} ${i}]
				if {"or" != ${word} && ${i} != ${len_2}} {
					lappend result ${word}
				}

			}
		} elseif {[regexp "wrong # args: should be \"${tcmd}\(.*\)\"" \
			${msg} all hint]
		} {
			set result [string trim $hint]
		} else {
			# check, if it's a blt error msg ...
			#
			set msglst [split ${msg} \n]
			foreach line ${msglst} {
				if {[regexp "${cmd}\[ \t\]\+\(\[^ \t\]*\)\[^:\]*$" \
					${line} all sub]} {
				if {[regexp "${tcmd}\[ \t\]\+\(\[^ \t\]*\)\[^:\]*$" \
					${line} all sub]
				} {
					lappend result [list ${sub}]
				}
			}
		}
	}
	return ${result}
}

		return ${pre}${res}
	} else {
		return ${res}
	}
	return ""
}

proc BraceOrControlStatement {text start end line pos mod} {
proc BraceOrCommand {text start end line pos mod} {
	if {![string length [Lindex $line $pos]]} {
		return [list \{ {}]; # \}
	} else {
		set new_line [string trim [IncompleteListRemainder $line]]
		if {![regexp {^([\{\"])(.*)$} $new_line all pre new_line]} {
			set pre ""
		}

# DATE: Sep-06-1999
#
proc EventuallyEvaluateFirst {partT startT endT lineT} {
	# return; # disabled
	upvar $partT part $startT start $endT end $lineT line

	set oldlen [string length ${line}]
	set line [string trim ${line}]
	# set line [string trim ${line}]
	set line [string trimleft ${line}]
	set diff [expr [string length $line] - $oldlen]
	incr start $diff
	incr end $diff

	set char [string index ${line} 0]
	if {{[} != ${char} && {$} != ${char}} {return}

					return [DisplayHints <$arg>]
				}
			}
		}


		# Ok, also no proc. Try to do the same as for widgets now:
		# try to get at least the first option from an error output.
		# if the subcommand is configure or cget, try to get the
		# try to complete from the option table if the subcommand
		# is `configure' or `cget' otherwise try to get further
		# subcommands.
		# option table.
		#
		switch -- $pos {
			1 {
				set cmds [TrySubCmds ${alias}]
				if {[llength ${cmds}]} {
					return [TryFromList ${part} ${cmds}]
				}
			}
			default {
				set sub [Lindex $line 1]
				switch -- $sub {
					configure -
					cget {
						return [CompleteFromOptions \
		return [CompleteFromOptionsOrSubCmds $part $start $end $line $pos]
						${part} ${start} ${line} ${alias}]
					}
				}
			}
		}


		# no specific command completer found.
		return ""
	}
	error "{NOTREACHED (this is probably an error)}"
}


# explicit command completers
#

proc complete(for) {text start end line pos mod} {
	switch -- $pos {
		1 -
		2 -
		3 -
		4 {
			return [BraceOrControlStatement $text $start $end $line $pos $mod]
			return [BraceOrCommand $text $start $end $line $pos $mod]
		}
	}
	return ""
}

proc complete(foreach) {text start end line pos mod} {
	switch -- $pos {

	# we don't offer the completion `then':
	# it's optional, more difficult to parse
	# and who uses it anyway?
	#
	switch -- $pos {
		1 -
		2 {
			return [BraceOrControlStatement $text $start $end $line $pos $mod]
			return [BraceOrCommand $text $start $end $line $pos $mod]
		}
		default {
			set prev [PreviousWord ${start} ${line}]
			switch -- $prev {
				then -
				else -
				elseif {
					return [BraceOrControlStatement \
					return [BraceOrCommand \
					$text $start $end $line $pos $mod]
				}
				default {
					if {-1 == [lsearch [ProperList $line] else]} {
						return [CompleteFromList $text {else elseif}]
					}
				}

				children -
				export -
				forget -
				import { return [DisplayHints ?pattern?] }
				delete { return [TryFromList ${mod} $space_matches] }
				eval -
				inscope {
					return [BraceOrControlStatement \
					return [BraceOrCommand \
					$text $start $end $line $pos $mod]
				}
				which { return [CompleteFromList ${mod} {-variable <name>}] }
			}
		}
		4 {
			switch -- $cmd {

	return ""
}

proc complete(while) {text start end line pos mod} {
	switch -- $pos {
		1 -
		2 {
			return [BraceOrControlStatement $text $start $end $line $pos $mod]
			return [BraceOrCommand $text $start $end $line $pos $mod]
		}
	}
	return ""
}

# -------------------------------------
#                  TK

# @return number of options
# @date Sep-14-1999
#
proc OptionTable {cmd optionsT} {
	upvar $optionsT options
	# first we build an option table
	#
	if {[catch [list set option_table [${cmd} configure]] msg]} {
	if {[catch [list set option_table [eval ${cmd}]] msg]} {
		return 0
	}
	foreach optline ${option_table} {
		if {5 != [llength ${optline}]} continue else {
			lappend options(switches) [lindex ${optline} 0]
			lappend options(value)    [lindex ${optline} 4]
		}
	}
	return [llength ${option_table}]
}

#**
# try to complete a `cmd configure|cget ..' from the command's options.
# @param text start line cmd, standard tclreadlineCompleter arguments.
# @return a tclreadline completer formatted string.
# @date Sep-14-1999
#
proc CompleteFromOptions {text start line cmd} {
proc CompleteFromOptions {text start line} {

	# check if either `configure' or `cget' is present.
	#
	set prev [PreviousWord ${start} ${line}]

	set lst [ProperList ${line}]
	foreach keyword {configure cget} {
		set idx [lsearch ${lst} ${keyword}]
		if {-1 != ${idx}} {
			break
		}
	}
	if {-1 == ${idx}} {
		return
	}
	set cmd [lrange ${lst} 0 ${idx}]
	# puts stderr cmd=|$cmd|
	if {0 < [OptionTable ${cmd} options]} {

		set prev [PreviousWord ${start} ${line}]
		if {-1 != [set found [lsearch -exact $options(switches) ${prev}]]} {

			# complete only if the user has not
			# already entered something here.
			#
			if {![llength ${text}]} {
				# use this double list to quote option
				# values which have to be quoted.
				#
				return [list [list [lindex $options(value) ${found}]]]
			}

		} else {
			return [CompleteFromList ${text} \
			[RemoveUsedOptions $line $options(switches)]]
			[RemoveUsedOptions ${line} $options(switches)]]
		}
	}
	return ""
}

proc complete(WIDGET) {text start end line pos mod} {
proc CompleteFromOptionsOrSubCmds {text start end line pos} {
	set widget [Lindex ${line} 0]
	set cmd [Lindex ${line} 1]
	switch -- $pos {
		1 {
			set cmds [TrySubCmds ${widget}]
			if {[llength ${cmds}]} {
				return [TryFromList ${mod} ${cmds}]
			}
		}
	set from_opts [CompleteFromOptions ${text} ${start} ${line}]
	if {[string length ${from_opts}]} {
		return ${from_opts}
	} else {
		set cmds [TrySubCmds [lrange [ProperList ${line}] 0 [expr $pos - 1]]]
		# puts stderr cmds=|$cmds|
		if {[llength ${cmds}]} {
			return [TryFromList ${text} ${cmds}]
		}
	}
		default {
			if {([string match ${cmd}* cget] || \
				[string match ${cmd}* configure])
			} {
				return [CompleteFromOptions ${text} ${start} ${line} ${widget}]
			}
		}
	}
	return ""
	return ""
}

proc complete(WIDGET) {text start end line pos mod} {
	# set widget [Lindex ${line} 0]
	# set cmds [TrySubCmds ${widget}]
	# if {[llength ${cmds}]} {
	# 	return [TryFromList ${mod} ${cmds}]
	# }
	return [CompleteFromOptionsOrSubCmds ${text} ${start} ${end} ${line} ${pos}]
}

# SPECIFIC TK COMMAND COMPLETERS

proc complete(bell) {text start end line pos mod} {
	switch -- $pos {
	switch -- ${pos} {
		1 { return [CompleteFromList ${text} -displayof] }
		2 {
			if {"-displayof" == [PreviousWord ${start} ${line}]} {
				return [CompleteFromList ${text} [ToplevelWindows]]
			}
		}
	}
}

#**
# TODO: shit. make this better!
# @param text, a std completer argument (current word).
# @param fullpart, the full text of the current position.
# @param lst, the list to complete from.
# @param pre, leading `quote'.
# @param sep, word separator.
# @param post, trailing `quote'.
# @return a formatted completer string.
# @date Sep-15-1999
#
proc CompleteListFromList {text fullpart lst pre sep post} {

	# puts stderr ""
	# puts stderr text=|$text|
	# puts stderr lst=|$lst|
	# puts stderr pre=|$pre|
	# puts stderr sep=|$sep|
	# puts stderr post=|$post|

	if {![string length ${fullpart}]} {

		# nothing typed so far. Insert a $pre
		# and inhibit further completion.
		#
		return [list ${pre} {}]

	} elseif {[regexp ${post} ${text}]} {

		# finalize
		#
		set diff \
		[expr [CountChar ${fullpart} ${pre}] - [CountChar ${fullpart} ${post}]]
		for {set i 0} {${i} < ${diff}} {incr i} {
			append text ${post}
		}
		append text " "
		return ${text}

	} elseif {![regexp -- ^\(.*\[${pre}${sep}\]\)\(\[^${pre}${sep}\]*\)$ \
		${text} all left right]
	} {
		set left {}
		set right ${text}
	}

	# puts stderr \nleft=|$left|
	# puts stderr \nright=|$right|
	set exact_matches [MatchesFromList ${right} ${lst}]
	# TODO this is awkward. Think of making it better!
	#
	if {1 == [llength ${exact_matches}] && -1 != [lsearch ${lst} ${right}]
	} {
		#set completion [CompleteFromList ${right} [list ${sep} ${post}] 1]
		return [list ${left}${right}${sep} {}]
	} else {
		set completion [CompleteFromList ${right} ${lst} 1]
	}
	# puts stderr \ncompletion=|$completion|
	if {![string length [lindex $completion 0]]} {
		return [concat [list ${left}] [lrange $completion 1 end]]
	} elseif {[string length ${left}]} {
		return [list ${left}]${completion}
	} else {
		return ${completion}
	}
	return ""
}

proc complete(bind) {text start end line pos mod} {
	switch -- $pos {
		1 {
			set widgets [WidgetChildren ${text}]
			set toplevels [ToplevelWindows]
			if {[catch {set toplevelClass [winfo class .]}]} {
				set toplevelClass ""
			}
			set rest {
				Button Canvas Checkbutton Entry Frame Label
				Listbox Menu Menubutton Message Radiobutton
				Scale Scrollbar Text
				all
			}
			return [CompleteFromList ${text} \
			[concat $toplevels $widgets $toplevelClass $rest]]
		}
		2 {
			if {![string length ${text}]} {
				# insert a < and inhibit further completion
				return [list < {}]
			} elseif {[regexp > ${text}]} {
				set diff [expr [CountChar ${text} <] - [CountChar ${text} >]]
				for {set i 0} {$i < $diff} {incr i} {
					append text >
				}
				append text " "
				return ${text}
			} else {
				regexp -- {^(.*[<-])([^<-]*)} ${text} all left right
			}
			set modifiers {
				Alt Control Shift Lock Double Triple
				B1 B2 B3 B4 B5 Button1 Button2 Button3 Button4 Button5
				M M1 M2 M3 M4 M5        
				Meta Mod1 Mod2 Mod3 Mod4 Mod5
			}
			set events {
				Activate Button ButtonPress ButtonRelease
				Circulate Colormap Configure Deactivate Destroy
				Enter Expose FocusIn FocusOut Gravity
				Key KeyPress KeyRelease Leave Map Motion
				MouseWheel Property Reparent Unmap Visibility
			}
			set sequence [concat $modifiers $events]
			set exact_matches [MatchesFromList ${right} ${sequence}]
			return [CompleteListFromList ${text} \
			# TODO this is awkward. Think of making it better!
			#
			if {1 == [llength ${exact_matches}] && \
				-1 != [lsearch ${sequence} ${right}]
			} {
			[Lindex $line 2] ${sequence} < - >]
		}
		3 {
				set completion [CompleteFromList ${right} {> -} 1]
			} else {
				set completion [CompleteFromList ${right} $sequence 1]
			}
			# return [DisplayHints {<script> <+script>}]
			return [BraceOrCommand $text $start $end $line $pos $mod]
		}
			if {![string length [lindex $completion 0]]} {
				return [concat ${left} [lrange $completion 1 end]]
			} else {
				return ${left}${completion}
			}
		}
		3 {
			# return [DisplayHints {<script> <+script>}]
			return [BraceOrControlStatement $text $start $end $line $pos $mod]
	}
	return ""
}

proc complete(bindtags) {text start end line pos mod} {
	switch -- $pos {
		1 { return [CompleteFromList ${text} [WidgetChildren ${text}]] }
		2 {
			return [CompleteListFromList ${text} [Lindex $line 2] \
			[bindtags [Lindex $line 1]] \{ { } \}]
		}
	}
	return ""
}

proc complete(image) {text start end line pos mod} {
	set sub [Lindex $line 1]

#!/usr/local/bin/tclsh
# FILE: "/diska/home/joze/src/tclreadline/tclreadlineInit.tcl.in"
# LAST MODIFICATION: "Wed Sep  8 18:09:57 1999 (joze)"
# FILE: "/disk01/home/joze/src/tclreadline/tclreadlineInit.tcl.in"
# LAST MODIFICATION: "Wed Sep 15 15:23:16 1999 (joze)"
# (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
# Copyright (C) 1999  Johannes Zellner
#

# http://www.zellner.org/tclreadline/
#
# ================================================================== 

package provide tclreadline @TCLREADLINE_VERSION@

namespace eval tclreadline:: {
    namespace export Init
	namespace export Init
}

proc ::tclreadline::Init {} {
    
    if [catch {load @TCLREADLINE_LIBRARY@/@TCLREADLINE_LIB_FILE@} msg] {
        puts stderr $msg
        exit 2
    }
	
	if [catch {load @TCLREADLINE_LIBRARY@/@TCLREADLINE_LIB_FILE@} msg] {
		puts stderr $msg
		exit 2
	}
}

tclreadline::Init
::tclreadline::readline customcompleter ::tclreadline::ScriptCompleter

source [file join [file dirname [info script]] tclreadlineSetup.tcl]

set auto_index(::tclreadline::ScriptCompleter) \
[list source [file join [file dirname [info script]] tclreadlineCompleter.tcl]]

#!/usr/locanl/bin/tclsh
# FILE: "/home/joze/src/tclreadline/tclreadlineSetup.tcl.in"
# LAST MODIFICATION: "Mon Sep 13 23:44:55 1999 (joze)"
# FILE: "/disk01/home/joze/src/tclreadline/tclreadlineSetup.tcl.in"
# LAST MODIFICATION: "Wed Sep 15 15:23:30 1999 (joze)"
# (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
# Copyright (C) 1999  Johannes Zellner
#

# package provide tclreadline @TCLREADLINE_VERSION@
package provide tclreadline 0.9

proc unknown args {

    global auto_noexec auto_noload env unknown_pending tcl_interactive
    global errorCode errorInfo
	global auto_noexec auto_noload env unknown_pending tcl_interactive
	global errorCode errorInfo

    # Save the values of errorCode and errorInfo variables, since they
    # may get modified if caught errors occur below.  The variables will
    # be restored just before re-executing the missing command.
	# Save the values of errorCode and errorInfo variables, since they
	# may get modified if caught errors occur below.  The variables will
	# be restored just before re-executing the missing command.

    set savedErrorCode $errorCode
    set savedErrorInfo $errorInfo
    set name [lindex $args 0]
    if ![info exists auto_noload] {
        #
        # Make sure we're not trying to load the same proc twice.
        #
        if [info exists unknown_pending($name)] {
            return -code error "self-referential recursion in \"unknown\" for command \"$name\""
        }
        set unknown_pending($name) pending
        set ret [catch {auto_load $name [uplevel 1 {namespace current}]} msg]
        unset unknown_pending($name)
        if {$ret != 0} {
            return -code $ret -errorcode $errorCode \
                "error while autoloading \"$name\": $msg"
        }
        if ![array size unknown_pending] {
            unset unknown_pending
        }
        if $msg {
            set errorCode $savedErrorCode
            set errorInfo $savedErrorInfo
            set code [catch {uplevel 1 $args} msg]
            if {$code ==  1} {
                #
                # Strip the last five lines off the error stack (they're
                # from the "uplevel" command).
                #
	set savedErrorCode $errorCode
	set savedErrorInfo $errorInfo
	set name [lindex $args 0]
	if ![info exists auto_noload] {
		#
		# Make sure we're not trying to load the same proc twice.
		#
		if [info exists unknown_pending($name)] {
			return -code error "self-referential recursion in \"unknown\" for command \"$name\""
		}
		set unknown_pending($name) pending
		set ret [catch {auto_load $name [uplevel 1 {namespace current}]} msg]
		unset unknown_pending($name)
		if {$ret != 0} {
			return -code $ret -errorcode $errorCode \
				"error while autoloading \"$name\": $msg"
		}
		if ![array size unknown_pending] {
			unset unknown_pending
		}
		if $msg {
			set errorCode $savedErrorCode
			set errorInfo $savedErrorInfo
			set code [catch {uplevel 1 $args} msg]
			if {$code ==  1} {
				#
				# Strip the last five lines off the error stack (they're
				# from the "uplevel" command).
				#

                set new [split $errorInfo \n]
                set new [join [lrange $new 0 [expr [llength $new] - 6]] \n]
                return -code error -errorcode $errorCode \
                        -errorinfo $new $msg
            } else {
                return -code $code $msg
            }
        }
    }
				set new [split $errorInfo \n]
				set new [join [lrange $new 0 [expr [llength $new] - 6]] \n]
				return -code error -errorcode $errorCode \
						-errorinfo $new $msg
			} else {
				return -code $code $msg
			}
		}
	}

    # REMOVED THE [info script] TEST (joze, SEP 98)
    if {([info level] == 1) \
            && [info exists tcl_interactive] && $tcl_interactive} {
        if ![info exists auto_noexec] {
            set new [auto_execok $name]
            if {$new != ""} {
                set errorCode $savedErrorCode
                set errorInfo $savedErrorInfo
                set redir ""
                if {[info commands console] == ""} {
                    set redir ">&@stdout <@stdin"
                }
                # LOOK FOR GLOB STUFF IN $ARGS (joze, SEP 98)
                return [uplevel eval exec $redir $new \
                    [::tclreadline::Glob [lrange $args 1 end]]]
            }
        }
        set errorCode $savedErrorCode
        set errorInfo $savedErrorInfo
        if {$name == "!!"} {
            set newcmd [history event]
        } elseif {[regexp {^!(.+)$} $name dummy event]} {
            set newcmd [history event $event]
        } elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name dummy old new]} {
            set newcmd [history event -1]
            catch {regsub -all -- $old $newcmd $new newcmd}
        }
        if [info exists newcmd] {
            tclLog $newcmd
            history change $newcmd 0
            return [uplevel $newcmd]
        }
	# REMOVED THE [info script] TEST (joze, SEP 98)
	if {([info level] == 1) \
			&& [info exists tcl_interactive] && $tcl_interactive} {
		if ![info exists auto_noexec] {
			set new [auto_execok $name]
			if {$new != ""} {
				set errorCode $savedErrorCode
				set errorInfo $savedErrorInfo
				set redir ""
				if {[info commands console] == ""} {
					set redir ">&@stdout <@stdin"
				}
				# LOOK FOR GLOB STUFF IN $ARGS (joze, SEP 98)
				return [uplevel eval exec $redir $new \
					[::tclreadline::Glob [lrange $args 1 end]]]
			}
		}
		set errorCode $savedErrorCode
		set errorInfo $savedErrorInfo
		if {$name == "!!"} {
			set newcmd [history event]
		} elseif {[regexp {^!(.+)$} $name dummy event]} {
			set newcmd [history event $event]
		} elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name dummy old new]} {
			set newcmd [history event -1]
			catch {regsub -all -- $old $newcmd $new newcmd}
		}
		if [info exists newcmd] {
			tclLog $newcmd
			history change $newcmd 0
			return [uplevel $newcmd]
		}

        set ret [catch {set cmds [info commands $name*]} msg]
        if {[string compare $name "::"] == 0} {
            set name ""
        }
        if {$ret != 0} {
            return -code $ret -errorcode $errorCode \
                "error in unknown while checking if \"$name\" is a unique command abbreviation: $msg"
        }
        if {[llength $cmds] == 1} {
            return [uplevel [lreplace $args 0 0 $cmds]]
        }
        if {[llength $cmds] != 0} {
            if {$name == ""} {
                return -code error "empty command name \"\""
            } else {
                return -code error \
                        "ambiguous command name \"$name\": [lsort $cmds]"
            }
        }
    }
    return -code error "invalid command name \"$name\""
		set ret [catch {set cmds [info commands $name*]} msg]
		if {[string compare $name "::"] == 0} {
			set name ""
		}
		if {$ret != 0} {
			return -code $ret -errorcode $errorCode \
				"error in unknown while checking if \"$name\" is a unique command abbreviation: $msg"
		}
		if {[llength $cmds] == 1} {
			return [uplevel [lreplace $args 0 0 $cmds]]
		}
		if {[llength $cmds] != 0} {
			if {$name == ""} {
				return -code error "empty command name \"\""
			} else {
				return -code error \
						"ambiguous command name \"$name\": [lsort $cmds]"
			}
		}
	}
	return -code error "invalid command name \"$name\""
}

namespace eval tclreadline {

namespace export Setup Glob Loop InitTclCmds InitTkCmds Print ls

proc ls {args} {
    if {[exec uname -s] == "Linux"} {
        eval exec ls --color -FC [Glob $args]
    } else {
        eval exec ls -FC [Glob $args]
    }
	if {[exec uname -s] == "Linux"} {
		eval exec ls --color -FC [Glob $args]
	} else {
		eval exec ls -FC [Glob $args]
	}
}

proc Setup {args} {

    uplevel #0 {
	uplevel #0 {

        if {"" == [info commands ::tclreadline::readline]} {
            ::tclreadline::Init
        }
		if {"" == [info commands ::tclreadline::readline]} {
			::tclreadline::Init
		}

        if {[catch {set a [::tclreadline::prompt1]}] \
            && [info nameofexecutable] != ""} {
		if {[catch {set a [::tclreadline::prompt1]}] \
			&& [info nameofexecutable] != ""} {

            namespace eval ::tclreadline {
                variable prompt_string
                set base [file tail [info nameofexecutable]]
			namespace eval ::tclreadline {
				variable prompt_string
				set base [file tail [info nameofexecutable]]

                if {[string match tclsh* $base] && [info exists tcl_version]} {
                    set prompt_string \
                        "
\[0;91mtclsh$tcl_version
\[0m"
                } elseif {[string match wish* $base] \
                    && [info exists tk_version]} {
                    set prompt_string "
\[0;94mwish$tk_version
\[0m"
                } else {
                    set prompt_string "
\[0;91m$base
\[0m"
                }
				if {[string match tclsh* $base] && [info exists tcl_version]} {
					set prompt_string \
						"
\[0;91mtclsh$tcl_version
\[0m"
				} elseif {[string match wish* $base] \
					&& [info exists tk_version]} {
					set prompt_string "
\[0;94mwish$tk_version
\[0m"
				} else {
					set prompt_string "
\[0;91m$base
\[0m"
				}

            }
			}

            if {"" == [info procs ::tclreadline::prompt1]} {
                proc ::tclreadline::prompt1 {} {
                    variable prompt_string
                    global env
                    if {[catch {set pwd [pwd]} tmp]} {
                        set pwd "unable to get pwd"
                    }
			if {"" == [info procs ::tclreadline::prompt1]} {
				proc ::tclreadline::prompt1 {} {
					variable prompt_string
					global env
					if {[catch {set pwd [pwd]} tmp]} {
						set pwd "unable to get pwd"
					}

                    if [info exists env(HOME)] {
                        regsub $env(HOME) $pwd "~" pwd
                    }
                    return "$prompt_string \[$pwd\]"
                }
            }
            # puts body=[info body ::tclreadline::prompt1]
        }
					if [info exists env(HOME)] {
						regsub $env(HOME) $pwd "~" pwd
					}
					return "$prompt_string \[$pwd\]"
				}
			}
			# puts body=[info body ::tclreadline::prompt1]
		}

        if {"" == [info procs exit]} {
		if {"" == [info procs exit]} {

            catch {rename ::tclreadline::Exit ""}
            rename exit ::tclreadline::Exit
			catch {rename ::tclreadline::Exit ""}
			rename exit ::tclreadline::Exit

            proc exit {args} {
			proc exit {args} {

                if {[catch {
                    ::tclreadline::readline write \
                    [::tclreadline::HistoryFileGet]
                } ::tclreadline::errorMsg]} {
                    puts stderr $::tclreadline::errorMsg
                }
				if {[catch {
					::tclreadline::readline write \
					[::tclreadline::HistoryFileGet]
				} ::tclreadline::errorMsg]} {
					puts stderr $::tclreadline::errorMsg
				}

                if [catch "eval ::tclreadline::Exit $args" message] {
                    puts stderr "error:"
                    puts stderr "$message"
                }
                # NOTREACHED
            }
        }
				if [catch "eval ::tclreadline::Exit $args" message] {
					puts stderr "error:"
					puts stderr "$message"
				}
				# NOTREACHED
			}
		}

    }
	}

    global env
    variable historyfile
	global env
	variable historyfile

    if {[string trim [llength ${args}]]} {
        set historyfile ""
        catch {
            set historyfile [file nativename [lindex ${args} 0]]
        }
        if {"" == [string trim $historyfile]} {
            set historyfile [lindex ${args} 0]
        }
    } else {
        if [info exists env(HOME)] {
            set historyfile  $env(HOME)/.tclsh-history
        } else {
            set historyfile  .tclsh-history
        }
    }
    set ::tclreadline::errorMsg [readline initialize $historyfile]
    if {$::tclreadline::errorMsg != ""} {
        puts stderr $::tclreadline::errorMsg
    }
	if {[string trim [llength ${args}]]} {
		set historyfile ""
		catch {
			set historyfile [file nativename [lindex ${args} 0]]
		}
		if {"" == [string trim $historyfile]} {
			set historyfile [lindex ${args} 0]
		}
	} else {
		if [info exists env(HOME)] {
			set historyfile  $env(HOME)/.tclsh-history
		} else {
			set historyfile  .tclsh-history
		}
	}
	set ::tclreadline::errorMsg [readline initialize $historyfile]
	if {$::tclreadline::errorMsg != ""} {
		puts stderr $::tclreadline::errorMsg
	}

    # InitCmds
	# InitCmds

    rename Setup ""
	rename Setup ""
}

proc HistoryFileGet {} {
    variable historyfile
    return $historyfile
	variable historyfile
	return $historyfile
}

proc Glob {string} {

    set commandstring ""
    foreach name $string {
        set replace [glob -nocomplain -- $name]
        if {$replace == ""} {
            lappend commandstring $name
        } else {
            lappend commandstring $replace
        }
    }
    # return $commandstring
    # Christian Krone <krischan@sql.de> proposed
    return [eval concat $commandstring]
	set commandstring ""
	foreach name $string {
		set replace [glob -nocomplain -- $name]
		if {$replace == ""} {
			lappend commandstring $name
		} else {
			lappend commandstring $replace
		}
	}
	# return $commandstring
	# Christian Krone <krischan@sql.de> proposed
	return [eval concat $commandstring]
}



proc Loop {args} {

    eval Setup ${args}
	eval Setup ${args}

    uplevel #0 {
	uplevel #0 {

        while {1} {
		while {1} {

            if [info exists tcl_prompt2] {
                set prompt2 $tcl_prompt2
            } else {
                set prompt2 ">"
            }
			if [info exists tcl_prompt2] {
				set prompt2 $tcl_prompt2
			} else {
				set prompt2 ">"
			}

            if {[catch {
                if {"" != [namespace eval ::tclreadline {info procs prompt1}]} {
                    set LINE [::tclreadline::readline read \
                    [::tclreadline::prompt1]]
                } else {
                    set LINE [::tclreadline::readline read %]
                }
                while {![::tclreadline::readline complete $LINE]} {
                    append LINE "\n"
                    append LINE [tclreadline::readline read ${prompt2}]
                }
            } ::tclreadline::errorMsg]} {
                puts stderr [list tclreadline::Loop: error. \
                $::tclreadline::errorMsg]
                continue
            }
			if {[catch {
				if {"" != [namespace eval ::tclreadline {info procs prompt1}]} {
					set LINE [::tclreadline::readline read \
					[::tclreadline::prompt1]]
				} else {
					set LINE [::tclreadline::readline read %]
				}
				while {![::tclreadline::readline complete $LINE]} {
					append LINE "\n"
					append LINE [tclreadline::readline read ${prompt2}]
				}
			} ::tclreadline::errorMsg]} {
				puts stderr [list tclreadline::Loop: error. \
				$::tclreadline::errorMsg]
				continue
			}

            # Magnus Eriksson <magnus.eriksson@netinsight.se> proposed
            # to add the line also to tclsh's history.
            #
            # I decided to add only lines which are different from
            # the previous one to the history. This is different
            # from tcsh's behaviour, but I found it quite convenient
            # while using mshell on os9.
            #
            if {[string length $LINE] && [history event 0] != $LINE} {
                history add $LINE
            }
			# Magnus Eriksson <magnus.eriksson@netinsight.se> proposed
			# to add the line also to tclsh's history.
			#
			# I decided to add only lines which are different from
			# the previous one to the history. This is different
			# from tcsh's behaviour, but I found it quite convenient
			# while using mshell on os9.
			#
			if {[string length $LINE] && [history event 0] != $LINE} {
				history add $LINE
			}

            if [catch {
                set result [eval $LINE]
                if {$result != "" && [tclreadline::Print]} {
                    puts $result
                }
                set result ""
            } ::tclreadline::errorMsg] {
                puts stderr $::tclreadline::errorMsg
                puts stderr [list while evaluating $LINE]
            }
			if [catch {
				set result [eval $LINE]
				if {$result != "" && [tclreadline::Print]} {
					puts $result
				}
				set result ""
			} ::tclreadline::errorMsg] {
				puts stderr $::tclreadline::errorMsg
				puts stderr [list while evaluating $LINE]
			}

        }
    }
		}
	}
}

proc Print {args} {
    variable PRINT
    if ![info exists PRINT] {
        set PRINT yes
    }
    if [regexp -nocase \(true\|yes\|1\) $args] {
        set PRINT yes
    } elseif [regexp -nocase \(false\|no\|0\) $args] {
        set PRINT no
    }
    return $PRINT
	variable PRINT
	if ![info exists PRINT] {
		set PRINT yes
	}
	if [regexp -nocase \(true\|yes\|1\) $args] {
		set PRINT yes
	} elseif [regexp -nocase \(false\|no\|0\) $args] {
		set PRINT no
	}
	return $PRINT
}
# 
# 
# proc InitCmds {} {
#     # XXX
#     return 
#     # XXX