- Supports input history, so you can use up/down keys to edit and re-execute your query (just like readline lets),
- You can use left/right and home/end keys to move across a query string and edit it (just like readline lets too),
- It always uses the same SQLite interface version as other scripts on the host, so you'll not get problems when you've created database by another script with one interface version and you're trying to read/modify it by the manager.
#!/usr/bin/env tclsh # tclline: An attempt at a pure tcl readline. set VER 1.0 # Use Tclx if available: catch { package require Tclx # Prevent sigint from killing our shell: signal ignore SIGINT } # Initialise our own env variables: foreach {var val} { PROMPT "sqlite) " 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 } unset var val array set ALIASES {} set forever 0 # Resource & history files: set HISTFILE $env(HOME)/.sqlite_history set RCFILE $env(HOME)/.sqliterc # Database set ver [package require sqlite] if {$argc != 1} { puts stderr "$argv0 <database file>" exit 1 } if {[catch {sqlite db $argv} res]} { puts stderr "Error:\n$res" exit 1 } puts "Console Sqlite Manager v$VER (SQLite interface version is $ver)" puts "Database opened: $argv" puts "\\h\tfor help.\n" # Procs proc pad {cnt char str} { set lgt [string length $str] if {$lgt < $cnt} { set addlgt [expr {$cnt - $lgt}] append str [string repeat $char $addlgt] } return $str } proc center {cnt char str} { set lgt [string length $str] if {$lgt >= $cnt} { return [string range $str 0 $cnt] } set spcs [expr $cnt-$lgt] set spcs [expr $spcs.0/2] if {[string index $spcs 2] == 5} { set lsp [string index $spcs 0] set rsp [expr [string index $spcs 0]+1] } else { set lsp [string index $spcs 0] set rsp [string index $spcs 0] } return "[string repeat $char $lsp]$str[string repeat $char $rsp]" } 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] return $ret } proc goto {row {col 1}} { switch -- $row { "home" {set row 1} } print "[ESC]\[${row};${col}H" nowait } proc gotocol {col} { print "\r" nowait if {$col > 0} { print "[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 prompt [subst $env(PROMPT)] set txt "$prompt$txt" foreach {end mid} $env(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 {$env(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 % $env(COLUMNS)}] set row [expr {$n + ($cursorLen / $env(COLUMNS)) + 1}] if {$cursorLen >= $len} { set col 0 incr row } set found 1 } incr n [expr {int(ceil(double($len)/$env(COLUMNS)))}] while {$len > 0} { lappend out [string range $line 0 [expr {$env(COLUMNS)-1}]] set line [string range $line $env(COLUMNS) end] set len [expr {$len-$env(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 env(CMDLINE_LINES) $n # Output line(s): print "\r$txt" if {$row} { print "[ESC]\[${row}A" nowait } gotocol $col lappend env(CMDLINE_LINES) $row } 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 ALIASES set name [lindex $args 0] set cmdline $env(CMDLINE) set cmd [string trim [regexp -inline {^\s*[^\s]+} $cmdline]] if {[info exists ALIASES($cmd)]} { set cmd [regexp -inline {^\s*[^\s]+} $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 } 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 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)] } } \u001b { ;# ESC - handle escape sequences handleEscapes } } # Rate limiter: set keybuffer "" } 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)] } if {$env(HISTORY_LEVEL) <= -1} { set env(HISTORY_LEVEL) -1 set env(CMDLINE) "" set env(CMDLINE_CURSOR) 0 } elseif {$env(HISTORY_LEVEL) > $hlen} { set env(HISTORY_LEVEL) $hlen } } ################################ # History handling functions ################################ proc getHistory {} { global env return $env(HISTORY) } proc setHistory {hlist} { global env set env(HISTORY) $hlist } proc appendHistory {cmdline} { global env set old [lsearch -exact $env(HISTORY) $cmdline] if {$old != -1} { set env(HISTORY) [lreplace $env(HISTORY) $old $old] } lappend env(HISTORY) $cmdline set env(HISTORY) [lrange $env(HISTORY) end-$env(HISTORY_BUFFER) end] } ################################ # main() ################################ proc rawInput {} { fconfigure stdin -buffering none -blocking 0 fconfigure stdout -buffering none -translation crlf exec stty raw -echo } proc lineInput {} { fconfigure stdin -buffering line -blocking 1 fconfigure stdout -buffering line exec stty -raw echo } proc doExit {{code 0}} { global env HISTFILE # Reset terminal: puts "" lineInput catch {db close} 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 do_select {cmd} { if {[catch { set i 0 set cols [list] db eval $cmd col { foreach c $col(*) { if {[info exists max($c)]} { if {[string length $col($c)] > $max($c)} { set max($c) [string length $col($c)] } } else { set max($c) [string length $col($c)] } lappend val($i) [list $c $col($c)] } incr i set cols $col(*) } set wd 15 foreach c $cols { if {$max($c) < $wd} { if {$max($c) > [string length $c]} { set width($c) $max($c) } else { set width($c) [string length $c] } } else { set width($c) $wd } } set buf "" set f 1 foreach row [lsort -dictionary [array names val]] { if {$f} { # Horizontal line set fcol 1 foreach c $cols { if {!$fcol} { append buf "+" } append buf "[pad $width($c) {-} {}]" set fcol 0 } set f 0 append buf "\n" # Header set fcol 1 foreach c $cols { if {!$fcol} { append buf "|" } append buf "[center $width($c) { } $c]" set fcol 0 } append buf "\n" # Horizontal line set fcol 1 foreach c $cols { if {!$fcol} { append buf "+" } append buf "[pad $width($c) {-} {}]" set fcol 0 } set f 0 append buf "\n" } # Rows set fcol 1 foreach c $cols { if {!$fcol} { append buf "|" } foreach v $val($row) { if {[lindex $v 0] == $c} { append buf "[pad $width($c) { } [string range [lindex $v 1] 0 [expr {$wd-1}]]]" break } } set fcol 0 } append buf "\n" } # Horizontal line set fcol 1 foreach c $cols { if {!$fcol} { append buf "+" } append buf "[pad $width($c) {-} {}]" set fcol 0 } set f 0 append buf "\n" return $buf } res]} { return "$res" } } proc handleExecuteCmd {cmd} { switch -- [string range $cmd 0 1] { "\\h" { append buf "\\h\tfor help\n" append buf "\\e\tto execute Tcl command (\[db] is a database object)\n" append buf "\\s\talternative SELECT results display method. Use for long cell values.\n" append buf "\\l\tlists all tables in database.\n" append buf "\\t\tshows table structure (columns, types, etc).\n" append buf "\\q\tto quit\n" } "\\q" { db close doExit } "\\e" { catch {[eval [string range $cmd 3 end]]} res return $res } "\\l" { append buf "\nTables:\n" append buf "-------\n" db eval {SELECT name FROM sqlite_master WHERE type = 'table'} col { append buf "$col(name)\n" } append buf "\n" } "\\t" { set tb [string range $cmd 3 end] if {$tb == ""} return append buf "----------------------+-----------+--------------+----------\n" append buf " Column name | Data type | Default Val. | Not NULL \n" append buf "----------------------+-----------+--------------+----------\n" if {[catch { db eval "PRAGMA table_info($tb)" { append buf "[pad 22 { } $name]|[pad 11 { } $type]|[pad 14 { } $dflt_value]|[center 10 { } [expr {$notnull == 1 ? true : {}}]]\n" } } res]} { append buf "$res\n" } append buf "----------------------+-----------+--------------+----------\n" } "\\s" { append buf "----- START -----\n" set f 1 if {[catch { db eval [string range $cmd 3 end] col { if {$f} { set max 0 foreach c $col(*) { if {[string length $c] > $max} { set max [string length $c] } } set f 0 } else { append buf "\n" } foreach c $col(*) { append buf "[pad $max { } $c] = '$col($c)'\n" } } } res]} { append buf "$res\n" } append buf "------ END ------" return $buf } default { if {[string tolower [lindex [split $cmd] 0]] != "select"} { catch {db eval $cmd} res append buf "$res\n" } else { append buf [do_select $cmd] } } } } if {[file exists $RCFILE]} { source $RCFILE } # Load history if available: if {[llength $env(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 doExit proc tclline {} { global env set char "" set keybuffer [read stdin] set env(COLUMNS) [getColumns] while {$keybuffer != ""} { 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) } elseif {$char == "\n" || $char == "\r"} { if {[info complete $env(CMDLINE)] && [string index $env(CMDLINE) end] != "\\"} { lineInput print "\n" nowait uplevel #0 { global env ALIASES # Handle aliases: set cmdline $env(CMDLINE) set cmd [string trim [regexp -inline {^\s*[^\s]+} $cmdline]] if {[info exists ALIASES($cmd)]} { regsub -- "(?q)$cmd" $cmdline $ALIASES($cmd) cmdline } # Run the command: #catch $cmdline res set res [handleExecuteCmd $cmdline] if {$res != ""} { print "$res\n" } # Append HISTORY: set env(HISTORY_LEVEL) -1 appendHistory $env(CMDLINE) set env(CMDLINE) "" set env(CMDLINE_CURSOR) 0 set env(CMDLINE_LINES) {0 0} } rawInput } else { 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) } } else { handleControls } } prompt $env(CMDLINE) } tclline fileevent stdin readable tclline vwait forever doExit
DKF: Interesting. I wonder if it is possible to split this into two parts: a generic readline engine and the code to specialize it for working with sqlite...Googie: It would be. There are few problems to solve: 1) Command/file completion is disturbing here, 2) '*' character substitution (glob file matching), 3) external code has to be able to connect to line handling (see procedure handleExecuteCmd above).I see the following ways to solve them: 1) Should be configurable via boolean variable (enable/disable), 2) same as 1st point, 3) let tclline procedure be more flexible, put some list variable into it, that would say which other procedures should be called to handle input line.It would be also nice to be able to connect to single character handling.MJ: readline seems to be providing the points above already, however it is not Tcl only.