# FILE: "/home/joze/src/tclreadline/tclreadlineSetup.tcl.in"
# FILE: tclreadlineSetup.tcl.in
# LAST MODIFICATION: "Mit, 10 Jan 2001 06:29:34 +0100 (joze)"
# (C) 1998 - 2001 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# ---
# tclreadline -- gnu readline for tcl
# http://www.zellner.org/tclreadline/
# Copyright (c) 1998 - 2001, Johannes Zellner <johannes@zellner.org>
# Copyright (c) 1998 - 2014, Johannes Zellner <johannes@zellner.org>
# This software is copyright under the BSD license.
# ---


package provide tclreadline @VERSION@

proc unknown args {

    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.

    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).
		#
    #
    # 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]
	}
    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]"
	    }
	}
    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 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 {

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

	if {"" == [info procs ::tclreadline::prompt1] && [info nameofexecutable] != ""} {
    if {"" == [info procs ::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;31mtclsh$tcl_version
\[0m"
		} elseif {[string match wish* $base] \
		    && [info exists tk_version]} {
			set prompt_string "
\[0;34mwish$tk_version
\[0m"
		    } else {
			set prompt_string "
\[0;31m$base
\[0m"
		    }
        if {[string match tclsh* $base] && [info exists tcl_version]} {
            set prompt_string \
            "
\[0;31mtclsh$tcl_version
\[0m"
        } elseif {[string match wish* $base] \
            && [info exists tk_version]} {
            set prompt_string "
\[0;34mwish$tk_version
\[0m"
            } else {
            set prompt_string "
\[0;31m$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 ::tclreadline::prompt2] && [info nameofexecutable] != ""} {
    if {"" == [info procs ::tclreadline::prompt2] && [info nameofexecutable] != ""} {

	    if {"" == [info procs ::tclreadline::prompt2]} {
		proc ::tclreadline::prompt2 {} {
		    return ">"
		}
	    }
	    # puts body=[info body ::tclreadline::prompt2]
	}
        if {"" == [info procs ::tclreadline::prompt2]} {
        proc ::tclreadline::prompt2 {} {
            return ">"
        }
        }
        # puts body=[info body ::tclreadline::prompt2]
    }

	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
        }

		# this call is ignored, if tclreadline.c
		# was compiled with CLEANUP_AFER_SIGNAL
		# not defined. This is the case for
		# older versions of libreadline.
		#
		::tclreadline::readline reset-terminal
        # this call is ignored, if tclreadline.c
        # was compiled with CLEANUP_AFER_SIGNAL
        # not defined. This is the case for
        # older versions of libreadline.
        #
        ::tclreadline::readline reset-terminal

		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

    if {[string trim [llength ${args}]]} {
	set historyfile ""
	catch {
	    set historyfile [file nativename [lindex ${args} 0]]
	}
	if {"" == [string trim $historyfile]} {
	    set historyfile [lindex ${args} 0]
	}
    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
	}
    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
    puts stderr $::tclreadline::errorMsg
    }

    # InitCmds

    rename Setup ""
}

proc HistoryFileGet {} {
    variable historyfile
    return $historyfile
}

# obsolete
#
proc Glob {string} {

    set commandstring ""
    foreach name $string {
	set replace [glob -nocomplain -- $name]
	if {$replace == ""} {
	    lappend commandstring $name
	} else {
	    lappend commandstring $replace
	}
    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}

    uplevel #0 {

	while {1} {
    while {1} {

	    if {[catch {
		if {"" != [namespace eval ::tclreadline {info procs prompt1}]} {
		    set ::tclreadline::LINE [::tclreadline::readline read \
		    [::tclreadline::prompt1]]
		} else {
		    set ::tclreadline::LINE [::tclreadline::readline read %]
		}
		while {![::tclreadline::readline complete $::tclreadline::LINE]} {
		    append ::tclreadline::LINE "\n"
		    if {"" != [namespace eval ::tclreadline {info procs prompt2}]} {
			append ::tclreadline::LINE \
			    [tclreadline::readline read [::tclreadline::prompt2]]
		    } else {
			append ::tclreadline::LINE [tclreadline::readline read >]
		    }
		}
	    } ::tclreadline::errorMsg]} {
		puts stderr [list tclreadline::Loop: error. \
		$::tclreadline::errorMsg]
		continue
	    }
        if {[catch {
        if {"" != [namespace eval ::tclreadline {info procs prompt1}]} {
            set ::tclreadline::LINE [::tclreadline::readline read \
            [::tclreadline::prompt1]]
        } else {
            set ::tclreadline::LINE [::tclreadline::readline read %]
        }
        while {![::tclreadline::readline complete $::tclreadline::LINE]} {
            append ::tclreadline::LINE "\n"
            if {"" != [namespace eval ::tclreadline {info procs prompt2}]} {
            append ::tclreadline::LINE \
                [tclreadline::readline read [::tclreadline::prompt2]]
            } else {
            append ::tclreadline::LINE [tclreadline::readline read >]
            }
        }
        } ::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 $::tclreadline::LINE] && \
		    [history event 0] != $::tclreadline::LINE} {
		history add $::tclreadline::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 $::tclreadline::LINE] && \
            [history event 0] != $::tclreadline::LINE} {
        history add $::tclreadline::LINE
        }

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

	}
    }
    }
}

proc Print {args} {
    variable PRINT
    if ![info exists PRINT] {
	set PRINT yes
    set PRINT yes
    }
    if [regexp -nocase \(true\|yes\|1\) $args] {
	set PRINT yes
    set PRINT yes
    } elseif [regexp -nocase \(false\|no\|0\) $args] {
	set PRINT no
    set PRINT no
    }
    return $PRINT
}
# 
# 
#
#
# proc InitCmds {} {
#     # XXX
#     return 
#     return
#     # XXX
#     global tcl_version tk_version
#     if {[info exists tcl_version]} {
#         InitTclCmds
#     }
#     if {[info exists tk_version]} {
#         InitTkCmds
#     }
#     rename InitCmds ""
# }
# 
#
# proc InitTclCmds {} {
#     variable known_cmds
#     foreach line {
#         "after option ?arg arg ...?"
#         "append varName ?value value ...?"
#         "array option arrayName ?arg ...?"
#         "bgerror"

#         "while test command"
#     } {
#         readline add $line
#         set known_cmds([lindex $line 0]) ${line}
#     }
#     rename InitTclCmds ""
# }
# 
#
# proc InitTkCmds {} {
#     variable known_cmds
#     foreach line {
#         "bind window ?pattern? ?command?"
#         "bindtags window ?tags?"
#         "button pathName ?options?"
#         "canvas pathName ?options?"

#         "wm option window ?arg ...?"
#     } {
#         readline add $line
#         set known_cmds([lindex $line 0]) ${line}
#     }
#     rename InitTkCmds ""
# }
# 
#


}; # namespace tclreadline