#!/usr/local/bin/wish -f
#  ^^^^^^^^^^^^^^^^^^^^^^^ modify the path to find wish on your computer#
#########################################################################
#									#
# This is my adressbuch / addressbook program				#
# Version 0.4.0, 02.04.1995						#
# copyright by Clemens Durka, 1995					#
# durka@informatik.tu-muenchen.de					#
# Technische Universitaet Muenchen					#
# Lehrstuhl 14								#
#									#
# You may use it under the terms of the GNU Public Licence		#
#########################################################################
set version "Version 0.4.0, 02.04.1995"
#########################################################################
# Please modify these constants to your local needs			#
#########################################################################
# The configurationsfiles (with path)					#

#set configfile "/usr/stud/durka/adr/lib/adressbuch.config"
set configfile "/usr/local/lib/addressbook/addressbook.config"
#set myconfigfile "~/.adressbuch.config"
set myconfigfile "~/.addressbook.config"


#########################################################################
#########################################################################
# End of the configurable parameters					#
# Don't modify anything below unless you know what you are doing!	#
#########################################################################
#########################################################################

set possible_languages {german english french}
set allfieldids {mrmrs title firstname lastname company institute departement addon pobox street country zip city birthday phone phonepriv phonework fax email category remark other}

#------------------------------------------
# Do Defaultconfiguration
#------------------------------------------

proc do_defaultconfigure {} {
    global options language searchtype only_stdout bitmaps adrfile
    global nbfields maxindex index tcl_precision lastpressed somethingchanged

    set options(language) german
    set options(adrfile) {}
    set options(mycountry) D
    set options(myareacode) {}
    set options(dialoutlocal) {}
    set options(dialoutdistance) {}
    set options(libdir) /usr/local/lib/addressbook
    set options(callprog,phone) {echo "Not defined"}
    set options(callprog,fax) {echo "Not defined"}
    set options(callprog,email) {echo "Not defined"}
    set options(only_stdout) 1
    set options(searchtype) match
    set options(pressdelay) 2000
    set options(select_mask) "*"

    set options(callprog,phonepriv) $options(callprog,phone)
    set options(callprog,phonework) $options(callprog,phone)
    set searchtype $options(searchtype)
    set only_stdout $options(only_stdout)
    set language $options(language)
    set bitmaps $options(libdir)/bitmaps

    set nbfields 0
    set maxindex -1
    set index 0
    set tcl_precision 17
    set lastpressed 0
    set somethingchanged 0
   
    option add *font -adobe-helvetica-bold-r-normal--*-120-*-*-*-*-iso8859-1 widgetDefault
    option add *Entry.font -adobe-helvetica-medium-r-normal--*-120-*-*-*-*-iso8859-1 widgetDefault

}   
    

#------------------------------------------
# Load Configurationfile
#------------------------------------------

proc loadconfigfile {configfile} {
    global options language searchtype only_stdout bitmaps
    
    set f [open $configfile]
    while {[gets $f line] >= 0} {
 	if {[string length $line] > 0} {
	    if {[string index $line 0] != "#"} {
		if {[lindex $line 1] == "YES"} { 
		    set options([lindex $line 0]) 1
		} elseif {[lindex $line 1] == "NO"} {
                    set options([lindex $line 0]) 0
		} else {
		set options([lindex $line 0]) [lindex $line 1]
		}
	    }
	}
    }
    close $f
    set options(callprog,phonepriv) $options(callprog,phone)
    set options(callprog,phonework) $options(callprog,phone)
    set searchtype $options(searchtype)
    set only_stdout $options(only_stdout)
    set language $options(language)
    set bitmaps $options(libdir)/bitmaps
}


#------------------------------------------
# Load languagespecific things
#------------------------------------------

proc loadlanguage {lang} {
    global mes 
    
    set f [open $lang]
    while {[gets $f line] >= 0} {
 	if {[string length $line] > 0} {
	    if {[string index $line 0] != "#"} {
		set mes([lindex $line 0]) [lindex $line 1]
	    }
	}
    }
    close $f
}


#------------------------------------------
# Load country informations
#------------------------------------------

proc loadcountries {} {
    global options countries possible_languages allcodes
    
    set cindex [expr [lsearch $possible_languages $options(language)] + 2]

    set f [open $options(libdir)/countries]
    while {[gets $f line] >= 0} {
 	if {[string length $line] > 0} {
	    if {[string index $line 0] != "#"} {
		set l [split $line ";"]
		set code [lindex $l 0]
		set countries($code,intl_prefix) [lindex $l 1]
		set countries($code,intl_dialout) [lindex $l 5]
		set countries($code,intl_leaveout) [lindex $l 6]
		set countries($code,fullname) [lindex $l $cindex]
		lappend allcodes $code
	    }
	}
    }
    close $f
}



do_defaultconfigure
if [file exists $configfile] {
    loadconfigfile $configfile
}
if [file exists $myconfigfile] {
    loadconfigfile $myconfigfile
}
loadlanguage $options(libdir)/$options(language).translation

source "$options(libdir)/$options(language).helptext"

loadcountries

foreach i [winfo child .] {
    catch {destroy $i}
}


#------------------------------------------
# Load Database
#------------------------------------------

proc loaddatabase {filename} {
    global index language nbfields names adrbook maxindex fields somethingchanged

    loaddataformatfile $filename.fmt

    set index 0
    set f [open $filename]
    
    while {[gets $f line] >= 0} {
	set adrbook($index) [split $line $fields(separatorchar)]
	incr index
    }
    close $f
    set maxindex [expr $index - 1]
    set somethingchanged 0
}

#------------------------------------------
# Save Database
#------------------------------------------

proc savedatabase {filename} {
    global mes language nbfields names adrbook maxindex somethingchanged fields

    if [file exists $filename] {
	exec mv $filename $filename.bak
    }
    set f [open $filename w]

    for {set i 0} {$i <= $maxindex} {incr i} {
	puts $f [join $adrbook($i) $fields(separatorchar)]
    }
    close $f
    .f.main.list.status.2 configure -text $mes(saved)
    set somethingchanged 0
}


#------------------------------------------
# Load Dataformatfile
#------------------------------------------

proc loaddataformatfile {file} {
    global options language searchtype only_stdout bitmaps
    global fields allfieldids names nbfields mes
    
    foreach i $allfieldids {
	set fields($i) -1
    }
    set f [open $file]
    while {[gets $f line] >= 0} {
 	if {[string length $line] > 0} {
	    if {[string index $line 0] != "#"} {
		set fields([lindex $line 0]) [lindex $line 1]
		if [regexp \[0-9\] [string index $line 0]] { 
		    set fields([lindex $line 1]) [lindex $line 0]
		}
	    }
	}
    }
    set i 0
    set names {}
    while {[info exists fields($i)]} {
	lappend names $mes($fields($i))
	incr i
    }
    set nbfields [llength $names]
}

#------------------------------------------
# Dismiss Preferences
#------------------------------------------

proc prefdismiss {} {
    destroy .pref
}

# Needs to be developed
proc prefquit {} { destroy .pref }
proc prefsave {} { destroy .pref }
proc prefreset {} { destroy .pref }

#------------------------------------------
# Edit global Preferences
#------------------------------------------

proc prefeditglob {} {
    global language somethingchanged mes possible_languages options
    if [catch {toplevel .pref}] {
	raise .pref
    } else {
	wm title .pref $mes(globpref)
	set buttons [frame .pref.but]
	pack .pref.but -side top -fill x
	button $buttons.quit -text $mes(cancel) -command prefquit
	button $buttons.save -text $mes(save) -command prefsave
	#button $buttons.reset -text "Reset" -command prefreset
	#button $buttons.dismiss -text "Dismiss" -command prefdismiss
	label $buttons.label -text "Sorry, you cannot change anything in here yet. To edit anything, modify the configfile"
	pack $buttons.label -side left -fill x
	pack $buttons.quit $buttons.save -side right
	#pack $buttons.reset $buttons.dismiss -side right
	frame .pref.b -borderwidth 2 -relief raised
	pack .pref.b -fill both
	set body [frame .pref.b.b -bd 10]
	pack .pref.b.b -fill both

	set maxwidth 45
	
	set f [frame $body.1 -borderwidth 2]
	pack $f -fill both
	label $f.l -text $mes(language) -width $maxwidth
	pack $f.l -side left
	foreach c $possible_languages {
	    radiobutton $f.$c -text $c -variable options(language) -value $c	
	    pack $f.$c -side left
	}

	set f [frame $body.2 -borderwidth 2]
	pack $f -fill both
	label $f.l -text $mes(country) -width $maxwidth
	pack $f.l -side left
	entry $f.e -width 10 -relief sunken
	pack $f.e -side left -fill x -expand true
	$f.e insert 0 $options(mycountry)
	bind $f.e <Return> {set $options(mycountry) [%W get]}
	
	set f [frame $body.3 -borderwidth 2]
	pack $f -fill both
	label $f.l -text $mes(areacode) -width $maxwidth
	pack $f.l -side left
	entry $f.e -width 10 -relief sunken
	pack $f.e -side left -fill x -expand true
	$f.e insert 0 $options(myareacode)
	bind $f.e <Return> {set $options(myareacode) [%W get]}
	
	set f [frame $body.4 -borderwidth 2]
	pack $f -fill both
	label $f.l -text $mes(localprefix) -width $maxwidth
	pack $f.l -side left
	entry $f.e -width 10 -relief sunken
	pack $f.e -side left -fill x -expand true
	$f.e insert 0 $options(dialoutlocal)
	bind $f.e <Return> {set $options(dialoutlocal) [%W get]}
	
	set f [frame $body.5 -borderwidth 2]
	pack $f -fill both
	label $f.l -text $mes(distanceprefix) -width $maxwidth
	pack $f.l -side left
	entry $f.e -width 10 -relief sunken
	pack $f.e -side left -fill x -expand true
	$f.e insert 0 $options(dialoutdistance)
	bind $f.e <Return> {set $options(dialoutdistance) [%W get]}
	
	set f [frame $body.6 -borderwidth 2]
	pack $f -fill both
	label $f.l -text $mes(defadrfile) -width $maxwidth
	pack $f.l -side left
	entry $f.e -width 10 -relief sunken
	pack $f.e -side left -fill x -expand true
	$f.e insert 0 $options(adrfile)
	bind $f.e <Return> {set $options(adrfile) [%W get]}
	
	set f [frame $body.7 -borderwidth 2]
	pack $f -fill both
	label $f.l -text $mes(libdir) -width $maxwidth
	pack $f.l -side left
	entry $f.e -width 10 -relief sunken
	pack $f.e -side left -fill x -expand true
	$f.e insert 0 $options(libdir)
	bind $f.e <Return> {set $options(libdir) [%W get]}
	
	set f [frame $body.8 -borderwidth 2]
	pack $f -fill both
	label $f.l -text $mes(defsearchopt) -width $maxwidth
	pack $f.l -side left
	radiobutton $f.1 -text "exact" -variable options(searchtype) -value exact
	pack $f.1 -side left
	radiobutton $f.2 -text "match" -variable options(searchtype) -value match
	pack $f.2 -side left
	radiobutton $f.3 -text "regexp" -variable options(searchtype) -value regexp
	pack $f.3 -side left

	set f [frame $body.20 -borderwidth 2]
	pack $f -fill both
	label $f.l -text $mes(defonlystdout) -width $maxwidth
	pack $f.l -side left
	checkbutton $f.c -text "On" -variable options(only_stdout)
	pack $f.c -side left
	
	set f [frame $body.21 -borderwidth 2]
	pack $f -fill both
	label $f.l -text $mes(phoneprog) -width [expr $maxwidth + 20]
	pack $f.l -side top
	entry $f.e -width 40 -relief sunken
	pack $f.e  -fill x -expand true
	$f.e insert 0 $options(callprog,phone)
	bind $f.e <Return> {set $options(callprog,phone) [%W get]}
	
	set f [frame $body.22 -borderwidth 2]
	pack $f -fill both
	label $f.l -text $mes(faxprog) -width [expr $maxwidth + 20]
	pack $f.l -side top
	entry $f.e -width 40 -relief sunken
	pack $f.e -fill x -expand true
	$f.e insert 0 $options(callprog,fax)
	bind $f.e <Return> {set $options(callprog,fax) [%W get]}
	
	set f [frame $body.23 -borderwidth 2]
	pack $f -fill both
	label $f.l -text $mes(emailprog) -width [expr $maxwidth + 20]
	pack $f.l -side top
	entry $f.e -width 40 -relief sunken
	pack $f.e -fill x -expand true
	$f.e insert 0 $options(callprog,email)
	bind $f.e <Return> {set $options(callprog,email) [%W get]}
	
    }
}


#------------------------------------------
# Edit dataspecific Preferences
#------------------------------------------

proc prefeditfile {} {
    global language somethingchanged options mes
    global fields allfieldids nbfields language
    if [catch {toplevel .pref}] {
	raise .pref
    } else {
	wm title .pref $mes(filepref)
	set buttons [frame .pref.but]
	pack .pref.but -side top -fill x
	button $buttons.quit -text $mes(cancel) -command prefquit
	button $buttons.save -text $mes(save) -command prefsave
	#button $buttons.reset -text "Reset" -command prefreset
	#button $buttons.dismiss -text "Dismiss" -command prefdismiss
	label $buttons.label -text "Sorry, you cannot change anything in here yet. To edit anything, modify the formatfile"
	pack $buttons.label -side left -fill x
	pack $buttons.quit $buttons.save -side right
	#pack $buttons.reset $buttons.dismiss -side right
	frame .pref.b -borderwidth 2 -relief raised
	pack .pref.b -fill both
	set body [frame .pref.b.b -bd 10]
	pack .pref.b.b -fill both

	set maxwidth 15
	
	set f [frame $body.2 -borderwidth 2]
	pack $f -fill both
	label $f.l -text $mes(separatorchar) -width $maxwidth
	pack $f.l -side left
	entry $f.e -width 10 -relief sunken
	pack $f.e -side left -fill x -expand true
	$f.e insert 0 $fields(separatorchar)
	bind $f.e <Return> {set $fields(separatorchar) [%W get]}
	
	set f [frame $body.3 -borderwidth 2]
	pack $f -fill both
	label $f.l -text "listboxformat" -width $maxwidth
	pack $f.l -side left
	entry $f.e -width 10 -relief sunken
	pack $f.e -side left -fill x -expand true
	$f.e insert 0 $fields(listboxformat)
	bind $f.e <Return> {set $fields(listboxformat) [%W get]}
	
	set f [frame $body.4 -borderwidth 2]
	pack $f -fill both
	label $f.l -text "listboxentry1" -width $maxwidth
	pack $f.l -side left
	entry $f.e -width 10 -relief sunken
	pack $f.e -side left -fill x -expand true
	$f.e insert 0 $fields(listboxentry1)
	bind $f.e <Return> {set $fields(listboxentry1) [%W get]}
	
	set f [frame $body.5 -borderwidth 2]
	pack $f -fill both
	label $f.l -text "listboxentry2" -width $maxwidth
	pack $f.l -side left
	entry $f.e -width 10 -relief sunken
	pack $f.e -side left -fill x -expand true
	$f.e insert 0 $fields(listboxentry2)
	bind $f.e <Return> {set $fields(listboxentry2) [%W get]}
	
	foreach fld $allfieldids {
	    set f [frame $body.$fld -borderwidth 0]
	    pack $f -fill both
	    label $f.l -text $mes($fld) -width $maxwidth
	    pack $f.l -side left
	    for {set i 0} {$i <= $nbfields} {incr i} {
		radiobutton $f.$i -text $i -variable fields($fld) -value $i	
		pack $f.$i -side left
	    }
	}
    }
}


#------------------------------------------
# Put the country code in the correct field
#------------------------------------------

proc putcountrycode ind {
    global allcodes fields
    .f.main.entry.$fields(country).entry delete 0 end
    .f.main.entry.$fields(country).entry insert 0 [lindex $allcodes $ind]
}


#------------------------------------------
# Show all countries
#------------------------------------------

proc countrycodes {} {
    global mes allcodes countries
    if [catch {toplevel .countries}] {
	raise .countries
    } else {
	wm title .countries $mes(countries)
	set buttons [frame .countries.but]
	pack .countries.but -side top -fill x
	button $buttons.quit -text $mes(close) -command {destroy .countries}
	pack $buttons.quit -side right -expand yes -fill x
        
	set cb [frame .countries.b -borderwidth 2]
	pack $cb -fill both
	
	listbox $cb.list -relief sunken -geometry 30x15 -yscrollcommand "$cb.scroll set" -font "-*-fixed-bold-*-*-*-*-*-*-*-*-*-iso8859-1"
	tk_listboxSingleSelect $cb.list 
	scrollbar $cb.scroll -orient vertical -command "$cb.list yview" -relief sunken
	pack $cb.list -side left -padx 2
	pack $cb.scroll -side right -fill y -padx 2
	bind $cb.list <1> {%W select from [%W nearest %y]; putcountrycode [.countries.b.list curselection]}

	foreach code $allcodes {
	    $cb.list insert end [format "%3s %s" $code $countries($code,fullname)]
	} 
    }
}





#------------------------------------------
# Create the basic front end.
#------------------------------------------

proc createbasicfrontend {} {
    global mes

#------------------------------------------
# Add menus, dialog boxes
#------------------------------------------

    wm title . $mes(adressbook)
    wm iconname . $mes(adressbook)

    frame .f
    pack .f -fill y -fill x -expand yes
    frame .f.menu -relief raised -borderwidth 1
    pack .f.menu -side top -fill x -expand yes

    menubutton .f.menu.file -text $mes(file) -menu .f.menu.file.m  -underline 0
    menu .f.menu.file.m
    .f.menu.file.m add command -label $mes(load) -command loadAction  -underline 0
    .f.menu.file.m add command -label $mes(save) -command saveAction  -underline 0
    .f.menu.file.m add command -label $mes(saveas) -command saveasAction  -underline 2
    .f.menu.file.m add command -label $mes(print) -command printAction  -underline 0
    .f.menu.file.m add command -label $mes(import) -command importAction  -underline 0
    .f.menu.file.m add command -label $mes(export) -command exportAction  -underline 1
    .f.menu.file.m add command -label $mes(close) -command closeAction  -underline 1
    .f.menu.file.m add command -label $mes(exit) -command quitAction  -underline 0
    pack .f.menu.file -side left

    .f.menu.file.m entryconfig 0 -accel Ctrl+L
    bind Entry <Control-f> loadAction
    .f.menu.file.m entryconfig 1 -accel Ctrl+V
    bind Entry <Control-v> saveAction
    .f.menu.file.m entryconfig 2 -accel Ctrl+W
    bind Entry <Control-w> saveasAction
    .f.menu.file.m entryconfig 3 -accel Ctrl+P
    bind Entry <Control-p> printAction
    .f.menu.file.m entryconfig 4 -accel Ctrl+I
    bind Entry <Control-i> importAction
    .f.menu.file.m entryconfig 5 -accel Ctrl+E
    bind Entry <Control-e> exportAction
    .f.menu.file.m entryconfig 6 -accel Ctrl+O
    bind Entry <Control-o> closeAction
    .f.menu.file.m entryconfig 7 -accel Ctrl+Q
    bind Entry <Control-q> quitAction

    menubutton .f.menu.options -text $mes(options) -menu .f.menu.options.m  -underline 0
    menu .f.menu.options.m
    .f.menu.options.m add cascade -label $mes(searchopt) -menu .f.menu.options.m.search
    .f.menu.options.m add cascade -label $mes(onlystdout) -menu .f.menu.options.m.out
    .f.menu.options.m add command -label $mes(globpref) -command prefeditglob 
    .f.menu.options.m add command -label $mes(filepref) -command prefeditfile
    pack .f.menu.options -side left -padx 20

    menu .f.menu.options.m.search
    .f.menu.options.m.search add radiobutton -label $mes(exactsearch) -variable searchtype -value exact
    .f.menu.options.m.search add radiobutton -label $mes(wildsearch) -variable searchtype -value match
    .f.menu.options.m.search add radiobutton -label $mes(regexpsearch) -variable searchtype -value regexp

    menu .f.menu.options.m.out
    .f.menu.options.m.out add checkbutton -label $mes(on) -variable only_stdout

    menubutton .f.menu.countries -text $mes(countries) -menu .f.menu.countries.m  -underline 0
    menu .f.menu.countries.m
    .f.menu.countries.m add command -label $mes(countrycodes) -command countrycodes 
    pack .f.menu.countries -side left -padx 0

    label .f.menu.space -text " "  -width 55
    pack .f.menu.space -side left

    menubutton .f.menu.help -text $mes(help) -menu .f.menu.help.m -underline 0
    menu .f.menu.help.m
    pack .f.menu.help -side right
    .f.menu.help.m add command -label $mes(oncontext) -command {Help context}
    .f.menu.help.m add command -label $mes(onhelp) -command {Help help}
    .f.menu.help.m add command -label $mes(onwindow) -command {Help window}
    .f.menu.help.m add command -label $mes(onentry) -command {Help .f.main.entry.0.entry}
    .f.menu.help.m add command -label $mes(onkeys) -command {Help keys}
    .f.menu.help.m add command -label $mes(onversion) -command {showversion}
 
    tk_menuBar .f.menu .f.menu.file .f.menu.options .f.menu.countries .f.menu.help
    tk_bindForTraversal .
}


#------------------------------------------
# Create the front end with a database
#------------------------------------------

proc createfrontend {} {
    global nbfields names adrbook fields helpCmds helpTopics
    global language maxindex nbfound index bitmaps
    global searchtype only_stdout mes found phones

    frame .f.main
    pack .f.main -side top -fill x -fill y -expand yes -padx 2 -pady 2
    set f [frame .f.main.entry]
    pack $f -side left -fill x -fill y -expand yes -anchor center


    for {set i 0} {$i < $nbfields} {incr i} {
	frame $f.$i
	pack $f.$i -side top -pady 2 -anchor e -fill y -expand true

	label $f.$i.label -text [format "%s:" [lindex $names $i]] -anchor e
	entry $f.$i.entry -width 35 -relief sunken
	pack $f.$i.entry .f.main.entry.$i.label -side right -fill x -expand true
	bind $f.$i.entry <Return> "focus $f.[expr $i + 1].entry"
	bind $f.$i.entry <Down> "focus $f.[expr $i + 1].entry"
	bind $f.$i.entry <Up> "focus $f.[expr $i - 1].entry"
    } 
    bind $f.[expr $nbfields - 1].entry <Return> {focus $f.0.entry}
    bind $f.[expr $nbfields - 1].entry <Down> {focus $f.0.entry}
    bind $f.0.entry <Up> {focus $f.[expr $nbfields - 1].entry}
    bind Entry <Left> {%W icursor [expr [%W index insert] - 1]}
    bind Entry <Right> {%W icursor [expr [%W index insert] + 1]}
    bind Entry <Shift-Left> {%W icursor 0}
    bind Entry <Home> {%W icursor 0}
    bind Entry <Shift-Right> {%W icursor end}
    bind Entry <End> {%W icursor end}
    bind Entry <Any-F1> {Help [winfo containing %X %Y] %X %Y}
    bind Entry <Any-Help> {Help [winfo containing %X %Y] %X %Y}

    frame .f.buttons
    pack .f.buttons -side bottom -pady 2 -padx 2 -expand yes -fill x -anchor center
    button .f.buttons.clear -text $mes(clear)
    button .f.buttons.add -text $mes(add)
    button .f.buttons.change -text $mes(update)
    button .f.buttons.search -text $mes(search)
    button .f.buttons.auswahl -text $mes(generalview) 
    pack .f.buttons.clear .f.buttons.add .f.buttons.change .f.buttons.search  \
	.f.buttons.auswahl \
	-side left -expand yes -fill x -padx 0

    .f.buttons.clear config -command { clearAction;\
	.f.main.list.status.4.e delete 0 end; \
	if {[focus] == ".f.main.list.status.4.e"} {focus .f.main.entry.0.entry}}
    bind Entry <Control-c> { clearAction;\
	.f.main.list.status.4.e delete 0 end; \
	if {[focus] == ".f.main.list.status.4.e"} {focus .f.main.entry.0.entry}}
    .f.buttons.add config -command addAction
    bind Entry <Control-a> addAction
    .f.buttons.change config -command updateAction
    bind Entry <Control-u> updateAction
    .f.buttons.search config -command "searchAdr"
    bind Entry <Control-s> "searchAdr"
    .f.buttons.auswahl config -command "auswahlAdr"
    bind Entry <Control-g> "auswahlAdr"


    #
    # Listbox
    #

    frame .f.main.list -relief raised
    pack .f.main.list -side left -expand yes -fill y -padx 10
    #frame .f.main.list.title -geometry 40x6
    #pack .f.main.list.title -fill both 
    button .f.main.list.title -text $mes(adressbook) -relief raised \
	-font -Adobe-times-medium-r-normal--*-180-*-*-*-*-iso8859-1 \
	-activebackground bisque -command showversion
    pack .f.main.list.title -pady 2 -padx 1  -fill both -expand yes

    frame .f.main.list.lb
    pack .f.main.list.lb
    listbox .f.main.list.lb.box -relief sunken -geometry 27x16 -yscrollcommand ".f.main.list.lb.scroll set" 
    tk_listboxSingleSelect .f.main.list.lb.box
    bind .f.main.list.lb.box <1> {%W select from [%W nearest %y]; showAdr [.f.main.list.lb.box curselection]; .f.main.list.status.4.e delete 0 end}
    scrollbar .f.main.list.lb.scroll -orient vertical -command ".f.main.list.lb.box yview" -relief sunken
    pack .f.main.list.lb.box -side left -expand yes -fill y -padx 2 
    pack .f.main.list.lb.scroll -side right -expand yes -fill y -padx 2
    # In der Listbox werden folgende Felder angezeigt
    set found {}
    set lbf $fields(listboxformat)
    set lb1 $fields(listboxentry1)
    set lb2 $fields(listboxentry2)
    for {set i 0} {$i <= $maxindex} {incr i} {
	.f.main.list.lb.box insert end [format $lbf [lindex $adrbook($i) $lb1] [lindex $adrbook($i) $lb2]]
	lappend found $i
    }
    set nbfound [llength $found]
    setSelection 0

    # message .f.main.list.status  -aspect 1000 -width 100 -relief raised -justify center
    # label .f.main.list.status  -height 2 -width 27 -relief raised 
    frame .f.main.list.status  -height 3 -width 27 -relief raised 
    pack .f.main.list.status -pady 2 -padx 4 -side bottom -expand yes -fill x
    label .f.main.list.status.0 -height 1 -width 27 -relief raised
    label .f.main.list.status.1 -height 1 -width 27 -relief raised 
    label .f.main.list.status.2 -height 1 -width 27 -relief raised 
    pack .f.main.list.status.0 .f.main.list.status.1 .f.main.list.status.2 -expand yes -fill x
    .f.main.list.status.0 configure -text [format $mes(readend) $index]
    .f.main.list.status.1 configure -text [format $mes(records) $index]
    # .f.main.list.status.2 configure -text [format $mes(records) $index]
    frame .f.main.list.status.3 -width 27
    pack .f.main.list.status.3 -anchor center -expand yes -fill x
    button .f.main.list.status.3.0 -bitmap @$bitmaps/le
    button .f.main.list.status.3.1 -bitmap @$bitmaps/ll
    button .f.main.list.status.3.2 -bitmap @$bitmaps/l
    button .f.main.list.status.3.3 -bitmap @$bitmaps/r
    button .f.main.list.status.3.4 -bitmap @$bitmaps/rr
    button .f.main.list.status.3.5 -bitmap @$bitmaps/re
    pack .f.main.list.status.3.0 .f.main.list.status.3.1 \
	 .f.main.list.status.3.2 .f.main.list.status.3.3 \
	 .f.main.list.status.3.4 .f.main.list.status.3.5 \
	 -side left -expand yes -fill x

    frame .f.main.list.status.4 -width 27
    pack .f.main.list.status.4 -anchor center -expand yes -fill x
    button .f.main.list.status.4.b -text $mes(goto)
    entry .f.main.list.status.4.e -width 9 -relief sunken
    pack .f.main.list.status.4.b -side left -expand yes -fill x
    pack .f.main.list.status.4.e -side left -expand yes -fill x

    bind Entry <Prior> "moverelAdr -1"
    bind Entry <Next>  "moverelAdr  1"
    .f.main.list.status.3.0 config -command "moveabsAdr 0"
    .f.main.list.status.3.1 config -command "moverelAdr -10"
    .f.main.list.status.3.2 config -command "moverelAdr -1"
    .f.main.list.status.3.3 config -command "moverelAdr  1"
    .f.main.list.status.3.4 config -command "moverelAdr  10"
    .f.main.list.status.3.5 config -command "moveabsAdr [expr $nbfound - 1]"
    .f.main.list.status.4.b config -command {set $lastpressed 0; .f.main.list.status.4.e delete 0 end; focus .f.main.list.status.4.e}

    # Add 26 Buttons from A to Z
    set a [frame .f.main.abc -height 13 -width 2]
    pack $a -side right
    for {set i 0} {$i < 26} {incr i 2} {
	frame $a.frame$i
	pack $a.frame$i -side top 
	button $a.$i -text [format "%c" [expr $i+65]] -width 2
	button $a.[expr $i + 1] -text [format "%c" [expr $i+66]] -width 2
	pack $a.$i    -in $a.frame$i -side left 
	pack $a.[expr $i + 1]  -in $a.frame$i -side right 
    }

    for {set i 0} {$i < 26} {incr i} {
    	bind $a.$i <1> "tk_butDown %W; abcAdr $i %t"
    	bind .f.main.list.status.4.e [format "%c" [expr $i + 65]] "abcAdr %A 0"
    	bind .f.main.list.status.4.e [format "%c" [expr $i + 97]] "abcAdr %A 0"
	set helpTopics($a.$i) $helpTopics(.f.main.abc.0)
    }

    # Add the mail, fax and phone buttons
    label $a.space -height 1
    pack $a.space -side top
    set phones {}
    foreach p {phone phonepriv phonework} {
	if {$fields($p) >= 0} {
	    lappend phones $p
	}
    }
    button $a.mail  -bitmap @$bitmaps/mail  -width 36
    pack $a.mail  -side top -anchor center 
    foreach p $phones { 
	button $a.$p -bitmap @$bitmaps/$p -width 36
	pack $a.$p -side top -anchor center 
    }
    button $a.fax   -bitmap @$bitmaps/fax   -width 36
    pack $a.fax   -side top -anchor center 
    button $a.email -bitmap @$bitmaps/email -width 36
    pack $a.email -side top -anchor center 

    $a.mail  config -command "do_mail"
    $a.fax   config -command "do_callprog fax"
    $a.email config -command "do_callprog email"
    foreach p $phones {
    	.f.main.abc.$p config -command "do_callprog $p"
    }

    # init the fields and set the focus

    if {$nbfields > 0} {
	showAdr 0
    }
    focus .f.main.list.status.4.e
    focus default .f.main.list.status.4.e

    # Help text and commands follow:
    set helpCmds(.f.menu.file.m) {getMenuTopic $topic $x $y}
    set helpCmds(.f.menu.file.m.none) {set topic ".f.menu.file"}
    for {set i 0} {$i < $nbfields} {incr i} {
	set helpCmds(.f.main.entry.$i.label) {set topic .f.main.entry.$i.entry}
	set helpTopics(.f.main.entry.$i.entry) $helpTopics(.f.main.entry.0.entry)
    }
}



# The mkDialog procedure below was pirated from the widget demo.  It
# was not written fresh for this benchmark.

# Create a dialog box.  Takes three or more arguments.  The first is
# the name of the window to use for the dialog box.  The second is a set
# of arguments for use in creating the message of the dialog box.  The
# third and following arguments consist of two-element lists, each
# describing one button.  The first element gives the text to be displayed
# in the button, the second gives the command to be invoked when the
# button is invoked.

proc mkDialog {w msgArgs args} {
    catch {destroy $w}
    toplevel $w -class Dialog
    set oldFocus [focus]

    # Create two frames in the main window. The top frame will hold the
    # message and the bottom one will hold the buttons.  Arrange them
    # one above the other, with any extra vertical space split between
    # them.

    frame $w.top -relief raised -border 1
    frame $w.bot -relief raised -border 1
    pack $w.top $w.bot -side top -fill both -expand yes

    # Create the message widget and arrange for it to be centered in the
    # top frame.
    
    eval message $w.top.msg -justify center \
	    -font -Adobe-times-medium-r-normal--*-180-*-*-*-*-iso8859-1 $msgArgs
    pack $w.top.msg -side top -expand yes -padx 2 -pady 2

    # Create as many buttons as needed and arrange them from left to right
    # in the bottom frame.  Embed the left button in an additional sunken
    # frame to indicate that it is the default button, and arrange for that
    # button to be invoked as the default action for clicks and returns in
    # the dialog.

    if {[llength $args] > 0} {
	set arg [lindex $args 0]
	frame $w.bot.0 -relief sunken -border 1
	pack $w.bot.0 -side left -expand yes -padx 10 -pady 10
	button $w.bot.0.button -text [lindex $arg 0] \
		-command "[lindex $arg 1]; destroy $w; focus $oldFocus"
	pack $w.bot.0.button -expand yes -padx 6 -pady 6
	bind $w.top <Enter> "$w.bot.0.button activate"
	bind $w.top.msg <Enter> "$w.bot.0.button activate"
	bind $w.bot <Enter> "$w.bot.0.button activate"
	bind $w.top <Leave> "$w.bot.0.button deactivate"
	bind $w.top.msg <Leave> "$w.bot.0.button deactivate"
	bind $w.bot <Leave> "$w.bot.0.button deactivate"
	bind $w <1> "$w.bot.0.button config -relief sunken"
	bind $w <ButtonRelease-1> \
		"[lindex $arg 1]; $w.bot.0.button deactivate; destroy $w; focus $oldFocus"
	bind $w <Return> "[lindex $arg 1]; destroy $w; focus $oldFocus"
	focus $w

	set i 1
	foreach arg [lrange $args 1 end] {
	    button $w.bot.$i -text [lindex $arg 0] \
		    -command "[lindex $arg 1]; destroy $w; focus $oldFocus"
	    pack $w.bot.$i -side left -expand yes -padx 10
	    set i [expr $i+1]
	}
    }
    wm geometry $w +300+350
}

#------------------------------------------
# Select a file
#------------------------------------------

proc selectfile {defaultname} {
    global mes options select_op select_result

    set select_result [file tail $defaultname]
    if { $defaultname != "" } {
	cd [file dirname $defaultname]
    }

    if [catch {toplevel .select}] {
	raise .select
    } else {
	wm title .select $mes(fileselection)
	frame .select.frame -borderwidth 2 -relief raised
	frame .select.frame.f -relief raised

        set pwd [pwd]
	set pwd_length [string length $pwd]
	if { $pwd_length > 30 } {
	    set tmp "..."
	    append tmp [string range $pwd [expr $pwd_length - 27] $pwd_length]
	    set pwd $tmp
	}
	label .select.frame.pwd -width 30 -text $pwd
	entry .select.frame.file -textvariable file_name -relief sunken
	#set_default_entry_bindings .select.frame.file
	focus .select.frame.file
	set file_name [file tail $defaultname]
	listbox .select.frame.f.list -geometry 30x10 \
	    -yscrollcommand ".select.frame.f.scroll set"
	scrollbar .select.frame.f.scroll -command ".select.frame.f.list yview" \
	    -relief sunken
	button .select.frame.load -text $select_op -command { \
	    if { "$file_name" != "" } { \
		if { [string index $file_name 0] == "/" } { \
		    set select_result $file_name; \
		} else { \
		    set temp [pwd]; \
		    append temp /; \
		    append temp $file_name; \
		    set select_result $temp \
		} \
	    }; \
	    destroy .select }
        if { "$file_name" != "" } { 
            .select.frame.load configure -text "$select_op $file_name" 
	    .select.frame.file delete 0 end
	    .select.frame.file insert 0 $file_name
        } else { 
            .select.frame.load configure -text "$select_op <$mes(nofile)>" 
        } 

	button .select.frame.cancel -text Cancel -command { \
	    set select_result "" ; destroy .select }

	pack .select.frame -side top -fill both -expand 1
	pack .select.frame.pwd .select.frame.file .select.frame.f \
	    -side top -fill both -expand 1
	pack .select.frame.load .select.frame.cancel -side left -fill x -expand 1
	pack .select.frame.f.list -side left -fill both -expand 1
	pack .select.frame.f.scroll -side left -anchor e -fill y -expand 1

	load_list .select $options(select_mask)

	bind .select.frame.f.list <Double-Button> { \
	    set choose [.select.frame.f.list get [.select.frame.f.list \
		curselection]]; \
	    if { [file exists $choose] == 0 } {
		append choose $options(select_mask)
	    }
	    set type [file type $choose]; \
	    if { "$type" == "directory" } { \
		cd $choose; \
		set pwd [pwd]; \
		set pwd_length [string length $pwd]; \
		if { $pwd_length > 30 } { \
		    set tmp "..."; \
		    append tmp [string range $pwd [expr $pwd_length - 27] $pwd_length]; \
		    set pwd $tmp; \
		}; \
		load_list .select $options(select_mask); \
		.select.frame.pwd configure -text $pwd; \
		.select.frame.load configure -text "$select_op <$mes(nofile)>"; \
		set file_name "" \
	    } else { \
		set file_name $choose; \
		.select.frame.load configure -text "$select_op $file_name" \
	    } \
	} 
	bind .select.frame.file <Leave> { \
            if { "$file_name" != "" } { \
            	.select.frame.load configure -text "$select_op $file_name" \
            } else { \
            	.select.frame.load configure -text "$select_op <$mes(nofile)>" \
            } \
    	}

    	bind .select.frame.file <Return> { \
            if { "$file_name" != "" } { \
            	.select.frame.load configure -text "$select_op $file_name"; \
		if { [string index $file_name 0] == "/" } { \
		     set select_result $file_name; \
		} else { \
            	     set temp [pwd]; \
            	     append temp /; \
            	     append temp $file_name; \
            	     set select_result $temp; \
		} \
            	destroy .select; \
            } \
	}
    }
}


proc load_list args {
    # load file names

    set arglist [split $args]
    set w [lindex $arglist 0]
    set mask [lindex $arglist 1]

    $w.frame.f.list delete 0 end

    $w.frame.f.list insert end "../"

    foreach file [lsort [glob -nocomplain *]] {
        set base [file tail $file]
        set type [file type $file] 
        if { "$type" == "directory" } {
            append base "/"
            $w.frame.f.list insert end "$base"
        } elseif { "$mask" == "*" } {
            $w.frame.f.list insert end "$base"
        } elseif { "[file extension $file]" == "$mask" } {
            $w.frame.f.list insert end "$base"
        }
    }
}


#------------------------------------------
# Show Version
#------------------------------------------

proc showversion {} {
    global options mes bitmaps version

    toplevel .showversion

    wm title .showversion "$mes(about) $mes(adressbook)"
    wm iconname .showversion "$mes(about) $mes(adressbook)"
    frame .showversion.frame -borderwidth 2 -relief raised
    set f "-adobe-times-medium-r-normal--*-180-*-*-*-*-iso8859-1"

    button .showversion.frame.but -bitmap @$bitmaps/author -relief ridge
    label .showversion.frame.l1 -text $mes(adressbook) -font $f
    label .showversion.frame.l2 -text $version 
    label .showversion.frame.l3 -text "This is an alpha version"
    label .showversion.frame.l4 -text "Please report bugs to"
    label .showversion.frame.l5 -text "durka@informatik.tu-muenchen.de"
    label .showversion.frame.l6 -text "Copyright by Clemens Durka, 1995"

    button .showversion.dismiss -text "OK" -command "destroy .showversion" \
	-font -adobe-helvetica-bold-r-normal-*-14-*-*-*-*-*-iso8859-1

    pack .showversion.frame -side top -fill both -expand 1
    pack .showversion.frame.but -padx 4 -pady 4 -side left -fill both -expand 1
    pack .showversion.frame.l1 .showversion.frame.l2 .showversion.frame.l3 \
            .showversion.frame.l4 .showversion.frame.l5 \
            .showversion.frame.l6 \
            -ipadx 4m -side top -fill both -expand 1
    pack .showversion.dismiss -side bottom -fill x
}
#proc deleteAction {} {
#     mkDialog .delete {-text "Are you sure?" -aspect 10000} \
# 	    "OK clearAction" "Cancel {}"
# }
#.f.buttons.delete config -command deleteAction

#------------------------------------------
# Different Actions
#------------------------------------------

proc loadAction {} {
    global adrfile mes select_op select_result somethingchanged

    set select_op $mes(load)
    selectfile $adrfile
    tkwait window .select

    if { "$select_result" != "" } {
	set adrfile $select_result

	if {$somethingchanged} {
	    mkDialog .reloadSelection "-text {$mes(closemes)} -aspect 400" \
		"$mes(continue) {doloadAction}" "$mes(cancel) {}"
	} else {
	    doloadAction
        }
    }
}

proc doloadAction {} {
    global mes adrfile nbfields

    loaddatabase $adrfile
    if { [wm title .] != "$mes(adressbook)"} {
	destroy .f.main .f.buttons
    }
    wm title . "$mes(adressbook) - [file tail $adrfile]"
    wm iconname . "$mes(adressbook) - [file tail $adrfile]"
    createfrontend
    if {$nbfields > 0} {
	showAdr 0
    }
    focus .f.main.list.status.4.e
} 

proc saveAction {} {
    global adrfile
    savedatabase $adrfile
}

proc saveasAction {} {
    global adrfile mes select_op select_result

    set select_op $mes(saveas)
    selectfile $adrfile
    tkwait window .select

    if { "$select_result" != "" } {
	if [file exists $select_result] {
	    mkDialog .saveasSelection "-text {$mes(overwrite): $select_result} -aspect 400" \
		"$mes(continue) {dosaveasAction}" "$mes(cancel) {}"
	} else {
	    dosaveasAction
        }
    }
}

proc dosaveasAction {} {
    global mes adrfile select_result

    exec cp $adrfile.fmt $select_result.fmt
    set adrfile $select_result
    savedatabase $adrfile
    wm title . "$mes(adressbook) - [file tail $adrfile]"
    wm iconname . "$mes(adressbook) - [file tail $adrfile]"
}

proc closeAction {} {
    global mes somethingchanged
    if {$somethingchanged} {
	mkDialog .closeSelection "-text {$mes(closemes)} -aspect 400" \
	    "$mes(close) {docloseAction}" "$mes(cancel) {}" 
    } else {
	docloseAction
    }
}

proc docloseAction {} {
    global mes

    destroy .f.main .f.buttons
    wm title . "$mes(adressbook)"
    wm iconname . "$mes(adressbook)"
}

proc importAction {} {
    mkDialog .fileSelection {-text "Not implemented yet." -aspect 400} "OK {}"
}

proc exportAction {} {
    mkDialog .fileSelection {-text "Not implemented yet." -aspect 400} "OK {}"
}

proc quitAction {} {
    global mes somethingchanged
    if {$somethingchanged} {
	mkDialog .quitSelection "-text {$mes(quitmes)} -aspect 400" "$mes(exit) {exit}" "$mes(cancel) {}" 
    } else {
        exit
    }
}

proc printAction {} {
    global mes language
    mkDialog .printSelection "-text {$mes(askprint)} -aspect 400" "OK {printAdr}" "Cancel {}"}

proc printAdr {} {
    adrliste 
    exec a2ps -1 -F4.9 -HAdressliste -nL -p -8 /tmp/adressliste > /tmp/adr.ps 2>/tmp/err
    exec /usr/local/bin/psselect -p1 /tmp/adr.ps > /tmp/adr1.ps 2>>/tmp/err
    exec /usr/local/bin/psselect -p2 /tmp/adr.ps > /tmp/adr2.ps 2>>/tmp/err
#    exec lpr /tmp/adr1.ps
#    exec lpr /tmp/adr2.ps
}

#------------------------------------------
# Print Addresslist
#------------------------------------------

proc adrliste {} {
    global adrbook printfile countries maxindex
    set f [open /tmp/adressliste w]
    set i 0
    while { $i <= $maxindex } {
        set akt $adrbook($i)
        # Name
	set name [concat [lindex $akt 0] [lindex $akt 1]] 
	# Strasse
	set str {}
	if {[lindex $akt 2] == {} } {
	    set str [lindex $akt 3] 
	} else { 
	    set str [format "%s, %s" [lindex $akt 2] [lindex $akt 3]]  
	}
	# Telefon
	set tel {}
	if { [lindex $akt 11] != {} } {
	    set tel [format "%s, %s, %s" [lindex $akt 8] [lindex $akt 9] \
	             [lindex $akt 10]]
	} else { 
	    if { [lindex $akt 9] != {} } {
	    	set tel [format "%s, %s" [lindex $akt 8] [lindex $akt 9]]
	    } else {
	    	set tel [lindex $akt 8]
	    }
	}
	if { $tel != {} } { 
#	    if { [lindex $akt 8] != {} } {
#		set tel [format "+%s(%s)%s" $countries([lindex $akt 4],intl_prefix) \
#		         [lindex $akt 8] $tel ]
#	    } else {
	    	set tel [format "+%s %s" $countries([lindex $akt 4],intl_prefix) $tel]
#	    }
	} 
	
	puts $f [format "%-27s%-49s%3s-%-6s%-31s%-10s %s" $name $str \
	  [lindex $akt 4] [lindex $akt 5] [lindex $akt 6] [lindex $akt 7] $tel]
	set i [expr $i+1]
    }
    close $f
}

#------------------------------------------
# Add a new record
#------------------------------------------

proc addAction {} {
    global mes language maxindex
    mkDialog .updateSelection "-text {$mes(addrecord)} -aspect 400" "OK {updateAdr [incr maxindex]}" "Cancel {}"
}

#------------------------------------------
# Update a existing record
#------------------------------------------

proc updateAction {} {
    global mes language currentindex
    mkDialog .updateSelection "-text {$mes(changerecord)} -aspect 400" "OK {updateAdr $currentindex}" "Cancel {}"
}

#------------------------------------------
# Read work for update and adding records
#------------------------------------------

proc updateAdr {index} {
    global adrbook language nbfields mes somethingchanged
    set line {}
    for {set i 0} {$i < $nbfields} {incr i} {
	lappend line [.f.main.entry.$i.entry get]
    }
    set adrbook($index) $line
    .f.main.list.status.2 configure -text [format $mes(recordchanged) [expr $index + 1]]
    set somethingchanged 1
    setSelection -1
}

#------------------------------------------
# Clear the Edit Fields
#------------------------------------------

proc clearAction {} {
    global nbfields
    # Felder loeschen
    for {set i 0} {$i < $nbfields} {incr i} {
	.f.main.entry.$i.entry delete 0 end
    }
}


#----------------------------------------------------
# Set selection in listbox
#----------------------------------------------------

proc setSelection i {
    global nbfields nbfound currentselection
    if {$i == -1} {
	set i $currentselection
    }
    if {$i > $nbfound - $nbfields / 2} {
	.f.main.list.lb.box yview [expr $nbfound - $nbfields]
    } else {
	.f.main.list.lb.box yview [expr $i - $nbfields / 2]
    }
    .f.main.list.lb.box select clear
    .f.main.list.lb.box select to $i
    set currentselection $i
}
    

#----------------------------------------------------
# Show complete Address
#----------------------------------------------------

proc showAdr nr {
    global adrbook language nbfields found mes maxindex
    global currentindex currentselection

    clearAction
    set currentselection $nr
    set currentindex [lindex $found $nr]
    if [info exists adrbook($currentindex)] {
	set line $adrbook($currentindex)
	for {set i 0} {$i < $nbfields} {incr i} {
	    .f.main.entry.$i.entry insert 0 [lindex $line $i]
    	}
	.f.main.list.status.2 configure -text [format $mes(recordof) [expr $currentindex + 1] [expr $maxindex + 1]]
    }
}


#----------------------------------------------------
# Search for Address
#----------------------------------------------------

proc searchAdr {} {
    global adrbook maxindex found nbfound mes language nbfields 
    global fields searchtype
    set found {}
    set searchlist {}
    for {set j 0} {$j < $nbfields} {incr j} {
        set eintrag($j) [.f.main.entry.$j.entry get]
	if {$eintrag($j) != ""} {
	    lappend searchlist $j
	}
    }
    switch -exact $searchtype {
        "exact" { # exact search
	    for {set i 0} {$i <= $maxindex} {incr i} {
		set ende 1
	        foreach j $searchlist {
		    if {[string compare $eintrag($j) [lindex $adrbook($i) $j]] != 0} {
	    		set ende 0 ; break } 
		}
		if {$ende == 1} {
		    lappend found $i
		}
	    }
	}
        "match" { # matching search
	    for {set i 0} {$i <= $maxindex} {incr i} {
		set ende 1
	        foreach j $searchlist {
		    if {![string match $eintrag($j) [lindex $adrbook($i) $j]]} {
	    		set ende 0 ; break } 
		}
		if {$ende == 1} {
		    lappend found $i
		}
	    }
	}
        "regexp" { # regexpr search
	    for {set i 0} {$i <= $maxindex} {incr i} {
		set ende 1
	        foreach j $searchlist {
		    if {![regexp $eintrag($j) [lindex $adrbook($i) $j]]} {
	    		set ende 0 ; break } 
		}
		if {$ende == 1} {
		    lappend found $i
		}
	    }
	}
    }

    set nbfound [llength $found]
    .f.main.list.status.0 configure -text $mes(aftersearch)
    .f.main.list.status.1 configure -text [format $mes(found) $nbfound]
    if {$nbfound > 0} { 
        .f.main.list.lb.box delete 0 end
	set lbf $fields(listboxformat)
	set lb1 $fields(listboxentry1)
	set lb2 $fields(listboxentry2)
	for {set i 0} {$i < $nbfound} {incr i} {
	    .f.main.list.lb.box insert end [format $lbf [lindex $adrbook([lindex $found $i]) $lb1] [lindex $adrbook([lindex $found $i]) $lb2]]
	}
 	showAdr 0
	setSelection 0
    } else {
        set found {}
        for {set i 0} {$i <= $maxindex} {incr i} {
	    lappend found $i
	}
    }
}

 
#----------------------------------------------------
# Auswahl Button
#----------------------------------------------------
# Auswahl gesamt

proc auswahlAdr {} {
    global adrbook maxindex found nbfound fields
    global mes language
    set found {}
    # Listbox wieder laden
    .f.main.list.lb.box delete 0 end
    for {set i 0} {$i <= $maxindex} {incr i} {
	.f.main.list.lb.box insert end [format $fields(listboxformat) [lindex $adrbook($i) $fields(listboxentry1)] [lindex $adrbook($i) $fields(listboxentry2)]]
	lappend found $i
    }
    set nbfound [llength $found]
    .f.main.list.status.0 configure -text $mes(total)
    .f.main.list.status.1 configure -text [format $mes(records) [expr $maxindex + 1]]
    showAdr 0 
    setSelection 0
}


#----------------------------------------------------
# Move Button (absolute)
#----------------------------------------------------

proc moveabsAdr {i} {
    global nbfound nbfields
    if {$i >= $nbfound} { set i [expr $nbfound - 1] } 
    if {$i < 0}         { set i 0 }
    showAdr $i 
    setSelection $i
    .f.main.list.status.4.e delete 0 end
}


#----------------------------------------------------
# Move Button (relative)
#----------------------------------------------------

proc moverelAdr {offset} {
    global nbfound nbfields currentselection
    set i [expr $currentselection + $offset]
    if {$i >= $nbfound} { set i [expr $nbfound - 1] }
    if {$i < 0}         { set i 0 }
    showAdr $i 
    setSelection $i
    .f.main.list.status.4.e delete 0 end
}


#----------------------------------------------------
# ABC Buttons
#----------------------------------------------------

proc abcAdr {ch presstime} {
    global adrbook found nbfound fields lastpressed searchfor options
    set a 0
    set b [expr $nbfound - 1]
    set lbeintrag1 $fields(listboxentry1)
    if {$presstime == 0} {
	.f.main.list.status.4.e insert end [string tolower $ch]
    } elseif {$presstime - $lastpressed > $options(pressdelay)} {
    # if too much time elaped since last press begin search
	.f.main.list.status.4.e delete 0 end
	.f.main.list.status.4.e insert 0 [format "%c" [expr $ch + 97]]
    } else {
	.f.main.list.status.4.e insert end [format "%c" [expr $ch + 97]]
    }
    set searchfor [.f.main.list.status.4.e get]
    set lastpressed $presstime
    # Binary Search until a + 1 = b
    while {$b - $a > 1} {
    	set c [expr ($a+$b) / 2]
        if {[string compare [string tolower [lindex $adrbook([lindex $found $c]) $lbeintrag1]] $searchfor] < 0} {
	    set a $c
	} else {
	    set b $c
	}
    }
    # Choose a or b
    if {[string compare [string tolower [lindex $adrbook([lindex $found $a]) $lbeintrag1]] $searchfor] < 0} {
    	showAdr $b
	setSelection $b
    } else {
    	showAdr $a
	setSelection $a
    }
    focus .f.main.list.status.4.e
}



#----------------------------------------------------
# Prepare Number for dialing
#----------------------------------------------------

proc prepare_number {num coun} {
    global options countries
    set tel ""
    # Delete anything after a letter
    regsub "\[A-Za-z\].*" $num "" num
    # Delete all nonnumbers ()/- 
    regsub -all "\[ ()/+\-\]" $num "" num
    if {$coun != $options(mycountry)} {
        # international call
	set tel $options(dialoutdistance)
	append tel $countries($options(mycountry),intl_dialout)
	if {[string first $countries($coun,intl_prefix) $num] != 0} {
	    append tel $countries($coun,intl_prefix)
	    if {[string first $countries($coun,intl_leaveout) $num] == 0} {
		regsub $countries($coun,intl_leaveout) $num "" num
	    }
	}
	append tel $num
    } else {
	if {[string first $countries($coun,intl_prefix) $num] == 0} {
	    regsub $countries($coun,intl_prefix) $num $countries($coun,intl_leaveout) num
	}
	if {[string first $options(myareacode) $num] == 0} {
	    # local call
	    set tel $options(dialoutlocal)
	    regsub $options(myareacode) $num "" num
	    append tel $num
	} else {
	    # national call
	    set tel $options(dialoutdistance)
	    append tel $num
	}
    }
    return $tel
}


#----------------------------------------------------
# Phone Fax Email or Mail Button - call apropriate programm
#----------------------------------------------------

proc do_callprog thisone {
    global adrbook currentindex fields options only_stdout

    set num [lindex $adrbook($currentindex) $fields($thisone)]
    if {$num == {}} {
	puts stderr "Empty field, cannot call programm."
    } else {
	if {$thisone != "email"} {
	    set num [prepare_number $num  \
		[lindex $adrbook($currentindex) $fields(country)]]
	}
	if {$only_stdout} {
	    puts stdout $num
	} else {
    	    regsub %number $options(callprog,$thisone) $num callprog
	    set callprog [linsert $callprog 0 exec]
	    puts stdout $callprog
	    eval $callprog
	}
    }
}


#----------------------------------------------------
# Mail Button - give a mailadress to stdout or print an envellope
#----------------------------------------------------

proc do_mail {} {
    global adrbook fields currentindex countries options

    set line $adrbook($currentindex)
    foreach a {mrmrs title} {
	if {$fields($a) >= 0} {
	    if {[lindex $line $fields($a)] != ""} {
		puts -nonewline stdout "[lindex $line $fields($a)] "
	    }
	}
    }
    puts stdout ""
    foreach a {firstname lastname} {
	if {$fields($a) >= 0} {
	    if {[lindex $line $fields($a)] != ""} {
		puts -nonewline stdout "[lindex $line $fields($a)] "
	    }
	}
    }
    puts stdout ""
    foreach a {addon street} {
	if {$fields($a) >= 0} {
	    if {[lindex $line $fields($a)] != ""} {
		puts stdout [lindex $line $fields($a)]
	    }
	}
    }
    set c [lindex $line $fields(country)]
    # countries where you have 'city, zip' (separated by comma)
    if {($c == "USA") || ($c == "MEX")} {
	if {$fields(city) >= 0} {
	    if {[lindex $line $fields(city)] != ""} {
		puts -nonewline stdout "[lindex $line $fields(city)], "
	    }
	}
	if {$fields(zip) >= 0} {
	    if {[lindex $line $fields(zip)] != ""} {
		puts stdout [lindex $line $fields(zip)]
	    }
	}
	if {$options(mycountry) != $c} {puts stdout $countries($c,fullname)}
    # countries where you have 'city zip' (separated by space)
    } elseif {($c == "CDN") || ($c == "GB") || ($c == "AUS") || \
	      ($c == "IND") || ($c == "J") || ($c == "ROK") || \
	      ($c == "GCA") || ($c == "SGP")} {
	if {$fields(city) >= 0} {
	    if {[lindex $line $fields(city)] != ""} {
		puts -nonewline stdout "[lindex $line $fields(city)] "
	    }
	}
	if {$fields(zip) >= 0} {
	    if {[lindex $line $fields(zip)] != ""} {
		puts stdout [lindex $line $fields(zip)]
	    }
	}
	if {$options(mycountry) != $c} {puts stdout $countries($c,fullname)}
    } else {
    # countries where you have 'zip city' (separated by space)
	if {$options(mycountry) != $c} {puts -nonewline stdout "$c-"}
	if {$fields(zip) >= 0} {
	    if {[lindex $line $fields(zip)] != ""} {
		puts -nonewline stdout "[lindex $line $fields(zip)] "
	    }
	}
	if {$fields(city) >= 0} {
	    if {[lindex $line $fields(city)] != ""} {
		puts stdout [lindex $line $fields(city)]
	    }
	}
	if {$options(mycountry) != $c} {puts stdout $countries($c,fullname)}
    }
    puts stdout ""
}

#----------------------------------------------------
# help
#----------------------------------------------------

proc Help {topic {x 0} {y 0}} {
    global helpTopics helpCmds mes
    if {$topic == ""} return
    while {[info exists helpCmds($topic)]} {
	set topic [eval $helpCmds($topic)]
    }
    if [info exists helpTopics($topic)] {
	set msg $helpTopics($topic)
    } else {
	set msg $mes(nohelp)
    }
    mkDialog .help "-text {$mes(infoon) $topic:\n\n$msg} -justify left -aspect 300" "OK {}"
}

proc getMenuTopic {w x y} {
    return $w.[$w index @[expr $y-[winfo rooty $w]]]
}

#----------------------------------------------------
# main - Call all the routines
#----------------------------------------------------

proc main {} {
    global options mes adrfile nbfields

    createbasicfrontend

    set adrfile $options(adrfile)
    if [file exists $adrfile] {
	loaddatabase $adrfile 
	wm title . "$mes(adressbook) - [file tail $adrfile]"
	wm iconname . "$mes(adressbook) - [file tail $adrfile]"
	createfrontend
    }
}

#----------------------------------------------------
# call main and catch errors
#----------------------------------------------------

if [catch main result] {
    tkerror $result
}

