# # t-DB Mini Database Manager # by Mike Doyle ([email protected]) # based on Richard Suchenwirth's Little Database API, Little Database Gui, # and Persistent array utility #
proc persistentArray {arrName {filename {}}} {
upvar 1 $arrName arr
array set arr {} ;# to make sure it exists, and is an array
if {$filename==""} {set filename $arrName.txt}
set filename [file join [pwd] $filename]
if [file exists $filename] {
set fp [open $filename]
array set arr [read $fp]
close $fp
}
uplevel 1 [list trace var $arrName wu [list persist'save $filename]]
}
proc persist'save {filename arrName el op} {
upvar 1 $arrName arr
switch -- $op {
w {set value $arr($el)}
u {set value {}}
}
set fp [open $filename a]
puts $fp [list $el $value]
close $fp
}
proc db {table args} {
upvar #0 $table db
set key "" ;# in case args is empty
foreach {- key item value} $args break
set exists [info exists db($key)]
set res {}
switch [llength $args] {
0 {
array set db {} ;# force to be an array
interp alias {} $table {} db $table -
set res $table
}
1 {set res [array names db]}
2 {if {$key != ""} {
if {$exists} {set res $db($key)}
} else {array unset db}
}
3 {if {$item != ""} {
if {$exists} {
set t $db($key)
if {!([set pos [lsearch $t $item]]%2)} {
set res [lindex $t [incr pos]]
}
}
} elseif {$exists} {unset db($key)}
}
4 {
if {$exists} {
if {!([set pos [lsearch $db($key) $item]]%2)} {
if {$value != ""} {
set db($key) [lreplace $db($key) [incr pos] $pos $value]
} else {set db($key) [lreplace $db($key) $pos [incr pos]]}
} elseif {$value != ""} {
lappend db($key) $item $value
}
} elseif {$value != ""} {set db($key) [list $item $value]}
set res $value ;# to be returned
}
default {
if {[llength $args]%2} {error "non-paired item/value list"}
foreach {item value} [lrange $args 2 end] {
db $table - $key $item $value
}
}
}
set res
}
namespace eval db::ui {
variable topic ""
} ;# required before procs can be defined
proc db::ui::browse {table} {
global record current_table
set record ""
set current_table $table
set t [toplevel .tpl]
wm title $t "Mike's Mini Database Manager v.0.5"
wm protocol $t WM_DELETE_WINDOW {exit}
db $table
set m1 [frame $t.top]
listbox $m1.lb -bg white -height 5 -yscrollcommand [list $m1.y1 set]
bind $m1.lb <ButtonRelease-1> [list db::ui::select %W %y Tables]
bind $m1.lb <Double-ButtonRelease-1> {.tpl.main.lb delete 0 end; set current_table [.tpl.top.lb get @0,%y]; foreach i [lsort -dic [[.tpl.top.lb get @0,%y]]] {.tpl.main.lb insert end $i}; db::ui::htext2 .tpl.main.t [.tpl.top.lb get @0,%y] -yscrollcommand [list .tpl.main.y2 set]}
scrollbar $m1.y1 -command [list $m1.lb yview]
htexttop $m1.t Tables -yscrollcommand [list $m1.y2 set]
scrollbar $m1.y2 -command [list $m1.t yview]
eval pack [winfo children $m1] -side left -fill y
pack $m1.t -fill both -expand 1
set b1 [frame $t.bottom1]
button $b1.edit -text Edit -command {db::edit_table .tpl.bottom1.edit $record Tables}
button $b1.new -text New -command {db::new_table .tpl.bottom1.new $record Tables}
button $b1.del -text Delete -command {db::delete_table .tpl.bottom1.del $record Tables}
label $b1.find -text Find:
entry $b1.tofind
bind $b1.tofind <Return> [list db::ui::find %W $m1.t Tables]
button $b1.action -text " 0 " -background green -command {catch "console show"}
eval pack [winfo children $b1] -side left -fill x
pack $b1.tofind -expand 1
pack $b1 -side top -fill x
foreach i [lsort -dic [Tables]] {$m1.lb insert end $i}
set m [frame $t.main]
listbox $m.lb -bg white -height 15 -yscrollcommand [list $m.y1 set]
bind $m.lb <ButtonRelease-1> [list db::ui::select %W %y $table]
scrollbar $m.y1 -command [list $m.lb yview]
htext $m.t $table -yscrollcommand [list $m.y2 set]
scrollbar $m.y2 -command [list $m.t yview]
eval pack [winfo children $m] -side left -fill y
pack $m.t -fill both -expand 1
set b [frame $t.bottom]
button $b.edit -text Edit -command {db::edit_record .tpl.bottom.edit $record $current_table}
button $b.new -text New -command {db::new_record .tpl.bottom.new $record $current_table}
button $b.del -text Delete -command {db::delete_record .tpl.bottom.del $record $current_table}
label $b.find -text Find:
entry $b.tofind
bind $b.tofind <Return> [list db::ui::find %W $m.t $table]
button $b.action -text " ! " -command {db::ui::callback $db::ui::topic}
eval pack [winfo children $b] -side left -fill x
pack $b.tofind -expand 1
pack $b -side bottom -fill x
pack $m1 -fill both -expand 0
pack $m -fill both -expand 1
foreach i [lsort -dic [$table]] {$m.lb insert end $i}
set t
}
proc db::ui::callback args {} ;# redefine this for specific action
proc db::ui::htext {w table args} {
eval text $w -bg grey90 -padx 3 -wrap word -height 7 -width 50 $args
$w tag config title -font {Times 12 bold}
$w tag config link -foreground blue -underline 1
$w tag bind link <Enter> "$w config -cursor hand2"
$w tag bind link <Leave> "$w config -cursor {}"
$w tag bind link <ButtonRelease-1> [list db::ui::click %W %x %y $table]
$w insert end \n\n$table\n\n title "Select topic from listbox"
$w insert end "\n\n[llength [$table]] entries in table"
set w
}
proc db::ui::htexttop {w table args} {
eval text $w -bg grey90 -padx 3 -wrap word -height 7 -width 50 $args
$w tag config title -font {Times 12 bold}
$w tag config link -foreground blue -underline 1
$w tag bind link <Enter> "$w config -cursor hand2"
$w tag bind link <Leave> "$w config -cursor {}"
$w tag bind link <ButtonRelease-1> [list db::ui::click %W %x %y $table]
$w insert end \n\n$table\n\n title "Double-click table name at left to view its records"
set w
}proc db::ui::htext2 {w table args} {
$w delete 1.0 end
$w tag config title -font {Times 12 bold}
$w tag config link -foreground blue -underline 1
$w tag bind link <Enter> "$w config -cursor hand2"
$w tag bind link <Leave> "$w config -cursor {}"
$w tag bind link <ButtonRelease-1> [list db::ui::click %W %x %y $table]
$w insert end \n\n$table\n\n title "Select topic from listbox"
$w insert end "\n\n[llength [$table]] entries in table"
bind .tpl.main.lb <ButtonRelease-1> [list db::ui::select %W %y $table]
set w
}
proc db::ui::click {w x y table} {
set range [$w tag prevrange link [$w index @$x,$y]]
if [llength $range] {
Show $w [eval $w get $range] $table
}
}
proc db::ui::select {w y table} {
global record
set record [$w get @0,$y]
Show [winfo parent $w].t [$w get @0,$y] $table
}
proc db::ui::Show {w title table} {
variable topic
set topic $title
$w delete 1.0 end
$w insert end $title\n title \n
set titles [$table]
foreach {item value} [$table $title] {
if {$item == "@" && [file exists $value]} {
set img [image create photo -file $value]
$w image create 1.0 -image $img
$w insert 1.1 " "
} else {
$w insert end $item\t
foreach word $value {
if {[lsearch $titles $word]>=0} {set tag link} else {set tag {}}
$w insert end $word $tag " "
}
}
$w insert end \n
}
}
proc db::ui::find {w textw table} {
set tofind [$w get]
set found {}
foreach key [$table] {
set data [$table $key]
if [regexp -indices -nocase ($tofind) $data -> pos] {
lappend found [list $key [lindex $pos 0] $data]
}
}
switch [llength $found] {
0 {error "No match for $tofind"}
1 {Show $textw [lindex [lindex $found 0] 0] $table}
default {choice $textw $table $tofind $found}
}
}
proc db::ui::choice {w table tofind found} {
$w delete 1.0 end
$w insert end "Search results for '$tofind':\n" title \n
foreach pair $found {
foreach {title pos data} $pair break
set context [string range $data [expr $pos-15] [expr $pos+25]]
$w insert end $title link \t...$context...\n "" pos=$pos\n
}
}proc db::edit_record {w r table} { global record current_table $w configure -text Done .tpl.bottom.del configure -state disabled .tpl.bottom.new configure -state disabled .tpl.bottom.find configure -text Record: .tpl.bottom.tofind delete 0 end .tpl.bottom.tofind insert end "{$table} {$r} $table $r" .tpl.bottom.edit configure -command {eval .tpl.bottom.tofind get;
.tpl.bottom.tofind delete 0 end;
.tpl.bottom.find configure -text Find:
db::ui::Show .tpl.main.t $record $current_table
.tpl.bottom.edit configure -text Edit
.tpl.bottom.del configure -state active
.tpl.bottom.new configure -state active
.tpl.bottom.edit configure -command {db::edit_record .tpl.bottom.edit $record $current_table}}}
proc db::new_record {w r table} { global record current_table $w configure -text Done .tpl.bottom.del configure -state disabled .tpl.bottom.edit configure -state disabled .tpl.bottom.find configure -text Record: .tpl.bottom.tofind delete 0 end .tpl.bottom.tofind insert end "$table {RECORD} {FIELD} {VALUE}" .tpl.bottom.new configure -command {eval .tpl.bottom.tofind get;
set record [lindex [.tpl.bottom.tofind get] 1]
.tpl.main.lb delete 0 end;
foreach i [lsort -dic [$current_table]] {.tpl.main.lb insert end $i};
.tpl.bottom.tofind delete 0 end;
.tpl.bottom.find configure -text Find:
.tpl.bottom.del configure -state active
.tpl.bottom.edit configure -state active
db::ui::Show .tpl.main.t $record $current_table
.tpl.bottom.new configure -text New
.tpl.bottom.new configure -command {db::new_record .tpl.bottom.new $record $current_table}}}
proc db::delete_record {w r table} { global record current_table $w configure -text Done .tpl.bottom.new configure -state disabled .tpl.bottom.edit configure -state disabled .tpl.bottom.find configure -text "Delete $r? Enter yes/no to confirm/cancel:" .tpl.bottom.tofind delete 0 end .tpl.bottom.del configure -command { if {.tpl.bottom.tofind get == "yes"} {
.tpl.bottom.tofind delete 0 end
.tpl.bottom.tofind insert end {$current_table $record ""}
eval [.tpl.bottom.tofind get];
}
.tpl.main.lb delete 0 end;
foreach i [lsort -dic [$current_table]] {.tpl.main.lb insert end $i};
.tpl.bottom.tofind delete 0 end;
.tpl.bottom.new configure -state active
.tpl.bottom.edit configure -state active
.tpl.bottom.find configure -text Find:
.tpl.bottom.del configure -text Delete
.tpl.main.t delete 1.0 end
.tpl.bottom.del configure -command {db::delete_record .tpl.bottom.del $record $current_table}
}}
proc db::edit_table {w r table} { global record current_table $w configure -text Done .tpl.bottom1.del configure -state disabled .tpl.bottom1.new configure -state disabled .tpl.bottom1.find configure -text Record: .tpl.bottom1.tofind delete 0 end .tpl.bottom1.tofind insert end "{$table} {$r} $table $r" .tpl.bottom1.edit configure -command {eval .tpl.bottom1.tofind get;
.tpl.bottom1.tofind delete 0 end;
.tpl.bottom1.find configure -text Find:
db::ui::Show .tpl.top.t $record Tables
.tpl.bottom1.edit configure -text Edit
.tpl.bottom1.del configure -state active
.tpl.bottom1.new configure -state active
.tpl.bottom1.edit configure -command {db::edit_table .tpl.bottom1.edit $record Tables}}}
proc db::new_table {w r table} { global record current_table $w configure -text Done .tpl.bottom1.del configure -state disabled .tpl.bottom1.edit configure -state disabled .tpl.bottom1.find configure -text Record: .tpl.bottom1.tofind delete 0 end .tpl.bottom1.tofind insert end "$table {TABLENAME} Description: {DESCRIPTION TEXT}" $w configure -command {eval .tpl.bottom1.tofind get;
set record [lindex [.tpl.bottom1.tofind get] 1]
db $record
persistentArray $record
.tpl.top.lb delete 0 end;
foreach i [lsort -dic [Tables]] {.tpl.top.lb insert end $i};
.tpl.bottom1.tofind delete 0 end;
.tpl.bottom1.find configure -text Find:
.tpl.bottom1.del configure -state active
.tpl.bottom1.edit configure -state active
db::ui::Show .tpl.top.t $record Tables
.tpl.bottom1.new configure -text New
.tpl.bottom1.new configure -command {db::new_record .tpl.bottom1.new $record Tables}}}
proc db::delete_table {w r table} { global record current_table $w configure -text Done .tpl.bottom1.new configure -state disabled .tpl.bottom1.edit configure -state disabled .tpl.bottom1.find configure -text "Delete $r? Enter yes/no to confirm/cancel:" .tpl.bottom1.tofind delete 0 end .tpl.bottom1.del configure -command { if {.tpl.bottom1.tofind get == "yes"} {
.tpl.bottom1.tofind delete 0 end
.tpl.bottom1.tofind insert end {Tables $record ""}
eval [.tpl.bottom1.tofind get];
}
.tpl.top.lb delete 0 end;
foreach i [lsort -dic [Tables]] {.tpl.top.lb insert end $i};
.tpl.bottom1.tofind delete 0 end;
.tpl.bottom1.new configure -state active
.tpl.bottom1.edit configure -state active
.tpl.bottom1.find configure -text Find:
.tpl.bottom1.del configure -text Delete
.tpl.top.t delete 1.0 end
.tpl.bottom1.del configure -command {db::delete_table .tpl.bottom1.del $record $current_table}
}}
wm withdraw .
db Tables persistentArray Tables foreach i [lsort -dic [Tables] {persistentArray $i; db $i} db::ui::browse Introduction