aboutsummaryrefslogtreecommitdiffstatshomepage
path: root/libraries/sqlite/unix/sqlite-3.5.1/contrib/sqlitecon.tcl
diff options
context:
space:
mode:
authordan miller2007-10-21 08:36:32 +0000
committerdan miller2007-10-21 08:36:32 +0000
commit2f8d7092bc2c9609fa98d6888106b96f38b22828 (patch)
treeda6c37579258cc965b52a75aee6135fe44237698 /libraries/sqlite/unix/sqlite-3.5.1/contrib/sqlitecon.tcl
parent* Committing new PolicyManager based on an ACL system. (diff)
downloadopensim-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.tcl679
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#
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}