#!/usr/local/bin/tclsh
# FILE: "/home/joze/src/tclreadline/tclreadlineSetup.tcl.in"
# LAST MODIFICATION: "Tue Aug 24 03:04:10 1999 (joze)"
# (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
# Copyright (C) 1999  Johannes Zellner
#

}

# get the longest common completion
# e.g. str == {tcl_version tclreadline_version tclreadline_library}
# --> [tclreadline::GetCommon ${str}] == "tcl"
#
proc tclreadline::GetCommon {str} {
    # puts stderr str=$str
    set match0 [lindex ${str} 0]
    set len0 [string length $match0]
    set no_matches [llength ${str}]
    set part ""
    for {set i 0} {$i < $len0} {incr i} {
        set char [string index $match0 $i]
        for {set j 1} {$j < $no_matches} {incr j} {
            if {$char != [string index [lindex ${str} $j] $i]} {
                break
            }
        }
        if {$j < $no_matches} {
            break
        } else {
            append part $char
        }
    }
    # puts stderr part=$part
    return ${part}
}

proc tclreadline::SubCmd {start line} {
    set depth 0
    for {set i $start} {$i > 0} {incr i -1} {
        set c [string index $line $i]
        if {{;} == $c} {
            incr i; # discard command break character
            return [list [expr $start - $i] [string range $line $i end]]
        } elseif {{]} == $c} {
            incr depth
        } elseif {{[} == $c} {
            incr depth -1
            if {$depth < 0} {
                incr i; # discard command break character
                return [list [expr $start - $i] [string range $line $i end]]
            }
        }
    }
    return ""
}

# % p<TAB>
# % bla put<TAB> $b
# % put<TAB> $b
# part  == put
# start == 0
# end   == 3
# line  == "put $b"
# [PartPosition] should return 0
#
proc tclreadline::PartPosition {part start end line} {
    incr start -1
    # puts stderr "(tclreadline::PartPosition) line=|$line|" 
    # puts stderr "(tclreadline::PartPosition) start=$start"
    set line [string range $line 0 $start]
    regsub -all -- \" $line {\"} line
    # puts stderr "(tclreadline::PartPosition) line=|$line|" 
    set result [llength $line]
    # puts stderr $result
    return $result
}

# if the line entered so far is
# % puts $b<TAB>
# part  == $b
# start == 5
# end   == 7
# line  == "$puts $b"
#
proc tclreadline::ScriptCompleter {part start end line} {
    # puts stderr "(ScriptCompleter) |$part| $start $end |$line|"
    variable known_cmds
    if {{$} == [string index $part 0]} {
        # variable completion. Check first, if the
        # variable starts with a plain `$' or should
        # be enclosed in braces.
        #
        if {"\{" == [string index $part 1]} {
            set var [string range $part 2 end]

                return [join [list $left $matches $right] ""]
            }
        } elseif {"" != $matches} { ; # more than one matches
            return "${left}[tclreadline::GetCommon ${matches}] ${matches}"
        } else {
            return ""; # nothing to complete
        }
    # SCENARIO:
    #
    # % puts bla; put<TAB> $b
    # part  == put
    # start == 10
    # end   == 13
    # line  == "puts bla; put $b"
    # [SubCmd] --> {1 " put $b"} == sub
    # new_start = [lindex $sub 0] == 1
    # new_end   = [expr $end - ($start - $new_start)] == 4
    # new_part  == $part == put
    # new_line  = [lindex $sub 1] == " put $b"
    # 
    } elseif {"" != [set sub [tclreadline::SubCmd $start $line]]} {
        set new_start [lindex $sub 0]
        set new_end [expr $end - ($start - $new_start)]
        set new_line [lindex $sub 1]
        # puts stderr "(SubCmd) $new_start $new_end $new_line"
        return \
            [tclreadline::ScriptCompleter $part $new_start $new_end $new_line]
    } elseif {0 == [set pos [tclreadline::PartPosition $part $start $end $line]]} {
        # puts stderr "(PartPosition) $part $start $end $line"
        set matches [array names known_cmds "[string trim ${part}]*"]
        # puts matches=|$matches|
        if {1 == [llength $matches]} { ; # unique match
            return $matches
        } elseif {"" != $matches} {
            set common [tclreadline::GetCommon ${matches}]
            # puts stderr common=|$common|
            if {"" == $common} {
                return "[list $part] ${matches}"
            } else {
                return "$common ${matches}"
            }
        } else {
            return ""; # nothing to complete
        }
    } else {
        # try to use $pos further ...
        regsub -all -- \" $line {\"} thisline
        set cmd [lindex $thisline 0]
        if {"" != [array names known_cmds $cmd]} {
            set current [lindex $known_cmds($cmd) $pos]
            if {"" != $current && "" == [string trim $part]} {
                return $current
            } else {
                return ""
            }
        } else {
            return ""
        }
    }
    return "{NOTREACHED (this is probably an error)}"
}

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

    if {[info exists tk_version]} {
        ::tclreadline::InitTkCmds
    }
    rename tclreadline::InitCmds ""
}

proc ::tclreadline::InitTclCmds {} {
    variable known_cmds
    foreach line {
        "after option ?arg arg ...?"
        "append varName ?value value ...?"
        "array option arrayName ?arg ...?"
        "binary option ?arg arg ...?"
        "catch command ?varName?"
        "clock option ?arg ...?"
        "close channelId"
        "eof channelId"
        "error message ?errorInfo? ?errorCode?"
        "eval arg ?arg ...?"
        "exec ?switches? arg ?arg ...?"
        "expr arg ?arg ...?"
        "fblocked channelId"
        "fconfigure channelId ?optionName? ?value? ?optionName value?..."
        "fcopy input output ?-size size? ?-command callback?"
        "file option ?arg ...?"
        "fileevent channelId event ?script?"
        "flush channelId"
        "for start test next command"
        "foreach varList list ?varList list ...? command"
        "format formatString ?arg arg ...?"
        "gets channelId ?varName?"
        "glob ?switches? name ?name ...?"
        "global varName ?varName ...?"
        "incr varName ?increment?"
        "info option ?arg arg ...?"
        "interp cmd ?arg ...?"
        "join list ?joinString?"
        "lappend varName ?value value ...?"
        "lindex list index"
        "linsert list index element ?element ...?"
        "llength list"
        "load fileName ?packageName? ?interp?"
        "lrange list first last"
        "lreplace list first last ?element element ...?"
        "lsearch ?mode? list pattern"
        "lsort ?options? list"
        "namespace subcommand ?arg ...?"
        "open fileName ?access? ?permissions?"
        "package option ?arg arg ...?"
        "proc name args body"
        "puts ?-nonewline? ?channelId? string"
        "read ?-nonewline? channelId"
        "regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"
        "regsub ?switches? exp string subSpec varName"
        "rename oldName newName"
        "scan string format ?varName varName ...?"
        "seek channelId offset ?origin?"
        "set varName ?newValue?"
        "socket ?-myaddr addr? ?-myport myport? ?-async? host port"
        "socket -server command ?-myaddr addr? port"
        "source fileName"
        "split string ?splitChars?"
        "string option arg ?arg ...?"
        "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"
        "switch ?switches? string pattern body ... ?default body?"
        "tell channelId"
        "time command ?count?"
        "trace option \[arg arg ...\]"
        "unset varName ?varName ...?"
        "uplevel ?level? command ?arg ...?"
        "upvar ?level? otherVar localVar ?otherVar localVar ...?"
        "vwait name"
        "while test command"
    } {
        tclreadline::readline add $line
        set known_cmds([lindex $line 0]) [lrange $line 1 end]
    }
    rename tclreadline::InitTclCmds ""
}

proc ::tclreadline::InitTkCmds {} {
    variable known_cmds
    foreach line {
        "bind window ?pattern? ?command?"
        "bindtags window ?tags?"
        "button pathName ?options?"
        "canvas pathName ?options?"
        "checkbutton pathName ?options?"
        "clipboard option ?arg arg ...?"
        "entry pathName ?options?"
        "event option ?arg1?"
        "font option ?arg?"
        "frame pathName ?options?"
        "grab option ?arg arg ...?"
        "grid option arg ?arg ...?"
        "image option ?args?"
        "label pathName ?options?"
        "listbox pathName ?options?"
        "lower window ?belowThis?"
        "menu pathName ?options?"
        "menubutton pathName ?options?"
        "message pathName ?options?"
        "option cmd arg ?arg ...?"
        "pack option arg ?arg ...?"
        "radiobutton pathName ?options?"
        "raise window ?aboveThis?"
        "scale pathName ?options?"
        "scrollbar pathName ?options?"
        "selection option ?arg arg ...?"
        "send ?options? interpName arg ?arg ...?"
        "text pathName ?options?"
        "tk option ?arg?"
        "tkwait variable|visibility|window name"
        "toplevel pathName ?options?"
        "winfo option ?arg?"
        "wm option window ?arg ...?"
    } {
        tclreadline::readline add $line
        set known_cmds([lindex $line 0]) [lrange $line 1 end]
    }
rename tclreadline::InitTkCmds ""
}