# A Tk console widget for SQLite.  Invoke sqlitecon::create with a window name,# a prompt string, a title to set a new top-level window, and the SQLite# database handle.  For example:##     sqlitecon::create .sqlcon {sql:- } {SQL Console} db## A toplevel window is created that allows you to type in SQL commands to# be processed on the spot.## A limited set of dot-commands are supported:##     .table#     .schema ?TABLE?#     .mode list|column|multicolumn|line#     .exit## In addition, a new SQL function named "edit()" is created.  This function# takes a single text argument and returns a text result.  Whenever the# the function is called, it pops up a new toplevel window containing a# text editor screen initialized to the argument.  When the "OK" button# is pressed, whatever revised text is in the text editor is returned as# the result of the edit() function.  This allows text fields of SQL tables# to be edited quickly and easily as follows:##    UPDATE table1 SET dscr = edit(dscr) WHERE rowid=15;## Create a namespace to work in#namespace eval ::sqlitecon {  # do nothing}# Create a console widget named $w.  The prompt string is $prompt.# The title at the top of the window is $title.  The database connection# object is $db#proc sqlitecon::create {w prompt title db} {  upvar #0 $w.t v  if {[winfo exists $w]} {destroy $w}  if {[info exists v]} {unset v}  toplevel $w  wm title $w $title  wm iconname $w $title  frame $w.mb -bd 2 -relief raised  pack $w.mb -side top -fill x  menubutton $w.mb.file -text File -menu $w.mb.file.m  menubutton $w.mb.edit -text Edit -menu $w.mb.edit.m  pack $w.mb.file $w.mb.edit -side left -padx 8 -pady 1  set m [menu $w.mb.file.m -tearoff 0]  $m add command -label {Close} -command "destroy $w"  sqlitecon::create_child $w $prompt $w.mb.edit.m  set v(db) $db  $db function edit ::sqlitecon::_edit}# This routine creates a console as a child window within a larger# window.  It also creates an edit menu named "$editmenu" if $editmenu!="".# The calling function is responsible for posting the edit menu.#proc sqlitecon::create_child {w prompt editmenu} {  upvar #0 $w.t v  if {$editmenu!=""} {    set m [menu $editmenu -tearoff 0]    $m add command -label Cut -command "sqlitecon::Cut $w.t"    $m add command -label Copy -command "sqlitecon::Copy $w.t"    $m add command -label Paste -command "sqlitecon::Paste $w.t"    $m add command -label {Clear Screen} -command "sqlitecon::Clear $w.t"    $m add separator    $m add command -label {Save As...} -command "sqlitecon::SaveFile $w.t"    catch {$editmenu config -postcommand "sqlitecon::EnableEditMenu $w"}  }  scrollbar $w.sb -orient vertical -command "$w.t yview"  pack $w.sb -side right -fill y  text $w.t -font fixed -yscrollcommand "$w.sb set"  pack $w.t -side right -fill both -expand 1  bindtags $w.t Sqlitecon  set v(editmenu) $editmenu  set v(history) 0  set v(historycnt) 0  set v(current) -1  set v(prompt) $prompt  set v(prior) {}  set v(plength) [string length $v(prompt)]  set v(x) 0  set v(y) 0  set v(mode) column  set v(header) on  $w.t mark set insert end  $w.t tag config ok -foreground blue  $w.t tag config err -foreground red  $w.t insert end $v(prompt)  $w.t mark set out 1.0  after idle "focus $w.t"}bind Sqlitecon <1> {sqlitecon::Button1 %W %x %y}bind Sqlitecon <B1-Motion> {sqlitecon::B1Motion %W %x %y}bind Sqlitecon <B1-Leave> {sqlitecon::B1Leave %W %x %y}bind Sqlitecon <B1-Enter> {sqlitecon::cancelMotor %W}bind Sqlitecon <ButtonRelease-1> {sqlitecon::cancelMotor %W}bind Sqlitecon <KeyPress> {sqlitecon::Insert %W %A}bind Sqlitecon <Left> {sqlitecon::Left %W}bind Sqlitecon <Control-b> {sqlitecon::Left %W}bind Sqlitecon <Right> {sqlitecon::Right %W}bind Sqlitecon <Control-f> {sqlitecon::Right %W}bind Sqlitecon <BackSpace> {sqlitecon::Backspace %W}bind Sqlitecon <Control-h> {sqlitecon::Backspace %W}bind Sqlitecon <Delete> {sqlitecon::Delete %W}bind Sqlitecon <Control-d> {sqlitecon::Delete %W}bind Sqlitecon <Home> {sqlitecon::Home %W}bind Sqlitecon <Control-a> {sqlitecon::Home %W}bind Sqlitecon <End> {sqlitecon::End %W}bind Sqlitecon <Control-e> {sqlitecon::End %W}bind Sqlitecon <Return> {sqlitecon::Enter %W}bind Sqlitecon <KP_Enter> {sqlitecon::Enter %W}bind Sqlitecon <Up> {sqlitecon::Prior %W}bind Sqlitecon <Control-p> {sqlitecon::Prior %W}bind Sqlitecon <Down> {sqlitecon::Next %W}bind Sqlitecon <Control-n> {sqlitecon::Next %W}bind Sqlitecon <Control-k> {sqlitecon::EraseEOL %W}bind Sqlitecon <<Cut>> {sqlitecon::Cut %W}bind Sqlitecon <<Copy>> {sqlitecon::Copy %W}bind Sqlitecon <<Paste>> {sqlitecon::Paste %W}bind Sqlitecon <<Clear>> {sqlitecon::Clear %W}# Insert a single character at the insertion cursor#proc sqlitecon::Insert {w a} {  $w insert insert $a  $w yview insert}# Move the cursor one character to the left#proc sqlitecon::Left {w} {  upvar #0 $w v  scan [$w index insert] %d.%d row col  if {$col>$v(plength)} {    $w mark set insert "insert -1c"  }}# Erase the character to the left of the cursor#proc sqlitecon::Backspace {w} {  upvar #0 $w v  scan [$w index insert] %d.%d row col  if {$col>$v(plength)} {    $w delete {insert -1c}  }}# Erase to the end of the line#proc sqlitecon::EraseEOL {w} {  upvar #0 $w v  scan [$w index insert] %d.%d row col  if {$col>=$v(plength)} {    $w delete insert {insert lineend}  }}# Move the cursor one character to the right#proc sqlitecon::Right {w} {  $w mark set insert "insert +1c"}# Erase the character to the right of the cursor#proc sqlitecon::Delete w {  $w delete insert}# Move the cursor to the beginning of the current line#proc sqlitecon::Home w {  upvar #0 $w v  scan [$w index insert] %d.%d row col  $w mark set insert $row.$v(plength)}# Move the cursor to the end of the current line#proc sqlitecon::End w {  $w mark set insert {insert lineend}}# Add a line to the history#proc sqlitecon::addHistory {w line} {  upvar #0 $w v  if {$v(historycnt)>0} {    set last [lindex $v(history) [expr $v(historycnt)-1]]    if {[string compare $last $line]} {      lappend v(history) $line      incr v(historycnt)    }  } else {    set v(history) [list $line]    set v(historycnt) 1  }  set v(current) $v(historycnt)}# Called when "Enter" is pressed.  Do something with the line# of text that was entered.#proc sqlitecon::Enter w {  upvar #0 $w v  scan [$w index insert] %d.%d row col  set start $row.$v(plength)  set line [$w get $start "$start lineend"]  $w insert end \n  $w mark set out end  if {$v(prior)==""} {    set cmd $line  } else {    set cmd $v(prior)\n$line  }  if {[string index $cmd 0]=="." || [$v(db) complete $cmd]} {    regsub -all {\n} [string trim $cmd] { } cmd2    addHistory $w $cmd2    set rc [catch {DoCommand $w $cmd} res]    if {![winfo exists $w]} return    if {$rc} {      $w insert end $res\n err    } elseif {[string length $res]>0} {      $w insert end $res\n ok    }    set v(prior) {}    $w insert end $v(prompt)  } else {    set v(prior) $cmd    regsub -all {[^ ]} $v(prompt) . x    $w insert end $x  }  $w mark set insert end  $w mark set out {insert linestart}  $w yview insert}# Execute a single SQL command.  Pay special attention to control# directives that begin with "."## The return value is the text output from the command, properly# formatted.#proc sqlitecon::DoCommand {w cmd} {  upvar #0 $w v  set mode $v(mode)  set header $v(header)  if {[regexp {^(\.[a-z]+)} $cmd all word]} {    if {$word==".mode"} {      regexp {^.[a-z]+ +([a-z]+)} $cmd all v(mode)      return {}    } elseif {$word==".exit"} {      destroy [winfo toplevel $w]      return {}    } elseif {$word==".header"} {      regexp {^.[a-z]+ +([a-z]+)} $cmd all v(header)      return {}    } elseif {$word==".tables"} {      set mode multicolumn      set cmd {SELECT name FROM sqlite_master WHERE type='table'               UNION ALL               SELECT name FROM sqlite_temp_master WHERE type='table'}      $v(db) eval {PRAGMA database_list} {         if {$name!="temp" && $name!="main"} {            append cmd "UNION ALL SELECT name FROM $name.sqlite_master\                        WHERE type='table'"         }      }      append cmd  { ORDER BY 1}    } elseif {$word==".fullschema"} {      set pattern %      regexp {^.[a-z]+ +([^ ]+)} $cmd all pattern      set mode list      set header 0      set cmd "SELECT sql FROM sqlite_master WHERE tbl_name LIKE '$pattern'               AND sql NOT NULL UNION ALL SELECT sql FROM sqlite_temp_master               WHERE tbl_name LIKE '$pattern' AND sql NOT NULL"      $v(db) eval {PRAGMA database_list} {         if {$name!="temp" && $name!="main"} {            append cmd " UNION ALL SELECT sql FROM $name.sqlite_master\                        WHERE tbl_name LIKE '$pattern' AND sql NOT NULL"         }      }    } elseif {$word==".schema"} {      set pattern %      regexp {^.[a-z]+ +([^ ]+)} $cmd all pattern      set mode list      set header 0      set cmd "SELECT sql FROM sqlite_master WHERE name LIKE '$pattern'               AND sql NOT NULL UNION ALL SELECT sql FROM sqlite_temp_master               WHERE name LIKE '$pattern' AND sql NOT NULL"      $v(db) eval {PRAGMA database_list} {         if {$name!="temp" && $name!="main"} {            append cmd " UNION ALL SELECT sql FROM $name.sqlite_master\                        WHERE name LIKE '$pattern' AND sql NOT NULL"         }      }    } else {      return \        ".exit\n.mode line|list|column\n.schema ?TABLENAME?\n.tables"    }  }  set res {}  if {$mode=="list"} {    $v(db) eval $cmd x {      set sep {}      foreach col $x(*) {        append res $sep$x($col)        set sep |      }      append res \n    }    if {[info exists x(*)] && $header} {      set sep {}      set hdr {}      foreach col $x(*) {        append hdr $sep$col        set sep |      }      set res $hdr\n$res    }  } elseif {[string range $mode 0 2]=="col"} {    set y {}    $v(db) eval $cmd x {      foreach col $x(*) {        if {![info exists cw($col)] || $cw($col)<[string length $x($col)]} {           set cw($col) [string length $x($col)]        }        lappend y $x($col)      }    }    if {[info exists x(*)] && $header} {      set hdr {}