[slebetman]: Here's my first attempt at a pure-tcl implementation of readline-like capabilities. Save this into a file '''tclline.tcl''' and source it from an interactive [tclsh].

Currently it supports history and a very buggy command/word completion.

The good news is that console programs like vi and links and even the [Linux Console Text Editor In Pure TCL] works perfectly with this. The less than good news is that colors somehow don't work automatically. They work, just not on by default. Maybe something to do with environment variables.

If you are brave enough with it you can even source it from your '''.tclshrc''' file.

[ak]: Note that the 'exec stty ...' is unix specific. It is also the one part we cannot do in pure Tcl. It is either the exec, or a C extension (like Expect (I think Expect can do the same changes to the pty stty is able of. IIRC)). Regarding colors, the terminal should be ANSI compatible. Like xterm. Needs TERM=xterm for this. See also the new 'term' module of [tcllib], which contains symbolic names/commands for lots of the command sequences recognized by an ansi terminal.

[slebetman]: Quite true ;) I guess this really should be called '''Unix/Linux Readline in Pure Tcl'''. Actually, ''stty'' is not the only dependency. This also assumes a VT100/xterm/linux terminal. The escape sequences won't work things like the COMSPEC shell or even [Tkcon].

Here's a newer version that handles line editing. The word completion is still very buggy:

  #! /usr/bin/env tclsh
  # tclline: An attempt at a pure tcl readline.
  
  # Initialise our own env variables if available:
  foreach {var val} {
      PROMPT ">"
      HISTORY ""
      HISTORY_LEVEL -1
      CMDLINE ""
      CMDLINE_CURSOR 0
      COMPLETION_MATCH ""
  } {
      if {![info exists env($var)]} {
          set env($var) $val
      }
  }
  
  # Initialise HISTORY if available:
  set HISTFILE $env(HOME)/.tclline_history
  if {[llength $env(HISTORY)] == 0} {
      if {[file exists $HISTFILE]} {
          set f [open $HISTFILE r]
          set env(HISTORY) [split [read $f] "\n"]
          close $f
      }
  }
  
  proc shift {ls} {
      upvar 1 $ls LIST
      set ret [lindex $LIST 0]
      set LIST [lrange $LIST 1 end]
      return $ret
  }
  proc readbuf {txt} {
      upvar 1 $txt STRING
      
      set ret [string index $STRING 0]
      set STRING [string range $STRING 1 end]
      if {$STRING == ""} {
          append STRING [read stdin]
      }
      return $ret
  }
  proc goto {row {col 1}} {
      switch -- $row {
          "home" {set row 1}
      }
      puts -nonewline "\u001b\[${row};${col}H"
  }
  proc gotocol {col} {
      puts -nonewline "\r\033\[${col}C"
  }
  proc clear {} {
      puts -nonewline "\033\[2J"
      goto home
  }
  proc clearline {} {
      puts -nonewline "\033\[2K\r"
  }
  proc prompt {{txt ""}} {
      global env
      clearline
      puts -nonewline "$env(PROMPT)$txt"
      gotocol [expr {$env(CMDLINE_CURSOR) + 1}]
  }
  
  # This was taken and modified from Tcl8.3 in interactive mode.
  proc unknown {args} {
      global auto_noexec auto_noload env unknown_pending tcl_interactive
      global errorCode errorInfo
  
      # If the command word has the form "namespace inscope ns cmd"
      # then concatenate its arguments onto the end and evaluate it.
  
      set cmd [lindex $args 0]
      if {[regexp "^namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} {
          set arglist [lrange $args 1 end]
      set ret [catch {uplevel 1 ::$cmd $arglist} result]
          if {$ret == 0} {
              return $result
          } else {
          return -code $ret -errorcode $errorCode $result
          }
      }
  
      # Save the values of errorCode and errorInfo variables, since they
      # may get modified if caught errors occur below.  The variables will
      # be restored just before re-executing the missing command.
  
      set savedErrorCode $errorCode
      set savedErrorInfo $errorInfo
      set name [lindex $args 0]
      if {![info exists auto_noload]} {
          #
          # Make sure we're not trying to load the same proc twice.
          #
          if {[info exists unknown_pending($name)]} {
              return -code error "self-referential recursion in \"unknown\" for command \"$name\"";
          }
          set unknown_pending($name) pending;
          set ret [catch {auto_load $name [uplevel 1 {::namespace current}]} msg]
          unset unknown_pending($name);
          if {$ret != 0} {
              append errorInfo "\n    (autoloading \"$name\")"
              return -code $ret -errorcode $errorCode -errorinfo $errorInfo $msg
          }
          if {![array size unknown_pending]} {
              unset unknown_pending
          }
          if {$msg} {
              set errorCode $savedErrorCode
              set errorInfo $savedErrorInfo
              set code [catch {uplevel 1 $args} msg]
              if {$code ==  1} {
              #
              # Strip the last five lines off the error stack (they're
              # from the "uplevel" command).
              #
  
              set new [split $errorInfo \n]
              set new [join [lrange $new 0 [expr {[llength $new] - 6}]] \n]
              return -code error -errorcode $errorCode  -errorinfo $new $msg
              } else {
              return -code $code $msg
              }
          }
      }
  
      if {[info exists tcl_interactive] && $tcl_interactive} {
          if {![info exists auto_noexec]} {
              set new [auto_execok $name]
              if {[string compare {} $new]} {
                  set errorCode $savedErrorCode
                  set errorInfo $savedErrorInfo
                  set redir ""
                  if {[string equal [info commands console] ""]} {
                      set redir ">&@stdout <@stdin"
                  }
                  return [uplevel 1 exec $redir $new [lrange $args 1 end]]
              }
          }
          set errorCode $savedErrorCode
          set errorInfo $savedErrorInfo
          if {[string equal $name "!!"]} {
              set newcmd [history event]
          } elseif {[regexp {^!(.+)$} $name dummy event]} {
              set newcmd [history event $event]
          } elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name dummy old new]} {
              set newcmd [history event -1]
              catch {regsub -all -- $old $newcmd $new newcmd}
          }
          if {[info exists newcmd]} {
              tclLog $newcmd
              history change $newcmd 0
              return [uplevel 1 $newcmd]
          }
  
          set ret [catch {set cmds [info commands $name*]} msg]
          if {[string equal $name "::"]} {
              set name ""
          }
          if {$ret != 0} {
          return -code $ret -errorcode $errorCode  \
            "error in unknown while checking if \"$name\" is a unique command abbreviation: $msg"
          }
          if {[llength $cmds] == 1} {
              return [uplevel 1 [lreplace $args 0 0 $cmds]]
          }
          if {[llength $cmds]} {
              if {[string equal $name ""]} {
              return -code error "empty command name \"\""
              } else {
              return -code error  "ambiguous command name \"$name\": [lsort $cmds]"
              }
          }
      }
      return -code error "invalid command name \"$name\""
  
  }
  
  ################################
  # Key bindings
  ################################
  proc handleEscapes {} {
      global env
      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 {$env(CMDLINE_CURSOR) < [string length $env(CMDLINE)]} {
                      incr env(CMDLINE_CURSOR)
                  }
                  set found 1; break
              }
              "\[D" { ;# Cursor Left
                  if {$env(CMDLINE_CURSOR) > 0} {
                      incr env(CMDLINE_CURSOR) -1
                  }
                  set found 1; break
              }
              "\[H" -
              "\[7~" -
              "\[1~" { ;# home
                  set env(CMDLINE_CURSOR) 0
                  set found 1; break
              }
              "\[3~" { ;# delete
                  if {$env(CMDLINE_CURSOR) < [string length $env(CMDLINE)]} {
                      set env(CMDLINE) [string replace $env(CMDLINE) \
                          $env(CMDLINE_CURSOR) $env(CMDLINE_CURSOR)]
                  }
                  set found 1; break
              }
              "\[F" -
              "\[K" -
              "\[8~" -
              "\[4~" { ;# end
                  set env(CMDLINE_CURSOR) [string length $env(CMDLINE)]
                  set found 1; break
              }
              "\[5~" { ;# 5 Page Up
                  set found 1; break
              }
              "\[6~" { ;# 6 Page Down
                  set found 1; break
              }
          }
      }
      if {$found == 0} {
          # unhandled escape
          # flush stdout
      }
  }
  
  proc handleControls {} {
  uplevel 1 {
      # Control chars start at a == \u0001 and count up.
      switch -exact -- $char {
          \u0003 { ;# ^c
              doExit
          }
          \u0008 -
          \u007f { ;# ^h && backspace ?
              if {$env(CMDLINE_CURSOR) > 0} {
                  incr env(CMDLINE_CURSOR) -1
                  set env(CMDLINE) [string replace $env(CMDLINE) \
                      $env(CMDLINE_CURSOR) $env(CMDLINE_CURSOR)]
              }
          }
          \u001b { ;# ESC - handle escape sequences
              handleEscapes
          }
      }
      # Rate limiter:
      set keybuffer ""
  }
  }
  
  proc handleCompletion {} {
      global env
      set maybe ""
      
      # First find out what kind of word we need to complete:
      set wordstart [string last " " $env(CMDLINE)]
      # incr wordstart
      set word [string range $env(CMDLINE) $wordstart end]
      
      if {[string trim $word] == ""} return
      
      # Get all possibilities, deal with duplicates later:
      if {$wordstart != 0} {
          set maybe [concat $maybe [glob -nocomplain $word*]]
      } else {
          foreach dir [split $env(PATH) :] {
              foreach f [glob -nocomplain -directory $dir $word*] {
                  lappend maybe [string trimleft \
                      [string range $f \
                          [string length $dir] end] "/"]
              }
          }
      }
      foreach fun [info procs] {
          if {[string match $word* $fun]} {
              lappend maybe $fun
          }
      }
      
      # Now find the shortest matching substring:
      set maybe [lsort $maybe]
      set shortest [lindex $maybe 0]
      foreach x $maybe {
          while {![string match $shortest* $x]} {
              if {"$word" == "$shortest"} break
              set shortest [string range $shortest 0 end-1]
          }
      }
      if {"$word" == "$shortest"} {
          if {[llength $maybe] > 1 && $env(COMPLETION_MATCH) != $maybe} {
              clearline
              puts "\n$maybe"
          }
          set env(COMPLETION_MATCH) $maybe
      } else {
          if {[file isdirectory $shortest] &&
              [string index $shortest end] != "/"} {
              append shortest "/"
          }
          set env(CMDLINE) [string replace $env(CMDLINE) $wordstart end $shortest]
      }
      set env(CMDLINE_CURSOR) [string length $env(CMDLINE)]
      prompt $env(CMDLINE)
      flush stdout
  }
  
  proc handleHistory {x} {
      global env
  
      set hlen [llength $env(HISTORY)]
      incr env(HISTORY_LEVEL) $x
      if {$env(HISTORY_LEVEL) > -1} {
          set env(CMDLINE) [lindex $env(HISTORY) end-$env(HISTORY_LEVEL)]
          set env(CMDLINE_CURSOR) [string length $env(CMDLINE)]
          prompt $env(CMDLINE)
          flush stdout
      }
      if {$env(HISTORY_LEVEL) <= -1} {
          set env(HISTORY_LEVEL) -1
          set env(CMDLINE) ""
          set env(CMDLINE_CURSOR) 0
          prompt ""
          flush stdout
      } elseif {$env(HISTORY_LEVEL) > $hlen} {
          set env(HISTORY_LEVEL) $hlen
      }
  }
  
  ################################
  # main()
  ################################
  
  proc rawInput {} {
      fconfigure stdin -buffering none -blocking 0
      fconfigure stdout -buffering none -translation crlf
      exec stty raw -echo
  }
  
  proc lineInput {} {
      exec stty -raw echo
  }
  
  proc doExit {} {
      global env HISTFILE
      
      # Reset terminal:
      puts -nonewline "\033c\033\[2J"
      flush stdout
      lineInput
      
      if {[llength $env(HISTORY)] > 0} {
          set f [open $HISTFILE w]
          puts -nonewline $f [join $env(HISTORY) "\n"]
          close $f
      }
      
      exit 0
  }
  
  set char ""
  set keybuffer ""
  
  rawInput
  prompt
  flush stdout
  
  while {$char != "\u0011"} {
      append keybuffer [read stdin]
      if {[eof stdin]} {return done}
      
      set char [readbuf keybuffer]
      if {$char != ""} {
          if {[string is print $char]} {
              set x $env(CMDLINE_CURSOR)
              
              if {$x < 1 && [string trim $char] == ""} continue
              
              set trailing [string range $env(CMDLINE) $x end]
              set env(CMDLINE) [string replace $env(CMDLINE) $x end]
              append env(CMDLINE) $char
              append env(CMDLINE) $trailing
              incr env(CMDLINE_CURSOR)
              
              prompt $env(CMDLINE)
              flush stdout
          } elseif {$char == "\t"} {
              handleCompletion
          } elseif {$char == "\n" || $char == "\r"} {
              set env(CMDLINE) [string trim $env(CMDLINE)]
              if {[string compare -length 4 $env(CMDLINE) "exit"]} {
                  lineInput
                  puts ""
                  catch $env(CMDLINE) res
                  puts $res
                  
                  # Append HISTORY:
                  set env(HISTORY_LEVEL) -1
                  set old [lsearch -exact $env(HISTORY) $env(CMDLINE)]
                  if {$old != -1} {
                      set env(HISTORY) [lreplace $env(HISTORY) $old $old]
                  }
                  lappend env(HISTORY) $env(CMDLINE)
  
                  set env(CMDLINE) ""
                  set env(CMDLINE_CURSOR) 0
                  rawInput
                  prompt
                  flush stdout
              } else {
                  doExit
              }
          } else {
              handleControls
              prompt $env(CMDLINE)
          }
      }
      after 40
  }
  doExit


to have tclline automatically available when you start [tclsh] add the following to your '''.tclshrc''' file:

  if {$tcl_interactive} {
    source /path/to/your/tclline.tcl
  }
[rdt] Nice idea, but my question is: Is the '''if''' test really necessary?  Isn't .tclshrc only read when tclsh is running interactively?  Next question: How about adding this into the interactive part of ''init.tcl'' ?

[rdt] Another question: I can't really see what you changed in the ''unknown'' proc as I have 8.4 and tkdiff on the two procs shows a '''lot''' of change in the 8.4 version.  So what did you change/add to that proc for your version?

[slebetman]: Only one simple thing: I removed the [[info level]] and [[info script]] test to allow unknown to call auto_execok from any level after the shell sources tclline. Try running the commands below in an interactive session of tclsh and see if the output makes sense. If it does, that's probably the only editing you need:

  set x [info body unknown]
  set x [regsub -all {if \{.{0,5}info level.{0,10}?&&} $x "if {"]
  set x [regsub -all {if \{.{0,5}info script.{0,10}?&&} $x "if {"]
  set x "proc unknown {[info args unknown]} {$x}"