diff options
author | dan miller | 2007-10-21 08:36:32 +0000 |
---|---|---|
committer | dan miller | 2007-10-21 08:36:32 +0000 |
commit | 2f8d7092bc2c9609fa98d6888106b96f38b22828 (patch) | |
tree | da6c37579258cc965b52a75aee6135fe44237698 /libraries/sqlite/unix/sqlite-3.5.1/contrib/sqlitecon.tcl | |
parent | * Committing new PolicyManager based on an ACL system. (diff) | |
download | opensim-SC_OLD-2f8d7092bc2c9609fa98d6888106b96f38b22828.zip opensim-SC_OLD-2f8d7092bc2c9609fa98d6888106b96f38b22828.tar.gz opensim-SC_OLD-2f8d7092bc2c9609fa98d6888106b96f38b22828.tar.bz2 opensim-SC_OLD-2f8d7092bc2c9609fa98d6888106b96f38b22828.tar.xz |
libraries moved to opensim-libs, a new repository
Diffstat (limited to 'libraries/sqlite/unix/sqlite-3.5.1/contrib/sqlitecon.tcl')
-rw-r--r-- | libraries/sqlite/unix/sqlite-3.5.1/contrib/sqlitecon.tcl | 679 |
1 files changed, 0 insertions, 679 deletions
diff --git a/libraries/sqlite/unix/sqlite-3.5.1/contrib/sqlitecon.tcl b/libraries/sqlite/unix/sqlite-3.5.1/contrib/sqlitecon.tcl deleted file mode 100644 index b5dbcaf..0000000 --- a/libraries/sqlite/unix/sqlite-3.5.1/contrib/sqlitecon.tcl +++ /dev/null | |||
@@ -1,679 +0,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 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 | } | ||