Version 15 of SQLiteTablelist
Updated 2006-03-24 05:55:45
By Alex Caldwell.
This is a designer/viewer and editor for SQLite3 databases. It uses the Tablelist widget as the viewer/editor for viewing and editing tables and views. Changes to the data in the cells in a table are updated in the database automatically. You can enter simple SQL queries and get the results back in a Tk text widget, a Tablelist or both side by side. It was part of a medical project for setting up a database of contacts with a mail merge set up. But I thought it would be potentially useful as a generalizable tool for working with SQLite databases from Tcl. I'm still working on it, so there are a lot of random comments, puts statements and commented out junk that didn't work in the code I posted. Sorry about that. In addition to the TclSqlite3 [L1 ] [L2 ] extension and the Tablelist extension, it uses an Iwidgets combobox and an an Iwidgets paned window, so it also requires the Iwidgets extension of Incr Tcl.
CAUTION See discussion below regarding various possible problems. It works for our simple database, but may cause problems with other schema we have not considered. Do not attempt to open an important database and try to edit data without backup copies of your data, or it might damage your database! It is a preliminary and I felt potentially useful tool, but has not been thoroughly tested. I was hoping to get Tcler help for improving it and fixing problems.
# Alex Caldwell M.D. # [email protected] package require Tk package require Tablelist package require Iwidgets package require Sqlite3 #create some bitmaps for the fax and mail merge buttons image create bitmap fax -data { #define fax_width 31 #define fax_height 21 static unsigned char fax_bits[] = { 0xf0, 0xff, 0xff, 0x1f, 0x18, 0x00, 0x00, 0x10, 0x08, 0x00, 0x00, 0x18, 0xe8, 0x39, 0x21, 0x0b, 0x28, 0x44, 0x12, 0x0b, 0x28, 0x44, 0x0c, 0x0b, 0xe8, 0x7c, 0x0c, 0x0b, 0x2e, 0x44, 0x12, 0x38, 0x2a, 0x44, 0x21, 0x2b, 0x0a, 0x00, 0x00, 0x28, 0x0a, 0x00, 0x00, 0x28, 0xfa, 0xff, 0xff, 0x2f, 0x02, 0x00, 0x00, 0x20, 0xfa, 0xff, 0xff, 0x27, 0x0a, 0x30, 0xf2, 0x24, 0xfa, 0xff, 0xff, 0x2f, 0x02, 0x30, 0x92, 0x2c, 0x02, 0xf0, 0xff, 0x2f, 0x02, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0xfe, 0xff, 0xff, 0x3f}; } image create bitmap mail -data { #define brief_width 31 #define brief_height 21 static unsigned char brief_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0x3f, 0x02, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x3a, 0x00, 0x00, 0x27, 0x02, 0x00, 0x00, 0x25, 0xba, 0x01, 0x00, 0x25, 0x02, 0x00, 0x00, 0x27, 0x02, 0x00, 0x00, 0x20, 0x02, 0xfc, 0x07, 0x20, 0x02, 0x00, 0x00, 0x20, 0x02, 0x7c, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x02, 0xfc, 0x79, 0x20, 0x02, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0xfe, 0xff, 0xff, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; } image create bitmap email -data { #define email_width 31 #define email_height 21 static unsigned char email_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0x3f, 0x02, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x24, 0x02, 0x00, 0x40, 0x24, 0x02, 0x00, 0x00, 0x24, 0x72, 0x2a, 0x43, 0x24, 0x8a, 0xbe, 0x44, 0x24, 0x7a, 0xaa, 0x44, 0x24, 0x0a, 0xaa, 0x44, 0x24, 0x72, 0x2a, 0xeb, 0x2e, 0x02, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0xfe, 0xff, 0xff, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; } set types { {{SQLite} {.db}} {{All Files} {*.*}} } sqlite3 db [set database_name [tk_getOpenFile -initialdir "./" -title \ "Choose Sqlite Database File" -filetypes $types]] wm title . "[file tail $database_name] - Tables" #Eval_Remote $sock {sqlite3 db ./medrolodex.db} # get the names of all the tables set table_names [db eval {SELECT name FROM sqlite_master WHERE type='table' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='table' ORDER BY name;}] # check the no. of tables - used later to configure views in a green foreground color set no_tables [llength $table_names] append table_names " [db eval {SELECT name FROM sqlite_master WHERE type='view' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='view' ORDER BY name;}]" # create a button for each table which when clicked will create a tablelist widget and populate it with data from the table #foreach table $table_names { # button ._$table -text $table -command "createtablelist $table" # pack ._$table -side left #} # try a listbox instead to see what works best frame .topframe pack .topframe -expand true -fill both frame .topframe.leftframe frame .topframe.rightframe pack .topframe.leftframe -side left -expand true -fill both pack .topframe.rightframe -side right -expand true -fill y listbox .topframe.leftframe.list -width 115 -yscrollcommand {.topframe.rightframe.scroll set} pack .topframe.leftframe.list -expand true -fill both scrollbar .topframe.rightframe.scroll -command {.topframe.leftframe.list yview} pack .topframe.rightframe.scroll -expand true -fill y foreach table $table_names { .topframe.leftframe.list insert end $table } # configure the foreground color of the views in green to distinguish from tables in black for {set x $no_tables} {$x < [.topframe.leftframe.list index end]} {incr x} { .topframe.leftframe.list itemconfigure $x -foreground green } bind .topframe.leftframe.list <Double-Button-1> { #createtablelist [selection get] foreach i [selection get] {createtablelist $i} } set report_type text frame .bottomframe pack .bottomframe -side top -expand true -fill x button .bottomframe.button1 -text "New Table" -command newTable pack .bottomframe.button1 -side left -padx 2 -pady 4 button .bottomframe.button2 -text "Delete Selected Table" -command { dropTable [selection get] } pack .bottomframe.button2 -side left -padx 2 -pady 4 frame .sqlframe pack .sqlframe -side top -expand true -fill x #label .sqlframe.label -text "SQL Query" #pack .sqlframe.label -side left #entry .sqlframe.entry -width 80 -textvariable sqlquery iwidgets::combobox .sqlframe.entry -width 75 -editable true -unique true -labeltext "SQL Query" -labelpos w -textvariable sqlquery -selectioncommand { #puts "selected: [.sqlframe.entry getcurselection]" set sqlquery [.sqlframe.entry getcurselection] #.sqlframe.entry insert list end $sqlquery set f [open ${database_name}_queries.tcl w] for {set x 0} {$x < [.sqlframe.entry index end]} {incr x} { puts $f [.sqlframe.entry get $x] } close $f } lappend query_list "" if {[file isfile ${database_name}_queries.tcl]} { set f [open ${database_name}_queries.tcl r] while {![eof $f]} { gets $f line if {$line != {}} { lappend query_list "$line" } } close $f } #.sqlframe.entry insert list end {SELECT * FROM SpokanePhysicians;} foreach query $query_list { .sqlframe.entry insert list end $query } #.sqlframe.entry selection set {} pack .sqlframe.entry -side left -expand true -fill both button .sqlframe.go_button -text "Go" -command { catch { destroy .result_text destroy .result_scroll destroy .result_scroll2 destroy .query_results destroy .hsb destroy .vsb destroy .pw } iwidgets::panedwindow .pw -width 6i -height 2.5i -orient vertical pack .pw -expand true -fill both .pw add "left" -margin 2 .pw add "right" -margin 2 set left [.pw childsite "left"] set right [.pw childsite "right"] set no_columns 1 set column_names "" set result [db eval "$sqlquery"] regexp {SELECT.+FROM} $sqlquery no_columns if {![regexp {\*} $no_columns]} { regsub -all {SELECT } $no_columns {} no_columns regsub -all { FROM} $no_columns {} no_columns #set no_columns [split $no_columns ", "] regsub -all {, } $no_columns { } no_columns set column_names [split $no_columns " "] set no_columns [llength [split $no_columns " "]] #puts $result if {$report_type == "text" || $report_type == "both"} { if {$report_type == "text"} { .pw fraction 100 0 } else { .pw fraction 50 50 } scrollbar .result_scroll2 -orient horizontal -command {.result_text xview} pack .result_scroll2 -in $left -expand true -fill x scrollbar .result_scroll -command {.result_text yview} pack .result_scroll -in $left -side left -anchor w -padx 0 -expand true -fill y text .result_text -width 125 -yscrollcommand {.result_scroll set} -wrap none pack .result_text -in $left -side left -anchor w -padx 0 -expand true -fill both } set initial_result_length [llength $result] for {set x $no_columns} {$x <= [llength $result]} {incr x [expr $no_columns + 1]} { set result [linsert $result $x \n] } #for {set x 1} {$x <= [llength $result]} {incr x 1} { # if {[expr $x % ($no_columns + 1)] eq 0} { # set result [linsert $result $x \n] # } else { # set result [linsert $result $x "\t"] # } #} regsub -all {\{\n\}} $result "\n" result if {$report_type == "text" || $report_type == "both"} { .result_text insert end "$column_names \n" .result_text insert end $result } set new_column_names [list "0 [join $column_names "\n0 "]"] regsub -all {\{} $new_column_names {} new_column_names regsub -all {\}} $new_column_names {} new_column_names if {$report_type == "tablelist" || $report_type == "both"} { if {$report_type == "tablelist"} { .pw fraction 0 100 } else { .pw fraction 50 50 } tablelist::tablelist .query_results -columns $new_column_names \ -labelcommand tablelist::sortByColumn -sortcommand demo::compareAsSet \ -editendcommand applyValue -height 15 -width 120 -stretch all \ -xscrollcommand [list .hsb set] -yscrollcommand [list .vsb set] \ -stripebackground #e0e8f0 for {set x 0} {$x < [llength $column_names]} {incr x} { .query_results columnconfigure $x -maxwidth 30 -editable no } scrollbar .vsb -orient vertical -command [list .query_results yview] scrollbar .hsb -orient horizontal -command [list .query_results xview] #grid .query_results -row 0 -column 0 -sticky news #grid .vsb -row 0 -column 1 -sticky ns #grid .hsb -row 1 -column 0 -sticky ew #grid rowconfigure $tf 0 -weight 1 #grid columnconfigure $tf 0 -weight 1 pack .hsb -in $right -expand true -fill x pack .vsb -in $right -side left -fill y pack .query_results -in $right -side left foreach line [split $result "\n"] { regsub -all {'} $line {\\u0027} line regsub -all {"} $line {\\u0022} line #.query_results insert end [string map {' \'} $line] .query_results insert end $line } } } else { #toplevel .message #label .message.label -text "Sorry, cannot process the wildcard yet" #pack .message.label #label .message.label2 -text "column names" #pack .message.label2 if {$report_type == "text" || $report_type == "both"} { if {$report_type == "text"} { .pw fraction 100 0 } else { .pw fraction 50 50 } scrollbar .result_scroll2 -orient horizontal -command {.result_text xview} pack .result_scroll2 -in $left -expand true -fill x scrollbar .result_scroll -command {.result_text yview} pack .result_scroll -in $left -side left -anchor w -padx 0 -expand true -fill y text .result_text -width 125 -xscrollcommand {.result_scroll2 set} -yscrollcommand {.result_scroll set} -wrap none pack .result_text -in $left -side left -anchor w -padx 0 -expand true -fill both } #need to get the table_name in order to find the column names when using a wildcard if {[regexp "WHERE" $sqlquery]} { regexp {FROM .+ WHERE} $sqlquery table_name regsub {FROM } $table_name {} table_name regsub { WHERE} $table_name {} table_name } else { regexp {FROM [^ ;]+[ ;]} $sqlquery table_name regsub {FROM } $table_name {} table_name set table_name [string trimright $table_name] set table_name [string trimright $table_name ";"] } #.message.label configure -text "$table_name" # need to get the names of all the columns in the selected table using SQL command on the sqlite_master table set initial_column_names [db eval [subst {SELECT sql FROM (SELECT * FROM sqlite_master UNION ALL SELECT * FROM sqlite_temp_master) WHERE tbl_name LIKE '$table_name' AND type!='meta' ORDER BY type DESC, name;}]] if {[regexp "CREATE TABLE" $initial_column_names]} { # get rid of some junk in the reply that we don't want regsub "CREATE TABLE $table_name" $initial_column_names {} initial_column_names regsub -all {\(} $initial_column_names {} initial_column_names regsub -all {\)} $initial_column_names {} initial_column_names regsub -all {\{} $initial_column_names {} initial_column_names regsub -all {\}} $initial_column_names {} initial_column_names # the reply still contains the column name followed by a comma and the type description # so we need to make a new list with only the first element - the name without the type description set key_index_counter 0 foreach name [split $initial_column_names ","] { if {[regexp "PRIMARY KEY" $name]} { set primary_key $key_index_counter set primary_key_name [lindex $name 0] } lappend column_names [lindex $name 0] incr key_index_counter } } if {[regexp "CREATE VIEW" $initial_column_names] && ![regexp "\\*" $initial_column_names]} { # we need to get the names of the columns you want from between the SELECT and the FROM statments regexp "SELECT .+ FROM" $initial_column_names match puts "match == $match" regsub "SELECT " $match {} match regsub " FROM" $match {} match regsub -all {, } $match { } match puts "match == $match" # in this case, the initial_column_names is actually the table names - I know that is confusing - just too lazy to change the code regsub "CREATE VIEW $table_name AS SELECT .+ FROM " $initial_column_names {} initial_column_names regsub { WHERE.+$} $initial_column_names {} initial_column_names set initial_column_names [split $initial_column_names ", "] regsub -all {\(} $initial_column_names {} initial_column_names regsub -all {\)} $initial_column_names {} initial_column_names regsub -all {\{} $initial_column_names {} initial_column_names regsub -all {\}} $initial_column_names {} initial_column_names regsub -all {\\} $initial_column_names {} initial_column_names set column_names $match } # this is the case where you use a wildcard for selecting the columnames when creating a view. So you will get all the column names in the tablelist widget. if {[regexp "CREATE VIEW" $initial_column_names] && [regexp "\\*" $initial_column_names]} { regsub "CREATE VIEW $table_name AS SELECT \\* FROM " $initial_column_names {} initial_column_names regsub { WHERE.+$} $initial_column_names {} initial_column_names set initial_column_names [split $initial_column_names ", "] regsub -all {\(} $initial_column_names {} initial_column_names regsub -all {\)} $initial_column_names {} initial_column_names regsub -all {\{} $initial_column_names {} initial_column_names regsub -all {\}} $initial_column_names {} initial_column_names regsub -all {\\} $initial_column_names {} initial_column_names puts $initial_column_names foreach view_table $initial_column_names { set initial_column_names2 [db eval [subst {SELECT sql FROM (SELECT * FROM sqlite_master UNION ALL SELECT * FROM sqlite_temp_master) WHERE tbl_name LIKE '$view_table' AND type!='meta' ORDER BY type DESC, name;}]] regsub "CREATE TABLE $view_table" $initial_column_names2 {} initial_column_names2 regsub -all {\(} $initial_column_names2 {} initial_column_names2 regsub -all {\)} $initial_column_names2 {} initial_column_names2 regsub -all {\{} $initial_column_names2 {} initial_column_names2 regsub -all {\}} $initial_column_names2 {} initial_column_names2 # the reply still contains the column name followed by a comma and the type description # so we need to make a new list with only the first element - the name without the type description set key_index_counter 0 foreach name [split $initial_column_names2 ","] { if {[regexp "PRIMARY KEY" $name]} { set primary_key $key_index_counter set primary_key_name [lindex $name 0] } lappend column_names [lindex $name 0] incr key_index_counter } } } set no_columns [llength [split $column_names " "]] for {set x $no_columns} {$x <= [llength $result]} {incr x [expr $no_columns + 1]} { set result [linsert $result $x \n] } #.message.label configure -text "$initial_column_names" #.message.label2 configure -text "$column_names" if {$report_type == "text" || $report_type == "both"} { .result_text insert end "$column_names \n" } regsub -all {\{\n\}} $result "\n" result if {$report_type == "text" || $report_type == "both"} { .result_text insert end $result } set new_column_names [list "0 [join $column_names "\n0 "]"] regsub -all {\{} $new_column_names {} new_column_names regsub -all {\}} $new_column_names {} new_column_names if {$report_type == "tablelist" || $report_type == "both"} { if {$report_type == "tablelist"} { .pw fraction 0 100 } else { .pw fraction 50 50 } tablelist::tablelist .query_results -columns $new_column_names \ -labelcommand tablelist::sortByColumn -sortcommand demo::compareAsSet \ -editendcommand applyValue -height 15 -width 120 -stretch all \ -xscrollcommand [list .hsb set] -yscrollcommand [list .vsb set] \ -stripebackground #e0e8f0 for {set x 0} {$x < [llength $column_names]} {incr x} { .query_results columnconfigure $x -maxwidth 30 -editable no } scrollbar .vsb -orient vertical -command [list .query_results yview] scrollbar .hsb -orient horizontal -command [list .query_results xview] #grid .query_results -row 0 -column 0 -sticky news #grid .vsb -row 0 -column 1 -sticky ns #grid .hsb -row 1 -column 0 -sticky ew #grid rowconfigure $tf 0 -weight 1 #grid columnconfigure $tf 0 -weight 1 pack .hsb -in $right -expand true -fill x pack .vsb -in $right -side left -expand true -fill y pack .query_results -in $right -side left foreach line [split $result "\n"] { #regsub -all {\'} $line {\\\'} line .query_results insert end [string map {' \'} $line] } } } } pack .sqlframe.go_button -side left menubutton .sqlframe.report_type -relief raised -indicatoron true -text "Result Format" -menu .sqlframe.report_type.menu pack .sqlframe.report_type -side left menu .sqlframe.report_type.menu .sqlframe.report_type.menu add radiobutton -label "Text " -variable report_type -value "text" -command {.sqlframe.report_type configure -text "Text "} .sqlframe.report_type.menu add radiobutton -label "Tablelist " -variable report_type -value "tablelist" -command {.sqlframe.report_type configure -text "Tablelist "} .sqlframe.report_type.menu add radiobutton -label "Both " -variable report_type -value "both" -command {.sqlframe.report_type configure -text "Both "} label .sqlframe.column_label -text "No. Columns" pack .sqlframe.column_label -side left #set no_columns 1 entry .sqlframe.columns -width 3 -textvariable no_columns pack .sqlframe.columns -side left -expand true -fill both focus -force .sqlframe.entry proc applyValue {tbl row col text} { global primary_key primary_key_name #This proc gets called whenever you edit a value in a cell that is editable #The purpose is to then update the database with the change you made automatically # get the name of this table for the UPDATE sql command by introspection by querying the wm for the top level title. # This way you can have multiple tablists open on different tables and each will know what table it updates # without having to set any global variables. set table_name [wm title [winfo parent [winfo parent $tbl]]] puts $table_name # this inserts the change into the table cell from the entry box after user hits return key or moves to another cell # it is set up to trim or the spaces on the right unless the data in the box is only a space, which is the default value. # a box has to have something in it in order to match the tablelist rows to rows in the SQLite table. This is because # if you have nothing in a box, the tablelist widget will output a list with that member removed from the list and then the # values going into the SQLIte table when it is updated do not match the right entry in the tablelist with the right column # in the SQLite table. if {![string compare $text " "]} { $tbl cellconfigure $row,$col -text [string trimleft [string trimright $text]] } else { $tbl cellconfigure $row,$col -text $text } # get the name of column by querying the tablelist widget for the title on the button at the top of the column # this will be passed to the SQL command for updating the database down below set columnname [$tbl columncget $col -title] #puts "columnname == $columnname" #set values "'" set changes [$tbl get $row] #puts "changes == $changes" set key [lindex $changes $primary_key] #puts "key == $key" #puts "primary_key_name == $primary_key_name" set changes2 [lindex $changes $col] regsub -all {'} $changes2 {\\u0027} changes2 regsub -all {"} $changes2 {\\u0022} changes2 #puts "changes2 == $changes2" #set changes [join $changes "','"] #regsub -all {\{} $changes {'} changes #regsub -all {\}} $changes {'} changes #regsub -all {@} $changes At changes #append values $changes #append values "'" # db eval [subst {INSERT INTO Names VALUES($values);}] db eval [subst {UPDATE $table_name SET $columnname = '$changes2' WHERE $primary_key_name = '$key';}] return [string trimleft [string trimright $text]] } proc newRecord {tbl table_name} { global sock primary_key primary_key_name column_names set lastrow [expr [$tbl index end] -1] # this gets the highest value of the primary key, assuming that column is sorted in ascending order in the tablelist. # that might not be a safe assumption, it might be better to get the key values with an SQL command but this will do for now. # get the values in the last row in the table set lastindex [lindex [$tbl get $lastrow] $primary_key] # the primary_key variable has the column number of the primary key column. # this gets the value in that column in the last row and increments it by one. if {$lastindex != ""} { set lastindex [incr lastindex 1] } else { set lastindex 1 } for {set x 0} {$x < [llength $column_names]} {incr x} { lappend new_row_data { } } # this inserts a new row in the table with the new index in the primary key column #$tbl insert end "{ } $lastindex { } { } { } { } { } { } { } { } { } { } { } { } { } { } { } { }" set new_row_data [lreplace $new_row_data $primary_key $primary_key $lastindex] $tbl insert end "$new_row_data" $tbl see end set new_row_data [join $new_row_data "\',\'"] set new_row_data "\'$new_row_data\'" puts $new_row_data #Eval_Remote $sock "db eval [subst {\{INSERT INTO Names VALUES(' ',$lastindex,' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ');\}}]" db eval [subst {INSERT INTO $table_name VALUES($new_row_data);}] } # This is called whenever user clicks the delete selected row button when the cursor is focused on a certain row proc deleteRecord {tbl table_name row primary_key} { set row_to_delete [eval $row] puts "table_name == $table_name" puts "row to delete == $row_to_delete" puts "primary_key == $primary_key" # get the value in the cell representing the primary key to pass later to the SQL DELETE command set primary_key_value [eval $tbl getcells $row_to_delete,$primary_key] puts "primary_key_value == $primary_key_value" # get the name of column with the primary key by querying the tablelist widget for the title on the button at the top of the column # this will be passed to the SQL command for updating the database down below set columnname [$tbl columncget $primary_key -title] puts "columnname == $columnname" # Make a simple dialog to give user a chance to back out before it is too late. toplevel .are_you_sure label .are_you_sure.label -text "Are you sure you want to delte row $row_to_delete ?" pack .are_you_sure.label button .are_you_sure.yes -text "Yes, I AM sure" -command " destroy .are_you_sure # delete the row from the tablelist widget - has no actual effect on the SQLite database $tbl delete $row_to_delete # finally, delete the row from the Sqlite database itself. db eval {DELETE FROM $table_name WHERE $columnname = $primary_key_value} set sure_variable true " pack .are_you_sure.yes button .are_you_sure.no -text "No, I am NOT sure" -command { destroy .are_you_sure set sure_variable false } pack .are_you_sure.no tkwait variable sure_variable } proc newTable {} { global table_names set newTableName "" toplevel .newTable label .newTable.label -text "Table Name" pack .newTable.label entry .newTable.entry -textvariable newTableName pack .newTable.entry button .newTable.newField -text "Add Field" -command { set newFieldName "" set newFieldType "" toplevel .newField label .newField.label -text "Field Name" pack .newField.label entry .newField.entry -textvariable newFieldName pack .newField.entry menubutton .newField.menubutton -relief raised -text {Type Field} -indicatoron true -menu .newField.menubutton.menu menu .newField.menubutton.menu .newField.menubutton.menu add radiobutton -label "TEXT" -variable newFieldType -value "TEXT" .newField.menubutton.menu add radiobutton -label "numeric" -variable newFieldType -value "numeric" .newField.menubutton.menu add radiobutton -label "BLOB" -variable newFieldType -value "BLOB" .newField.menubutton.menu add radiobutton -label "INTEGER PRIMARY KEY" -variable newFieldType -value "INTEGER PRIMARY KEY" pack .newField.menubutton button .newField.done -text Done -command { lappend new_field_list "$newFieldName $newFieldType ," puts $new_field_list destroy .newField } pack .newField.done } pack .newTable.newField button .newTable.create -text "Create Table" -command { if {![regexp $newTableName $table_names]} { if {[catch { regsub -all {\}} $new_field_list {} new_field_list regsub -all {\{} $new_field_list {} new_field_list regsub {,$} $new_field_list {} new_field_list puts $new_field_list } err]} { tk_dialog .error Error "You have to have at least one new field for your new table." error 0 OK return } set command [list db eval [subst {CREATE TABLE $newTableName ($new_field_list);}]] lappend table_names $newTableName puts $command eval $command .topframe.leftframe.list insert end $newTableName destroy .newTable } else { tk_dialog .error Error "You already have a table by that name. Please select another." error 0 OK } } pack .newTable.create } proc dropTable {table} { global table_names toplevel .are_you_sure label .are_you_sure.label -text "Are you sure you want to delte table $table ?" pack .are_you_sure.label button .are_you_sure.yes -text "Yes, I AM sure" -command " destroy .are_you_sure set sure_variable true db eval {[subst {DROP TABLE $table ;}]} .topframe.leftframe.list delete [.topframe.leftframe.list index active] for \{set x 0\} \{\$x < \[llength \$table_names\]\} \{incr x\} \{ if \{\[string compare $table \[lindex \$table_names \$x\]\] == \"0\"\} \{ set table_names \[lreplace \$table_names \$x \$x\] puts \"they match\" \} \} " pack .are_you_sure.yes button .are_you_sure.no -text "No, I am NOT sure" -command { destroy .are_you_sure set sure_variable false } pack .are_you_sure.no tkwait variable sure_variable } proc createtablelist {table_name} { global sock primary_key primary_key_name column_names set column_names {} set primary_key_name {} set primary_key {} # need to get the names of all the columns in the selected table using SQL command on the sqlite_master table set initial_column_names [db eval [subst {SELECT sql FROM (SELECT * FROM sqlite_master UNION ALL SELECT * FROM sqlite_temp_master) WHERE tbl_name LIKE '$table_name' AND type!='meta' ORDER BY type DESC, name;}]] #set column_names [Eval_Remote $sock db eval [subst {SELECT sql FROM (SELECT * FROM sqlite_master) WHERE tbl_name LIKE '$table_name' AND type!='meta' ORDER BY type DESC, name;}]] if {[regexp "CREATE TABLE" $initial_column_names]} { # get rid of some junk in the reply that we don't want regsub "CREATE TABLE $table_name" $initial_column_names {} initial_column_names regsub -all {\(} $initial_column_names {} initial_column_names regsub -all {\)} $initial_column_names {} initial_column_names regsub -all {\{} $initial_column_names {} initial_column_names regsub -all {\}} $initial_column_names {} initial_column_names # the reply still contains the column name followed by a comma and the type description # so we need to make a new list with only the first element - the name without the type description set key_index_counter 0 foreach name [split $initial_column_names ","] { if {[regexp "PRIMARY KEY" $name]} { set primary_key $key_index_counter set primary_key_name [lindex $name 0] } lappend column_names [lindex $name 0] incr key_index_counter } } # in this case you do not want all the column names if {[regexp "CREATE VIEW" $initial_column_names] && ![regexp "\\*" $initial_column_names]} { # we need to get the names of the columns you want from between the SELECT and the FROM statments regexp "SELECT .+ FROM" $initial_column_names match puts "match == $match" regsub "SELECT " $match {} match regsub " FROM" $match {} match regsub -all {, } $match { } match puts "match == $match" # in this case, the initial_column_names is actually the table names - I know that is confusing - just too lazy to change the code regsub "CREATE VIEW $table_name AS SELECT .+ FROM " $initial_column_names {} initial_column_names regsub { WHERE.+$} $initial_column_names {} initial_column_names set initial_column_names [split $initial_column_names ", "] regsub -all {\(} $initial_column_names {} initial_column_names regsub -all {\)} $initial_column_names {} initial_column_names regsub -all {\{} $initial_column_names {} initial_column_names regsub -all {\}} $initial_column_names {} initial_column_names regsub -all {\\} $initial_column_names {} initial_column_names #puts $initial_column_names # now loop through the selected tables and get the column names #foreach view_table $initial_column_names { # set initial_column_names2 [db eval [subst {SELECT sql FROM (SELECT * FROM sqlite_master UNION ALL SELECT * FROM sqlite_temp_master) WHERE tbl_name LIKE '$view_table' AND type!='meta' ORDER BY type DESC, name;}]] # regsub "CREATE TABLE $view_table" $initial_column_names2 {} initial_column_names2 # regsub -all {\(} $initial_column_names2 {} initial_column_names2 # regsub -all {\)} $initial_column_names2 {} initial_column_names2 # regsub -all {\{} $initial_column_names2 {} initial_column_names2 # regsub -all {\}} $initial_column_names2 {} initial_column_names2 # the reply still contains the column name followed by a comma and the type description # so we need to make a new list with only the first element - the name without the type description # set key_index_counter 0 # foreach name [split $initial_column_names2 ","] { # if {[regexp "PRIMARY KEY" $name]} { # set primary_key $key_index_counter # set primary_key_name [lindex $name 0] # } # lappend column_names [lindex $name 0] # incr key_index_counter # } #in this case the column names comes from the SELECT columnname1, columnname2 FROM # so we just set columnames equal to that set column_names $match #} } # this is the case where you use a wildcard for selecting the columnames when creating a view. So you will get all the column names in the tablelist widget. if {[regexp "CREATE VIEW" $initial_column_names] && [regexp "\\*" $initial_column_names]} { regsub "CREATE VIEW $table_name AS SELECT \\* FROM " $initial_column_names {} initial_column_names regsub { WHERE.+$} $initial_column_names {} initial_column_names set initial_column_names [split $initial_column_names ", "] regsub -all {\(} $initial_column_names {} initial_column_names regsub -all {\)} $initial_column_names {} initial_column_names regsub -all {\{} $initial_column_names {} initial_column_names regsub -all {\}} $initial_column_names {} initial_column_names regsub -all {\\} $initial_column_names {} initial_column_names puts $initial_column_names foreach view_table $initial_column_names { set initial_column_names2 [db eval [subst {SELECT sql FROM (SELECT * FROM sqlite_master UNION ALL SELECT * FROM sqlite_temp_master) WHERE tbl_name LIKE '$view_table' AND type!='meta' ORDER BY type DESC, name;}]] regsub "CREATE TABLE $view_table" $initial_column_names2 {} initial_column_names2 regsub -all {\(} $initial_column_names2 {} initial_column_names2 regsub -all {\)} $initial_column_names2 {} initial_column_names2 regsub -all {\{} $initial_column_names2 {} initial_column_names2 regsub -all {\}} $initial_column_names2 {} initial_column_names2 # the reply still contains the column name followed by a comma and the type description # so we need to make a new list with only the first element - the name without the type description set key_index_counter 0 foreach name [split $initial_column_names2 ","] { if {[regexp "PRIMARY KEY" $name]} { set primary_key $key_index_counter set primary_key_name [lindex $name 0] } lappend column_names [lindex $name 0] incr key_index_counter } } } set top .configTop for {set n 2} {[winfo exists $top]} {incr n} { set top .configTop$n } toplevel $top -class DemoTop wm title $top $table_name set tf $top.tf frame $tf set tbl $tf.tbl set vsb $tf.vsb set hsb $tf.hsb set new_column_names [list "0 [join $column_names "\n0 "]"] #puts $new_column_names regsub -all {\{} $new_column_names {} new_column_names regsub -all {\}} $new_column_names {} new_column_names tablelist::tablelist $tbl -columns $new_column_names -selectmode multiple \ -labelcommand tablelist::sortByColumn -sortcommand demo::compareAsSet \ -editendcommand applyValue -height 15 -width 100 -stretch all \ -xscrollcommand [list $hsb set] -yscrollcommand [list $vsb set] \ -stripebackground #e0e8f0 # -editstartcommand enableDelete #$tbl columnconfigure 3 -maxwidth 30 -editable yes #$tbl columnconfigure 4 -maxwidth 30 -editable yes for {set x 0} {$x < [llength $column_names]} {incr x} { $tbl columnconfigure $x -maxwidth 30 -editable yes if {$x == $primary_key} { $tbl columnconfigure $x -foreground red -editable no } } scrollbar $vsb -orient vertical -command [list $tbl yview] scrollbar $hsb -orient horizontal -command [list $tbl xview] # # Create three buttons within a frame child of the top-level widget # set bf $top.bf frame $bf set b1 $bf.b1 set b2 $bf.b2 set b3 $bf.b3 set b4 $bf.b4 set b5 $bf.b5 set b6 $bf.b6 set b7 $bf.b7 button $b1 -text "Refresh" -command [list demo::putConfig \$w $tbl] -state disabled button $b4 -text "New Record" -command [list newRecord $tbl $table_name] # button $b2 -text "Sort as set" -command [list $tbl sort] -state disabled # row delete button initially disabled because tablelist widget will set inital active row to 0 and you don't want to delete # until user selects row by putting the mouse on it at least. button $b2 -text "Delete Seleted Row" -command [list deleteRecord $tbl $table_name "$tbl index active" $primary_key] -state disabled button $b3 -text "Close" -command [list destroy $top] if {$table_name == "SpokanePhysicians"} { button $b5 -image fax -command " foreach row \[$tbl curselection\] \{ toplevel .fax text .fax.t pack .fax.t .fax.t insert 1.0 \" Jerry Park D.O. 101 Main St. Spokane WA 88845 \[clock format \[clock seconds\] -format \"%m/%d/%Y %R\"\]\\n\\n\\n\" set this_row \[$tbl get \$row\] .fax.t insert end \"\[lindex \$this_row 2\] \[lindex \$this_row 1\] \[lindex \$this_row 4\]\\n\" .fax.t insert end \"\[lindex \$this_row 5\]\\n\" .fax.t insert end \"\[lindex \$this_row 6\] \[lindex \$this_row 7\] \[lindex \$this_row 8\]\\n\\n\\n\" .fax.t insert end \"Hi \[lindex \$this_row 2\]!\\n\\\n\\n\" .fax.t insert end \" I was just wanting to let you know that our new tkfp_tablelist2.tcl program seems to be working.\\n\\n\\n\\n\" .fax.t insert end \" Yours truly,\\n\\n\" .fax.t insert end \" Jerry Park D.O.\" button .fax.done -text {Send} -command {set done_variable true;destroy .fax} pack .fax.done -side left button .fax.cancel -text {Cancel} -command {set done_variable true;destroy .fax} pack .fax.cancel -side left -padx 5 tkwait variable done_variable \} " button $b6 -image email button $b7 -image mail } set bodyTag [$tbl bodytag] bind $bodyTag <FocusIn> [list $b2 configure -state normal] # # Manage the widgets # grid $tbl -row 0 -column 0 -sticky news grid $vsb -row 0 -column 1 -sticky ns grid $hsb -row 1 -column 0 -sticky ew grid rowconfigure $tf 0 -weight 1 grid columnconfigure $tf 0 -weight 1 pack $b1 $b2 $b4 $b3 -side left -expand yes -pady 10 if {$table_name == "SpokanePhysicians"} { pack $b5 $b6 $b7 -side left -expand yes -pady 10 } pack $bf -side bottom -fill x pack $tf -side top -expand yes -fill both #insert some data retrieved by sql from the database into the tablelist #the blank space at the end of each variable is because the tablelist seems #to ignor nulls and moves things over one unless you put a space in. set data [db eval [subst {Select * from $table_name;}]] #foreach {BusinessOrganizationType NameID Honorific FirstName LastName Degree ExtraDegrees Nickname SpecialtyID Specialty2ID BusinessOrganization Birthday Custom1_Name Custom2_Name Custom3_Name Custom4_Name Comments_Name DateLastUpdated_Name} $data { # $tbl insert end " \"$BusinessOrganizationType \" \"$NameID\" \"$Honorific \" \"$FirstName \" \"$LastName \" \"$Degree \" \"$ExtraDegrees \" \"$Nickname \" \"$SpecialtyID \" \"$Specialty2ID \" \"$BusinessOrganization \" \"$Birthday \" \"$Custom1_Name \" \"$Custom2_Name \" \"$Custom3_Name \" \"$Custom4_Name \" \"$Comments_Name \" \"$DateLastUpdated_Name \"" #} #set column_insert_command " \\\"\$" #set column_insert_list [join $column_names " \\\" \\\"\$"] #append column_insert_command $column_insert_list #append column_insert_command " \\\"" append column_insert_command " \\\"\$\{" set key_counter 0 foreach name $column_names { #if {[regexp {\.} $name]} { # set name [lindex [split $name "."] 1] #} if {$key_counter != $primary_key && ![string compare $name " "] && ![string compare $name ""]} { append column_insert_command "$name\} \\\" \\\"\$\{" } else { append column_insert_command "$name\}\\\" \\\"\$\{" } incr key_counter } append column_insert_command "\} \\\"" regsub {\$\{\}} $column_insert_command {} column_insert_command foreach $column_names $data { set command "$tbl insert end \"$column_insert_command\"" #puts $command eval $command #update idletasks } }
LES on 2006-03-24: This program causes "segmentation fault" in my Linux box with ActiveTcl 8.5a4.
Discussion Regarding Display Problem Hi again,
I think I remember something that applies here - with tclsqlite, if you have a table in the SQLite database and ask for a row back as a list, you can get a list like this if there is an empty value (I may be using the wrong term there, is it the same as a Null value to SQLite?) in the row:
e d f {} g
I found that when you then insert a list like that into a row in the Tablelist widget, the tablelist widget ignores the {} member of the list, and moves the other members to the right of it one cell over to the left. Then the rows that come after that row also all get shifted over too, so the first member of the next row will be inserted in the last cell on the previous row's line in the tablelist widget. In our database, I substituted empty members of the table with a space or a _ so the list would look like:e d f {_} g
or
e d f { } g
and then I trimmed off the extra space or _ when some data was actually finally added to that field in the table. I am thinking this might be where the shifting you are seeing is coming from. I should also mention that the SQL query combobox is not fully compliant with standard SQL in that it is sensitive to the amount of whitespace - it only allows one space between keywords in the SQL statement. It is likely it may not understand complicated SQL queries with nested sub queries and stuff like that.
Alex
Andreas Kupries <[email protected]> wrote:
This application seems to have problems when a table has an index set on it.
I used it on a database I had here and it showed me additional columns which were not in the table. From some clues (like the title of one bein PRIMARY) I guess they were for the index. However the app filled these columns with the data from the table, not from the index, causing the values to be shuffled around over several entries. I.e. instead of, for example
a b c d e a b c d e ...
I got shown
a b c d e a b c d e a b c d e a b c ...
-- Andreas Kupries Developer @ http://www.ActiveState.com