======
#
# tclline: An attempt at a pure tcl readline.
#
# This base code taken from http://wiki.tcl.tk/20215 and
# http://wiki.tcl.tk/16139
#
# Author: HCG
# Licence: "as freely available as possible" http://wiki.tcl.tk/4381
#
# Modified by rjmcmahon: fixes history and multiple key sequences per input char (may not assume atomic)
# Also added ability to extend the completion handlers
#
# Note: The wiki.tcl.tk is broken with respect to creating a new page and reverting back to an old page
# Some comments from the previous wiki page no longer shown as the file upload seem to overwrite the entire wiki page.
#
# [LV] Actually, it isn't broken - but there might be a misunderstanding in terms of the functionality of file upload.
# The comments on each page are literally part of the page itself. The file upload replaces the complete contents of the page with new contents
# Thus, if the comments would be useful to keep, you should download the current wiki text page, replace the portion of the page containing
# code or whatever with the new contents, then upload the entire page. By just uploading tclline, you are effectively saying "the only thing
# I want on this page is the contents of this file".
#
package provide TclReadLine 1.1

# Use Tclx if available:
catch {
      package require Tclx

      # Prevent sigint from killing our shell:
      signal ignore SIGINT
}

namespace eval TclReadLine {

    namespace export interact

    # Initialise our own env variables:
    variable PROMPT ">"
    variable COMPLETION_MATCH ""
    
    # Support extensions to the completion handling
    # which will be called in list order.
    # Initialize with the "open sourced" TCL base handler
    # taken from the wiki page
    variable COMPLETION_HANDLERS [list TclReadLine::handleCompletionBase]

    #
    #  This value was determined by measuring 
    #  a cygwin over ssh. 
    #
    variable READLINE_LATENCY 10 # in ms
    
    variable CMDLINE ""
    variable CMDLINE_CURSOR 0
    variable CMDLINE_LINES 0
    variable CMDLINE_PARTIAL
    
    variable ALIASES
    array set ALIASES {}
    
    variable forever 0
    
    # Resource and history files:
    variable HISTORY_SIZE 100
    variable HISTORY_LEVEL 0
    variable HISTFILE $::env(HOME)/.tclline_history
    variable  RCFILE $::env(HOME)/.tcllinerc
}

proc TclReadLine::ESC {} {
    return "\033"
}

proc TclReadLine::shift {ls} {
    upvar 1 $ls LIST
    set ret [lindex $LIST 0]
    set LIST [lrange $LIST 1 end]
    return $ret
}

proc TclReadLine::readbuf {txt} {
    upvar 1 $txt STRING
    
    set ret [string index $STRING 0]
    set STRING [string range $STRING 1 end]
    return $ret
}

proc TclReadLine::goto {row {col 1}} {
    switch -- $row {
        "home" {set row 1}
    }
    print "[ESC]\[${row};${col}H" nowait
}

proc TclReadLine::gotocol {col} {
    print "\r" nowait
    if {$col > 0} {
        print "[ESC]\[${col}C" nowait
    }
}

proc TclReadLine::clear {} {
    print "[ESC]\[2J" nowait
    goto home
}

proc TclReadLine::clearline {} {
    print "[ESC]\[2K\r" nowait
}

proc TclReadLine::getColumns {} {
    set cols 0
    if {![catch {exec stty -a} err]} {
        # check for Linux stlye stty output
        if {[regexp {rows (= )?(\d+); columns (= )?(\d+)} $err - i1 rows i2 cols]} {
            return $cols
        }
        # check for BSD style stty output
        if {[regexp { (\d+) rows; (\d+) columns;} $err - rows cols]} {
            return $cols
        }
    }
    return $cols
}

proc TclReadLine::localInfo {args} {
    set v [uplevel _info $args]
    if { [string equal "script" [lindex $args 0]] } {
        if { [string equal $v $TclReadLine::ThisScript] } {
            return ""
        }
    }
    return $v
}

proc TclReadLine::localPuts {args} {
    
    set l [llength $args]
    if { 3 < $l } {
        return -code error "Error: wrong \# args"
    }
    
    if { 1 < $l } {
        if { [string equal "-nonewline" [lindex $args 0]] } {
            if { 2 < $l } {
                # we don't send to channel...
                eval _origPuts $args
            } else {
                set str [lindex $args 1]
                append TclReadLine::putsString $str ;# no newline...
            }
        } else {
            # must be a channel
            eval _origPuts $args
        }
    } else {
        append TclReadLine::putsString [lindex $args 0] "\n"
    }
}

proc TclReadLine::prompt {{txt ""}} {
    
    if { "" != [info var ::tcl_prompt1] } {
        rename ::puts ::_origPuts
        rename TclReadLine::localPuts ::puts
        variable putsString
        set putsString ""
        eval [set ::tcl_prompt1]
        set prompt $putsString
        rename ::puts TclReadLine::localPuts
        rename ::_origPuts ::puts
    } else {
        variable PROMPT
        set prompt [subst $PROMPT]
    }
    set txt "$prompt$txt"
    variable CMDLINE_LINES
    variable CMDLINE_CURSOR
    variable COLUMNS
    foreach {end mid} $CMDLINE_LINES break
    
    # Calculate how many extra lines we need to display.
    # Also calculate cursor position:
    set n -1
    set totalLen 0
    set cursorLen [expr {$CMDLINE_CURSOR+[string length $prompt]}]
    set row 0
    set col 0
    
    # Render output line-by-line to $out then copy back to $txt:
    set found 0
    set out [list]
    foreach line [split $txt "\n"] {
        set len [expr {[string length $line]+1}]
        incr totalLen $len
        if {$found == 0 && $totalLen >= $cursorLen} {
            set cursorLen [expr {$cursorLen - ($totalLen - $len)}]
            set col [expr {$cursorLen % $COLUMNS}]
            set row [expr {$n + ($cursorLen / $COLUMNS) + 1}]
            
            if {$cursorLen >= $len} {
                set col 0
                incr row
            }
            set found 1
        }
        incr n [expr {int(ceil(double($len)/$COLUMNS))}]
        while {$len > 0} {
            lappend out [string range $line 0 [expr {$COLUMNS-1}]]
            set line [string range $line $COLUMNS end]
            set len [expr {$len-$COLUMNS}]
        }
    }
    set txt [join $out "\n"]
    set row [expr {$n-$row}]
    
    # Reserve spaces for display:
    if {$end} {
        if {$mid} {
            print "[ESC]\[${mid}B" nowait
        }
        for {set x 0} {$x < $end} {incr x} {
            clearline
            print "[ESC]\[1A" nowait
        }
    }
    clearline
    set CMDLINE_LINES $n
    
    # Output line(s):
    print "\r$txt"
    
    if {$row} {
        print "[ESC]\[${row}A" nowait
    }
    gotocol $col
    lappend CMDLINE_LINES $row
}

proc TclReadLine::print {txt {wait wait}} {
    # Sends output to stdout chunks at a time.
    # This is to prevent the terminal from
    # hanging if we output too much:
    while {[string length $txt]} {
        puts -nonewline [string range $txt 0 2047]
        set txt [string range $txt 2048 end]
        if {$wait == "wait"} {
            after 1
        }
    }
}

proc TclReadLine::unknown {args} {
    
    set name [lindex $args 0]
    set cmdline $TclReadLine::CMDLINE
    set cmd [string trim [regexp -inline {^\s*[^\s]+} $cmdline]]
    if {[info exists TclReadLine::ALIASES($cmd)]} {
        set cmd [regexp -inline {^\s*[^\s]+} $TclReadLine::ALIASES($cmd)]
    }
    
    set new [auto_execok $name]
    if {$new != ""} {
        set redir ""
        if {$name == $cmd && [info command $cmd] == ""} {
            set redir ">&@ stdout <@ stdin"
        }
        if {[catch {
            uplevel 1 exec $redir $new [lrange $args 1 end]} ret]
        } {
            return
        }
        return $ret
    }
    
    uplevel _unknown $args
}

proc TclReadLine::alias {word command} {
    variable ALIASES
    set ALIASES($word) $command
}

proc TclReadLine::unalias {word} {
    variable ALIASES
    array unset ALIASES $word
}

################################
# Key bindings
################################
proc TclReadLine::handleEscapes {} {
    
    variable CMDLINE
    variable CMDLINE_CURSOR
    
    upvar 1 keybuffer keybuffer
    set seq ""
    set found 0
    while {[set ch [readbuf keybuffer]] != ""} {
        append seq $ch

        switch -exact -- $seq {
            "\[A" { ;# Cursor Up (cuu1,up)
                handleHistory 1
                set found 1; break
            }
            "\[B" { ;# Cursor Down
                handleHistory -1
                set found 1; break
            }
            "\[C" { ;# Cursor Right (cuf1,nd)
                if {$CMDLINE_CURSOR < [string length $CMDLINE]} {
                    incr CMDLINE_CURSOR
                }
                set found 1; break
            }
            "\[D" { ;# Cursor Left
                if {$CMDLINE_CURSOR > 0} {
                    incr CMDLINE_CURSOR -1
                }
                set found 1; break
            }
            "\[H" -
            "\[7~" -
            "\[1~" { ;# home
                set CMDLINE_CURSOR 0
                set found 1; break
            }
            "\[3~" { ;# delete
                if {$CMDLINE_CURSOR < [string length $CMDLINE]} {
                    set CMDLINE [string replace $CMDLINE \
                                     $CMDLINE_CURSOR $CMDLINE_CURSOR]
                }
                set found 1; break
            }
            "\[F" -
            "\[K" -
            "\[8~" -
            "\[4~" { ;# end
                set CMDLINE_CURSOR [string length $CMDLINE]
                set found 1; break
            }
            "\[5~" { ;# Page Up
            }
            "\[6~" { ;# Page Down
            }
        }
    }
    return $found
}

proc TclReadLine::handleControls {} {
    
    variable CMDLINE
    variable CMDLINE_CURSOR
    
    upvar 1 char char
    upvar 1 keybuffer keybuffer
    
    # Control chars start at a == \u0001 and count up.
    switch -exact -- $char {
        \u0001 { ;# ^a
            set CMDLINE_CURSOR 0
        }
        \u0002 { ;# ^b
            if { $CMDLINE_CURSOR > 0 } {
                incr CMDLINE_CURSOR -1
            }
        }
        \u0004 { ;# ^d
            # should exit - if this is the EOF char, and the
            #   cursor is at the end-of-input
            if { 0 == [string length $CMDLINE] } {
                doExit
            }
            set CMDLINE [string replace $CMDLINE \
                             $CMDLINE_CURSOR $CMDLINE_CURSOR]
        }
        \u0005 { ;# ^e
            set CMDLINE_CURSOR [string length $CMDLINE]
        }
        \u0006 { ;# ^f
            if {$CMDLINE_CURSOR < [string length $CMDLINE]} {
                incr CMDLINE_CURSOR
            }
        }
        \u0007 { ;# ^g
            set CMDLINE ""
            set CMDLINE_CURSOR 0
        }
        \u000b { ;# ^k
            variable YANK
            set YANK  [string range $CMDLINE [expr {$CMDLINE_CURSOR  } ] end ]
            set CMDLINE [string range $CMDLINE 0 [expr {$CMDLINE_CURSOR - 1 } ]]
        }
        \u0019 { ;# ^y
            variable YANK
            if { [ info exists YANK ] } {
                set CMDLINE \
                    "[string range $CMDLINE 0 [expr {$CMDLINE_CURSOR - 1 }]]$YANK[string range $CMDLINE $CMDLINE_CURSOR end]"
            }
        }
        \u000e { ;# ^n
            handleHistory -1
        }
        \u0010 { ;# ^p
            handleHistory 1
        }
        \u0003 { ;# ^c
            # clear line
            set CMDLINE ""
            set CMDLINE_CURSOR 0
        }
        \u0008 -
        \u007f { ;# ^h && backspace ?
            if {$CMDLINE_CURSOR > 0} {
                incr CMDLINE_CURSOR -1
                set CMDLINE [string replace $CMDLINE \
                                 $CMDLINE_CURSOR $CMDLINE_CURSOR]
            }
        }
        \u001b { ;# ESC - handle escape sequences
            handleEscapes
        }
    }
    # Rate limiter:
    set keybuffer ""
}

proc TclReadLine::shortMatch {maybe} {
    # Find the shortest matching substring:
    set maybe [lsort $maybe]
    set shortest [lindex $maybe 0]
    foreach x $maybe {
        while {![string match $shortest* $x]} {
            set shortest [string range $shortest 0 end-1]
        }
    }
    return $shortest
}

proc TclReadLine::addCompletionHandler {completion_extension} {
    variable COMPLETION_HANDLERS
    set COMPLETION_HANDLERS [concat $completion_extension $COMPLETION_HANDLERS]
}

proc TclReadLine::delCompletionHandler {completion_extension} {
    variable COMPLETION_HANDLERS
    set COMPLETION_HANDLERS [lsearch -all -not -inline $COMPLETION_HANDLERS $completion_extension] 
}

proc TclReadLine::getCompletionHandler {} {
    variable COMPLETION_HANDLERS
    return "$COMPLETION_HANDLERS"
}

proc TclReadLine::handleCompletion {} {
    variable COMPLETION_HANDLERS
    foreach handler $COMPLETION_HANDLERS {
        if {[eval $handler] == 1} {
            break
        } 
    }
    return 
}

proc TclReadLine::handleCompletionBase {} {
    variable CMDLINE
    variable CMDLINE_CURSOR
    
    set vars ""
    set cmds ""
    set execs ""
    set files ""
    
    # First find out what kind of word we need to complete:
    set wordstart [string last " " $CMDLINE [expr {$CMDLINE_CURSOR-1}]]
    incr wordstart
    set wordend [string first " " $CMDLINE $wordstart]
    if {$wordend == -1} {
        set wordend end
    } else {
        incr wordend -1
    }
    set word [string range $CMDLINE $wordstart $wordend]
    
    if {[string trim $word] == ""} return
    
    set firstchar [string index $word 0]
    
    # Check if word is a variable:
    if {$firstchar == "\$"} {
        set word [string range $word 1 end]
        incr wordstart
        
        # Check if it is an array key:proc
        
        set x [string first "(" $word]
        if {$x != -1} {
            set v [string range $word 0 [expr {$x-1}]]
            incr x
            set word [string range $word $x end]
            incr wordstart $x
            if {[uplevel \#0 "array exists $v"]} {
                set vars [uplevel \#0 "array names $v $word*"]
            }
        } else {
            foreach x [uplevel \#0 {info vars}] {
                if {[string match $word* $x]} {
                    lappend vars $x
                }
            }
        }
    } else {
        # Check if word is possibly a path:
        if {$firstchar == "/" || $firstchar == "." || $wordstart != 0} {
            set files [glob -nocomplain -- $word*]
        }
        if {$files == ""} {
            # Not a path then get all possibilities:
            if {$firstchar == "\[" || $wordstart == 0} {
                if {$firstchar == "\["} {
                    set word [string range $word 1 end]
                    incr wordstart
                }
                # Check executables:
                foreach dir [split $::env(PATH) :] {
                    foreach f [glob -nocomplain -directory $dir -- $word*] {
                        set exe [string trimleft [string range $f \
                                                      [string length $dir] end] "/"]
                        
                        if {[lsearch -exact $execs $exe] == -1} {
                            lappend execs $exe
                        }
                    }
                }
                # Check commands:
                foreach x [info commands] {
                    if {[string match $word* $x]} {
                        lappend cmds $x
                    }
                }
            } else {
                # Check commands anyway:
                foreach x [info commands] {
                    if {[string match $word* $x]} {
                        lappend cmds $x
                    }
                }
            }
        }
        if {$wordstart != 0} {
            # Check variables anyway:
            set x [string first "(" $word]
            if {$x != -1} {
                set v [string range $word 0 [expr {$x-1}]]
                incr x
                set word [string range $word $x end]
                incr wordstart $x
                if {[uplevel \#0 "array exists $v"]} {
                    set vars [uplevel \#0 "array names $v $word*"]
                }
            } else {
                foreach x [uplevel \#0 {info vars}] {
                    if {[string match $word* $x]} {
                        lappend vars $x
                    }
                }
            }
        }
    }
    
    variable COMPLETION_MATCH
    set maybe [concat $vars $cmds $execs $files]
    set shortest [shortMatch $maybe]
    if {"$word" == "$shortest"} {
        if {[llength $maybe] > 1 && $COMPLETION_MATCH != $maybe} {
            set COMPLETION_MATCH $maybe
            clearline
            set temp ""
            foreach {match format} {
                vars  "35"
                cmds  "1;32"
                execs "32"
                files "0"
            } {
                if {[llength [set $match]]} {
                    append temp "[ESC]\[${format}m"
                    foreach x [set $match] {
                        append temp "[file tail $x] "
                    }
                    append temp "[ESC]\[0m"
                }
            }
            print "\n$temp\n"
        }
    } else {
        if {[file isdirectory $shortest] &&
            [string index $shortest end] != "/"} {
            append shortest "/"
        }
        if {$shortest != ""} {
            set CMDLINE \
                [string replace $CMDLINE $wordstart $wordend $shortest]
            set CMDLINE_CURSOR \
                [expr {$wordstart+[string length $shortest]}]
        } elseif { $COMPLETION_MATCH != " not found "} {
            set COMPLETION_MATCH " not found "
            print "\nNo match found.\n"
        }
    }
}

proc TclReadLine::handleHistory {x} {
    variable HISTORY_LEVEL
    variable HISTORY_SIZE
    variable CMDLINE
    variable CMDLINE_CURSOR
    variable CMDLINE_PARTIAL
    
    set maxid [expr [history nextid] - 1]
    if {$maxid > 0} {
        #
        #  Check for a top level command line and history event
        #  Store this command line locally (i.e. don't use the history stack)
        #
        if {$HISTORY_LEVEL == 0} {
            set CMDLINE_PARTIAL $CMDLINE
        } 
        incr HISTORY_LEVEL $x
        #
        #  Note:  HISTORY_LEVEL is used to offset into
        #  the history events.  It will be reset to zero 
        #  when a command is executed by tclline.
        #  
        #  Check the three bounds of
        #  1) HISTORY_LEVEL < 0 - Restore the top level cmd line (not in history stack)
        #  2) HISTORY_LEVEL > HISTORY_SIZE
        #  3) HISTORY_LEVEL > maxid
        #
        if {$HISTORY_LEVEL <= 0} {
            set HISTORY_LEVEL 0 
            if {[info exists CMDLINE_PARTIAL]} {
                set CMDLINE $CMDLINE_PARTIAL
                set CMDLINE_CURSOR [string length $CMDLINE]
            }
            return
        } elseif {$HISTORY_LEVEL > $maxid} {
            set HISTORY_LEVEL $maxid
        } elseif {$HISTORY_LEVEL > $HISTORY_SIZE} {
            set HISTORY_LEVEL $HISTORY_SIZE
        } 
        set id [expr ($maxid + 1) - $HISTORY_LEVEL]
        set cmd [history event $id]
        set CMDLINE $cmd
        set CMDLINE_CURSOR [string length $cmd]
    }
}

################################
# History handling functions
################################

proc TclReadLine::getHistory {} {
    variable HISTORY_SIZE
    
    set l [list]
    set e [history nextid]
    set i [expr $e - $HISTORY_SIZE]
    if {$i <= 0} {
        set i 1
    }
    for { set i } {$i < $e} {incr i} {
        lappend l [history event $i]
    }
    return $l
}

proc TclReadLine::setHistory {hlist} {
    foreach event $hlist {
        history add $event
    }
}

################################
# main()
################################

proc TclReadLine::rawInput {} {
    fconfigure stdin -buffering none -blocking 0
    fconfigure stdout -buffering none -translation crlf
    exec stty raw -echo
}

proc TclReadLine::lineInput {} {
    fconfigure stdin -buffering line -blocking 1
    fconfigure stdout -buffering line
    exec stty -raw echo
}

proc TclReadLine::doExit {{code 0}} {
    variable HISTFILE
    variable HISTORY_SIZE 

    # Reset terminal:
    #print "[ESC]c[ESC]\[2J" nowait
    
    restore ;# restore "info' command -
    lineInput
    
    set hlist [getHistory]
    #
    # Get rid of the TclReadLine::doExit, shouldn't be more than one
    #
    set hlist [lsearch -all -not -inline $hlist "TclReadLine::doExit"]
    set hlistlen [llength $hlist]
    if {$hlistlen > 0} {
        set f [open $HISTFILE w]
        if {$hlistlen > $HISTORY_SIZE} {
            set hlist [lrange $hlist [expr ($hlistlen - $HISTORY_SIZE - 1)] end]
        }
        foreach x $hlist {
            # Escape newlines:
            puts $f [string map {
                \n "\\n"
                "\\" "\\b"
            } $x]
        }
        close $f
    }
    
    exit $code
}

proc TclReadLine::restore {} {
    lineInput
    rename ::unknown TclReadLine::unknown
    rename ::_unknown ::unknown
}

proc TclReadLine::interact {} {

    rename ::unknown ::_unknown
    rename TclReadLine::unknown ::unknown
    
    variable RCFILE
    if {[file exists $RCFILE]} {
        source $RCFILE
    }

    # Load history if available:
    # variable HISTORY
    variable HISTFILE
    variable HISTORY_SIZE
    history keep $HISTORY_SIZE
    
    if {[file exists $HISTFILE]} {
        set f [open $HISTFILE r]
        set hlist [list]
        foreach x [split [read $f] "\n"] {
            if {$x != ""} {
                # Undo newline escapes:
                lappend hlist [string map {
                    "\\n" \n
                    "\\\\" "\\"
                    "\\b" "\\"
                } $x]
            }
        }
        setHistory $hlist
        unset hlist
        close $f
    }
    
    rawInput
    
    # This is to restore the environment on exit:
    # Do not unalias this!
    alias exit TclReadLine::doExit
    
    variable ThisScript [info script]
    
    tclline ;# emit the first prompt
    
    fileevent stdin readable TclReadLine::tclline
    variable forever
    vwait TclReadLine::forever
    
    restore
}


proc TclReadLine::check_partial_keyseq {buffer} {
    variable READLINE_LATENCY
    upvar $buffer keybuffer

    #
    # check for a partial esc sequence as tclline expects the whole sequence
    #
    if {[string index $keybuffer 0] == [ESC]} {
        #
        # Give extra time to read partial key sequences
        # 
        set timer  [expr [clock clicks -milliseconds] + $READLINE_LATENCY]
        while {[clock clicks -milliseconds] < $timer } {
            append keybuffer [read stdin]
        }
    }
}

proc TclReadLine::tclline {} {
    variable COLUMNS
    variable CMDLINE_CURSOR
    variable CMDLINE
    
    set char ""
    set keybuffer [read stdin]
    set COLUMNS [getColumns]
    
    check_partial_keyseq keybuffer
    
    while {$keybuffer != ""} {
        if {[eof stdin]} return
        set char [readbuf keybuffer]
        if {$char == ""} {
            # Sleep for a bit to reduce CPU overhead:
            after 40
            continue
        }
        
        if {[string is print $char]} {
            set x $CMDLINE_CURSOR
            
            if {$x < 1 && [string trim $char] == ""} continue
            
            set trailing [string range $CMDLINE $x end]
            set CMDLINE [string replace $CMDLINE $x end]
            append CMDLINE $char
            append CMDLINE $trailing
            incr CMDLINE_CURSOR
        } elseif {$char == "\t"} {
            handleCompletion
        } elseif {$char == "\n" || $char == "\r"} {
            if {[info complete $CMDLINE] &&
                [string index $CMDLINE end] != "\\"} {
                lineInput
                print "\n" nowait
                uplevel \#0 {
                    
                    # Handle aliases:
                    set cmdline $TclReadLine::CMDLINE
                    #
                    # Add the cmd line to history before doing any substitutions
                    # 
                    history add $cmdline
                    set cmd [string trim [regexp -inline {^\s*[^\s]+} $cmdline]]
                    if {[info exists TclReadLine::ALIASES($cmd)]} {
                        regsub -- "(?q)$cmd" $cmdline $TclReadLine::ALIASES($cmd) cmdline
                    }
                    
                    # Perform glob substitutions:
                    set cmdline [string map {
                        "\\*" \0
                        "\\~" \1
                    } $cmdline]
                    #
                    # Prevent glob substitution of *,~ for tcl commands
                    #
                    if {[info commands $cmd] != ""} {
                        set cmdline [string map {
                            "\*" \0
                            "\~" \1
                        } $cmdline]
                    }
                    while {[regexp -indices \
                                {([\w/\.]*(?:~|\*)[\w/\.]*)+} $cmdline x]
                       } {
                        foreach {i n} $x break
                        set s [string range $cmdline $i $n]
                        set x [glob -nocomplain -- $s]
                        
                        # If glob can't find anything then don't do
                        # glob substitution, pass * or ~ as literals:
                        if {$x == ""} {
                            set x [string map {
                                "*" \0
                                "~" \1
                            } $s]
                        }
                        set cmdline [string replace $cmdline $i $n $x]
                    }
                    set cmdline [string map {
                        \0 "*"
                        \1 "~"
                    } $cmdline]
                    
                    rename ::info ::_info
                    rename TclReadLine::localInfo ::info

                    # Reset HISTORY_LEVEL before next command
                    set TclReadLine::HISTORY_LEVEL 0
                    if {[info exists TclReadLine::CMDLINE_PARTIAL]} {
                        unset TclReadLine::CMDLINE_PARTIAL
                    }
                    
                    # Run the command:
                    set code [catch $cmdline res]
                    rename ::info TclReadLine::localInfo
                    rename ::_info ::info
                    if {$code == 1} {
                        TclReadLine::print "$::errorInfo\n"
                    } else {
                        TclReadLine::print "$res\n"
                    }
                    
                    set TclReadLine::CMDLINE ""
                    set TclReadLine::CMDLINE_CURSOR 0
                    set TclReadLine::CMDLINE_LINES {0 0}
                } ;# end uplevel
                rawInput
            } else {
                set x $CMDLINE_CURSOR
                
                if {$x < 1 && [string trim $char] == ""} continue
                
                set trailing [string range $CMDLINE $x end]
                set CMDLINE [string replace $CMDLINE $x end]
                append CMDLINE $char
                append CMDLINE $trailing
                incr CMDLINE_CURSOR
            }
        } else {
            handleControls
        }
    }
    prompt $CMDLINE
}

#
# Use the following to invoke readline  
#
# TclReadLine::interact
#
======


It might be faster to use [scan] vs. firing up the regex engine, especially as this is called for every character input.  Alternatively, if Tclx is available it makes more sense to trap SIGWINCH and update COLUMNS in the handler.
----
[wdb] works fine. 
How to manage that it is executed automatically on invoking tclsh?

[LV] See [tclshrc] for a suggestion.

[RLH] Does this mean readline can now work in tclsh?

[LV] I think it means that the code on this page works in tclsh. As long as that is what you mean by readline, then sure.

----
[tb] - 2009-12-16 - I just sourced this code into a tclkit-8.5.1 and noticed I had to escape the star in:

 info proc ::TclReadLine::\*

[AM} Yes, I can confirm that. Though: 

 info proc ::TclReadLine::g*

or
 
 info proc ::TclReadline::*g*

does work, so it seems to be a problem with a bare asterisk only. (The command that is stored contains the list of files that are present ...)


----
'''[LVwikignome] - 2009-12-16 08:33:33'''

If this code appears to be working well, perhaps it would be worthwhile considering adding it to [tcllib] or some similar commonly distributed package so that it is available readily.

----
'''[arjen] - 2009-12-18 05:48:42'''

I copied the code verbatim and had no problem whatsoever.

Nice work! (It really acts as an interactive shell, so that you can run external commands like ls and vi)

----
'''[mjs] - 2010-02-16 00:58:43'''

As with the previous version, the stty regexp doesn't work for BSD stty (e.g. Mac OS X).  This works for me:

======
    set cols 0
    if {![catch {exec stty -a} err]} {                                                                                              
        # match for BSD stty                                                                                                        
        regexp {(\d+) rows; (\d+) columns;} $err junk rows cols                                                                     
        if {$cols == 0} {                                                                                                           
            # match for Linux stty                                                                                                 
            regexp {rows (= )?(\d+); columns (= )?(\d+)} $err junk i1 rows i2 cols                                                  
        }                                                                                                                           
    }
======



----
'''[rjmcmahon] - 2010-03-03 13:22:11'''
Made a fix to handle preserving the command line under edit during history events.  See the code around CMDLINE_PARTIAL.  Note: Still need to look into adding mjs' BSD fix.  (Trying to find a MAC to verify.)

----
'''[rjmcmahon] - 2010-03-04 14:40:10'''

Made the fix (per mjs' commnet) to TclReadLine::getColumns enabling support for BSD style stty output.  Tested it on a MAC.

----
'''[rjmcmahon] - 2010-03-05 14:18:43'''

Found and fixed a bug when history was larger than history size and doExit is called.

----
'''[rjmcmahon] - 2010-03-12 19:19:59'''

Fix for glob substitutions of * and ~ so handled properly per shell, tcl command and history add.

----
'''[mocallins] - 2010-05-20 14:08:38'''

Problem with down arrow and last command on the stack.
Locks up tclsh and you have to go to another session and kill the process id :((

----
'''[SRIV] - 2010-05-26 08:33:38'''
Any error in this code will make the tclsh non-responsive because you loose control over the raw tty. I noted the same problem and after looking through the stack trace, I came up with a fix. I didn't go through all the code to try to understand how it was supposed to work, but I understand the fail condition.
Modify the last few lines of TclReadLine::handleHistory as follows.
======
set id [expr ($maxid + 1) - $HISTORY_LEVEL]
if {$id > $maxid} {
  set cmd ""
} else {
  set cmd [history event $id]
}
set CMDLINE $cmd
set CMDLINE_CURSOR [string length $cmd]
======

Unrelated to the bug above, when I place this code into ~/.tclshrc, I add the following line to the end:
======
if {$::tcl_interactive} {TclReadLine::interact}
======
so that it only is enabled from interactive shells, not running apps.
----
[rjmcmahon]

Fix down arrow bug
<<categories>>Category Dev. Tools