| OLD | NEW |
|---|
| (Empty) |
| 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 # | |
| 31 namespace 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 # | |
| 39 proc 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 # | |
| 62 proc 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 | |
| 98 bind Sqlitecon <1> {sqlitecon::Button1 %W %x %y} | |
| 99 bind Sqlitecon <B1-Motion> {sqlitecon::B1Motion %W %x %y} | |
| 100 bind Sqlitecon <B1-Leave> {sqlitecon::B1Leave %W %x %y} | |
| 101 bind Sqlitecon <B1-Enter> {sqlitecon::cancelMotor %W} | |
| 102 bind Sqlitecon <ButtonRelease-1> {sqlitecon::cancelMotor %W} | |
| 103 bind Sqlitecon <KeyPress> {sqlitecon::Insert %W %A} | |
| 104 bind Sqlitecon <Left> {sqlitecon::Left %W} | |
| 105 bind Sqlitecon <Control-b> {sqlitecon::Left %W} | |
| 106 bind Sqlitecon <Right> {sqlitecon::Right %W} | |
| 107 bind Sqlitecon <Control-f> {sqlitecon::Right %W} | |
| 108 bind Sqlitecon <BackSpace> {sqlitecon::Backspace %W} | |
| 109 bind Sqlitecon <Control-h> {sqlitecon::Backspace %W} | |
| 110 bind Sqlitecon <Delete> {sqlitecon::Delete %W} | |
| 111 bind Sqlitecon <Control-d> {sqlitecon::Delete %W} | |
| 112 bind Sqlitecon <Home> {sqlitecon::Home %W} | |
| 113 bind Sqlitecon <Control-a> {sqlitecon::Home %W} | |
| 114 bind Sqlitecon <End> {sqlitecon::End %W} | |
| 115 bind Sqlitecon <Control-e> {sqlitecon::End %W} | |
| 116 bind Sqlitecon <Return> {sqlitecon::Enter %W} | |
| 117 bind Sqlitecon <KP_Enter> {sqlitecon::Enter %W} | |
| 118 bind Sqlitecon <Up> {sqlitecon::Prior %W} | |
| 119 bind Sqlitecon <Control-p> {sqlitecon::Prior %W} | |
| 120 bind Sqlitecon <Down> {sqlitecon::Next %W} | |
| 121 bind Sqlitecon <Control-n> {sqlitecon::Next %W} | |
| 122 bind Sqlitecon <Control-k> {sqlitecon::EraseEOL %W} | |
| 123 bind Sqlitecon <<Cut>> {sqlitecon::Cut %W} | |
| 124 bind Sqlitecon <<Copy>> {sqlitecon::Copy %W} | |
| 125 bind Sqlitecon <<Paste>> {sqlitecon::Paste %W} | |
| 126 bind Sqlitecon <<Clear>> {sqlitecon::Clear %W} | |
| 127 | |
| 128 # Insert a single character at the insertion cursor | |
| 129 # | |
| 130 proc 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 # | |
| 137 proc 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 # | |
| 147 proc 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 # | |
| 157 proc 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 # | |
| 167 proc sqlitecon::Right {w} { | |
| 168 $w mark set insert "insert +1c" | |
| 169 } | |
| 170 | |
| 171 # Erase the character to the right of the cursor | |
| 172 # | |
| 173 proc sqlitecon::Delete w { | |
| 174 $w delete insert | |
| 175 } | |
| 176 | |
| 177 # Move the cursor to the beginning of the current line | |
| 178 # | |
| 179 proc 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 # | |
| 187 proc sqlitecon::End w { | |
| 188 $w mark set insert {insert lineend} | |
| 189 } | |
| 190 | |
| 191 # Add a line to the history | |
| 192 # | |
| 193 proc 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 # | |
| 211 proc 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 # | |
| 251 proc 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 # | |
| 401 proc 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 # | |
| 411 proc 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 # | |
| 421 proc 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 # | |
| 434 proc 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 # | |
| 452 proc 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 # | |
| 462 proc 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 # | |
| 492 proc 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 # | |
| 502 proc 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 # | |
| 512 proc 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 # | |
| 528 proc 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 # | |
| 536 proc 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 # | |
| 548 proc 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 # | |
| 563 proc 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 # | |
| 572 proc 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 # | |
| 597 proc 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 # | |
| 620 proc 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 # | |
| 638 proc sqlitecon::Clear w { | |
| 639 $w delete 1.0 {insert linestart} | |
| 640 } | |
| 641 | |
| 642 # An in-line editor for SQL | |
| 643 # | |
| 644 proc 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 } | |
| OLD | NEW |
|---|
Chromium Code Reviews
Issue 2363173002:
[sqlite] Remove obsolete reference version 3.8.7.4. (Closed)
