[wdb] For certain uses I need a very minimalistic shell window where Tk is not yet loaded. Below my `shell.tcl`.

Purpose: (1) play around with commands, (2) with my OS (Linux) send commands to the shell. The app name is like filename: `shell.tcl`.

Example: to write letter `a` to console window I use the command `send shell.tcl [list evalExpr "puts a"]`.

Key <Control-Up> sets cursor to previous command line. Key <Enter> on previous command line copies line to end. 

License (as always) [OLL]. Have fun!

======
#!/usr/bin/wish

# file: shell.tcl

package require Tk
tk appname shell.tcl
bind [winfo class .] <Destroy> exit

# create console window

destroy .shell
pack [frame .shell] -expand yes -fill both

grid [text .shell.t\
  -wrap none\
  -font "Monospace 10"\
  -yscrollcommand {.shell.v set}\
  -xscrollcommand {.shell.h set}]\
  [scrollbar .shell.v -orient vertical -command {.shell.t yview}]\
  -sticky news
grid [scrollbar .shell.h\
  -orient horizontal\
  -command {.shell.t xview}]\
  -sticky news
grid rowconfigure .shell 0 -weight 1
grid columnconfigure .shell 0 -weight 1

event add <<ToggleWrap>> <Escape><Key-space>

bind .shell.t <<ToggleWrap>> {
  if {[.shell.t cget -wrap] eq "none"} then {
    .shell.t configure -wrap char
    grid forget .shell.h
  } else {
    .shell.t configure -wrap none
    grid .shell.h -sticky news
  }
  after idle [list .shell.t see insert]
  break
}

after idle "event generate .shell.t <<ToggleWrap>>"

.shell.t tag configure prompt -foreground blue
.shell.t tag configure result -foreground green
.shell.t tag configure error -foreground red

bind .shell.t <Control-plus> {
  apply {win {lassign [$win cget -font] font size      
              $win configure -font [list $font [incr size 2]]}} %W
}
bind .shell.t <Control-minus> {
  apply {win {lassign [$win cget -font] font size
              if {$size >= 8} then {
                $win configure -font [list $font [incr size -2]]}}} %W
}
bind .shell.t <BackSpace> {
  if {[%W tag ranges sel] ne ""} then continue
  if {([%W get insert-1chars] eq " " &&
      "prompt" in [%W tag names insert-2chars]) ||
      "prompt" in [%W tag names insert-1chars]} then break
}
bind .shell.t <Left> {
  if {[apply {
        win {
          if {[$win tag ranges sel] ne ""} then {
            $win mark set insert sel.first
            $win tag remove sel 1.0 end
            return true
          } elseif {
            "prompt" in [$win tag names insert-1chars] ||
            "prompt" in [$win tag names insert-2chars]
          } then {
            lassign [$win tag prevrange prompt insert+1chars 1.0] start
            if {[$win compare $start != 1.0]} then {
              $win mark set insert $start-1chars
            }
            return true
          }
          return false
        }
      } %W]} then {
    %W see insert
    break
  }
}
bind .shell.t <Control-Left> continue
bind .shell.t <Shift-Left> continue
bind .shell.t <Delete> {
  if {[%W tag ranges sel] ne ""} then continue
  if {"prompt" in [%W tag names insert] ||
      ("prompt" in [%W tag names insert-1chars] &&
      [%W get insert] eq " ")  } then break
}
bind .shell.t <Right> {
  if {[%W tag ranges sel] ne ""} then {
    %W mark set insert sel.last
    %W tag remove sel 1.0 end
    break
  } elseif {"prompt" in [%W tag names insert+1chars]} then {
    %W mark set insert [lindex [%W tag nextrange prompt insert] end]+1chars
    break
  }
}
bind .shell.t <Control-Right> continue
bind .shell.t <Shift-Right> continue
bind .shell.t <Key-Home> {if {[cursorHome %W]} then break}
bind .shell.t <Key-Return> {
  if {[processReturnKey %W]} then break
}

bind .shell.t <Control-Up> {
  apply {
    win {
      lassign\
        [$win tag prevrange prompt "insert linestart - 1chars"] - idx
      if {$idx eq ""} then {
        set idx 1.0
      } elseif {[$win get $idx] eq " "} then {
        append idx +1chars
      }
      $win mark set insert $idx
    }
  } %W
  break
}

proc evalInputIfComplete {{win .shell.t}} {
  set src [inputText $win]
  if {[$win compare insert+1chars == end] && 
      [info complete $src]} then {
    if {[catch {set result [shell eval $src]} err]} then {
      message $err error
    } else {
      message $result
    }
    return true
  } else {
    return false
  }
}

proc processReturnKey {{win .shell.t}} {
  if {![copyCurrentLine $win]} then {
    $win insert insert \n ""
    $win see insert
    evalInputIfComplete $win
  }
  return true
}

proc message {msg {tag result} {win .shell.t}} {
  $win mark set insert end
  if {$msg ne ""} then {
    $win insert insert $msg $tag
  }
  prompt $win
  $win see insert
}

proc cursorHome {{win .shell.t}} {
  set range\
    [$win tag prevrange prompt "insert lineend" "insert linestart"]
  if {$range eq ""} then {
    return false
  } else {
    lassign $range - start
    if {[$win get $start] eq " "} then {
      $win mark set insert $start+1chars
    } else {
      $win mark set insert $start
    }
    return true
  }
}

proc prompt {{win .shell.t}} {
  $win mark set insert end
  if {[$win compare "insert linestart" < "insert lineend"]} then {
    $win insert insert \n ""
  }
  $win insert insert "%" prompt " "
  $win see insert
}

prompt
.shell.t delete 1.0

proc inputText {{win .shell.t}} {
  # content of last input line
  set promptRange [$win tag prevrange prompt end 1.0]
  lassign "$promptRange 0 1.0" - start
  if {[$win get $start] eq " "} then {
    set start $start+1chars
  }
  $win get $start end-1chars
}

proc copyCurrentLine {{win .shell.t}} {
  # copy current line to end of .shell.t
  set prev [$win tag prevrange prompt insert 1.0]
  if {$prev eq ""} then {
    set start 1.0
  } else {
    lassign $prev - start
    if {[$win get $start] eq " "} then {
      set start $start+1chars
    }
  }
  set next [$win tag nextrange prompt $start end]
  if {$next eq ""} then {
    # at end of text window, so do nothing
    return false
  } else {
    lassign $next end0
    set end $end0
    set nextResultRange [$win tag nextrange result $start end]
    if {$nextResultRange ne ""} then {
      lassign $nextResultRange end1
      if {[$win compare $end1 < $end]} then {
        set end $end1
      }
    }
    set nextErrorRange [$win tag nextrange error $start end]
    if {$nextErrorRange ne ""} then {
      lassign $nextErrorRange end2
      if {[$win compare $end2 < $end]} then {
        set end $end2
      }
    }
    set line [string trim [$win get $start $end] \n]
    $win mark set insert end
    $win insert insert $line
    $win see insert
    return true
  }
}

proc shellPuts args {
  set t .shell.t
  # $t insert insert \n ""
  switch -exact -- [llength $args] {
    1 {
      lassign $args arg
      $t insert end $arg\n result
      $t see insert
    }
    2 {
      lassign $args how text
      switch -exact -- $how {
        -nonewline {
          $t insert end $text result
        }
        stdout {
          $t insert end $text\n result
        }
        stderr {
          $t insert end $text\n error
        }
        default {
          shell eval __puts__ $args
        }
      }
    }
    default {
      shell eval __puts__ $args
    }
  }
}

interp create shell
shell eval rename puts __puts__
shell alias puts shellPuts
shell eval {
  proc echo args {puts $args}
  proc aloud args {putsFlat $args; uplevel $args}
  proc putsFlat str {puts [regsub -all {\n\s*} $str _]}
  proc putsVars args {
    puts [concat {*}[lmap var $args {list $var [uplevel set $var]}]]
  }
  proc sourceCode proc {
    # return source code of procedure $proc
    set proc [uplevel [list namespace origin $proc]]
    set arglist [list ]
    foreach arg [info args $proc] {
      if {[info default $proc $arg defaultvalue]} then {
        lappend arglist [list [list $arg] $defaultvalue]
      } else {
        lappend arglist [list $arg]
      }
    }
    list proc [namespace origin $proc] $arglist [info body $proc]
  }
  proc cat file {
    set chan [open $file r]
    set result [read $chan]
    close $chan
    set result
  }
}

proc evalExpr expr {
  if {[catch {shell eval $expr} result]} then {
    message $result error
  } else {
    message $result
  }
}

# main

if {$argv ne ""} then {
  evalExpr [lindex $argv 0]
} else {
  .shell.t delete 1.0 end
  catch {.shell.t insert end [exec fortune]\n\n result}
  .shell.t insert end\
    "Hint: Key sequence Escape, Space toggles text wrap!\n" prompt
  prompt
}
======

<<categories>>Enter Category Here