SQLiteTablelist

By Alex Caldwell.

This is a designer/viewer and editor for SQLite3 databases. It uses the Tablelist widget as the viewer/editor. It allows both viewing and editing data in SQLite tables. It allows viewing, but not editing SQLite views, since views are not editable in SQLite. 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. Thanks to the combobox's built in methods, it can store the SQL queries you type in, both during and between sessions, so you can select them from a drop down list. If you have a table named "SpokanePhysicians" that has fields named FirstName, LastName and Address, you can try the simple "mail merge" demo feature by selecting multiple rows and clicking on the "Fax" button. Or, edit the code to use a different table name for your mail merging. It's only a demo of how the idea would work, and does not actually link to any email or fax merging program.

CAUTION!!! NOT FOR PRODUCTION USE!!!

See discussion below regarding various possible problems. It works for our simple database, but may cause problems with other more complex 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 irreversibly DAMAGE YOUR DATABASE! It is a preliminary, and I felt potentially useful tool, but has not been thoroughly tested, i.e. I just barely got it working at all yesterday! I was hoping to get expert Tcler help for improving it and fixing problems. But I was so excited that it was working, I couldn't resist posting it on the Wiki. It has a lot of redundant code that needs to be broken out and put in procs for reuse and efficiency. Also, why do I always seem to be needing to use all those commands built up with a bunch of backquotes? I know there must be a better way to do that. Also why can't I summarize a question or answer about Tcl in just a few cryptic lines like others on the Tcler's Wiki? Why do I need these run-on sentences? Is that why my code is so bloated and hard to understand? Why? Why? Why?

I have a "network" version of this program that connects to a Tcl server using the Tcl socket library, so you can connect to your SQLite database remotely. The Tablelist widget is a natural fit with the network version, since it uses the Tcl list data structure, which is easy to send over a socket. The Tktable widget uses the Tcl array data structure, which has to be "serialized" before it can be sent over the socket and then reassembled into arrays on the other end. My network version has no encryption or authentication, so it is not secure. But if you want that version, send me an email. It requires another program that functions as the server that I did not post here.

 # by Alex Caldwell M.D
 # [email protected]
 # with much help from
 # Dr. Jerry Park D.O.
 # [email protected]

 package require Tk
 package require Tablelist
 package require Iwidgets
 package require sqlite3

 #create some bitmaps for the fax and mail merge buttons
 #bitmaps were borrowed from addressbook-0.7 a Tcl/Tk program by Klemens Durka

 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}}
    {{SQLiteExplorer} {.db3}}
    {{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;}]]
        puts "initial_column_names ==\n$initial_column_names"
        
        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   {((version\)|\(name),|(KE|PRIMAR)Y)|(version\)|\(name,|(KE|PRIMAR)Y)|(\(signature\)|UNIQUE)|(\(signature\),|UNIQUE)}  $initial_column_names {} initial_column_names
            regsub {PRIMARY KEY \((.+, .+)+\),} $initial_column_names {} initial_column_names
            regsub {UNIQUE \(.+\)} $initial_column_names {} initial_column_names
            regsub {PRIMARY KEY \((.+, .+)+\)} $initial_column_names {} initial_column_names
            puts "initial_column_names ==\n$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 ==\n$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]
                }
                if {[lindex $name 0] != "" && [lindex $name 0] != "CREATE"} {
                    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 statements
            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;}]]
    puts "initial_column_names ==\n$initial_column_names"
    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 {((version\)|\(name),|(KE|PRIMAR)Y)|(version\)|\(name,|(KE|PRIMAR)Y)|(\(signature\)|UNIQUE)|(\(signature\),|UNIQUE)}  $initial_column_names {} initial_column_names
        regsub {PRIMARY KEY \((.+, .+)+\),} $initial_column_names {} initial_column_names
        regsub {UNIQUE \(.+\)} $initial_column_names {} initial_column_names
        regsub {PRIMARY KEY \((.+, .+)+\)} $initial_column_names {} initial_column_names
        puts "initial_column_names ==\n$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 ==\n$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]
            }
            if {[lindex $name 0] != "" && [lindex $name 0] != "CREATE"} {
                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 statements
        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.

Alex Caldwell Thanks, So far I have only tested it on Windows XP with Active Tcl 8.4.9, tclsqlite 3.3.4, and Tablelist 4.3

AK wrote (in email):

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 being 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. 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
 ...

Alex Caldwell Email 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 Tcl list, you can get a list like this if there is an empty value in the SQLite table (I may be using the wrong term there, is it the same as a Null value to SQLite?) in that 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 of the list to the right of it one cell over to the left. Then the rows that come after that row in the table also all get shifted over to the left 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

 e d f { } g

This seemed to keep the Tcl list lengths in sync with the SQLite table and the Tablelist widget's rows. I then trimmed off the extra space or _ when some data was actually finally added to that field in the tablelist widget by the user. 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. 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. It has only been tested with some simple queries that we used in our little project.

Csaba Nemethi on 2006-03-24: It is not correct that Tablelist ignores empty list elements when inserting a row. Here is a simple example:

 package require Tablelist
 tablelist::tableist .tbl -columns {0 A  0 B  0 C}
 grid .tbl
 .tbl insert end {a b c}
 .tbl insert end {a {} c}
 .tbl insert end {{} b c}

Alex Caldwell Thanks, I see that you are right. I think the problems was actually sort of the reverse of what I said. I think it comes when I collect the list from the row in the tablelist that is being edited and send it to SQLite for updating the row. If there is an empty cell, my list would shorten by one and that would shift the data over in the SQLite table. So I made the cells default to contain a space, and that seemed to be a work around for the problem I was running into. When the user enters some data into an "empty" cell, I trim off the extra whitespace on the ends.

AK. My guess would then be that the code simply creates a tablelist with the wrong number of columns:

Sqlite returns a list

 {a b c d e a b c d e ...}

i.e. groups of 5. And the application inserts this into a tablelist which is configured for n (n != 5) columns, and thus takes the input in groups of n, and this shifts everything around.

Alex Caldwell Through the use of some really ugly looking regsub expressions, I was able to get the program to handle the database schema sent to me by AK that was not displaying properly. The way it gets the column names is to query the database for the table schemas. Then it picks apart the table schema using regexp and regsub, trying to get the column names. But obviously, I had only done it on a simple table schema with no indexes on them as in this example, which it now seems to handle. I am sure there are more variations of table schema that it won't handle, but if I got some samples of schema that have problems like this, I may be able to modify the "schema parser" to become more robust:

From Email Discussion Regarding Display Problems:

This schema should show the troubles:

                CREATE TABLE objects
                (  name      TEXT NOT NULL,
                   version   TEXT NOT NULL,
                   signature         TEXT NOT NULL,
                   PRIMARY KEY (name, version),
                   UNIQUE (signature)
                   )
                ;
                CREATE TABLE attr
                (  signature     TEXT NOT NULL,
                   name  TEXT NOT NULL,
                   value TEXT NOT NULL,
                   file TEXT NOT NULL,
                   PRIMARY KEY (signature, name)
                   )
                ;
                CREATE INDEX attr_file
                ON           attr (file)
                ;

Andreas Kupries

AK: Alex, thank you very much for your responsiveness. I just retrieved the updated code of this application and tried again to view my database. Everything is now looking fine. Thanks again.

LV 2007 Sep 06 I wonder - perhaps correspondence with the SQLite developer might provide a more tcl compatible interface for getting schema information. In that way, you wouldn't have to mess with all the regular expressions.

I mean, unless the schema is kept in full ascii sql format, sqlite is generating the above from metadata. So it shouldn't be that bit of a deal to return the information in the form of a tcl list, for instance, or perhaps a dict.

NEM 2008-05-18: You can get the columns for a query if there is at least one row in it:

 proc cols {db table} {
     $db eval {SELECT * FROM $table LIMIT 1} row { return $row(*) }
     error "unable to get columns for '$table'"
 }

DKF: It's a really good idea to put a LIMIT 1 clause in there. Otherwise, you could be doing quite a bit of work which will never be required. NEM Done.

KBK 2008-05-19 Tbere is a way to get the column information, even though that part of the schema is, in fact, kept in unparsed SQL. Try the following:

proc cols {db table} {
    set result {}
    $db eval "PRAGMA TABLE_INFO($table)" row { lappend result $row(name) }
    return $result
}

The PRAGMA TABLE_INFO query returns other information about the column, including its index within the table, its data type, its default value, and indicators for whether nulls are allowed and whether the column is a part of the primary key.

Brian Theado 2008-05-19: NEM, when the table has no rows, the row(*) variable still gets populated with the column names, so the following works even on empty tables:

 proc cols {db table} {
     $db eval {SELECT * FROM $table} row break
     return $row(*)
 }

NEM Interesting, so it gets set before the loop executes. Is this behaviour guaranteed/documented or just a side-effect of the current implementation?

HJG 2007-09-05 There is no menu and no buttons, so how should saving a new database work ?

Category Application

Category SQLite