Version 15 of Pure-tcl readline2

Updated 2009-12-18 05:07:40 by rjmcmahon
  package provide TclReadLine 1.1

  #! /usr/bin/env tclsh
  # tclline: An attempt at a pure tcl readline.

  # 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 HISTORY ""
      variable HISTORY_BUFFER 100
      variable COMPLETION_MATCH ""

      variable CMDLINE ""
      variable CMDLINE_CURSOR 0
      variable CMDLINE_LINES 0

      variable ALIASES
      array set ALIASES {}

      variable forever 0

      # Resource & history files:
      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]} {
          regexp {rows (= )?(\d+); columns (= )?(\d+)} $err junk i1 rows i2 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::handleCompletion {} {
      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 CMDLINE
      variable CMDLINE_CURSOR

      set len [expr {[history nextid] -1}]
      if { $len > 0 } {
          if { [catch {incr HISTORY_LEVEL $x} index] } {
              set index [expr { $x==1 ? 0 : $len-1 }]
              set HISTORY_LEVEL $index
          }
          if { $len == 1 } {
              set cmd [history event 1]
          } else {
              set index [expr { int(fmod( $index, $len)) }]
              set id [expr {$len - $index}]
              set HISTORY_LEVEL $id
              set cmd [history event $id]
          }
          set CMDLINE $cmd
          set CMDLINE_CURSOR [string length $cmd]
      }
  }

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

  proc TclReadLine::getHistory {} {
      set l [list]
      set e [history nextid]
      for { set i 1 } {$i < $e} {incr i} {
          lappend l [history event $i]
      }
      return $l
  }

  proc TclReadLine::setHistory {hlist} {
      global env
      set env(HISTORY) $hlist
  }

  ################################
  # 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

      # Reset terminal:
      #print "[ESC]c[ESC]\[2J" nowait

      restore ;# restore "info' command - 
      lineInput

      set hlist [getHistory]
      if {[llength $hlist] > 0} {
          set f [open $HISTFILE w]
          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

      if { [info exists HISTORY] &&
           [llength $HISTORY] == 0} {
          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::tclline {} {
      variable COLUMNS
      variable CMDLINE_CURSOR
      variable CMDLINE

      set char ""
      set keybuffer [read stdin]
      set COLUMNS [getColumns]

      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
                      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]
                      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
                      # Run the command:
                      catch {history add $cmdline exec} res
                      rename ::info TclReadLine::localInfo
                      rename ::_info ::info
                      if {$res != ""} {
                          TclReadLine::print "$res\n"
                      }
                      # Append HISTORY:
                      catch {unset TclReadLine::HISTORY_LEVEL}

                      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
  }

  TclReadLine::interact

I had issues with this code on Tcl 8.3. It looks like history command was adding empty lines to the history list. I have implemented a bandaid check for that:

In TclReadLine::tclline instead of:

  catch {history add $cmdline exec} res

I put:

  if {$cmdline == "" } {
    set res ""
  } elseif { [regexp -- "^ +$" $cmdline]} {
    set res ""
  } else {
    catch {history add $cmdline exec} res
  }

Maybe it's too many checks but it started working for me after this change. pn0.


2009-06-18 pn0 I came up with idea of a little shorter TclReadLine::handleHistory.

 proc TclReadLine::handleHistory {x} {
        variable HISTORY_LEVEL
        variable CMDLINE
        variable CMDLINE_CURSOR
        set len [expr {[history nextid] -1}]
        set index [expr {$len - ($len + $HISTORY_LEVEL + $x) % ($len + 1)}]
        set HISTORY_LEVEL [expr {$len + 1 -$index }]
        if {$index == 0 } {
                set cmd ""
        } else {
                set cmd [history event $index]
        }
        set CMDLINE $cmd
        set CMDLINE_CURSOR [string length $cmd]
 }

That requres initialization of HISTORY_LEVEL in the namespace eval and resetting it to 0 after command is executed.


2009-11-01 MJS

The regexp for parsing the output of stty -a doesn't work for BSD flavours (e.g. Darwin). This is marginally more portable:

proc TclReadLine::getColumns {} {
  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 (etc) stty
      regexp {rows (= )?(\d+); columns (= )?(\d+)} $err junk i1 rows i2 cols
    }
  }
  return $cols
}

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.


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.


Here are some diffs to fix the history functionality diff -c -w -p -r1.1 TclReadLine.tcl *** UTF/TclReadLine.tcl 17 Dec 2009 00:33:37 -0000 1.1 --- UTF/TclReadLine.tcl 18 Dec 2009 00:48:48 -0000 *************** namespace eval TclReadLine {

24,31 *

      # Initialise our own env variables:
      variable PROMPT ">"

- variable HISTORY "" - variable HISTORY_BUFFER 100

      variable COMPLETION_MATCH ""

      variable CMDLINE ""

--- 24,29 ---- *************** namespace eval TclReadLine {

37,43 *

      variable forever 0

! # Resource & history files:

      variable HISTFILE $::env(HOME)/.tclline_history
      variable  RCFILE $::env(HOME)/.tcllinerc
  }

--- 35,43 ----

      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::handleCompletion {} {

558,582 *

  proc TclReadLine::handleHistory {x} {
      variable HISTORY_LEVEL
      variable CMDLINE
      variable CMDLINE_CURSOR

! set len expr {[history nextid -1}] ! if { $len > 0 } { ! if { catch {incr HISTORY_LEVEL $x} index } { ! set index expr { $x==1 ? 0 : $len-1 } ! set HISTORY_LEVEL $index ! } ! if { $len == 1 } { ! set cmd history event 1 ! } else { ! set index expr { int(fmod( $index, $len)) } ! set id expr {$len - $index} ! set HISTORY_LEVEL $id ! set cmd history event $id

        }
        set CMDLINE $cmd
        set CMDLINE_CURSOR [string length $cmd]
      }
  }

--- 558,580 ----

  proc TclReadLine::handleHistory {x} {
      variable HISTORY_LEVEL

+ variable HISTORY_SIZE

      variable CMDLINE
      variable CMDLINE_CURSOR

! set lastid expr [history nextid - 1] ! # puts "$lastid $HISTORY_LEVEL \n history" ! if {$lastid > 0} { ! if {$lastid > $HISTORY_SIZE} { ! set cmdoffset expr $HISTORY_LEVEL % $HISTORY_SIZE ! } else { ! set cmdoffset expr $HISTORY_LEVEL % $lastid

        }

+ set id expr $lastid - $cmdoffset + set cmd history event $id

        set CMDLINE $cmd
        set CMDLINE_CURSOR [string length $cmd]

+ set HISTORY_LEVEL incr HISTORY_LEVEL $x

      }
  }

*************** proc TclReadLine::handleHistory {x} {

585,601 *

  ################################

  proc TclReadLine::getHistory {} {
      set l [list]
      set e [history nextid]

! for { set i 1 } {$i < $e} {incr i} {

        lappend l [history event $i]
      }
      return $l
  }

  proc TclReadLine::setHistory {hlist} {

! global env ! set env(HISTORY) $hlist

  }

  ################################

--- 583,606 ----

  ################################

  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 ! }

  }

  ################################

*************** proc TclReadLine::doExit {{code 0}} {

624,629 *

--- 629,639 ----

      lineInput

      set hlist [getHistory]

+ # + # Get rid of the TclReadLine::doExit, shouldn't be more than one + # + set indice lsearch $hlist "TclReadLine::doExit" + set hlist lreplace $hlist $indice $indice

      if {[llength $hlist] > 0} {
        set f [open $HISTFILE w]
        foreach x $hlist {

*************** proc TclReadLine::interact {} {

656,666 *

      }

      # Load history if available:

! variable HISTORY

      variable HISTFILE

- if { info exists HISTORY && - llength $HISTORY == 0} {

        if {[file exists $HISTFILE]} {
            set f [open $HISTFILE r]
            set hlist [list]

--- 666,674 ----

      }

      # Load history if available:

! # variable HISTORY

      variable HISTFILE

      if {[file exists $HISTFILE]} {
        set f [open $HISTFILE r]
        set hlist [list]

*************** proc TclReadLine::interact {} {

678,684 *

            unset hlist
            close $f
        }

! }

      rawInput

--- 686,693 ----

        unset hlist
        close $f
      }

! variable HISTORY_SIZE ! history keep $HISTORY_SIZE

      rawInput

*************** proc TclReadLine::tclline {} {

777,784 *

                    if {$res != ""} {
                        TclReadLine::print "$res\n"
                    }

! # Append HISTORY: ! catch {unset TclReadLine::HISTORY_LEVEL}

                    set TclReadLine::CMDLINE ""
                    set TclReadLine::CMDLINE_CURSOR 0

--- 786,793 ----

                    if {$res != ""} {
                        TclReadLine::print "$res\n"
                    }

! # Reset HISTORY_LEVEL before next command ! set TclReadLine::HISTORY_LEVEL 0

                    set TclReadLine::CMDLINE ""
                    set TclReadLine::CMDLINE_CURSOR 0