package require Tktable
# The [catch] below is a workaround for the bug in Galileo Galilei supplying 3.8.3.1 instead of 3.8.3
catch {package require sqlite3}

namespace path ::tcl::mathop

catch {font create myfont -family courier -size 10}

wm attributes . -fullscreen 1

# Create a Tktable for display of an attached file's schema
proc maketable {attachedname} {
        global tableinfo
        destroy {*}[winfo children .]
         set f [filename2widgetname $attachedname]
         set tableinfo(framename,$attachedname) $f
         pack [frame $f ] -padx 5 -pady 5
         set t $f.t
        table $t  -cols [expr {$::tableinfo(maxnumcols,$attachedname)+2}] -rows [expr {$::tableinfo(numtables,$attachedname)+1}] \
        -titlecols 1 -titlerows 1 -font myfont -command [list filltable %i %r %c %s $attachedname] -anchor w \
        -xscrollcommand [list ${t}sx set] -yscrollcommand [list ${t}sy set] -height 0 -width 0 -ipadx 4
        $t tag col entries 1
        $t tag configure entries -anchor e
        $t width 0 18
        scrollbar ${t}sy -orient vert -width 30 -command [list $t yview]
        scrollbar ${t}sx -orient horiz -width 30 -command [list $t xview]
        grid  $t  ${t}sy -sticky nsew
        grid ${t}sx -sticky new
        grid columnconfigure $f 0 -weight 1        
}

# Redraw the table (and enclosing frame) when the orientation is changed
#   Assumes the table widget is named xxxxxx.t and is enclosed in a frame
proc frameconfig tablewidget {
        if {[string range $tablewidget end-1 end] ne ".t"} return
                array set metrics [borg displaymetrics]
                set w [- $metrics(width) 10]
                set h [- $metrics(height) 10]
                [string range $tablewidget 0 end-2] configure -width $w -height  $h 
                $tablewidget configure -maxwidth [- $w 30] -maxheight [- $h 30] -width 0 -height 0
}

# Called by tktable innards to get values to show with display colnum & rownum
proc filltable { iswrite rownum colnum tblval attachedname}  {
    set retval {}
        if { ! $iswrite} {
        if {$rownum == 0} {
            switch $colnum \
                0 {set retval Table} \
                1 {set retval Entries} \
                default {set retval "F [expr $colnum - 1]"}
        } else {
            set rownum [expr {$rownum-1}]
            set tablename $::tableinfo(tablename,$attachedname,$rownum)
            if {$colnum == 0} {set retval $tablename}
            if {$colnum == 1} {set retval $::tableinfo(numentries,$attachedname,$tablename)}
            if {$colnum > 1 && $colnum <= $::tableinfo(numcols,$attachedname,$tablename)+1} {set retval $::tableinfo(colname,$attachedname,$tablename,[expr {$colnum - 1}]) }
            }
        }
    return $retval
}

# Attach a file and set up tableinfo global array
proc attachfile {filename attachedname} {
        global tableinfo
        db eval "attach \"$filename\"  as $attachedname"
        set tablesql_list [db eval "select sql from $attachedname.sqlite_master where type = 'table'"]
        set tableinfo(numtables,$attachedname) [llength $tablesql_list]
        set tablenum 0
        set tableinfo(maxnumcols,$attachedname) 0
        foreach tablesql $tablesql_list {
                regsub -nocase {create table } $tablesql {} tablesql
                regsub -all { +} $tablesql { } tablesql] 
                scan $tablesql {%[^(]%[^!]} tablename tabledef
                set tableinfo(tablename,$attachedname,$tablenum) $tablename
                set tableinfo(tablenum,$attachedname,$tablename) $tablenum
                set tableinfo(tabledef,$attachedname,$tablename) $tabledef
                set tableinfo(numentries,$attachedname,$tablename) [db eval "select count(*) from $attachedname.$tablename"]
            set colnum 0
            regexp {\((.*)\)} $tabledef -> tabledefguts
                foreach coldef [splitcols $tabledefguts] {
                        set isconstraint [regexp -nocase {^unique|^check|^primary key|^not null|^default|^collate|^references} $coldef]
                        if {$isconstraint} {
                                lappend tableinfo(constraint,$attachedname,$tablename) $coldef
                                
                        } else {
                                incr colnum
                                set colname [coldef2colname $coldef]
                                set tableinfo(colname,$attachedname,$tablename,$colnum) $colname
                                set tableinfo(colnum,$attachedname,$tablename,$colname) $colnum
                        }
                }
                set tableinfo(numcols,$attachedname,$tablename) $colnum
                set tableinfo(maxnumcols,$attachedname) [lindex [lsort -integer -decreasing [list $colnum $tableinfo(maxnumcols,$attachedname)]] 0]
            incr tablenum
        }
}

# Split a table definition at any comma not inside parentheses and return the list of column defs
proc splitcols tabledef {
    set collist [list]
    set colstring ""
    set parendepth 0
    foreach char [split $tabledef {}] {
        if {$char eq "("} {
            incr parendepth
            } elseif {$char eq ")"} {
                incr parendepth -1
            }
        if {$char ne "," || $parendepth > 0} {
            append colstring $char
        } else {
            lappend collist [string trim $colstring]
            set colstring ""
        }
    }
    lappend collist [string trim $colstring]
    return $collist
}   
        
# Ignore comments at the beginning of a column definition
proc coldef2colname coldef {
    foreach line [split $coldef \n] {
        if {[string range $line 0 1] ne "--"} {
            set colname [lindex $line 0]
            break
        }
    }
    return $colname
} 


# Convert attached name of file to frame name
proc filename2widgetname filename {
        return .$filename
}

global tableinfo

sqlite3 db main.sq3

set filename [tk_getOpenFile]

if {$filename eq ""} return

set attachedname _[file rootname [file tail $filename]]

attachfile $filename $attachedname

set t [filename2widgetname $attachedname]

maketable  $attachedname

bind . <Configure> {
        frameconfig %W
}

CashierTclTk

here

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References