[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].

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].

[slebetman] 14 Jul 2006: Implemented proper (not so buggy) word completion. Word completion first searches the filesystem, then falls back to tcl commands & procs and finally to (global?) variables. Implemented the '''alias''' and '''unalias''' commands. I needed them to support coloring in ''ls'' and ''vi'' (so I can do: ''alias ls {ls --color=auto}''). Also made history persistent by saving to a .tclline_history file and implemented a .tcllinerc file. The only remaining major features that's not yet implemented are long line editing and multi-line editing.

[slebetman]: New version. This now properly supports long line editing. Word completion now colours hints: commands are green, variables magenta everything else not coloured. I've also implemented "universal" command substitution which substitutes not only Tcl commands and procs but also substitutes executables via [exec]. So now you can do things like: '''set x [[split [[cat /etc/mtab]] \n]]'''. Multi-line editing is still not implemented.

  #! /usr/bin/env tclsh
  # tclline: An attempt at a pure tcl readline.
  
  # Initialise our own env variables:
  foreach {var val} {
      PROMPT ">"
      HISTORY ""
      HISTORY_BUFFER 100
      COMPLETION_MATCH ""
  } {
      if {![info exists env($var)]} {
          set env($var) $val
      }
  }
  foreach {var val} {
      CMDLINE ""
      CMDLINE_CURSOR 0
      CMDLINE_LINES 0
      HISTORY_LEVEL -1
  } {
      set env($var) $val
  }
  
  array set ALIASES {}
  
  # Initialise HISTORY if available:
  set HISTFILE $env(HOME)/.tclline_history
  set RCFILE $env(HOME)/.tcllinerc
  if {[llength $env(HISTORY)] == 0} {
      if {[file exists $HISTFILE]} {
          set f [open $HISTFILE r]
          set env(HISTORY) [split [read $f] "\n"]
          close $f
      }
  }
  
  proc ESC {} {
      return "\033"
  }
  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}
      }
      print "[ESC]\[${row};${col}H" nowait
  }
  proc gotocol {col} {
      print "\r[ESC]\[${col}C" nowait
  }
  proc clear {} {
      print "[ESC]\[2J" nowait
      goto home
  }
  proc clearline {} {
      print "[ESC]\[2K\r" nowait
  }
  proc getColumns {} {
      set cols 0
      if {![catch {exec stty -a} err]} {
          regexp {rows \d+; columns (\d+)} $err -> cols
      }
      return $cols
  }
  proc prompt {{txt ""}} {
      global env
      
      set env(COLUMNS) [getColumns]
      set prompt [subst $env(PROMPT)]
      set txt "$prompt$txt"
      set len [string length $txt]
      foreach {end mid} $env(CMDLINE_LINES) break
      
      # Calculate how many extra lines we need to display:
      set n [expr {int(ceil(double($len)/$env(COLUMNS)))-1}]
      
      # 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 env(CMDLINE_LINES) $n
      
      # Output line(s):
      print "\r$txt"
      
      # Set cursor position:
      set len [expr {$env(CMDLINE_CURSOR)+[string length $prompt]}]
      set col [expr {$len % $env(COLUMNS)}]
      set n [expr {$n-($len / $env(COLUMNS))}]
      if {$n <= 0} {
          if {$col == 0} {
              set col [expr {$env(COLUMNS)-1}]
          }
          set n 0
      } elseif {$n} {
          print "[ESC]\[${n}A" nowait
      }
      gotocol $col
      lappend env(CMDLINE_LINES) $n
  }
  proc 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
          }
      }
  }
  
  rename unknown _unknown
  proc unknown {args} {
      global env
  
      set name [lindex $args 0]
      set cmdline $env(CMDLINE)
      set cmd [string trim [regexp -inline {^\s*\w+} $cmdline]]
      
      set new [auto_execok $name]
      if {[string compare {} $new]} {
          set redir ""
          if {$name == $cmd && [info command $cmd] == ""} {
              set redir ">&@ stdout <@ stdin"
          }
          return [uplevel 1 exec $redir $new [lrange $args 1 end]]
      }
      
      eval _unknown $args
  }
  
  proc alias {word command} {
      global ALIASES
      set ALIASES($word) $command
  }
  
  proc unalias {word} {
      global ALIASES
      array unset ALIASES $word
  }
  
  ################################
  # 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~" { ;# Page Up }
              "\[6~" { ;# Page Down }
          }
      }
      return $found
  }
  
  proc handleControls {} {
      global env
      upvar 1 char char
      upvar 1 keybuffer keybuffer
  
      # 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)]
                  
                  prompt $env(CMDLINE)
              }
          }
          \u001b { ;# ESC - handle escape sequences
              if {[handleEscapes]} {
                  prompt $env(CMDLINE)
              }
          }
      }
      # Rate limiter:
      set keybuffer ""
  }
  
  proc 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 handleCompletion {} {
      global env
      set vars ""
      set cmds ""
      set execs ""
      set files ""
      
      # 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
      
      # Check if word is a variable:
      if {[string index $word 0] == "\$"} {
          foreach x [uplevel #0 {info vars}] {
              set x "\$$x"
              if {[string match $word* $x]} {
                  lappend vars $x
              }
          }
      } else {
          # Check if word is possibly a path:
          if {[string index $word 0] == "/" ||
              [string index $word 0] == "." ||
              $wordstart != 0
          } {
              set files [glob -nocomplain $word*]
          }
          if {$files == ""} {
              # Not a path then get all possibilities:
              if {$wordstart == 0} {
                  # Check executables:
                  foreach dir [split $env(PATH) :] {
                      foreach f [glob -nocomplain -directory $dir $word*] {
                          lappend execs [string trimleft \
                              [string range $f \
                                  [string length $dir] end] "/"]
                      }
                  }
              } else {
                  # Check variables anyway:
                  foreach x [uplevel #0 {info vars}] {
                      if {[string match $word* $x]} {
                          lappend vars $x
                      }
                  }
              }
              # Check commands:
              foreach x [info commands] {
                  if {[string match $word* $x]} {
                      lappend cmds $x
                  }
              }
          }
      }
      
      set maybe [concat $vars $cmds $execs $files]
      set shortest [shortMatch $maybe]
      if {"$word" == "$shortest"} {
          if {[llength $maybe] > 1 && $env(COMPLETION_MATCH) != $maybe} {
              clearline
              set temp ""
              foreach {match format} {
                  vars  "35"
                  cmds  "32"
                  execs "32"
                  files "0"
              } {
                  if {[llength $match]} {
                      append temp "[ESC]\[${format}m"
                      foreach x [set $match] {
                          append temp "[file tail $x] "
                      }
                      append temp "[ESC]\[0m"
                  }
              }
              print "\n$temp\n"
          }
          set env(COMPLETION_MATCH) $maybe
      } else {
          if {[file isdirectory $shortest] &&
              [string index $shortest end] != "/"} {
              append shortest "/"
          }
          if {$shortest != ""} {
              set env(CMDLINE) \
                  [string replace $env(CMDLINE) $wordstart end $shortest]
          } else {
              print "\nNo match found.\n"
          }
      }
      set env(CMDLINE_CURSOR) [string length $env(CMDLINE)]
      prompt $env(CMDLINE)
  }
  
  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)
      }
      if {$env(HISTORY_LEVEL) <= -1} {
          set env(HISTORY_LEVEL) -1
          set env(CMDLINE) ""
          set env(CMDLINE_CURSOR) 0
          prompt ""
      } 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 {{code 0}} {
      global env HISTFILE
      
      # Reset terminal:
      print "[ESC]c[ESC]\[2J" nowait
      lineInput
      
      if {[llength $env(HISTORY)] > 0} {
          set f [open $HISTFILE w]
          puts -nonewline $f [join $env(HISTORY) "\n"]
          close $f
      }
      
      exit $code
  }
  
  if {[file exists $RCFILE]} {
      source $RCFILE
  }
  
  rawInput
  prompt
  
  # This is to restore the environment on exit:
  # Do not unalias this!
  alias exit doExit
  
  proc tclline {} {
      global env
      set char ""
      set keybuffer ""
      
      while {1} {
          append keybuffer [read stdin]
          if {[eof stdin]} return
          set char [readbuf keybuffer]
          if {$char == ""} {
              # Sleep for a bit to reduce CPU time:
              after 40
              continue
          }
          
          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)
              
              if {$keybuffer == ""} {
                  prompt $env(CMDLINE)
              }
          } elseif {$char == "\t"} {
              handleCompletion
          } elseif {$char == "\n" || $char == "\r"} {
              after 1 {
                  global env ALIASES
                  print "\n" nowait
                  
                  # Handle aliases:
                  set cmdline $env(CMDLINE)
                  set cmd [string trim [regexp -inline {^\s*\w+} $cmdline]]
                  if {[info exists ALIASES($cmd)]} {
                      regsub -- "(?q)$cmd" $cmdline $ALIASES($cmd) cmdline
                  }
                  
                  # Run the command:
                  catch $cmdline res
                  print "$res\n"
                  
                  # 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(HISTORY) \
                      [lrange $env(HISTORY) end-$env(HISTORY_BUFFER) end]
                  
                  set env(CMDLINE) ""
                  set env(CMDLINE_CURSOR) 0
                  rawInput
                  prompt
                  after 1 tclline
              }
              lineInput
              return
          } else {
              handleControls
          }
      }
  }
  tclline
  
  vwait forever
  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}"

[rdt] 2006.07.13 - With some changes, that is what I did to use the 8.4 unknown.
Is there some reason that you did not use the history.tcl present in the distribution or is not present in yours?  I made use of it myself.

[slebetman]: I didn't know how to use it. I thought that history would always take the last executed command which also means the code in tclline itself. Now that I've tried it I see that's not really the case. But I still prefer my implementation since it removes duplicate events ''(This have been my pet peeve with almost all implementations of history, from tcl to bash to DOSKEY)''. Besides, an implementation of history is really is almost ''nothing''. It is merely an '''lappend''' to a list.

[rdt] 2006.07.14 - I understand what you are saying, however: history can be used in at least two ways.  Suppose that you need to redo a command from much earlier but don't remember the id.  You 'history | grep <something_unique>' and discover that it was 987.  You can then '!987' and redo it.  You do a few commands and then say '!-3' to redo it again.  If you don't put duplicates in the list (or keep up with all the id's for a command), then one of these capabilities gets lost.  
I think what you really want is to keep all the items in the list but be able to display the list in several different ways: a) 'history' for the default full list, b) 'history -20' for the 20 most recent, c) 'history -b' for the list without duplicates, but show the first & last id, and d) 'history <some_re>' to show only those items that match <some_re>.

[SRIV] I prefer the current optimized history. Its quick and simple and conforms to the 80/20 rule. A grep-able history is nifty, but If I need that, I shouldn't be doing work in a single console anway. I'd switch my devel work to a gui workstation.

[slebetman] My implementation of history is grep-able anyway (well, [regexp]-able at least). It's just a list stored in an environment variable!
  foreach x $env(HISTORY) {if {[regexp $something_unique $x]} {puts $x}}
The only thing I don't have is history substitution (haven't implemented because frankly I've never used it). I believe [Tkcon] does it via [unknown] which means we can implement it too.