Annotation of embedaddon/sqlite3/contrib/sqlitecon.tcl, revision 1.1
1.1 ! misho 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: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to sqlitecon.tcl CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / sqlite3 / contrib