A little database GUI

Richard Suchenwirth 2002-02-18 - In A little database API it was shown how a single proc can add basic database functionalities to an array. Present- day computer users are accustomed to graphical user interfaces (GUIs), so here comes an extension that lets you browse (offering a simple hypertext facility with automatic cross-referencing - links are added if a word is in the list of keys, plus full-text search) such little databases. The browser is a partial reinvention, or variation, of a little hypertext system. Note that the caller can associate a callback to the "!" button, which is used for map display in Tclworld.

WikiDbImage dbgui.jpg

 source dbapi.tcl
 namespace eval db::ui {
        variable topic ""
 } ;# required before procs can be defined
 proc db::ui::browse {database} {
    set t [toplevel .[clock clicks]]
    wm title $t $database
    db $database
    set m [frame $t.main]
    listbox $m.lb -bg white -height 5 -yscrollcommand [list $m.y1 set]
    bind    $m.lb <ButtonRelease-1> [list db::ui::select %W %y $database]
    scrollbar $m.y1 -command [list $m.lb yview]
    htext $m.t $database -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 [list db::edit $database]
    #button $b.new -text New -command [list db::new $database]
    #button $b.del -text Delete -command [list db::delete $database]
    label  $b.find -text Find:
    entry  $b.tofind
    bind   $b.tofind <Return> [list db::ui::find %W $m.t $database]
    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 $m -fill both -expand 1
    foreach i [lsort -dic [$database]] {$m.lb insert end $i}
    set t
 proc db::ui::callback args {} ;# redefine this for specific action
 proc db::ui::htext {w database 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 $database]
    $w insert end \n\n$database\n\n title "Select topic from listbox"
    $w insert end "\n\n[llength [$database]] entries in database"
    set w
 proc db::ui::click {w x y database} {
    set range [$w tag prevrange link [$w index @$x,$y]]
    if [llength $range] {
        Show $w [eval $w get $range] $database
 proc db::ui::select {w y database} {
    Show [winfo parent $w].t [$w get @0,$y] $database
 proc db::ui::Show {w title database} {
    variable topic
    set topic $title
    $w delete 1.0 end
    $w insert end $title\n title \n
    set titles [$database]
    foreach {item value} [$database $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 database} {
    set tofind [$w get]
    set found {}
    foreach key [$database] {
        set data [$database $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] $database}
        default {choice $textw $database $tofind $found}
 proc db::ui::choice {w database 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
 #----------------------------- a sample application...
 if {[file tail $argv0] == [file tail [info script]]} {
    db::ui::browse [source tclworld.db]
    wm withdraw .

Here are the beginning few lines of tclworld.db, for testing. Item names can be any non-empty string. I made it a habit to start each entry with the ":" item, to be read as "is a":

 set db [db "Tclworld database"]

 $db Earth      : {planet in Solar system} see.also continent \
                major.countries {China USA Russia India Japan}
 $db continent  : {large continuous land mass, as opposed to an island .
                The Earth 's continents are: Africa America Antarctica Asia Australia
 $db Africa     : continent major.countries {Egypt Kenya Nigeria {South Africa}}
 $db America    : continent parts {{North America} {Central America} {South America}}
 $db Asia       : continent NB {In fact, part of the Eurasia land mass} \
                major.countries {India China Japan Russia Indonesia}
 $db Alabama    : {state of USA} abbr AL pop 4,335,400 capital Montgomery \
                nick "Yellowhammer State" largest.city Birmingham,AL
 $db Alaska     : {state of USA} abbr AK pop 611,500 capital Juneau \
                nick "Last Frontier" largest.city Anchorage
 $db Arizona    : {state of USA} abbr AZ pop 4,664,600 capital Phoenix \
                nick "Grand Canyon State"
 $db Arkansas   : {state of USA} abbr AR pop 2,531,000 capital "Little Rock" \
                nick "The Natural State"
 $db Austin     : {capital of Texas}
 $db Beijing    : {capital of China} zh: \u5317\u4EAC
 $db California : {state of USA} abbr CA pop 33,198,100 nick "Golden State"\
                capital Sacramento largest.city {Los Angeles}
 $db Canada     @ flags/cd.gif : {country in {North America}} capital Ottawa
 # ... many lines omitted ...
 #----------- end of data; the last command returns the database name
 set db

In the last entry, the "@ flags/cd.gif" item would display the specified GIF image, if present - inlined images in a sort of "toy web browser"... Note also in the Beijing entry how we can of course use any Unicode in Tcl - important for global playing like with Tclworld.

HJG The code begins with "source dbapi.tcl", but I could not found this file here in the wiki?

escargo Using Google I found this fragment:

Where is this documented, and in what version of acs do these options appear? In acs4.1.1 I can see a proc called template::query defined in packages/acs-templating/tcl/database-procs/dbapi.tcl but none of the procs that it calls have these options. -- Andrew Grumet, February 22, 2001 (found here: [L1 ] -- broken link found on 13 Sep 2007)

EMJ Nothing to do with that, it is from A little database API as mentioned at the top!