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 SQLite 3# database handle. For example: 4# 5# sqlitecon::create .sqlcon {sql:- } {SQL Console} db 6# 7# A toplevel window is created that allows you to type in SQL commands to 8# be processed on the spot. 9# 10# A limited set of dot-commands are supported: 11# 12# .table 13# .schema ?TABLE? 14# .mode list|column|multicolumn|line 15# .exit 16# 17# In addition, a new SQL function named "edit()" is created. This function 18# takes a single text argument and returns a text result. Whenever the 19# the function is called, it pops up a new toplevel window containing a 20# text editor screen initialized to the argument. When the "OK" button 21# is pressed, whatever revised text is in the text editor is returned as 22# the result of the edit() function. This allows text fields of SQL tables 23# 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 in 30# 31namespace eval ::sqlitecon { 32 # do nothing 33} 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 connection 37# object is $db 38# 39proc sqlitecon::create {w prompt title db} { 40 upvar #0 $w.t v 41 if {[winfo exists $w]} {destroy $w} 42 if {[info exists v]} {unset v} 43 toplevel $w 44 wm title $w $title 45 wm iconname $w $title 46 frame $w.mb -bd 2 -relief raised 47 pack $w.mb -side top -fill x 48 menubutton $w.mb.file -text File -menu $w.mb.file.m 49 menubutton $w.mb.edit -text Edit -menu $w.mb.edit.m 50 pack $w.mb.file $w.mb.edit -side left -padx 8 -pady 1 51 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.m 54 set v(db) $db 55 $db function edit ::sqlitecon::_edit 56} 57 58# This routine creates a console as a child window within a larger 59# 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 v 64 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 separator 71 $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 y 76 text $w.t -font fixed -yscrollcommand "$w.sb set" 77 pack $w.t -side right -fill both -expand 1 78 bindtags $w.t Sqlitecon 79 set v(editmenu) $editmenu 80 set v(history) 0 81 set v(historycnt) 0 82 set v(current) -1 83 set v(prompt) $prompt 84 set v(prior) {} 85 set v(plength) [string length $v(prompt)] 86 set v(x) 0 87 set v(y) 0 88 set v(mode) column 89 set v(header) on 90 $w.t mark set insert end 91 $w.t tag config ok -foreground blue 92 $w.t tag config err -foreground red 93 $w.t insert end $v(prompt) 94 $w.t mark set out 1.0 95 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 cursor 129# 130proc sqlitecon::Insert {w a} { 131 $w insert insert $a 132 $w yview insert 133} 134 135# Move the cursor one character to the left 136# 137proc sqlitecon::Left {w} { 138 upvar #0 $w v 139 scan [$w index insert] %d.%d row col 140 if {$col>$v(plength)} { 141 $w mark set insert "insert -1c" 142 } 143} 144 145# Erase the character to the left of the cursor 146# 147proc sqlitecon::Backspace {w} { 148 upvar #0 $w v 149 scan [$w index insert] %d.%d row col 150 if {$col>$v(plength)} { 151 $w delete {insert -1c} 152 } 153} 154 155# Erase to the end of the line 156# 157proc sqlitecon::EraseEOL {w} { 158 upvar #0 $w v 159 scan [$w index insert] %d.%d row col 160 if {$col>=$v(plength)} { 161 $w delete insert {insert lineend} 162 } 163} 164 165# Move the cursor one character to the right 166# 167proc sqlitecon::Right {w} { 168 $w mark set insert "insert +1c" 169} 170 171# Erase the character to the right of the cursor 172# 173proc sqlitecon::Delete w { 174 $w delete insert 175} 176 177# Move the cursor to the beginning of the current line 178# 179proc sqlitecon::Home w { 180 upvar #0 $w v 181 scan [$w index insert] %d.%d row col 182 $w mark set insert $row.$v(plength) 183} 184 185# Move the cursor to the end of the current line 186# 187proc sqlitecon::End w { 188 $w mark set insert {insert lineend} 189} 190 191# Add a line to the history 192# 193proc sqlitecon::addHistory {w line} { 194 upvar #0 $w v 195 if {$v(historycnt)>0} { 196 set last [lindex $v(history) [expr $v(historycnt)-1]] 197 if {[string compare $last $line]} { 198 lappend v(history) $line 199 incr v(historycnt) 200 } 201 } else { 202 set v(history) [list $line] 203 set v(historycnt) 1 204 } 205 set v(current) $v(historycnt) 206} 207 208# Called when "Enter" is pressed. Do something with the line 209# of text that was entered. 210# 211proc sqlitecon::Enter w { 212 upvar #0 $w v 213 scan [$w index insert] %d.%d row col 214 set start $row.$v(plength) 215 set line [$w get $start "$start lineend"] 216 $w insert end \n 217 $w mark set out end 218 if {$v(prior)==""} { 219 set cmd $line 220 } else { 221 set cmd $v(prior)\n$line 222 } 223 if {[string index $cmd 0]=="." || [$v(db) complete $cmd]} { 224 regsub -all {\n} [string trim $cmd] { } cmd2 225 addHistory $w $cmd2 226 set rc [catch {DoCommand $w $cmd} res] 227 if {![winfo exists $w]} return 228 if {$rc} { 229 $w insert end $res\n err 230 } elseif {[string length $res]>0} { 231 $w insert end $res\n ok 232 } 233 set v(prior) {} 234 $w insert end $v(prompt) 235 } else { 236 set v(prior) $cmd 237 regsub -all {[^ ]} $v(prompt) . x 238 $w insert end $x 239 } 240 $w mark set insert end 241 $w mark set out {insert linestart} 242 $w yview insert 243} 244 245# Execute a single SQL command. Pay special attention to control 246# directives that begin with "." 247# 248# The return value is the text output from the command, properly 249# formatted. 250# 251proc sqlitecon::DoCommand {w cmd} { 252 upvar #0 $w v 253 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 multicolumn 267 set cmd {SELECT name FROM sqlite_master WHERE type='table' 268 UNION ALL 269 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 pattern 280 set mode list 281 set header 0 282 set cmd "SELECT sql FROM sqlite_master WHERE tbl_name LIKE '$pattern' 283 AND sql NOT NULL UNION ALL SELECT sql FROM sqlite_temp_master 284 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 pattern 294 set mode list 295 set header 0 296 set cmd "SELECT sql FROM sqlite_master WHERE name LIKE '$pattern' 297 AND sql NOT NULL UNION ALL SELECT sql FROM sqlite_temp_master 298 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 \n 319 } 320 if {[info exists x(*)] && $header} { 321 set sep {} 322 set hdr {} 323 foreach col $x(*) { 324 append hdr $sep$col 325 set sep | 326 } 327 set res $hdr\n$res 328 } 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 $col 349 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 0 358 foreach col $x(*) { 359 lappend arglist x$i 360 append arglist2 " \$x$i" 361 incr i 362 append format " %-$cw($col)s" 363 } 364 set format [string trimleft $format]\n 365 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 0 372 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 $i 382 while 1 { 383 append res [format $format [lindex $y $j]] 384 incr j $nrow 385 if {$j>=$nelem} break 386 append res { } 387 } 388 append res \n 389 } 390 } else { 391 $v(db) eval $cmd x { 392 foreach col $x(*) {append res "$col = $x($col)\n"} 393 append res \n 394 } 395 } 396 return [string trimright $res] 397} 398 399# Change the line to the previous line 400# 401proc sqlitecon::Prior w { 402 upvar #0 $w v 403 if {$v(current)<=0} return 404 incr v(current) -1 405 set line [lindex $v(history) $v(current)] 406 sqlitecon::SetLine $w $line 407} 408 409# Change the line to the next line 410# 411proc sqlitecon::Next w { 412 upvar #0 $w v 413 if {$v(current)>=$v(historycnt)} return 414 incr v(current) 1 415 set line [lindex $v(history) $v(current)] 416 sqlitecon::SetLine $w $line 417} 418 419# Change the contents of the entry line 420# 421proc sqlitecon::SetLine {w line} { 422 upvar #0 $w v 423 scan [$w index insert] %d.%d row col 424 set start $row.$v(plength) 425 $w delete $start end 426 $w insert end $line 427 $w mark set insert end 428 $w yview insert 429} 430 431# Called when the mouse button is pressed at position $x,$y on 432# the console widget. 433# 434proc sqlitecon::Button1 {w x y} { 435 global tkPriv 436 upvar #0 $w v 437 set v(mouseMoved) 0 438 set v(pressX) $x 439 set p [sqlitecon::nearestBoundry $w $x $y] 440 scan [$w index insert] %d.%d ix iy 441 scan $p %d.%d px py 442 if {$px==$ix} { 443 $w mark set insert $p 444 } 445 $w mark set anchor $p 446 focus $w 447} 448 449# Find the boundry between characters that is nearest 450# to $x,$y 451# 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,$y 461# 462proc sqlitecon::SelectTo {w x y} { 463 upvar #0 $w v 464 set cur [sqlitecon::nearestBoundry $w $x $y] 465 if {[catch {$w index anchor}]} { 466 $w mark set anchor $cur 467 } 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 end 472 } 473 set v(mouseMoved) 1 474 } 475 if {[$w compare $cur < anchor]} { 476 set first $cur 477 set last anchor 478 } else { 479 set first anchor 480 set last $cur 481 } 482 if {$v(mouseMoved)} { 483 $w tag remove sel 0.0 $first 484 $w tag add sel $first $last 485 $w tag remove sel $last end 486 update idletasks 487 } 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 v 494 set v(y) $y 495 set v(x) $x 496 sqlitecon::SelectTo $w $x $y 497} 498 499# Called whenever the mouse leaves the boundries of the widget 500# while button 1 is held down. 501# 502proc sqlitecon::B1Leave {w x y} { 503 upvar #0 $w v 504 set v(y) $y 505 set v(x) $x 506 sqlitecon::motor $w 507} 508 509# This routine is called to automatically scroll the window when 510# the mouse drags offscreen. 511# 512proc sqlitecon::motor w { 513 upvar #0 $w v 514 if {![winfo exists $w]} return 515 if {$v(y)>=[winfo height $w]} { 516 $w yview scroll 1 units 517 } elseif {$v(y)<0} { 518 $w yview scroll -1 units 519 } else { 520 return 521 } 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 active 527# 528proc sqlitecon::cancelMotor w { 529 upvar #0 $w v 530 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 $w 539 clipboard append -displayof $w $text 540 } 541} 542 543# Return 1 if the selection exists and is contained 544# entirely on the input line. Return 2 if the selection 545# exists but is not entirely on the input line. Return 0 546# if the selection does not exist. 547# 548proc sqlitecon::canCut w { 549 set r [catch { 550 scan [$w index sel.first] %d.%d s1x s1y 551 scan [$w index sel.last] %d.%d s2x s2y 552 scan [$w index insert] %d.%d ix iy 553 }] 554 if {$r==1} {return 0} 555 if {$s1x==$ix && $s2x==$ix} {return 1} 556 return 2 557} 558 559# Do a Cut operation if possible. Cuts are only allowed 560# if the current selection is entirely contained on the 561# current input line. 562# 563proc sqlitecon::Cut w { 564 if {[sqlitecon::canCut $w]==1} { 565 sqlitecon::Copy $w 566 $w delete sel.first sel.last 567 } 568} 569 570# Do a paste opeation. 571# 572proc sqlitecon::Paste w { 573 if {[sqlitecon::canCut $w]==1} { 574 $w delete sel.first sel.last 575 } 576 if {[catch {selection get -displayof $w -selection CLIPBOARD} topaste] 577 && [catch {selection get -displayof $w -selection PRIMARY} topaste]} { 578 return 579 } 580 if {[info exists ::$w]} { 581 set prior 0 582 foreach line [split $topaste \n] { 583 if {$prior} { 584 sqlitecon::Enter $w 585 update 586 } 587 set prior 1 588 $w insert insert $line 589 } 590 } else { 591 $w insert insert $topaste 592 } 593} 594 595# Enable or disable entries in the Edit menu 596# 597proc sqlitecon::EnableEditMenu w { 598 upvar #0 $w.t v 599 set m $v(editmenu) 600 if {$m=="" || ![winfo exists $m]} return 601 switch [sqlitecon::canCut $w.t] { 602 0 { 603 $m entryconf Copy -state disabled 604 $m entryconf Cut -state disabled 605 } 606 1 { 607 $m entryconf Copy -state normal 608 $m entryconf Cut -state normal 609 } 610 2 { 611 $m entryconf Copy -state normal 612 $m entryconf Cut -state disabled 613 } 614 } 615} 616 617# Prompt the user for the name of a writable file. Then write the 618# 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 $fd 629 } else { 630 puts $fd [string trimright [$w get 1.0 end] \n] 631 close $fd 632 } 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 SQL 643# 644proc sqlitecon::_edit {origtxt {title {}}} { 645 for {set i 0} {[winfo exists .ed$i]} {incr i} continue 646 set w .ed$i 647 toplevel $w 648 wm protocol $w WM_DELETE_WINDOW "$w.b.can invoke" 649 wm title $w {Inline SQL Editor} 650 frame $w.b 651 pack $w.b -side bottom -fill x 652 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 1 660 if {$title!=""} { 661 label $w.title -text $title 662 pack $w.title -side top -padx 5 -pady 5 663 } 664 text $w.t -bg white -fg black -yscrollcommand [list $w.sb set] 665 pack $w.t -side left -fill both -expand 1 666 scrollbar $w.sb -orient vertical -command [list $w.t yview] 667 pack $w.sb -side left -fill y 668 $w.t insert end $origtxt 669 670 vwait ::$w 671 672 if {[set ::$w]} { 673 set txt [string trimright [$w.t get 1.0 end]] 674 } else { 675 set txt $origtxt 676 } 677 destroy $w 678 return $txt 679} 680