sqlitetablelist.mht

TCL的数据库处理支撑库及一些示例

    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!=3D'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!=3D'meta' ORDER BY type DESC, name;}]]
    puts "initial_column_names =3D=3D\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)|(\(s=
ignature\)|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 =3D=3D\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 =3D=3D\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] !=3D "" && [lindex $name 0] =
!=3D "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 =3D=3D $match"
        regsub "SELECT " $match {} match
        regsub " FROM" $match {} match
        regsub -all {, } $match { } match
        puts "match =3D=3D $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!=3D'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!=3D'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 =3D=3D $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 =3D=3D "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 =3D=3D "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 !=3D $primary_key && ![string compare =
$name " "] && ![string compare $name ""]} {