AryaWu/sqlite
0
1# A Tk console widget for SQLite. Invoke sqlitecon::create with a window name,2# a prompt string, a title to set a new top-level window, and the SQLite3# database handle. For example:4#5# sqlitecon::create .sqlcon {sql:- } {SQL Console} db6#7# A toplevel window is created that allows you to type in SQL commands to8# be processed on the spot.9#10# A limited set of dot-commands are supported:11#12# .table13# .schema ?TABLE?14# .mode list|column|multicolumn|line15# .exit16#17# In addition, a new SQL function named "edit()" is created. This function18# takes a single text argument and returns a text result. Whenever the19# the function is called, it pops up a new toplevel window containing a20# text editor screen initialized to the argument. When the "OK" button21# is pressed, whatever revised text is in the text editor is returned as22# the result of the edit() function. This allows text fields of SQL tables23# to be edited quickly and easily as follows:24#25# UPDATE table1 SET dscr = edit(dscr) WHERE rowid=15;26#27 28 29# Create a namespace to work in30#31namespace eval ::sqlitecon {32 # do nothing33}34 35# Create a console widget named $w. The prompt string is $prompt.36# The title at the top of the window is $title. The database connection37# object is $db38#39proc sqlitecon::create {w prompt title db} {40 upvar #0 $w.t v41 if {[winfo exists $w]} {destroy $w}42 if {[info exists v]} {unset v}43 toplevel $w44 wm title $w $title45 wm iconname $w $title46 frame $w.mb -bd 2 -relief raised47 pack $w.mb -side top -fill x48 menubutton $w.mb.file -text File -menu $w.mb.file.m49 menubutton $w.mb.edit -text Edit -menu $w.mb.edit.m50 pack $w.mb.file $w.mb.edit -side left -padx 8 -pady 151 set m [menu $w.mb.file.m -tearoff 0]52 $m add command -label {Close} -command "destroy $w"53 sqlitecon::create_child $w $prompt $w.mb.edit.m54 set v(db) $db55 $db function edit ::sqlitecon::_edit56}57 58# This routine creates a console as a child window within a larger59# window. It also creates an edit menu named "$editmenu" if $editmenu!="".60# The calling function is responsible for posting the edit menu.61#62proc sqlitecon::create_child {w prompt editmenu} {63 upvar #0 $w.t v64 if {$editmenu!=""} {65 set m [menu $editmenu -tearoff 0]66 $m add command -label Cut -command "sqlitecon::Cut $w.t"67 $m add command -label Copy -command "sqlitecon::Copy $w.t"68 $m add command -label Paste -command "sqlitecon::Paste $w.t"69 $m add command -label {Clear Screen} -command "sqlitecon::Clear $w.t"70 $m add separator71 $m add command -label {Save As...} -command "sqlitecon::SaveFile $w.t"72 catch {$editmenu config -postcommand "sqlitecon::EnableEditMenu $w"}73 }74 scrollbar $w.sb -orient vertical -command "$w.t yview"75 pack $w.sb -side right -fill y76 text $w.t -font fixed -yscrollcommand "$w.sb set"77 pack $w.t -side right -fill both -expand 178 bindtags $w.t Sqlitecon79 set v(editmenu) $editmenu80 set v(history) 081 set v(historycnt) 082 set v(current) -183 set v(prompt) $prompt84 set v(prior) {}85 set v(plength) [string length $v(prompt)]86 set v(x) 087 set v(y) 088 set v(mode) column89 set v(header) on90 $w.t mark set insert end91 $w.t tag config ok -foreground blue92 $w.t tag config err -foreground red93 $w.t insert end $v(prompt)94 $w.t mark set out 1.095 after idle "focus $w.t"96}97 98bind Sqlitecon <1> {sqlitecon::Button1 %W %x %y}99bind Sqlitecon <B1-Motion> {sqlitecon::B1Motion %W %x %y}100bind Sqlitecon <B1-Leave> {sqlitecon::B1Leave %W %x %y}101bind Sqlitecon <B1-Enter> {sqlitecon::cancelMotor %W}102bind Sqlitecon <ButtonRelease-1> {sqlitecon::cancelMotor %W}103bind Sqlitecon <KeyPress> {sqlitecon::Insert %W %A}104bind Sqlitecon <Left> {sqlitecon::Left %W}105bind Sqlitecon <Control-b> {sqlitecon::Left %W}106bind Sqlitecon <Right> {sqlitecon::Right %W}107bind Sqlitecon <Control-f> {sqlitecon::Right %W}108bind Sqlitecon <BackSpace> {sqlitecon::Backspace %W}109bind Sqlitecon <Control-h> {sqlitecon::Backspace %W}110bind Sqlitecon <Delete> {sqlitecon::Delete %W}111bind Sqlitecon <Control-d> {sqlitecon::Delete %W}112bind Sqlitecon <Home> {sqlitecon::Home %W}113bind Sqlitecon <Control-a> {sqlitecon::Home %W}114bind Sqlitecon <End> {sqlitecon::End %W}115bind Sqlitecon <Control-e> {sqlitecon::End %W}116bind Sqlitecon <Return> {sqlitecon::Enter %W}117bind Sqlitecon <KP_Enter> {sqlitecon::Enter %W}118bind Sqlitecon <Up> {sqlitecon::Prior %W}119bind Sqlitecon <Control-p> {sqlitecon::Prior %W}120bind Sqlitecon <Down> {sqlitecon::Next %W}121bind Sqlitecon <Control-n> {sqlitecon::Next %W}122bind Sqlitecon <Control-k> {sqlitecon::EraseEOL %W}123bind Sqlitecon <<Cut>> {sqlitecon::Cut %W}124bind Sqlitecon <<Copy>> {sqlitecon::Copy %W}125bind Sqlitecon <<Paste>> {sqlitecon::Paste %W}126bind Sqlitecon <<Clear>> {sqlitecon::Clear %W}127 128# Insert a single character at the insertion cursor129#130proc sqlitecon::Insert {w a} {131 $w insert insert $a132 $w yview insert133}134 135# Move the cursor one character to the left136#137proc sqlitecon::Left {w} {138 upvar #0 $w v139 scan [$w index insert] %d.%d row col140 if {$col>$v(plength)} {141 $w mark set insert "insert -1c"142 }143}144 145# Erase the character to the left of the cursor146#147proc sqlitecon::Backspace {w} {148 upvar #0 $w v149 scan [$w index insert] %d.%d row col150 if {$col>$v(plength)} {151 $w delete {insert -1c}152 }153}154 155# Erase to the end of the line156#157proc sqlitecon::EraseEOL {w} {158 upvar #0 $w v159 scan [$w index insert] %d.%d row col160 if {$col>=$v(plength)} {161 $w delete insert {insert lineend}162 }163}164 165# Move the cursor one character to the right166#167proc sqlitecon::Right {w} {168 $w mark set insert "insert +1c"169}170 171# Erase the character to the right of the cursor172#173proc sqlitecon::Delete w {174 $w delete insert175}176 177# Move the cursor to the beginning of the current line178#179proc sqlitecon::Home w {180 upvar #0 $w v181 scan [$w index insert] %d.%d row col182 $w mark set insert $row.$v(plength)183}184 185# Move the cursor to the end of the current line186#187proc sqlitecon::End w {188 $w mark set insert {insert lineend}189}190 191# Add a line to the history192#193proc sqlitecon::addHistory {w line} {194 upvar #0 $w v195 if {$v(historycnt)>0} {196 set last [lindex $v(history) [expr $v(historycnt)-1]]197 if {[string compare $last $line]} {198 lappend v(history) $line199 incr v(historycnt)200 }201 } else {202 set v(history) [list $line]203 set v(historycnt) 1204 }205 set v(current) $v(historycnt)206}207 208# Called when "Enter" is pressed. Do something with the line209# of text that was entered.210#211proc sqlitecon::Enter w {212 upvar #0 $w v213 scan [$w index insert] %d.%d row col214 set start $row.$v(plength)215 set line [$w get $start "$start lineend"]216 $w insert end \n217 $w mark set out end218 if {$v(prior)==""} {219 set cmd $line220 } else {221 set cmd $v(prior)\n$line222 }223 if {[string index $cmd 0]=="." || [$v(db) complete $cmd]} {224 regsub -all {\n} [string trim $cmd] { } cmd2225 addHistory $w $cmd2226 set rc [catch {DoCommand $w $cmd} res]227 if {![winfo exists $w]} return228 if {$rc} {229 $w insert end $res\n err230 } elseif {[string length $res]>0} {231 $w insert end $res\n ok232 }233 set v(prior) {}234 $w insert end $v(prompt)235 } else {236 set v(prior) $cmd237 regsub -all {[^ ]} $v(prompt) . x238 $w insert end $x239 }240 $w mark set insert end241 $w mark set out {insert linestart}242 $w yview insert243}244 245# Execute a single SQL command. Pay special attention to control246# directives that begin with "."247#248# The return value is the text output from the command, properly249# formatted.250#251proc sqlitecon::DoCommand {w cmd} {252 upvar #0 $w v253 set mode $v(mode)254 set header $v(header)255 if {[regexp {^(\.[a-z]+)} $cmd all word]} {256 if {$word==".mode"} {257 regexp {^.[a-z]+ +([a-z]+)} $cmd all v(mode)258 return {}259 } elseif {$word==".exit"} {260 destroy [winfo toplevel $w]261 return {}262 } elseif {$word==".header"} {263 regexp {^.[a-z]+ +([a-z]+)} $cmd all v(header)264 return {}265 } elseif {$word==".tables"} {266 set mode multicolumn267 set cmd {SELECT name FROM sqlite_master WHERE type='table'268 UNION ALL269 SELECT name FROM sqlite_temp_master WHERE type='table'}270 $v(db) eval {PRAGMA database_list} {271 if {$name!="temp" && $name!="main"} {272 append cmd "UNION ALL SELECT name FROM $name.sqlite_master\273 WHERE type='table'"274 }275 }276 append cmd { ORDER BY 1}277 } elseif {$word==".fullschema"} {278 set pattern %279 regexp {^.[a-z]+ +([^ ]+)} $cmd all pattern280 set mode list281 set header 0282 set cmd "SELECT sql FROM sqlite_master WHERE tbl_name LIKE '$pattern'283 AND sql NOT NULL UNION ALL SELECT sql FROM sqlite_temp_master284 WHERE tbl_name LIKE '$pattern' AND sql NOT NULL"285 $v(db) eval {PRAGMA database_list} {286 if {$name!="temp" && $name!="main"} {287 append cmd " UNION ALL SELECT sql FROM $name.sqlite_master\288 WHERE tbl_name LIKE '$pattern' AND sql NOT NULL"289 }290 }291 } elseif {$word==".schema"} {292 set pattern %293 regexp {^.[a-z]+ +([^ ]+)} $cmd all pattern294 set mode list295 set header 0296 set cmd "SELECT sql FROM sqlite_master WHERE name LIKE '$pattern'297 AND sql NOT NULL UNION ALL SELECT sql FROM sqlite_temp_master298 WHERE name LIKE '$pattern' AND sql NOT NULL"299 $v(db) eval {PRAGMA database_list} {300 if {$name!="temp" && $name!="main"} {301 append cmd " UNION ALL SELECT sql FROM $name.sqlite_master\302 WHERE name LIKE '$pattern' AND sql NOT NULL"303 }304 }305 } else {306 return \307 ".exit\n.mode line|list|column\n.schema ?TABLENAME?\n.tables"308 }309 }310 set res {}311 if {$mode=="list"} {312 $v(db) eval $cmd x {313 set sep {}314 foreach col $x(*) {315 append res $sep$x($col)316 set sep |317 }318 append res \n319 }320 if {[info exists x(*)] && $header} {321 set sep {}322 set hdr {}323 foreach col $x(*) {324 append hdr $sep$col325 set sep |326 }327 set res $hdr\n$res328 }329 } elseif {[string range $mode 0 2]=="col"} {330 set y {}331 $v(db) eval $cmd x {332 foreach col $x(*) {333 if {![info exists cw($col)] || $cw($col)<[string length $x($col)]} {334 set cw($col) [string length $x($col)]335 }336 lappend y $x($col)337 }338 }339 if {[info exists x(*)] && $header} {340 set hdr {}341 set ln {}342 set dash ---------------------------------------------------------------343 append dash ------------------------------------------------------------344 foreach col $x(*) {345 if {![info exists cw($col)] || $cw($col)<[string length $col]} {346 set cw($col) [string length $col]347 }348 lappend hdr $col349 lappend ln [string range $dash 1 $cw($col)]350 }351 set y [concat $hdr $ln $y]352 }353 if {[info exists x(*)]} {354 set format {}355 set arglist {}356 set arglist2 {}357 set i 0358 foreach col $x(*) {359 lappend arglist x$i360 append arglist2 " \$x$i"361 incr i362 append format " %-$cw($col)s"363 }364 set format [string trimleft $format]\n365 if {[llength $arglist]>0} {366 foreach $arglist $y "append res \[format [list $format] $arglist2\]"367 }368 }369 } elseif {$mode=="multicolumn"} {370 set y [$v(db) eval $cmd]371 set max 0372 foreach e $y {373 if {$max<[string length $e]} {set max [string length $e]}374 }375 set ncol [expr {int(80/($max+2))}]376 if {$ncol<1} {set ncol 1}377 set nelem [llength $y]378 set nrow [expr {($nelem+$ncol-1)/$ncol}]379 set format "%-${max}s"380 for {set i 0} {$i<$nrow} {incr i} {381 set j $i382 while 1 {383 append res [format $format [lindex $y $j]]384 incr j $nrow385 if {$j>=$nelem} break386 append res { }387 }388 append res \n389 }390 } else {391 $v(db) eval $cmd x {392 foreach col $x(*) {append res "$col = $x($col)\n"}393 append res \n394 }395 }396 return [string trimright $res]397}398 399# Change the line to the previous line400#401proc sqlitecon::Prior w {402 upvar #0 $w v403 if {$v(current)<=0} return404 incr v(current) -1405 set line [lindex $v(history) $v(current)]406 sqlitecon::SetLine $w $line407}408 409# Change the line to the next line410#411proc sqlitecon::Next w {412 upvar #0 $w v413 if {$v(current)>=$v(historycnt)} return414 incr v(current) 1415 set line [lindex $v(history) $v(current)]416 sqlitecon::SetLine $w $line417}418 419# Change the contents of the entry line420#421proc sqlitecon::SetLine {w line} {422 upvar #0 $w v423 scan [$w index insert] %d.%d row col424 set start $row.$v(plength)425 $w delete $start end426 $w insert end $line427 $w mark set insert end428 $w yview insert429}430 431# Called when the mouse button is pressed at position $x,$y on432# the console widget.433#434proc sqlitecon::Button1 {w x y} {435 global tkPriv436 upvar #0 $w v437 set v(mouseMoved) 0438 set v(pressX) $x439 set p [sqlitecon::nearestBoundry $w $x $y]440 scan [$w index insert] %d.%d ix iy441 scan $p %d.%d px py442 if {$px==$ix} {443 $w mark set insert $p444 }445 $w mark set anchor $p446 focus $w447}448 449# Find the boundry between characters that is nearest450# to $x,$y451#452proc sqlitecon::nearestBoundry {w x y} {453 set p [$w index @$x,$y]454 set bb [$w bbox $p]455 if {![string compare $bb ""]} {return $p}456 if {($x-[lindex $bb 0])<([lindex $bb 2]/2)} {return $p}457 $w index "$p + 1 char"458}459 460# This routine extends the selection to the point specified by $x,$y461#462proc sqlitecon::SelectTo {w x y} {463 upvar #0 $w v464 set cur [sqlitecon::nearestBoundry $w $x $y]465 if {[catch {$w index anchor}]} {466 $w mark set anchor $cur467 }468 set anchor [$w index anchor]469 if {[$w compare $cur != $anchor] || (abs($v(pressX) - $x) >= 3)} {470 if {$v(mouseMoved)==0} {471 $w tag remove sel 0.0 end472 }473 set v(mouseMoved) 1474 }475 if {[$w compare $cur < anchor]} {476 set first $cur477 set last anchor478 } else {479 set first anchor480 set last $cur481 }482 if {$v(mouseMoved)} {483 $w tag remove sel 0.0 $first484 $w tag add sel $first $last485 $w tag remove sel $last end486 update idletasks487 }488}489 490# Called whenever the mouse moves while button-1 is held down.491#492proc sqlitecon::B1Motion {w x y} {493 upvar #0 $w v494 set v(y) $y495 set v(x) $x496 sqlitecon::SelectTo $w $x $y497}498 499# Called whenever the mouse leaves the boundries of the widget500# while button 1 is held down.501#502proc sqlitecon::B1Leave {w x y} {503 upvar #0 $w v504 set v(y) $y505 set v(x) $x506 sqlitecon::motor $w507}508 509# This routine is called to automatically scroll the window when510# the mouse drags offscreen.511#512proc sqlitecon::motor w {513 upvar #0 $w v514 if {![winfo exists $w]} return515 if {$v(y)>=[winfo height $w]} {516 $w yview scroll 1 units517 } elseif {$v(y)<0} {518 $w yview scroll -1 units519 } else {520 return521 }522 sqlitecon::SelectTo $w $v(x) $v(y)523 set v(timer) [after 50 sqlitecon::motor $w]524}525 526# This routine cancels the scrolling motor if it is active527#528proc sqlitecon::cancelMotor w {529 upvar #0 $w v530 catch {after cancel $v(timer)}531 catch {unset v(timer)}532}533 534# Do a Copy operation on the stuff currently selected.535#536proc sqlitecon::Copy w {537 if {![catch {set text [$w get sel.first sel.last]}]} {538 clipboard clear -displayof $w539 clipboard append -displayof $w $text540 }541}542 543# Return 1 if the selection exists and is contained544# entirely on the input line. Return 2 if the selection545# exists but is not entirely on the input line. Return 0546# if the selection does not exist.547#548proc sqlitecon::canCut w {549 set r [catch {550 scan [$w index sel.first] %d.%d s1x s1y551 scan [$w index sel.last] %d.%d s2x s2y552 scan [$w index insert] %d.%d ix iy553 }]554 if {$r==1} {return 0}555 if {$s1x==$ix && $s2x==$ix} {return 1}556 return 2557}558 559# Do a Cut operation if possible. Cuts are only allowed560# if the current selection is entirely contained on the561# current input line.562#563proc sqlitecon::Cut w {564 if {[sqlitecon::canCut $w]==1} {565 sqlitecon::Copy $w566 $w delete sel.first sel.last567 }568}569 570# Do a paste operation.571#572proc sqlitecon::Paste w {573 if {[sqlitecon::canCut $w]==1} {574 $w delete sel.first sel.last575 }576 if {[catch {selection get -displayof $w -selection CLIPBOARD} topaste]577 && [catch {selection get -displayof $w -selection PRIMARY} topaste]} {578 return579 }580 if {[info exists ::$w]} {581 set prior 0582 foreach line [split $topaste \n] {583 if {$prior} {584 sqlitecon::Enter $w585 update586 }587 set prior 1588 $w insert insert $line589 }590 } else {591 $w insert insert $topaste592 }593}594 595# Enable or disable entries in the Edit menu596#597proc sqlitecon::EnableEditMenu w {598 upvar #0 $w.t v599 set m $v(editmenu)600 if {$m=="" || ![winfo exists $m]} return601 switch [sqlitecon::canCut $w.t] {602 0 {603 $m entryconf Copy -state disabled604 $m entryconf Cut -state disabled605 }606 1 {607 $m entryconf Copy -state normal608 $m entryconf Cut -state normal609 }610 2 {611 $m entryconf Copy -state normal612 $m entryconf Cut -state disabled613 }614 }615}616 617# Prompt the user for the name of a writable file. Then write the618# entire contents of the console screen to that file.619#620proc sqlitecon::SaveFile w {621 set types {622 {{Text Files} {.txt}}623 {{All Files} *}624 }625 set f [tk_getSaveFile -filetypes $types -title "Write Screen To..."]626 if {$f!=""} {627 if {[catch {open $f w} fd]} {628 tk_messageBox -type ok -icon error -message $fd629 } else {630 puts $fd [string trimright [$w get 1.0 end] \n]631 close $fd632 }633 }634}635 636# Erase everything from the console above the insertion line.637#638proc sqlitecon::Clear w {639 $w delete 1.0 {insert linestart}640}641 642# An in-line editor for SQL643#644proc sqlitecon::_edit {origtxt {title {}}} {645 for {set i 0} {[winfo exists .ed$i]} {incr i} continue646 set w .ed$i647 toplevel $w648 wm protocol $w WM_DELETE_WINDOW "$w.b.can invoke"649 wm title $w {Inline SQL Editor}650 frame $w.b651 pack $w.b -side bottom -fill x652 button $w.b.can -text Cancel -width 6 -command [list set ::$w 0]653 button $w.b.ok -text OK -width 6 -command [list set ::$w 1]654 button $w.b.cut -text Cut -width 6 -command [list ::sqlitecon::Cut $w.t]655 button $w.b.copy -text Copy -width 6 -command [list ::sqlitecon::Copy $w.t]656 button $w.b.paste -text Paste -width 6 -command [list ::sqlitecon::Paste $w.t]657 set ::$w {}658 pack $w.b.cut $w.b.copy $w.b.paste $w.b.can $w.b.ok\659 -side left -padx 5 -pady 5 -expand 1660 if {$title!=""} {661 label $w.title -text $title662 pack $w.title -side top -padx 5 -pady 5663 }664 text $w.t -bg white -fg black -yscrollcommand [list $w.sb set]665 pack $w.t -side left -fill both -expand 1666 scrollbar $w.sb -orient vertical -command [list $w.t yview]667 pack $w.sb -side left -fill y668 $w.t insert end $origtxt669 670 vwait ::$w671 672 if {[set ::$w]} {673 set txt [string trimright [$w.t get 1.0 end]]674 } else {675 set txt $origtxt676 }677 destroy $w678 return $txt679}680