Version 11 of SQLiteTablelist
Updated 2006-03-23 09:00:20
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 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 ] 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.
# 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 } }