aboutsummaryrefslogtreecommitdiff
path: root/contrib
diff options
context:
space:
mode:
authorCy Schubert <cy@FreeBSD.org>2022-01-05 23:26:24 +0000
committerCy Schubert <cy@FreeBSD.org>2022-01-05 23:26:24 +0000
commit7e13a4eb402641ddf307497cc9ac7ce1ab21c2a8 (patch)
tree23e42bd656bb2b8efa9a69315eb0b24c22e05fd3 /contrib
parent9b0b0740be1f3d3751d366f3bb2952090a9dc505 (diff)
downloadsrc-7e13a4eb402641ddf307497cc9ac7ce1ab21c2a8.tar.gz
src-7e13a4eb402641ddf307497cc9ac7ce1ab21c2a8.zip
sqlite3: Vendor import of sqlite3 3.37.1
Diffstat (limited to 'contrib')
-rw-r--r--contrib/sqlitecon.tcl679
1 files changed, 0 insertions, 679 deletions
diff --git a/contrib/sqlitecon.tcl b/contrib/sqlitecon.tcl
deleted file mode 100644
index b5dbcafc2a5a..000000000000
--- a/contrib/sqlitecon.tcl
+++ /dev/null
@@ -1,679 +0,0 @@
-# A Tk console widget for SQLite. Invoke sqlitecon::create with a window name,
-# a prompt string, a title to set a new top-level window, and the SQLite
-# database handle. For example:
-#
-# sqlitecon::create .sqlcon {sql:- } {SQL Console} db
-#
-# A toplevel window is created that allows you to type in SQL commands to
-# be processed on the spot.
-#
-# A limited set of dot-commands are supported:
-#
-# .table
-# .schema ?TABLE?
-# .mode list|column|multicolumn|line
-# .exit
-#
-# In addition, a new SQL function named "edit()" is created. This function
-# takes a single text argument and returns a text result. Whenever the
-# the function is called, it pops up a new toplevel window containing a
-# text editor screen initialized to the argument. When the "OK" button
-# is pressed, whatever revised text is in the text editor is returned as
-# the result of the edit() function. This allows text fields of SQL tables
-# to be edited quickly and easily as follows:
-#
-# UPDATE table1 SET dscr = edit(dscr) WHERE rowid=15;
-#
-
-
-# Create a namespace to work in
-#
-namespace eval ::sqlitecon {
- # do nothing
-}
-
-# Create a console widget named $w. The prompt string is $prompt.
-# The title at the top of the window is $title. The database connection
-# object is $db
-#
-proc sqlitecon::create {w prompt title db} {
- upvar #0 $w.t v
- if {[winfo exists $w]} {destroy $w}
- if {[info exists v]} {unset v}
- toplevel $w
- wm title $w $title
- wm iconname $w $title
- frame $w.mb -bd 2 -relief raised
- pack $w.mb -side top -fill x
- menubutton $w.mb.file -text File -menu $w.mb.file.m
- menubutton $w.mb.edit -text Edit -menu $w.mb.edit.m
- pack $w.mb.file $w.mb.edit -side left -padx 8 -pady 1
- set m [menu $w.mb.file.m -tearoff 0]
- $m add command -label {Close} -command "destroy $w"
- sqlitecon::create_child $w $prompt $w.mb.edit.m
- set v(db) $db
- $db function edit ::sqlitecon::_edit
-}
-
-# This routine creates a console as a child window within a larger
-# window. It also creates an edit menu named "$editmenu" if $editmenu!="".
-# The calling function is responsible for posting the edit menu.
-#
-proc sqlitecon::create_child {w prompt editmenu} {
- upvar #0 $w.t v
- if {$editmenu!=""} {
- set m [menu $editmenu -tearoff 0]
- $m add command -label Cut -command "sqlitecon::Cut $w.t"
- $m add command -label Copy -command "sqlitecon::Copy $w.t"
- $m add command -label Paste -command "sqlitecon::Paste $w.t"
- $m add command -label {Clear Screen} -command "sqlitecon::Clear $w.t"
- $m add separator
- $m add command -label {Save As...} -command "sqlitecon::SaveFile $w.t"
- catch {$editmenu config -postcommand "sqlitecon::EnableEditMenu $w"}
- }
- scrollbar $w.sb -orient vertical -command "$w.t yview"
- pack $w.sb -side right -fill y
- text $w.t -font fixed -yscrollcommand "$w.sb set"
- pack $w.t -side right -fill both -expand 1
- bindtags $w.t Sqlitecon
- set v(editmenu) $editmenu
- set v(history) 0
- set v(historycnt) 0
- set v(current) -1
- set v(prompt) $prompt
- set v(prior) {}
- set v(plength) [string length $v(prompt)]
- set v(x) 0
- set v(y) 0
- set v(mode) column
- set v(header) on
- $w.t mark set insert end
- $w.t tag config ok -foreground blue
- $w.t tag config err -foreground red
- $w.t insert end $v(prompt)
- $w.t mark set out 1.0
- after idle "focus $w.t"
-}
-
-bind Sqlitecon <1> {sqlitecon::Button1 %W %x %y}
-bind Sqlitecon <B1-Motion> {sqlitecon::B1Motion %W %x %y}
-bind Sqlitecon <B1-Leave> {sqlitecon::B1Leave %W %x %y}
-bind Sqlitecon <B1-Enter> {sqlitecon::cancelMotor %W}
-bind Sqlitecon <ButtonRelease-1> {sqlitecon::cancelMotor %W}
-bind Sqlitecon <KeyPress> {sqlitecon::Insert %W %A}
-bind Sqlitecon <Left> {sqlitecon::Left %W}
-bind Sqlitecon <Control-b> {sqlitecon::Left %W}
-bind Sqlitecon <Right> {sqlitecon::Right %W}
-bind Sqlitecon <Control-f> {sqlitecon::Right %W}
-bind Sqlitecon <BackSpace> {sqlitecon::Backspace %W}
-bind Sqlitecon <Control-h> {sqlitecon::Backspace %W}
-bind Sqlitecon <Delete> {sqlitecon::Delete %W}
-bind Sqlitecon <Control-d> {sqlitecon::Delete %W}
-bind Sqlitecon <Home> {sqlitecon::Home %W}
-bind Sqlitecon <Control-a> {sqlitecon::Home %W}
-bind Sqlitecon <End> {sqlitecon::End %W}
-bind Sqlitecon <Control-e> {sqlitecon::End %W}
-bind Sqlitecon <Return> {sqlitecon::Enter %W}
-bind Sqlitecon <KP_Enter> {sqlitecon::Enter %W}
-bind Sqlitecon <Up> {sqlitecon::Prior %W}
-bind Sqlitecon <Control-p> {sqlitecon::Prior %W}
-bind Sqlitecon <Down> {sqlitecon::Next %W}
-bind Sqlitecon <Control-n> {sqlitecon::Next %W}
-bind Sqlitecon <Control-k> {sqlitecon::EraseEOL %W}
-bind Sqlitecon <<Cut>> {sqlitecon::Cut %W}
-bind Sqlitecon <<Copy>> {sqlitecon::Copy %W}
-bind Sqlitecon <<Paste>> {sqlitecon::Paste %W}
-bind Sqlitecon <<Clear>> {sqlitecon::Clear %W}
-
-# Insert a single character at the insertion cursor
-#
-proc sqlitecon::Insert {w a} {
- $w insert insert $a
- $w yview insert
-}
-
-# Move the cursor one character to the left
-#
-proc sqlitecon::Left {w} {
- upvar #0 $w v
- scan [$w index insert] %d.%d row col
- if {$col>$v(plength)} {
- $w mark set insert "insert -1c"
- }
-}
-
-# Erase the character to the left of the cursor
-#
-proc sqlitecon::Backspace {w} {
- upvar #0 $w v
- scan [$w index insert] %d.%d row col
- if {$col>$v(plength)} {
- $w delete {insert -1c}
- }
-}
-
-# Erase to the end of the line
-#
-proc sqlitecon::EraseEOL {w} {
- upvar #0 $w v
- scan [$w index insert] %d.%d row col
- if {$col>=$v(plength)} {
- $w delete insert {insert lineend}
- }
-}
-
-# Move the cursor one character to the right
-#
-proc sqlitecon::Right {w} {
- $w mark set insert "insert +1c"
-}
-
-# Erase the character to the right of the cursor
-#
-proc sqlitecon::Delete w {
- $w delete insert
-}
-
-# Move the cursor to the beginning of the current line
-#
-proc sqlitecon::Home w {
- upvar #0 $w v
- scan [$w index insert] %d.%d row col
- $w mark set insert $row.$v(plength)
-}
-
-# Move the cursor to the end of the current line
-#
-proc sqlitecon::End w {
- $w mark set insert {insert lineend}
-}
-
-# Add a line to the history
-#
-proc sqlitecon::addHistory {w line} {
- upvar #0 $w v
- if {$v(historycnt)>0} {
- set last [lindex $v(history) [expr $v(historycnt)-1]]
- if {[string compare $last $line]} {
- lappend v(history) $line
- incr v(historycnt)
- }
- } else {
- set v(history) [list $line]
- set v(historycnt) 1
- }
- set v(current) $v(historycnt)
-}
-
-# Called when "Enter" is pressed. Do something with the line
-# of text that was entered.
-#
-proc sqlitecon::Enter w {
- upvar #0 $w v
- scan [$w index insert] %d.%d row col
- set start $row.$v(plength)
- set line [$w get $start "$start lineend"]
- $w insert end \n
- $w mark set out end
- if {$v(prior)==""} {
- set cmd $line
- } else {
- set cmd $v(prior)\n$line
- }
- if {[string index $cmd 0]=="." || [$v(db) complete $cmd]} {
- regsub -all {\n} [string trim $cmd] { } cmd2
- addHistory $w $cmd2
- set rc [catch {DoCommand $w $cmd} res]
- if {![winfo exists $w]} return
- if {$rc} {
- $w insert end $res\n err
- } elseif {[string length $res]>0} {
- $w insert end $res\n ok
- }
- set v(prior) {}
- $w insert end $v(prompt)
- } else {
- set v(prior) $cmd
- regsub -all {[^ ]} $v(prompt) . x
- $w insert end $x
- }
- $w mark set insert end
- $w mark set out {insert linestart}
- $w yview insert
-}
-
-# Execute a single SQL command. Pay special attention to control
-# directives that begin with "."
-#
-# The return value is the text output from the command, properly
-# formatted.
-#
-proc sqlitecon::DoCommand {w cmd} {
- upvar #0 $w v
- set mode $v(mode)
- set header $v(header)
- if {[regexp {^(\.[a-z]+)} $cmd all word]} {
- if {$word==".mode"} {
- regexp {^.[a-z]+ +([a-z]+)} $cmd all v(mode)
- return {}
- } elseif {$word==".exit"} {
- destroy [winfo toplevel $w]
- return {}
- } elseif {$word==".header"} {
- regexp {^.[a-z]+ +([a-z]+)} $cmd all v(header)
- return {}
- } elseif {$word==".tables"} {
- set mode multicolumn
- set cmd {SELECT name FROM sqlite_master WHERE type='table'
- UNION ALL
- SELECT name FROM sqlite_temp_master WHERE type='table'}
- $v(db) eval {PRAGMA database_list} {
- if {$name!="temp" && $name!="main"} {
- append cmd "UNION ALL SELECT name FROM $name.sqlite_master\
- WHERE type='table'"
- }
- }
- append cmd { ORDER BY 1}
- } elseif {$word==".fullschema"} {
- set pattern %
- regexp {^.[a-z]+ +([^ ]+)} $cmd all pattern
- set mode list
- set header 0
- set cmd "SELECT sql FROM sqlite_master WHERE tbl_name LIKE '$pattern'
- AND sql NOT NULL UNION ALL SELECT sql FROM sqlite_temp_master
- WHERE tbl_name LIKE '$pattern' AND sql NOT NULL"
- $v(db) eval {PRAGMA database_list} {
- if {$name!="temp" && $name!="main"} {
- append cmd " UNION ALL SELECT sql FROM $name.sqlite_master\
- WHERE tbl_name LIKE '$pattern' AND sql NOT NULL"
- }
- }
- } elseif {$word==".schema"} {
- set pattern %
- regexp {^.[a-z]+ +([^ ]+)} $cmd all pattern
- set mode list
- set header 0
- set cmd "SELECT sql FROM sqlite_master WHERE name LIKE '$pattern'
- AND sql NOT NULL UNION ALL SELECT sql FROM sqlite_temp_master
- WHERE name LIKE '$pattern' AND sql NOT NULL"
- $v(db) eval {PRAGMA database_list} {
- if {$name!="temp" && $name!="main"} {
- append cmd " UNION ALL SELECT sql FROM $name.sqlite_master\
- WHERE name LIKE '$pattern' AND sql NOT NULL"
- }
- }
- } else {
- return \
- ".exit\n.mode line|list|column\n.schema ?TABLENAME?\n.tables"
- }
- }
- set res {}
- if {$mode=="list"} {
- $v(db) eval $cmd x {
- set sep {}
- foreach col $x(*) {
- append res $sep$x($col)
- set sep |
- }
- append res \n
- }
- if {[info exists x(*)] && $header} {
- set sep {}
- set hdr {}
- foreach col $x(*) {
- append hdr $sep$col
- set sep |
- }
- set res $hdr\n$res
- }
- } elseif {[string range $mode 0 2]=="col"} {
- set y {}
- $v(db) eval $cmd x {
- foreach col $x(*) {
- if {![info exists cw($col)] || $cw($col)<[string length $x($col)]} {
- set cw($col) [string length $x($col)]
- }
- lappend y $x($col)
- }
- }
- if {[info exists x(*)] && $header} {
- set hdr {}
- set ln {}
- set dash ---------------------------------------------------------------
- append dash ------------------------------------------------------------
- foreach col $x(*) {
- if {![info exists cw($col)] || $cw($col)<[string length $col]} {
- set cw($col) [string length $col]
- }
- lappend hdr $col
- lappend ln [string range $dash 1 $cw($col)]
- }
- set y [concat $hdr $ln $y]
- }
- if {[info exists x(*)]} {
- set format {}
- set arglist {}
- set arglist2 {}
- set i 0
- foreach col $x(*) {
- lappend arglist x$i
- append arglist2 " \$x$i"
- incr i
- append format " %-$cw($col)s"
- }
- set format [string trimleft $format]\n
- if {[llength $arglist]>0} {
- foreach $arglist $y "append res \[format [list $format] $arglist2\]"
- }
- }
- } elseif {$mode=="multicolumn"} {
- set y [$v(db) eval $cmd]
- set max 0
- foreach e $y {
- if {$max<[string length $e]} {set max [string length $e]}
- }
- set ncol [expr {int(80/($max+2))}]
- if {$ncol<1} {set ncol 1}
- set nelem [llength $y]
- set nrow [expr {($nelem+$ncol-1)/$ncol}]
- set format "%-${max}s"
- for {set i 0} {$i<$nrow} {incr i} {
- set j $i
- while 1 {
- append res [format $format [lindex $y $j]]
- incr j $nrow
- if {$j>=$nelem} break
- append res { }
- }
- append res \n
- }
- } else {
- $v(db) eval $cmd x {
- foreach col $x(*) {append res "$col = $x($col)\n"}
- append res \n
- }
- }
- return [string trimright $res]
-}
-
-# Change the line to the previous line
-#
-proc sqlitecon::Prior w {
- upvar #0 $w v
- if {$v(current)<=0} return
- incr v(current) -1
- set line [lindex $v(history) $v(current)]
- sqlitecon::SetLine $w $line
-}
-
-# Change the line to the next line
-#
-proc sqlitecon::Next w {
- upvar #0 $w v
- if {$v(current)>=$v(historycnt)} return
- incr v(current) 1
- set line [lindex $v(history) $v(current)]
- sqlitecon::SetLine $w $line
-}
-
-# Change the contents of the entry line
-#
-proc sqlitecon::SetLine {w line} {
- upvar #0 $w v
- scan [$w index insert] %d.%d row col
- set start $row.$v(plength)
- $w delete $start end
- $w insert end $line
- $w mark set insert end
- $w yview insert
-}
-
-# Called when the mouse button is pressed at position $x,$y on
-# the console widget.
-#
-proc sqlitecon::Button1 {w x y} {
- global tkPriv
- upvar #0 $w v
- set v(mouseMoved) 0
- set v(pressX) $x
- set p [sqlitecon::nearestBoundry $w $x $y]
- scan [$w index insert] %d.%d ix iy
- scan $p %d.%d px py
- if {$px==$ix} {
- $w mark set insert $p
- }
- $w mark set anchor $p
- focus $w
-}
-
-# Find the boundry between characters that is nearest
-# to $x,$y
-#
-proc sqlitecon::nearestBoundry {w x y} {
- set p [$w index @$x,$y]
- set bb [$w bbox $p]
- if {![string compare $bb ""]} {return $p}
- if {($x-[lindex $bb 0])<([lindex $bb 2]/2)} {return $p}
- $w index "$p + 1 char"
-}
-
-# This routine extends the selection to the point specified by $x,$y
-#
-proc sqlitecon::SelectTo {w x y} {
- upvar #0 $w v
- set cur [sqlitecon::nearestBoundry $w $x $y]
- if {[catch {$w index anchor}]} {
- $w mark set anchor $cur
- }
- set anchor [$w index anchor]
- if {[$w compare $cur != $anchor] || (abs($v(pressX) - $x) >= 3)} {
- if {$v(mouseMoved)==0} {
- $w tag remove sel 0.0 end
- }
- set v(mouseMoved) 1
- }
- if {[$w compare $cur < anchor]} {
- set first $cur
- set last anchor
- } else {
- set first anchor
- set last $cur
- }
- if {$v(mouseMoved)} {
- $w tag remove sel 0.0 $first
- $w tag add sel $first $last
- $w tag remove sel $last end
- update idletasks
- }
-}
-
-# Called whenever the mouse moves while button-1 is held down.
-#
-proc sqlitecon::B1Motion {w x y} {
- upvar #0 $w v
- set v(y) $y
- set v(x) $x
- sqlitecon::SelectTo $w $x $y
-}
-
-# Called whenever the mouse leaves the boundries of the widget
-# while button 1 is held down.
-#
-proc sqlitecon::B1Leave {w x y} {
- upvar #0 $w v
- set v(y) $y
- set v(x) $x
- sqlitecon::motor $w
-}
-
-# This routine is called to automatically scroll the window when
-# the mouse drags offscreen.
-#
-proc sqlitecon::motor w {
- upvar #0 $w v
- if {![winfo exists $w]} return
- if {$v(y)>=[winfo height $w]} {
- $w yview scroll 1 units
- } elseif {$v(y)<0} {
- $w yview scroll -1 units
- } else {
- return
- }
- sqlitecon::SelectTo $w $v(x) $v(y)
- set v(timer) [after 50 sqlitecon::motor $w]
-}
-
-# This routine cancels the scrolling motor if it is active
-#
-proc sqlitecon::cancelMotor w {
- upvar #0 $w v
- catch {after cancel $v(timer)}
- catch {unset v(timer)}
-}
-
-# Do a Copy operation on the stuff currently selected.
-#
-proc sqlitecon::Copy w {
- if {![catch {set text [$w get sel.first sel.last]}]} {
- clipboard clear -displayof $w
- clipboard append -displayof $w $text
- }
-}
-
-# Return 1 if the selection exists and is contained
-# entirely on the input line. Return 2 if the selection
-# exists but is not entirely on the input line. Return 0
-# if the selection does not exist.
-#
-proc sqlitecon::canCut w {
- set r [catch {
- scan [$w index sel.first] %d.%d s1x s1y
- scan [$w index sel.last] %d.%d s2x s2y
- scan [$w index insert] %d.%d ix iy
- }]
- if {$r==1} {return 0}
- if {$s1x==$ix && $s2x==$ix} {return 1}
- return 2
-}
-
-# Do a Cut operation if possible. Cuts are only allowed
-# if the current selection is entirely contained on the
-# current input line.
-#
-proc sqlitecon::Cut w {
- if {[sqlitecon::canCut $w]==1} {
- sqlitecon::Copy $w
- $w delete sel.first sel.last
- }
-}
-
-# Do a paste opeation.
-#
-proc sqlitecon::Paste w {
- if {[sqlitecon::canCut $w]==1} {
- $w delete sel.first sel.last
- }
- if {[catch {selection get -displayof $w -selection CLIPBOARD} topaste]
- && [catch {selection get -displayof $w -selection PRIMARY} topaste]} {
- return
- }
- if {[info exists ::$w]} {
- set prior 0
- foreach line [split $topaste \n] {
- if {$prior} {
- sqlitecon::Enter $w
- update
- }
- set prior 1
- $w insert insert $line
- }
- } else {
- $w insert insert $topaste
- }
-}
-
-# Enable or disable entries in the Edit menu
-#
-proc sqlitecon::EnableEditMenu w {
- upvar #0 $w.t v
- set m $v(editmenu)
- if {$m=="" || ![winfo exists $m]} return
- switch [sqlitecon::canCut $w.t] {
- 0 {
- $m entryconf Copy -state disabled
- $m entryconf Cut -state disabled
- }
- 1 {
- $m entryconf Copy -state normal
- $m entryconf Cut -state normal
- }
- 2 {
- $m entryconf Copy -state normal
- $m entryconf Cut -state disabled
- }
- }
-}
-
-# Prompt the user for the name of a writable file. Then write the
-# entire contents of the console screen to that file.
-#
-proc sqlitecon::SaveFile w {
- set types {
- {{Text Files} {.txt}}
- {{All Files} *}
- }
- set f [tk_getSaveFile -filetypes $types -title "Write Screen To..."]
- if {$f!=""} {
- if {[catch {open $f w} fd]} {
- tk_messageBox -type ok -icon error -message $fd
- } else {
- puts $fd [string trimright [$w get 1.0 end] \n]
- close $fd
- }
- }
-}
-
-# Erase everything from the console above the insertion line.
-#
-proc sqlitecon::Clear w {
- $w delete 1.0 {insert linestart}
-}
-
-# An in-line editor for SQL
-#
-proc sqlitecon::_edit {origtxt {title {}}} {
- for {set i 0} {[winfo exists .ed$i]} {incr i} continue
- set w .ed$i
- toplevel $w
- wm protocol $w WM_DELETE_WINDOW "$w.b.can invoke"
- wm title $w {Inline SQL Editor}
- frame $w.b
- pack $w.b -side bottom -fill x
- button $w.b.can -text Cancel -width 6 -command [list set ::$w 0]
- button $w.b.ok -text OK -width 6 -command [list set ::$w 1]
- button $w.b.cut -text Cut -width 6 -command [list ::sqlitecon::Cut $w.t]
- button $w.b.copy -text Copy -width 6 -command [list ::sqlitecon::Copy $w.t]
- button $w.b.paste -text Paste -width 6 -command [list ::sqlitecon::Paste $w.t]
- set ::$w {}
- pack $w.b.cut $w.b.copy $w.b.paste $w.b.can $w.b.ok\
- -side left -padx 5 -pady 5 -expand 1
- if {$title!=""} {
- label $w.title -text $title
- pack $w.title -side top -padx 5 -pady 5
- }
- text $w.t -bg white -fg black -yscrollcommand [list $w.sb set]
- pack $w.t -side left -fill both -expand 1
- scrollbar $w.sb -orient vertical -command [list $w.t yview]
- pack $w.sb -side left -fill y
- $w.t insert end $origtxt
-
- vwait ::$w
-
- if {[set ::$w]} {
- set txt [string trimright [$w.t get 1.0 end]]
- } else {
- set txt $origtxt
- }
- destroy $w
- return $txt
-}