# -*- make -*-
# FILE: "/diska/home/joze/src/tclreadline/Makefile.in"
# LAST MODIFICATION: "Mon Aug 30 14:13:02 1999 (joze)"
# LAST MODIFICATION: "Wed Sep  8 18:22:32 1999 (joze)"
# (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
# Copyright (C) 1999  Johannes Zellner
#

CC = @CC@
CC_SWITCHES = $(CFLAGS) $(SHLIB_CFLAGS) -I$(TOP_DIR) \
        -I$(TCL_INCLUDE_DIR) -I$(READLINE_INCLUDE_DIR)

OBJS = tclreadline.o

CSRCS = $(TOP_DIR)/tclreadline.c
TCLFILES = tclreadlineInit.tcl tclreadlineSetup.tcl
TCLFILES = tclreadlineInit.tcl tclreadlineSetup.tcl tclreadlineCompleter.tcl

SOURCES = \
    GPL \
    Makefile.in \
    README \
    configure.in \
    pkgIndex.tcl.in \
    sample.tclshrc \
    sources \
    tclreadline.c \
    tclreadline.h.in \
    tclreadline.n.in \
    tclreadlineConfig.sh.in \
    tclreadlineInit.tcl.in \
    tclreadlineSetup.tcl.in
    tclreadlineSetup.tcl.in \
    tclreadlineCompleter.tcl

MISC = TODO

AUXILIARY = \
    aux/config.guess \
    aux/config.sub \
    aux/install-sh \

	@echo "Installing $(TCLREADLINE_LIB_FILE)"
	@$(INSTALL_DATA) $(TCLREADLINE_LIB_FILE) \
            $(LIBRARY_INSTALL_DIR)/$(TCLREADLINE_LIB_FILE)
	@(cd $(LIBRARY_INSTALL_DIR); $(RANLIB) $(TCLREADLINE_LIB_FILE))
	chmod 555 $(LIBRARY_INSTALL_DIR)/$(TCLREADLINE_LIB_FILE)


install-libraries: tclreadlineInit.tcl tclreadlineSetup.tcl pkgIndex.tcl \
                   tclreadlineConfig.sh
install-libraries: tclreadlineInit.tcl tclreadlineSetup.tcl \
                   tclreadlineCompleter.tcl pkgIndex.tcl tclreadlineConfig.sh
	@$(MKINSTALLDIRS) $(LIBRARY_INSTALL_DIR)
	for f in \
	$(INSTALL_DATA) tclreadlineInit.tcl $(LIBRARY_INSTALL_DIR)
	$(INSTALL_DATA) tclreadlineSetup.tcl $(LIBRARY_INSTALL_DIR)
	$(INSTALL_DATA) pkgIndex.tcl $(LIBRARY_INSTALL_DIR)
	$(INSTALL_DATA) tclreadlineConfig.sh $(LIBRARY_INSTALL_DIR)
            tclreadlineInit.tcl \
            tclreadlineSetup.tcl \
            tclreadlineCompleter.tcl \
            pkgIndex.tcl \
            tclreadlineConfig.sh; do \
            $(INSTALL_DATA) $f $(LIBRARY_INSTALL_DIR) \
        done

FORCE:

$(MANN_INSTALL_DIR)/$(MAN): FORCE
	- $(INSTALL_DATA) $(srcdir)/$(MAN) $@ &&  chmod 644 $@

tclreadline.n.html: tclreadline.n

# -*- autoconf -*-
# FILE: "/diska/home/joze/src/tclreadline/configure.in"
# LAST MODIFICATION: "Mon Sep  6 11:30:15 1999 (joze)"
# LAST MODIFICATION: "Wed Sep  8 18:18:02 1999 (joze)"
# (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
# Copyright (C) 1999  Johannes Zellner
#

        break
    fi
done

if test -z "$TCL_LIB_DIR"; then
    AC_MSG_ERROR(Can't find Tcl libraries.  Use --with-tcl to specify the directory containing tclConfig.sh on your system.)
else
    . $TCL_LIB_DIR/tclConfig.sh
    AC_MSG_RESULT($TCL_LIB_DIR/tclConfig.sh)
    AC_MSG_CHECKING([for your tcl version])
    AC_MSG_RESULT([$TCL_VERSION, patchlevel $TCL_PATCH_LEVEL])
fi

#--------------------------------------------------------------------
#   Read in configuration information generated by Tcl for shared
#   libraries, and arrange for it to be substituted into our
#   Makefile.
#--------------------------------------------------------------------

file=$TCL_LIB_DIR/tclConfig.sh
. $file

SHLIB_CFLAGS=$TCL_SHLIB_CFLAGS
SHLIB_LD=$TCL_SHLIB_LD
if test $TCL_SHLIB_SUFFIX = ""; then
    AC_MSG_ERROR(TCL_SHLIB_SUFFIX not defined -- should be something like .so or .sl on unix.)
else
    SHLIB_SUFFIX=$TCL_SHLIB_SUFFIX

#!/bin/sh
# FILE: "/home/joze/src/tclreadline/sample.tclshrc"
# LAST MODIFICATION: "Sat Aug 28 23:41:17 1999 (joze)"
# FILE: "/diska/home/joze/src/tclreadline/sample.tclshrc"
# LAST MODIFICATION: "Wed Sep  8 18:10:30 1999 (joze)"
# (C) 1999 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# vim:set ft=tcl: \
exec tclsh "$0" "$@"


if {$tcl_interactive} {

    #
    # namespace import tclreadline::Print

    # store maximal this much lines in the history file
    #
    set tclreadline::historyLength 200

    # disable tclreadline's script completer
    #
    ::tclreadline::readline customcompleter ""

    # go to tclrealdine's main loop.
    #
    tclreadline::Loop
}

 /* ==================================================================

    FILE: "/diska/home/joze/src/tclreadline/tclreadline.c"
    LAST MODIFICATION: "Wed Sep  1 18:58:04 1999 (joze)"
    LAST MODIFICATION: "Wed Sep  8 17:47:13 1999 (joze)"
    (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
    $Id$
    ---

    tclreadline -- gnu readline for tcl
    Copyright (C) 1999  Johannes Zellner

            goto BAD_COMMAND;
        if (3 == argc) {
            if (tclrl_custom_completer)
                FREE(tclrl_custom_completer);
            if (!blank_line(argv[2]))
                tclrl_custom_completer = stripwhite(strdup(argv[2]));
        }
        Tcl_AppendResult (interp, tclrl_custom_completer, (char*) NULL);
        Tcl_AppendResult(interp, tclrl_custom_completer, (char*) NULL);
    } else if (c == 'b'  && strncmp(argv[1], "builtincompleter", length) == 0) {
        int bool = tclrl_use_builtin_completer;
        if (3 != argc && 2 != argc)
            goto BAD_COMMAND;
        if (3 == argc) {
            if (TCL_OK != Tcl_GetBoolean(interp, argv[2], &bool)) {
                Tcl_AppendResult(interp,

#!/usr/locanl/bin/tclsh
# FILE: "/diska/home/joze/src/tclreadline/tclreadlineCompleter.tcl"
# LAST MODIFICATION: "Wed Sep  8 17:30:20 1999 (joze)"
# (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
# Copyright (C) 1999  Johannes Zellner
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
# johannes@zellner.org
# http://www.zellner.org/tclreadline/
#
# ================================================================== 

# done:
#
# - append
# - array
# - bgerror
# - binary
# - break
# - catch
# - cd
# - clock
# - close
# - concat
# - continue
# - (ddd is only on M$)
# - encoding
# - eof
# - error
# - eval
# - exec
# - exit
# - expr
# - fblocked
# - fconfigure
# - fcopy
# - file
# - fileevent
# - flush
# - for # TODO
# - foreach # TODO
# - format # TODO
# - gets
# - glob
# - global
# - if # TODO
# - incr
# - index
# - info
# - interp
# - join
# - lappend
# - llength
# - linsert
# - list
# - load
# - lrange
# - lreplace
# - lsearch
# - lsort
# - history
# - load
# - namespace
# - open
# - package
# - pkg_mkIndex
# - proc
# - puts
# - pwd
# - pid
# - read
# - regexp
# - (registry is only on M$)
# - regsub
# - rename
# - (resource is on mac only)
# - return
# - scan # TODO
# - seek
# - socket
# - source
# - split # TODO
# - string
# - subst
# - switch
# - tell
# - time # TODO ??
# - trace
# - set
# - unknown
# - unset
# - update
# - uplevel
# - upvar
# - variable
# - vwait
# - while # TODO
# 


namespace eval tclreadline {

proc FirstNonOption {line} {
    set expr_pos 1
    foreach word [lrange ${line} 1 end] {; # 0 is the command itself
        if {"-" != [string index ${word} 0]} {
            break
        } else {
            incr expr_pos
        }
    }
    return ${expr_pos}
}

proc RemoveUsedOptions {line opts {terminate {}}} {
    if {[llength ${terminate}]} {
        if {[regexp -- ${terminate} ${line}]} {
            return ""
        }
    }
    set new ""
    foreach word ${opts} {
        if {![regexp -- ${word} ${line}]} {
            lappend new ${word}
        }
    }
    return [string trim ${new}]
}

proc Alert {} {
    puts -nonewline \a
    flush stdout
}

# AttemptFromList will return an empty string, if
# the text typed so far does not match any of the
# elements in list. This might be used to allow
# subsequent filename completion by the builtin
# completer.
#
proc AttemptFromList {text lst} {
    return [string trim [Format [FindInList $text $lst] $text]]
}

# CompleteFromList will never return an empty string.
#
proc CompleteFromList {text lst} {
    set result [AttemptFromList ${text} ${lst}]
    if {![llength ${result}]} {
        Alert
        return [string trim "${text} ${lst}"]
    } else {
        return ${result}
    }
}

# ???????
proc MenuFromList {text lst} {
    if {![llength ${text}]} {
        return [string trim "{} ${lst}"]
    } else {
        return [AttemptFromList ${text} ${lst}]
    }
}

# never return an empty string
#
proc Menu {lst} {
    return [string trim "{} ${lst}"]
}

proc FindInList {text lst} {
    set result ""
    foreach word $lst {
        if {[string match ${text}* ${word}]} {
            lappend result ${word}
        }
    }
    return [string trim $result]
}


# get the longest common completion
# e.g. str == {tcl_version tclreadline_version tclreadline_library}
# --> [GetCommon ${str}] == "tcl"
#
proc 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 SubCmd {start line} {
    set depth 0
    # puts stderr SubCmd
    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 ""
}

proc IsWhite {char} {
    if {" " == $char || "\n" == $char || "\t" == $char} {
        return 1
    } else {
        return 0
    }
}

proc PreviousWord {start line} {
    incr start -1
    set found 0
    for {set i $start} {$i > 0} {incr i -1} {
        set c [string index $line $i]
        if {${found} && [IsWhite $c]} {
            break
        } elseif {!${found} && ![IsWhite $c]} {
            set found 1
        }
    }
    return [string trim [string range ${line} $i $start]]
}

proc Quote {value left} {
    set right [Right ${left}]
    if {1 < [llength $value] && "" == $right} {
        return [list \"${value}\"]
    } else {
        return [list ${left}${value}${right}]
    }
}

proc InChannelId {text} {
    # return [ChannelId ${text} inChannel {stdin}]
    return [ChannelId ${text} inChannel]
}

proc OutChannelId {text} {
    # return [ChannelId ${text} outChannel {stdout stderr}]
    return [ChannelId ${text} outChannel]
}

proc ChannelId {text {descript channelId} {chs ""}} {
    if {"" == ${chs}} {
        if [catch {set chs [file channels]}] {
            set chs {stdin stdout stderr}
        }
    }
    if {[llength [set channel [MenuFromList ${text} ${chs}]]]} {
        return ${channel}
    } else {
        return [Menu ${descript}]
    }
}

proc QuoteQuotes {line} {
    regsub -all -- \" $line {\"} line
    regsub -all -- \{ $line {\{} line; # \}\} (keep the editor happy)
    return $line
}

#**
# get the word position.
# @return the word position
# @note will returned modified values.
# @sa EventuallyEvaluateFirst
# @date Sep-06-1999
#
# % p<TAB>
# % bla put<TAB> $b
# % put<TAB> $b
# part  == put
# start == 0
# end   == 3
# line  == "put $b"
# [PartPosition] should return 0
#
proc PartPosition {partT startT endT lineT} {

    upvar $partT part $startT start $endT end $lineT line
    EventuallyEvaluateFirst part start end line

    # puts stderr "(PartPosition) line\[start\]=[string index $line $start]"
    # puts stderr "(PartPosition) part=|$part|"
    incr start -1
    if {"\"" == [string index $line $start]} {
        incr start -1
    }
    # puts stderr "(PartPosition) line=|$line|" 
    # puts stderr "(PartPosition) start=$start"
    set line [string range $line 0 $start]
    set line [QuoteQuotes $line]
    # puts stderr "(PartPosition) line=|$line|" 
    set result [llength $line]
    # puts stderr $result
    return $result
}

proc Right {left} {
    if {"\"" == $left} {
        return ""
    } elseif {"\{" == $left} {
        return "\}"
    } elseif {"\\\{" == $left} {
        return "\\\}"
    }
    return ""
}

proc GetPrefix {text} {
    set null [string index $text 0]
    # puts null=|$null|
    if {"\"" == $null} {
        # puts stderr \neins\n
        set pre "\\\""
    } elseif {"\{" == $null} {
        # puts stderr \nzwei\n
        set pre "\\\{"
    } else {
        # puts stderr \ndrei\n
        set pre ""
    }
    return ${pre}
}

proc Format {matches {part {}}} {
    # puts matches=|$matches|
    # puts stderr \npart=|$part|\n
    set pre [GetPrefix ${part}]
    if {1 == [llength $matches]} { ; # unique match
        # puts stderr \nunique=$matches\n
        # puts stderr "\n|${pre}${matches}[Right ${pre}]|\n"
        return [string trim ${pre}${matches}[Right ${pre}]]
    } elseif {"" != ${matches}} {
        # puts stderr \nmore=$matches\n
        set common [GetCommon ${matches}]
        # puts stderr common=|$common|
        if {"" == $common} {
            return [string trim "[list $part] ${matches}"]
        } else {
            return [string trim "${pre}${common} ${matches}"]
        }
    } else {
        return ""; # nothing to complete
    }
}

proc ListCompletion {text {level -1}} {
    # TODO
    return ""
    # return [VarCompletion ${text} ${level}]
}

proc VarCompletion {text {level -1}} {
    if {-1 == ${level}} {
        set level [info level]
    } else {
        incr level
    }
    set pre [GetPrefix ${text}]

    if {"" == ${pre}} {
        set var ${text}
    } else {
        set var [string range ${text} 1 end]
    }

    # arrays
    #
    if {[regexp {([^(]*)\((.*)} ${var} all array name]} {
        set names [uplevel ${level} array names ${array} ${name}*]
        if {1 == [llength $names]} { ; # unique match
            return "${array}(${names})"
        } elseif {"" != ${names}} {
            return "${array}([GetCommon ${names}] ${names}"
        } else {
            return ""; # nothing to complete
        }
    }

    # non-arrays
    #
    regsub ":$" ${var} "::" var
    set namespaces [namespace children :: ${var}*]
    if {[llength ${namespaces}] && "::" != [string range ${var} 0 1]} {
        foreach name ${namespaces} {
            regsub "^::" ${name} "" name
            if {[string length ${name}]} {
                lappend new ${name}::
            }
        }
        set namespaces ${new}
        unset new
    }
    set matches \
    [string trim "[uplevel ${level} info vars ${var}*] ${namespaces}"]
    if {1 == [llength $matches]} { ; # unique match
        # check if this unique match is an
        # array name, (whith no "(" yet).
        #
        if {[uplevel ${level} array exists $matches]} {
            return [VarCompletion ${matches}( ${level}]; # recursion
        } else {
            return ${pre}${matches}[Right ${pre}]
        }
    } elseif {"" != $matches} { ; # more than one match
        set common [GetCommon ${matches}]
        if {"" == ${common}} {
            return [Format ${matches} ${text}]
        } else {
            return [string trim "${pre}${common} ${matches}"]
        }
    } else {
        return ""; # nothing to complete
    }
}

proc FullQualifiedMatches {qualifier matchlist} {
    set new ""
    foreach entry ${matchlist} {
        set full ${qualifier}::${entry}
        if {"" != [namespace which ${full}]} {
            lappend new ${full}
        }
    }
    return ${new}
}

proc ProcsOnlyCompletion {cmd} {
    return [CommandCompletion ${cmd} procs]
}

proc CommandsOnlyCompletion {cmd} {
    return [CommandCompletion ${cmd} commands]
}

proc CommandCompletion {cmd {action both} {spc ::}} {
    set quali [namespace qualifiers ${cmd}]
    if {[llength ${quali}]} {
        set rec [CommandCompletion [namespace tail ${cmd}] ${action} ${quali}]
        return [FullQualifiedMatches ${quali} ${rec}]
    }
    # puts stderr \ncmd=|$cmd|\n
    set cmd [string trim ${cmd}]*
    if {"procs" != ${action}} {
        set commands [namespace eval $spc "info commands [QuoteQuotes ${cmd}]"]
        # puts stderr commands=|$commands|
    } else {
        set commands ""
    }
    if {"commands" != ${action}} {
        set procs [namespace eval $spc "info procs [QuoteQuotes ${cmd}]"]
        # puts stderr procs=|$procs|
    } else {
        set procs ""
    }
    set matches [namespace eval $spc concat ${commands} ${procs}]
# 
#     foreach match ${matches} {
#         set full ${spc}::${match}
#         if {"" != [namespace which ${full}]} {
#             lappend new bla::${full}
#         }
#     }
# 
    set namespaces [namespace children $spc ${cmd}]
    if {![llength ${matches}] && 1 == [llength ${namespaces}]} {
        set namespaces [string trim ${namespaces}]
        regsub {^([^:])} $namespaces {::\1} namespaces
    #    set matches [namespace eval ${namespaces} \
    #    {concat [info commands] [info procs]}]
        if {"procs" != ${action}} {
            set n_commands [namespace eval ${namespaces} "info commands"]
        } else {
            set n_commands ""
        }
        if {"commands" != ${action}} {
            set n_procs [namespace eval ${namespaces} "info procs"]
        } else {
            set n_procs ""
        }
        set matches [string trim "${n_commands} ${n_procs}"]
        if {[llength ${matches}]} {
# 
#             foreach match ${matches} {
#                 set full ${namespaces}::${match}
#                 if {"" != [namespace which ${full}]} {
#                     lappend new ${namespaces}::${match}
#                 }
#             }
# 
#             set matches ${new}
#             unset new
# 
            set matches [FullQualifiedMatches ${namespaces} ${matches}]
            set namespaces ""
        }
    }
    return [string trim "${matches} ${namespaces}"]
}

#**
# check, if the first argument starts with a '['
# and must be evaluated before continuing.
# NOTE: eventually modifies all arguments.
# DATE: Sep-06-1999
#
proc EventuallyEvaluateFirst {partT startT endT lineT} {
    # return; # disabled
    upvar $partT part $startT start $endT end $lineT line
    set line [string trim ${line}]

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

    set pos 0
    while {-1 != [set idx [string first {]} ${line} ${pos}]]} {
        set cmd [string range ${line} 0 ${idx}]
        if {[info complete ${cmd}]} {
            break;
        }
        set pos [expr ${idx} + 1]
    }

    if {![info exists cmd]} {return}
    if {![info complete ${cmd}]} {return}
    set cmd [string range ${cmd} 1 [expr [string length ${cmd}] - 2]]
    set rest [string range ${line} [expr ${idx} + 1] end]

    if {[catch [list set result [string trim [eval ${cmd}]]]]} {return}

    set line ${result}${rest}
    set diff [expr [string length ${result}] - ([string length ${cmd}] + 2)]
    incr start ${diff}
    incr end ${diff}
}

# if the line entered so far is
# % puts $b<TAB>
# part  == $b
# start == 5
# end   == 7
# line  == "$puts $b"
#
proc ScriptCompleter {part start end line} {
    # puts stderr "(ScriptCompleter) |$part| $start $end |$line|"
    variable known_cmds
    if {{$} == [string index $part 0]} {
        # check for a !$ history event
        #
        if {$start > 0} {
            if {{!} == [string index $line [expr $start - 1]]} {
                return ""
            }
        }
        # variable completion. Check first, if the
        # variable starts with a plain `$' or should
        # be enclosed in braces.
        #
        set var [string range $part 1 end]
# 
#         if {"\{" == [string index $part 1]} {
#             set var [string range $part 2 end]
#             set left "\{"
#         } else {
#             set left ""
#             set var [string range $part 1 end]
#         }
# 
        # check if $var is an array name, which
        # already has already a "(" somewhere inside.
        #
        if {"" != [set vc [VarCompletion $var]]} {
            if {"" == [lindex $vc 0]} {
                return "\$ [lrange ${vc} 1 end]"
            } else {
                return \$${vc}
            }
            # puts stderr vc=|$vc|
        } else {
            return ""
        }
    # 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 [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 [ScriptCompleter $part $new_start $new_end $new_line]
    } elseif {0 == [set pos [PartPosition part start end line]]} {
        # puts stderr "(PartPosition) $part $start $end $line"
        # set matches [array names known_cmds "[string trim ${part}]*"]
        set all [CommandCompletion ${part}]
        #puts \nmatches=$matches\n
        return [Format $all $part]
    } else {
        # try to use $pos further ...
        # puts stderr |$line|
        if {"." == [string index [lindex ${line} 0] 0]} {
            set alias WIDGET
        } else {
            set alias [lindex [QuoteQuotes ${line}] 0]
        }
        foreach cmd [list ${alias} tclreadline_complete_unknown] {
            if {"" != [namespace eval ::tclreadline \
                [list info procs complete(${cmd})]]
            } {
                # to be more error-proof, we check here,
                # if complete($cmd) takes exactly 5 arguments.
                #
                if {6 != [set arguments [llength \
                    [namespace eval ::tclreadline \
                    [list info args complete(${cmd})]]]]
                } {
                    error [list complete(${cmd}) takes ${arguments} \
                    arguments, but should take exactly 6.]
                }

                # remove leading quotes
                #
                if {"\"" == [string index $part 0] \
                    || "\{" == [string index $part 0]
                } {
                    set mod [string range $part 1 end]
                } else {
                    set mod $part
                }

                if {[catch [list set script_result \
                    [complete(${cmd}) $part \
                    $start $end $line $pos $mod]] ::tclreadline::errorMsg]
                } {
                    error "error during evaluation of `complete(${cmd})'"
                }
                return ${script_result}
            }
        }
        # no specific command completer found.
        if {"" != [array names known_cmds $cmd]} {
            set current [lindex $known_cmds($cmd) $pos]
            if {"" != $current && "" == [string trim $part]} {
                return $current
            } else {
                return ""
            }
        } else {
            return ""
        }
    }
    error "{NOTREACHED (this is probably an error)}"
}


# explicit command completers
#

# -------------------------------------
#                 TCL
# -------------------------------------

proc complete(append) {text start end line pos mod} {
    switch -- $pos {
        1 { return [VarCompletion ${text}] }
        default { return [Menu ?value?] }
    }
}

proc complete(if) {text start end line pos mod} {
    # TODO: this is not good yet.
    if {2 == $pos} {
        return [AttemptFromList $text {then}]
    } elseif {$pos > 2} {
        set prev [PreviousWord ${start} ${line}]
        switch $prev {
            then -
            else -
            elseif { return "" }
        }
        return [AttemptFromList $text {then else elseif}]
    }
}

proc complete(incr) {text start end line pos mod} {
    if {1 == $pos} {
        set matches [uplevel 2 info vars "${mod}*"]
        set final ""
        # check for integers
        #
        foreach match $matches {
            if {[uplevel 2 array exists $match]} {
                continue
            }
            if {[regexp {^[0-9]+$} [uplevel 2 set $match]]} {
                lappend final $match
            }
        }
        return [Format ${final} $text]
    }
}

proc complete(array) {text start end line pos mod} {
    if {1 == $pos} {
        set cmds {
            anymore donesearch exists get names
            nextelement set size startsearch
        }
        return [AttemptFromList $text $cmds]
    } elseif {2 == $pos} {
        set cmd [lindex $line 1]
        switch -- $cmd {
            anymore -
            donesearch -
            exists -
            get -
            names -
            nextelement -
            set -
            size -
            startsearch {
                set matches ""
                set vars [uplevel [info level] info vars ${mod}*]
                foreach var ${vars} {
                    if {[uplevel [info level] array exists ${var}]} {
                        lappend matches ${var}
                    }
                }
                return [Format ${matches} ${text}]
            }
        }
    } elseif {3 == $pos} {
        set cmd [lindex $line 1]
        switch -- $cmd {
            get -
            names {
                if {[catch {
                    set names [uplevel [info level] \
                    array names [lindex $line 2] [lindex $line 3]*]}]} {
                    return ""
                } else {
                    set common [GetCommon ${names}]
                    if {"" == ${common}} {
                        return [Format ${names} ${text}]
                    } else {
                        return [string trim "${common} ${names}"]
                    }
                }
            }
        }
    }
    return ""
}

proc complete(binary) {text start end line pos mod} {
    set cmd [lindex $line 1]
    switch -- $pos {
        1 {
            return [AttemptFromList $text {format scan}]
        }
        2 {
            switch -- $cmd {
                format { return [Menu formatString] }
                scan   { return [Menu string] }
            }
        }
        3 {
            switch -- $cmd {
                format { return [Menu ?arg?] }
                scan   { return [Menu formatString] }
            }
        }
        default {
            switch -- $cmd {
                format { return [Menu ?arg?] }
                scan   { return [Menu ?varName?] }
            }
        }
    }
    return ""
}

proc complete(clock) {text start end line pos mod} {
    set cmd [lindex $line 1]
    switch -- $pos {
        1 {
            return [AttemptFromList $text {clicks format scan seconds}]
        }
        2 {
            switch -- $cmd {
                format  { return [Menu clockValue] }
                scan    { return [Menu dateString] }
                clicks  -
                seconds {}
            }
        }
        3 {
            switch -- $cmd {
                format {
                    set sub [lindex $line 3]
                    set subcmds {-fmt -gmt}
                    return [AttemptFromList $text $subcmds]
                }
                scan {
                    set sub [lindex $line 3]
                    set subcmds {-base -gmt}
                    return [AttemptFromList $text $subcmds]
                }
                clicks  -
                seconds {}
            }
        }
    }
    return ""
}

proc complete(encoding) {text start end line pos mod} {
    set cmd [lindex $line 1]
    switch -- $pos {
        1 {
            return [AttemptFromList $text {convertfrom convertto names system}]
        }
        2 {
            switch -- $cmd {
                names {}
                convertfrom -
                convertto -
                system {
                    return [AttemptFromList ${text} [encoding names]]
                }
            }
        }
    }
    return ""
}

proc complete(expr) {text start end line pos mod} {
    set cmds {
        acos    cos     hypot   sinh 
        asin    cosh    log     sqrt 
        atan    exp     log10   tan 
        atan2   floor   pow     tanh 
        ceil    fmod    sin     abs 
        double  int     rand    round 
        srand 
    }
    return [AttemptFromList $text $cmds]
}

proc complete(fconfigure) {text start end line pos mod} {
    set cmd [lindex $line 1]
    switch -- $pos {
        1 {
            return [ChannelId ${mod}]
        }
        default {
            set option [PreviousWord ${start} ${line}]
            switch -- $option {
                -blocking {
                    return [AttemptFromList ${text} {yes no}]
                }
                -buffering {
                    return [AttemptFromList ${text} {full line none}]
                }
                -buffersize {
                    if {![llength ${text}]} {
                        return [Menu newSize]
                    }
                }
                -encoding {
                    return [AttemptFromList ${text} [encoding names]]
                }
                -eofchar {
                    return [Menu {\{inChar\ outChar\}}]
                }
                -translation {
                    return [AttemptFromList ${text} {auto binary cr crlf lf}]
                }
                default {return [AttemptFromList $text {
                    -blocking -buffering -buffersize
                    -encoding -eofchar -translation}]
                }
            }
        }
    }
    return ""
}

proc complete(fcopy) {text start end line pos mod} {
    switch -- $pos {
        1 {
            return [InChannelId ${mod}]
        }
        2 {
            return [OutChannelId ${mod}]
        }
        default {
            set option [PreviousWord ${start} ${line}]
            switch -- $option {
                -size    { return [Menu size] }
                -command { return [Menu callback] }
                default  { return [AttemptFromList $text {-size -command}] }
            }
        }
    }
    return ""
}

proc complete(file) {text start end line pos mod} {
    switch -- $pos {
        1 {
            set cmds {
                atime attributes copy delete dirname executable exists
                extension isdirectory isfile join lstat mtime mkdir
                nativename owned pathtype readable readlink rename
                rootname size split stat tail type volumes writable
            }
            return [AttemptFromList $text $cmds]
        }
        2 {
            set cmd [lindex $line 1]
            switch -- $cmd {
                atime -
                attributes -
                dirname -
                executable -
                exists -
                extension -
                isdirectory -
                isfile -
                join -
                lstat -
                mtime -
                mkdir -
                nativename -
                owned -
                pathtype -
                readable -
                readlink -
                rootname -
                size -
                split -
                stat -
                tail -
                type -
                volumes -
                writable {
                    return ""
                }

                copy -
                delete -
                rename {
                #    set match [MenuFromList ${mod} {-force}]
                    return ""
                }
            }
        }
    }
    return ""
}

proc complete(fileevent) {text start end line pos mod} {
    switch -- $pos {
        1 {
            return [ChannelId ${mod}]
        }
        2 {
            return [CompleteFromList ${mod} {readable writable}]
        }
    }
    return ""
}

proc complete(flush) {text start end line pos mod} {
    switch -- $pos {
        1 { return [ChannelId ${mod}] }
    }
    return ""
}

proc complete(gets) {text start end line pos mod} {
    switch -- $pos {
        1 { return [InChannelId ${mod}] }
    }
    return ""
}

proc complete(glob) {text start end line pos mod} {
    switch -- $pos {
        1 {
            set matches [AttemptFromList ${mod} {-nocomplain --}]
            if {[llength [string trim ${mod}]] && [llength ${matches}]} {
                return ${matches}
            }
        }
    }
    return ""
}

proc complete(global) {text start end line pos mod} {
    return [VarCompletion ${text}]
}

proc complete(index) {text start end line pos mod} {
    if {1 == $pos} {
        return [VarCompletion ${text}]
    } elseif {2 == $pos && ![llength ${mod}]} {
        return <index>
    }
    return ""
}

proc complete(info) {text start end line pos mod} {
    if {1 == $pos} {
        set cmds {
            args body cmdcount commands complete default exists
            globals hostname level library loaded locals nameofexecutable
            patchlevel procs script sharedlibextension tclversion vars}
        return [AttemptFromList $text $cmds]
    } elseif {2 == $pos} {
        set cmd [lindex $line 1]
        switch -- $cmd {
            args -
            body -
            default -
            procs { return [complete(proc) ${text} 0 0 ${line} 1 ${mod}] }
            complete { ; # TODO
            }
            level { ; # TODO
            }
            loaded { ;# TODO
            }
            commands -
            exists -
            globals -
            locals -
            vars {
                if {"exists" == $cmd} {
                    set do vars
                } else {
                    set do $cmd
                }
                # puts stderr [list complete(info) level = [info level]]
                return \
                [Format [uplevel 2 info ${do} "${mod}*"] $text]
            }
        }
    }
    return ""
}

proc complete(interp) {text start end line pos mod} {
    set cmd [lindex $line 1]
    if {1 == $pos} {
        set cmds {
            alias aliases create delete eval exists expose hide hidden
            issafe invokehidden marktrusted slaves share target transfer}
        return [AttemptFromList $text $cmds]
    } elseif {2 == $pos} {
        switch -- $cmd {
            create {
                return [AttemptFromList $text {-safe -- ?path?}]
            }

            eval -
            exists -
            expose -
            hide -
            hidden -
            invokehidden -
            marktrusted -
            target {if {![llength ${mod}]} { return <path> }}

            aliases -
            delete -
            issafe -
            slaves {if {![llength ${mod}]} { return ?path? }}

            alias -
            share -
            transfer {if {![llength ${mod}]} { return <srcPath> }}
        }
    } elseif {3 == $pos} {
        switch -- $cmd {

            alias {if {![llength ${mod}]} { return <srcCmd> }}

            create {
                return [AttemptFromList $text {-safe -- ?path?}]
            }

            eval {if {![llength ${mod}]} { return <arg> }}
            delete {if {![llength ${mod}]} { return ?path? }}

            expose {if {![llength ${mod}]} { return <hiddenName> }}
            hide {if {![llength ${mod}]} { return <exposedCmdName> }}

            invokehidden {
                return \
                [AttemptFromList $text {?-global? <hiddenCmdName}]
            }

            target {if {![llength ${mod}]} { return <alias> }}

            exists {}
            hidden {}
            marktrusted {}
            aliases {}
            issafe {}
            slaves {}

            share -
            tranfer {return [ChannelId ${mod}]}
        }
    } elseif {4 == $pos} {
        switch -- $cmd {

            alias {if {![llength ${mod}]} { return <targetPath> }}

            create {
                return [AttemptFromList $text {-safe -- path}]
            }

            expose {if {![llength ${mod}]} { return ?exposedCmdName? }}
            hide {if {![llength ${mod}]} { return ?hiddenCmdName? }}

            share -
            tranfer {if {![llength ${mod}]} { return ?destPath? }}
        }
    }
    return ""
}

proc complete(join) {text start end line pos mod} {
    if {1 == $pos} {
        return [VarCompletion ${text}]
    }
    return ""
}

proc complete(lappend) {text start end line pos mod} {
    if {1 == $pos} {
        return [ListCompletion ${text}]
    }
    return ""
}

proc complete(linsert) {text start end line pos mod} {
    if {1 == $pos} {
        return [ListCompletion ${text}]
    }
    return ""
}

proc complete(llength) {text start end line pos mod} {
    if {1 == $pos} {
        return [ListCompletion ${text}]
    }
    return ""
}

proc complete(load) {text start end line pos mod} {
    if {1 == $pos} {
        return ""; # filename
    } elseif {2 == $pos && ![llength ${mod}]} {
        return "<packageName>"
    } elseif {3 == $pos && ![llength ${mod}]} {
        return "<interp>"
    }
    return ""
}

proc complete(lrange) {text start end line pos mod} {
    if {1 == $pos} {
        return [ListCompletion ${text}]
    } elseif {2 == $pos && ![llength ${mod}]} {
        return "<first>"
    } elseif {3 == $pos && ![llength ${mod}]} {
        return "<last>"
    }
    return ""
}

proc complete(lreplace) {text start end line pos mod} {
    if {1 == $pos} {
        return [ListCompletion ${text}]
    } elseif {2 == $pos && ![llength ${mod}]} {
        return "<first>"
    } elseif {3 == $pos && ![llength ${mod}]} {
        return "<last>"
    } elseif {![llength ${mod}]} {
        return "?element?"
    }
    return ""
}

proc complete(lsearch) {text start end line pos mod} {
    if {1 == $pos} {
        set options [MenuFromList ${mod} {
            -exact -glob -regexp <list>}]
        set matches [ListCompletion ${text}]
        return [string trim "${matches} ${options}"]
    } else {
        if {![llength ${mod}]} {
            set opt [lindex ${line} 1]
            if {[llength [MenuFromList ${opt} {
                -exact -glob -regexp }]]} {
                incr pos -1
            }
            if {1 == $pos} {
                return <list>
            } elseif {2 == $pos} {
                return <pattern>
            }
        }
    }
    return ""
}

proc complete(lsort) {text start end line pos mod} {
    set options [Menu ${mod} {
        -ascii -dictionary -integer -real -command
        -increasing -decreasing -index
    }]
    set matches [ListCompletion ${text}]
    return [string trim "${matches} ${options}"]
}

proc complete(history) {text start end line pos mod} {
    if {1 == $pos} {
        set cmds {add change clear event info keep nextid redo}
        return [AttemptFromList $text $cmds]
    } elseif {2 == ${pos}} {
        set cmd [lindex $line 1]
        switch -- $cmd {
            add { if {![llength ${mod}]} { return <newValue> } }
            change { if {![llength ${mod}]} { return <newValue> } }

            info -
            keep { if {![llength ${mod}]} { return ?count? } }

            event -
            redo { if {![llength ${mod}]} { return ?event? } }

            clear -
            nextid { return "" }
        }
    }
    return ""
}

proc complete(namespace) {text start end line pos mod} {
    regsub {^([^:])} ${mod} {::\1} mod
    # TODO dosn't work ???
    set space_matches [namespace children :: [string trim ${mod}*]]
    # puts \nspace_matches=|${space_matches}|
    set cmd [lindex $line 1]
    if {1 == $pos} {
        set cmds {
            children code current delete eval export forget
            import inscope origin parent qualifiers tail which}
        return [AttemptFromList $text $cmds]
    } elseif {2 == $pos} {
        switch -- $cmd {
            children -
            delete -
            eval -
            inscope -
            forget -
            parent { return [AttemptFromList ${mod} $space_matches] }
            code { return "" }
            current {}
            export { return [MenuFromList ${mod} -clear ?pattern?] }
            import {
                return [MenuFromList ${mod} "-force $space_matches"]
            }
            origin { if {![llength ${mod}]} { return <command> } }
            qualifiers -
            tail { if {![llength ${mod}]} { return <string> } }
            which { return [MenuFromList ${mod} {
                -command -variable <name>}] }
        }
     #      forget { if {![llength ${mod}]} { return ?pattern? } }
    } elseif {3 == $pos && "inscope" == $cmd} {
            if {![llength ${mod}]} { return arg }
    } else {
        switch -- $cmd {
            children { if {![llength ${mod}]} { return ?pattern? } }
            delete { return [AttemptFromList $text $space_matches] }
            eval { if {![llength ${mod}]} { return ?arg? } }
            inscope { if {![llength ${mod}]} { return ?arg? } }
            parent {}
            code {}
            current {}
            export -
            forget -
            import { return [Menu ?pattern?] }
            origin {}
            qualifiers {}
            tail {}
            which { return [MenuFromList $text {
                -command -variable <name>}] }
        }
    }
    return ""
}

proc complete(open) {text start end line pos mod} {
    if {![llength ${mod}]} {
        if {2 == $pos} {
            return ?access?
        } elseif {3 == $pos} {
            return ?permissions?
        }
    }
    return ""
}

proc complete(package) {text start end line pos mod} {
    set cmd [lindex $line 1]
    if {1 == $pos} {
        set cmds {
            forget ifneeded names present provide require
            unknown vcompare versions vsatisfies}
        return [AttemptFromList $text $cmds]
    } elseif {2 == $pos} {
        switch -- $cmd {
            forget -
            ifneeded -
            provide -
            versions { return [MenuFromList ${mod} [package names]] }
            present -
            require {
                return [MenuFromList ${mod} "-exact [package names]"] }
            names {}
            unknown { if {![llength ${mod}]} { return ?command? } }
            vcompare -
            vsatisfies { if {![llength ${mod}]} { return <version1> } }
        }
    } elseif {3 == $pos} {
        switch -- $cmd {
            forget {}
            ifneeded { if {![llength ${mod}]} { return <version> } }
            provide { if {![llength ${mod}]} { return ?version? } }
            versions {}
            present -
            require {
                set prev [PreviousWord ${start} ${line}]
                if {[llength [MenuFromList ${prev} -exact]]} {
                    return [MenuFromList ${mod} [package names]]
                } elseif {![llength ${mod}]} {
                    return ?version?
                }
            }
            names {}
            unknown {}
            vcompare -
            vsatisfies { if {![llength ${mod}]} { return <version2> } }
        }
    } 
    return ""
}

proc complete(pkg_mkIndex) {text start end line pos mod} {
    set cmds [RemoveUsedOptions ${line} {-direct -load -verbose -- <dir>} {--}]
    set res [string trim [MenuFromList $text $cmds]]
    if {[regexp -- [PreviousWord ${start} ${line}] -load] \
        && ![llength ${mod}]} {
            return <pkgPat>
    }
    if {![llength [join ${res}]]} {
        return ""
    } else {
        return ${res}
    }
    return ""
}

proc complete(proc) {text start end line pos mod} {
    # puts known_procs=|${known_procs}|
    if {1 == $pos} {
        set known_procs [ProcsOnlyCompletion ${mod}]
        set common [GetCommon ${known_procs}]
        if {"" == ${common}} {
            return [Format ${known_procs} ${text}]
        } else {
            return [string trim "${common} ${known_procs}"]
        }
    } elseif {2 == $pos} {
        set proc [lindex $line 1]
        if {[catch {set args [uplevel 2 info args ${proc}]}]} {
            return ""
        } else {
            return [list "\{${args}\} \{"]
        }
    }
    return ""
}

proc complete(puts) {text start end line pos mod} {
    if {1 == $pos} {
        return [MenuFromList ${mod} "-nonewline [OutChannelId ${mod}]"]
    } elseif {2 <= $pos} {
        if {![llength ${mod}]} {
            set opt [lindex ${line} 1]
            if {[llength [MenuFromList ${opt} {-nonewline}]]} {
                incr pos -1
            }
            if {1 == $pos} {
                return [OutChannelId ${mod}]
            } elseif {2 == $pos} {
                return [Menu <string>]
                return <string>
            }
        }
    }
    return ""
}

proc complete(read) {text start end line pos mod} {
    if {1 == $pos} {
        return [MenuFromList ${mod} "-nonewline [InChannelId ${mod}]"]
    } elseif {2 == $pos} {
        if {![llength ${mod}]} {
            set opt [lindex ${line} 1]
            if {[llength [MenuFromList ${opt} {-nonewline}]]} {
                return [InChannelId ${mod}]
            } elseif {![llength ${mod}]} {
                return <numBytes>
            }
        }
    }
    return ""
}

proc complete(regexp) {text start end line pos mod} {
    set prev [PreviousWord ${start} ${line}]
    if {[llength ${prev}] && ("-" == [string index ${prev} 0] || 1 == $pos)} {
        set cmds [RemoveUsedOptions ${line} {
            -nocase -indices -expanded -line 
            -linestop -lineanchor -about <expression> --} {--}]
        if {[llength ${cmds}]} {
            return [string trim [MenuFromList $text $cmds]]
        }
    } else {
        set virtual_pos [expr ${pos} - [FirstNonOption ${line}]]
        switch -- ${virtual_pos} {
            1 { if {![llength ${mod}]} { return <string> } }
            2 { if {![llength ${mod}]} { return ?matchVar? } }
            default { if {![llength ${mod}]} { return ?subMatchVar? } }
        }
    }
    return ""
}

proc complete(regsub) {text start end line pos mod} {
    set prev [PreviousWord ${start} ${line}]
    if {[llength ${prev}] && ("-" == [string index ${prev} 0] || 1 == $pos)} {
        set cmds [RemoveUsedOptions ${line} {-all -nocase -- <expression>} {--}]
        set res [string trim [MenuFromList ${mod} ${cmds}]]
        if {[llength ${res}]} {
            return ${res}
        }
    } else {
        set virtual_pos [expr ${pos} - [FirstNonOption ${line}]]
        switch -- ${virtual_pos} {
            1 { if {![llength ${mod}]} { return <expression> } }
            2 { if {![llength ${mod}]} { return <string> } }
            3 { if {![llength ${mod}]} { return <subSpec> } }
            4 { if {![llength ${mod}]} { return <varName> } }
        }
    }
    return ""
}

proc complete(rename) {text start end line pos mod} {
    if {1 == $pos} {
        set all [CommandCompletion ${mod}]
        return [Format $all ${mod}]
    } elseif {2 == $pos && ![llength ${mod}]} {
        return <newName>
    }
    return ""
}

proc complete(return) {text start end line pos mod} {
    # TODO this is not perfect yet
    set cmds {-code -errorinfo -errorcode <string>}
    set res [MenuFromList [PreviousWord ${start} ${line}] ${cmds}]
    if {1 == [llength ${res}]} {
        switch -- ${res} {
            -errorinfo { if {![llength ${mod}]} { return <info> } }
            -code -
            -errorcode {
                set codes {ok error return break continue}
                return [AttemptFromList ${mod} ${codes}]
            }
        }
    }
    set cmds [RemoveUsedOptions ${line} ${cmds}]
    set res [string trim [MenuFromList ${mod} ${cmds}]]
    if {[llength ${res}]} {
        return ${res}
    }
    return ""
}

proc complete(seek) {text start end line pos mod} {
    if {1 == $pos} {
        return [ChannelId ${mod}]
    } elseif {2 == $pos} {
        return [AttemptFromList ${mod} {start current end}]
    }
    return ""
}

proc complete(set) {text start end line pos mod} {
    # puts stderr "\ntext=|$text| $start $end\n"
    # puts stderr \nline=|$line|\n
    # puts stderr \npos=|$pos|\n
    # puts stderr \nmod=|$mod|\n
    if {1 == $pos} {
        return [VarCompletion ${text}]
    } elseif {2 == $pos && ($text == "" || $text == "\"" || $text == "\{")} {
        set line [QuoteQuotes $line]
        if {[catch "set value [list [uplevel [info level] set [lindex $line 1]]]" msg]} {
            return ""
        } else {
            return [Quote $value ${text}]
        }
    }
    return ""
}

proc complete(socket) {text start end line pos mod} {
    set cmd [lindex ${line} 1]
    set prev [PreviousWord ${start} ${line}]
    if {"-server" == ${cmd}} {
        # server sockets
        #
        if {2 == $pos && ![llength ${mod}]} { return <command> }
        switch -- ${prev} {
            -myaddr { if {![llength ${mod}]} { return <addr> } }
        }
        return [AttemptFromList ${mod} [concat {-error -sockname -peername}]]
    } else {
        # client sockets
        #
        switch -- ${prev} {
            -myaddr { if {![llength ${mod}]} { return <addr> } }
            -myport { if {![llength ${mod}]} { return <port> } }
        }

        # read the host table only once.
        #
        variable hosts
        if {![info exists hosts] && "-server" != ${cmd}} {
            set id [open /etc/hosts r]
            set hosts ""
            if {0 != ${id}} {
                while {-1 != [gets ${id} line]} {
                    regsub {#.*} ${line} {} line
                    if {[llength ${line}] >= 2} {
                        lappend hosts [lindex ${line} 1]
                    }
                }
                close $id
            } 
        }
        set cmds {-myaddr -myport -async -myaddr -error -sockname -peername}
        if {$pos <= 1} {
            lappend cmds -server
        }
        return [AttemptFromList ${mod} [concat ${cmds} ${hosts}]]
    }
    return ""
}

proc complete(source) {text start end line pos mod} {
    return ""; # force file name completion
}

proc complete(string) {text start end line pos mod} {
    set cmd [lindex ${line} 1]
    set cmds {
        compare first index last length match range tolower
        totitle toupper trim trimleft trimright wordend wordstart}
    if {1 == $pos} {
        return [AttemptFromList ${mod} ${cmds}]
    } elseif {2 == $pos} {
        switch -- $cmd {
            compare -
            first -
            last { if {![llength ${mod}]} { return <string1> } }

            match { if {![llength ${mod}]} { return <pattern> } }

            index -
            length -
            range -
            tolower -
            totitle -
            toupper -
            trim -
            trimleft -
            trimright -
            wordend -
            wordstart { if {![llength ${mod}]} { return <string> } }
        }
    } elseif {3 == $pos} {
        switch -- $cmd {
            compare -
            first -
            last { if {![llength ${mod}]} { return <string2> } }

            index { if {![llength ${mod}]} { return <charIndex> } }
            length {}

            match { if {![llength ${mod}]} { return <string> } }

            range { if {![llength ${mod}]} { return <first> } }

            tolower -
            totitle -
            toupper {}

            trim -
            trimleft { if {![llength ${mod}]} { return ?chars? } }
            trimright -
            wordend -
            wordstart { if {![llength ${mod}]} { return <index> } }
        }
    }
    return ""
}

proc complete(subst) {text start end line pos mod} {
    set opts {-nobackslashes -nocommands -novariables}
    set opts [RemoveUsedOptions ${line} ${opts}]
    return [AttemptFromList ${mod} [concat ${opts} <string>]]
    return ""
}

proc complete(switch) {text start end line pos mod} {
    set opts {-exact -glob -regexp --}
    set opts [RemoveUsedOptions ${line} ${opts} {--}]
    return [AttemptFromList ${mod} [concat ${opts} <string>]]
    return ""
}

proc complete(tell) {text start end line pos mod} {
    if {1 == $pos} {
        return [ChannelId ${mod}]
    }
    return ""
}

proc complete(trace) {text start end line pos mod} {
    set cmd [lindex ${line} 1]
    if {1 == $pos} {
        return [AttemptFromList ${mod} {variable vdelete vinfo}]
    } elseif {2 == $pos} {
        return [Format [uplevel 2 info vars "${mod}*"] ${mod}]
    } elseif {3 == $pos && "variable" == ${cmd}} {
        return [AttemptFromList ${mod} {r w u}]
    }
    return ""
}

proc complete(update) {text start end line pos mod} {
    if {1 == $pos && ![llength ${mod}]} {
        return idletasks
    }
    return ""
}

proc complete(uplevel) {text start end line pos mod} {
    if {![llength ${mod}]} {
        if {1 == $pos} {
            return ?level?
        } elseif {2 == $pos} {
            return <command>
        } elseif {3 == $pos} {
            return ?arg?
        } elseif {4 == $pos} {
            return ?...?
        }
    }
    return ""
}

proc complete(upvar) {text start end line pos mod} {
    if {![llength ${mod}]} {
        if {1 == $pos} {
            return ?level?
        } elseif {2 == $pos} {
            return <otherVar>
        } elseif {3 == $pos} {
            return <myVar>
        } elseif {4 == $pos} {
            return ?...?
        }
    }
    return ""
}

proc complete(variable) {text start end line pos mod} {
    set modulo [expr $pos % 2]
    if {1 == ${modulo}} {
        return [VarCompletion ${mod}]
    } elseif {0 == ${modulo} && \
        ($text == "" || $text == "\"" || $text == "\{")} {
        set line [QuoteQuotes $line]
        incr pos -1
        if {[catch \
            "set value [list [uplevel [info level] set [lindex $line ${pos}]]]"\
            msg]} {
            return ""
        } else {
            return [Quote $value ${mod}]
        }
    }
    return ""
}

proc complete(vwait) {text start end line pos mod} {
    if {1 == ${pos}} {
        return [VarCompletion ${mod}]
    }
}

proc complete(unset) {text start end line pos mod} {
    return [VarCompletion ${text}]
}

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

# generic widget configuration

proc TrySubCmds {cmd} {
    set trystring ____
    set result ""
    if [catch {set result [${cmd} ${trystring}]} msg] {
        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}
                }

            }
        } 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]} {
                    lappend result [list ${sub}]
                }
            }
        }
    }
    return ${result}
}

proc WidgetList {pattern} {
    regsub {^([^\.])} ${pattern} {\.\1} pattern
    if {[winfo exists ${pattern}]} {
        return [winfo children ${pattern}]
    } else {
        regsub {.[^.]*$} $pattern {} pattern
        if {[winfo exists ${pattern}]} {
            return [winfo children ${pattern}]
        } else {
            return ""
        }
    }
}

proc complete(WIDGET) {text start end line pos mod} {
    set widget [lindex ${line} 0]
    set cmd [lindex ${line} 1]

    # first we build an option table
    #
    if {[catch [list set option_table [${widget} configure]] msg]} {
        return ""
    }
    foreach optline ${option_table} {
        if {5 != [llength ${optline}]} continue else {
            lappend options(switches) [lindex ${optline} 0]
            lappend options(value)    [lindex ${optline} 4]
        }
    }

    if {1 >= ${pos}} {
        set cmds [TrySubCmds ${widget}]
        if {[llength ${cmds}]} {
            return [AttemptFromList ${mod} ${cmds}]
        }
    } elseif {2 <= ${pos} && 
        ([string match ${cmd}* cget] || \
         [string match ${cmd}* configure])} {
        set prev [PreviousWord ${start} ${line}]
        #puts \nprev=|$prev|
        #puts switches=|$options(switches)|
        #puts found=[lsearch -exact ${prev} $options(switches)]
        if {-1 != [set found [lsearch -exact $options(switches) ${prev}]]} {
            if {![llength ${mod}]} {
                return [list "[lindex $options(value) ${found}]"]
            }
        } else {
            return [AttemptFromList ${mod} $options(switches)]
        }
    }
    return ""
}

proc complete(winfo) {text start end line pos mod} {
    set cmd [lindex ${line} 1]
    if {1 >= ${pos}} {
        set cmds [TrySubCmds winfo]
        if {[llength ${cmds}]} {
            return [AttemptFromList ${mod} ${cmds}]
        }
    } elseif {2 == ${pos}} {
        return [AttemptFromList ${mod} [WidgetList ${mod}]]
    }
    return ""
}

}; # namespace tclreadline

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