#!/usr/bin/wish -f
# If this is the second line of the program, the installationprocedure
# went wrong. Then adjust please the following two lines and the
# path to find wish in the first line
set configfile "/usr/local/lib/addressbook/addressbook.config"
set myconfigfile "~/.addressbook.config"
#
#########################################################################
#									#
# This is my adressbuch / addressbook program				#
# Version 0.5, 28.05.1995						#
# Copyright (C) 1995 Clemens Durka					#
#									#
# Clemens Durka (durka@informatik.tu-muenchen.de)			#
# Lehrstuhl fuer Effiziente Algorithmen, Prof. Dr. E. Mayr		#
# Technische Universitaet Muenchen					#
# Arcisstr. 21								#
# D-80290 Muenchen							#
# Germany								#
#									#
#########################################################################
#									#
# This program is free software; you can redistribute it and/or modify	#
# it under the terms of the GNU General Public License Version 2 as	#
# published by the Free Software Foundation.				#
#									#
# This program is distributed in the hope that it will be useful,	#
# but WITHOUT ANY WARRANTY; without even the implied warranty of	#
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the		#
# GNU General Public License for more details.				#
#									#
# You should have received a copy of the GNU General Public License	#
# along with this program; if not, write to the Free Software		#
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.		#
#									#
#########################################################################

#########################################################################
#########################################################################
# All configurable parameters are in the configfile			#
# Don't modify anything below unless you know what you are doing!	#
#########################################################################
#########################################################################

set version "Version 0.5, 28.05.1995"
set possible_languages {german english french}
set allfieldids {mrmrs title firstname lastname company institute departement addon pobox street country zip city state province county birthday phone phonepriv phonework fax email category remark other0 other1 other2 other3 other4 other5 other6 other7 other8 other9}

#------------------------------------------
# For Compatibility with tcl7.4/tk4.0
#------------------------------------------

if {[info tclversion]==7.4} {
    set newtclversion 1
} else {
    set newtclversion 0
}

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

proc do_defaultconfigure {} {
    global options 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 "Please define programm to call"}
    set options(callprog,fax) {echo "Please define programm to call"}
    set options(callprog,email) {echo "Please define programm to call"}
    set options(only_stdout) 1
    set options(texconvert) 0
    set options(searchtype) match
    set options(pressdelay) 1
    set options(select_mask) "*"
    set options(printform) address
    set options(entrywidth) 35
    set options(listboxwidth) 27
    set options(listboxheight) 16
    set options(printopt) latex
    set options(printtype) line
    set options(printarea) all
    set options(printfile) "/tmp/addresses_print"
    set options(from) {}
    set options(to) {}
    set options(makebackup) 1
    set options(dvips) {}
    set options(latex) {}
    set options(a2ps) {}

    set options(print,name)       {{mrmrs title} {firstname lastname}}
    set options(print,nametel)    {{mrmrs title} {firstname lastname} {phone , phonepriv , phonework , fax}}
    set options(print,address)    {{mrmrs title} {firstname lastname} {addon street} {pobox} {zipcity} {fullcountry}}
    set options(print,addresstel) {{mrmrs title} {firstname lastname} {addon street} {countryzipcity} {phone phonepriv phonework fax}}
    set options(print,almostever) {{mrmrs title} {firstname lastname} {addon street} {countryzipcity} {phone phonepriv phonework fax} {birthday} {email}}
    set options(print,everything) {{mrmrs title} {firstname lastname} {addon street} {zipcity} {fullcountry} {phone phonepriv phonework fax} {birthday} {email} {category} {remark}}
    set options(zipformat,eu) "zip city"
    set options(zipformat,uk) "city zip"
    set options(zipformat,us) "city , zip"

    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 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

}   
    

#------------------------------------------
# Get Commandline and Environment
#------------------------------------------

proc get_cmdline {} {
    global argv argc env configfile options bitmaps version
    if [info exists env(ADDRBOOK_CONFIG)] {
    	set configfile $env(ADDRBOOK_CONFIG)
	if [file exists $configfile] { loadconfigfile $configfile }
    }
    if [info exists env(ADDRBOOK_LIBDIR)] {
    	set options(libdir) $env(ADDRBOOK_LIBDIR)
	set bitmaps $options(libdir)/bitmaps
    }
    if [info exists env(ADDRBOOK_ADDRFILE)] {
    	set options(adrfile) $env(ADDRBOOK_ADDRFILE)
    }

    while {$argc > 0} {
    	switch -exact -- [lindex $argv 0] {
	    -c		-
	    -configfile	{ 
	    	set configfile [lindex $argv 1]
		if [file exists $configfile] { loadconfigfile $configfile }
	    }
	    -ld         -
	    -libdir	{
	        set options(libdir) [lindex $argv 1]
		set bitmaps $options(libdir)/bitmaps
	    }
	    -l          -
	    -lang       -
	    -language   {
		set options(language) [lindex $argv 1]
	    }
	    -a		-
	    -addrfile	-
	    -f		-
	    -file	{
	        set options(adrfile) [lindex $argv 1]
	    }
	    -hl         -
	    -hlp       {
		puts "Addressbook, $version"
		puts "Normally you can invoke addressbook without commandlineswitches,"
		puts "if you modify your personal configfile (.addressbook.config)"
		puts " "
		puts "Commandline switches"
		puts " "
		puts "-a  or -addrfile         path and filename of the addressfile to load"
		puts "-c  or -configfile       path and filename of the configfile to load"
		puts "-l  or -language         language (currently english, german, french)"
		puts "-ld or -libdir           path or the library directory"
		puts "-hlp                     show this help"
		puts " "
		exit
	    }
	    default	{
		puts [format "Unrecognized Option: %s %s" [lindex $argv 0] [lindex $argv 1]]
	    }
	}
	incr argc -2
	set argv [lrange $argv 2 end]
    }
}


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

proc loadconfigfile {configfile} {
    global options 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 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,zipformat)     [lindex $l 7]
		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
}
get_cmdline

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 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 nbfields names adrbook maxindex somethingchanged fields options

    if {$options(makebackup)} {
	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 searchtype only_stdout bitmaps
    global fields allfieldids names nbfields mes maxlength
    
    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]
		}
	    }
	}
    }
    foreach i {0 1 2 3 4 5 6 7 8 9} {
	if [info exists fields(label$i)] {
	    set mes(other$i) $fields(label$i)
	} else {
	    set fields(label$i) {}
	}
    }
    
    set i 0
    set names {}
    while {[info exists fields($i)]} {
	lappend names $mes($fields($i))
	incr i
    }
    set nbfields [llength $names]
    for {set i -1} {$i < $nbfields} {incr i} {
	set maxlength($i) 0
    }
}


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

proc prefeditglob {} {
    global 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 { destroy .pref }
	button $buttons.save -text $mes(save) -command {
	    foreach i {mycountry myareacode dialoutlocal dialoutdistance\
	        adrfile libdir callprog,phone callprog,fax callprog,email} {\
		    set options($i) [.pref.b.b.$i.e get]\
		};\
	    destroy .pref\
	}
	button $buttons.apply -text $mes(apply) -command {\
	    foreach i {mycountry myareacode dialoutlocal dialoutdistance\
	        adrfile libdir callprog,phone callprog,fax callprog,email} {\
		    set options($i) [.pref.b.b.$i.e get]\
		};\
	    destroy .pref\
	}
	button $buttons.reset -text $mes(reset) -command {\
	    do_defaultconfigure;\
	    if [file exists $configfile] {\
	        loadconfigfile $configfile\
	    };\
	    if [file exists $myconfigfile] {\
	        loadconfigfile $myconfigfile\
	    };\
	    destroy .pref\
        }
	label $buttons.label -text "You cannot save yet, you have to modify the configfile"
	pack $buttons.label -side left -fill x
	pack $buttons.quit $buttons.save -side right
	pack $buttons.apply $buttons.reset -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 50
	
	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
	}

	foreach i {mycountry myareacode dialoutlocal dialoutdistance \
	        adrfile libdir callprog,phone callprog,fax callprog,email} {
	    set f [frame $body.$i -borderwidth 2]
	    pack $f -fill both
	    label $f.l -text $mes($i) -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($i)
	}

	set f [frame $body.8 -borderwidth 2]
	pack $f -fill both
	label $f.l -text $mes(searchtype) -width $maxwidth
	radiobutton $f.1 -text "exact" -variable options(searchtype) -value exact
	radiobutton $f.2 -text "match" -variable options(searchtype) -value match
	radiobutton $f.3 -text "regexp" -variable options(searchtype) -value regexp
	pack $f.l $f.1 $f.2 $f.3 -side left

	set f [frame $body.19 -borderwidth 2]
	pack $f -fill both
	label $f.l -text $mes(only_stdout) -width $maxwidth
	checkbutton $f.c -text "On" -variable options(only_stdout)
	pack $f.l $f.c -side left

	set f [frame $body.20 -borderwidth 2]
	pack $f -fill both
	label $f.l -text $mes(texconvert) -width $maxwidth
	checkbutton $f.c -text "On" -variable options(texconvert)
	pack $f.l $f.c -side left
    }
}


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

proc prefeditfile {} {
    global somethingchanged options mes fields allfieldids nbfields

    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 { destroy .pref }
	button $buttons.save -text $mes(save) -command {\
	    foreach i {separatorchar listboxformat listboxentry1 listboxentry2\
		label0 label1 label2 label3 label4 label5 label6 label7\
		label8 label9} {\
		    set fields($i) [.pref.b.b.$i.e get]\
		};\
	    for {set i 0} {$i < $nbfields} {incr i} {\
		set fields($i) [.pref.b.c.$i.e get]\
	    };\
	    destroy .pref\
        }
	button $buttons.apply -text $mes(apply) -command {\
	    foreach i {separatorchar listboxformat listboxentry1 listboxentry2\
		label0 label1 label2 label3 label4 label5 label6 label7\
		label8 label9} {\
		    set fields($i) [.pref.b.b.$i.e get]\
		};\
	    for {set i 0} {$i < $nbfields} {incr i} {\
		set fields($i) [.pref.b.c.$i.e get]\
	    };\
	    destroy .pref\
	}
	button $buttons.reset -text $mes(reset) -command {\
	    loaddataformatfile $adrfile.fmt;\
	    destroy .pref\
        }
	label $buttons.label -text "You cannot save yet, you have to modify the formatfile"
	pack $buttons.label -side left -fill x
	pack $buttons.quit $buttons.save -side right
	pack $buttons.apply $buttons.reset -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 -side left -expand true

	set maxwidth 16

	foreach i {separatorchar listboxformat listboxentry1 listboxentry2} {
	    set f [frame $body.$i -borderwidth 2]
	    pack $f -fill both
	    label $f.l -text $mes($i) -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($i)
	}

	foreach i {0 1 2 3 4 5 6 7 8 9} {
	    set f [frame $body.label$i -borderwidth 0]
	    pack $f -fill both
	    label $f.l -text "$mes(labelfor) other$i" -width $maxwidth
	    pack $f.l -side left
	    entry $f.e -width 15 -relief sunken
	    pack $f.e -side left -fill x -expand true
	    $f.e insert 0 $fields(label$i)
	}	    

	set body [frame .pref.b.c -bd 10]
	pack .pref.b.c -fill both -side left -expand true

	for {set i 0} {$i < $nbfields} {incr i} {
	    set f [frame $body.$i -borderwidth 0]
	    pack $f -fill both
	    label $f.l -text "$mes(field) $i" -width 8
	    pack $f.l -side left
	    entry $f.e -width 15 -relief sunken
	    pack $f.e -side left -fill x -expand true
	    $f.e insert 0 $fields($i)
	    label $f.c -text "$mes($fields($i))" -width $maxwidth
	    pack $f.c -side left -fill x -expand true	    
	}
    }
}


#------------------------------------------
# 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 newtclversion

    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
	
	if $newtclversion {
	    listbox $cb.list -relief sunken -width 30 -height 15 -yscrollcommand "$cb.scroll set" -font "-*-fixed-bold-*-*-*-*-*-*-*-*-*-iso8859-1"
	    bind $cb.list <1> {tkListboxBeginSelect %W [%W index @%x,%y]; putcountrycode [.countries.b.list curselection]}
	} else {
	    listbox $cb.list -relief sunken -geometry 30x15 -yscrollcommand "$cb.scroll set" -font "-*-fixed-bold-*-*-*-*-*-*-*-*-*-iso8859-1"
	    tk_listboxSingleSelect $cb.list 
	    bind $cb.list <1> {%W select from [%W nearest %y]; putcountrycode [.countries.b.list curselection]}
	}
	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

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





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

proc createbasicfrontend {} {
    global mes newtclversion

    #------------------------------------------
    # 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
    menu .f.menu.file.m
    .f.menu.file.m add command -label $mes(load) -command loadAction
    .f.menu.file.m add command -label $mes(save) -command saveAction
    .f.menu.file.m add command -label $mes(saveas) -command saveasAction
    .f.menu.file.m add command -label $mes(print) -command printAction
    .f.menu.file.m add command -label $mes(import) -command importAction
    .f.menu.file.m add command -label $mes(export) -command exportAction
    .f.menu.file.m add command -label $mes(close) -command closeAction
    .f.menu.file.m add command -label $mes(exit) -command quitAction
    pack .f.menu.file -side left -padx 10
    
    if $newtclversion {
	.f.menu.file.m entryconfig 1 -accel Ctrl+L
	.f.menu.file.m entryconfig 2 -accel Ctrl+V
	.f.menu.file.m entryconfig 3 -accel Ctrl+W
	.f.menu.file.m entryconfig 4 -accel Ctrl+P
	.f.menu.file.m entryconfig 5 -accel Ctrl+I
	.f.menu.file.m entryconfig 6 -accel Ctrl+E
	.f.menu.file.m entryconfig 7 -accel Ctrl+O
	.f.menu.file.m entryconfig 8 -accel Ctrl+Q
    } else {
	.f.menu.file.m entryconfig 0 -accel Ctrl+L
	.f.menu.file.m entryconfig 1 -accel Ctrl+V
	.f.menu.file.m entryconfig 2 -accel Ctrl+W
	.f.menu.file.m entryconfig 3 -accel Ctrl+P
	.f.menu.file.m entryconfig 4 -accel Ctrl+I
	.f.menu.file.m entryconfig 5 -accel Ctrl+E
	.f.menu.file.m entryconfig 6 -accel Ctrl+O
	.f.menu.file.m entryconfig 7 -accel Ctrl+Q
    }
    bind Entry <Control-f> loadAction
    bind Entry <Control-v> saveAction
    bind Entry <Control-w> saveasAction
    bind Entry <Control-p> printAction
    bind Entry <Control-i> importAction
    bind Entry <Control-e> exportAction
    bind Entry <Control-o> closeAction
    bind Entry <Control-q> quitAction

    menubutton .f.menu.edit -text $mes(edit) -menu .f.menu.edit.m
    menu .f.menu.edit.m
    
    .f.menu.edit.m add command -label $mes(clear) -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}
    }
    .f.menu.edit.m add command -label $mes(delete) -command deleteAction
    .f.menu.edit.m add command -label $mes(add) -command addAction
    .f.menu.edit.m add command -label $mes(update) -command updateAction
    .f.menu.edit.m add command -label $mes(search) -command searchAdr
    .f.menu.edit.m add command -label $mes(generalview) -command auswahlAdr
    pack .f.menu.edit -side left -padx 10
  
    if $newtclversion {
	.f.menu.edit.m entryconfig 1 -accel Ctrl+C
	.f.menu.edit.m entryconfig 2 -accel Ctrl+D
	.f.menu.edit.m entryconfig 3 -accel Ctrl+A
	.f.menu.edit.m entryconfig 4 -accel Ctrl+U
	.f.menu.edit.m entryconfig 5 -accel Ctrl+S
	.f.menu.edit.m entryconfig 6 -accel Ctrl+G
    } else {
	.f.menu.edit.m entryconfig 0 -accel Ctrl+C
	.f.menu.edit.m entryconfig 1 -accel Ctrl+D
	.f.menu.edit.m entryconfig 2 -accel Ctrl+A
	.f.menu.edit.m entryconfig 3 -accel Ctrl+U
	.f.menu.edit.m entryconfig 4 -accel Ctrl+S
	.f.menu.edit.m entryconfig 5 -accel Ctrl+G
    }
    
    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}
    }
    bind Entry <Control-d> deleteAction
    bind Entry <Control-a> addAction
    bind Entry <Control-u> updateAction
    bind Entry <Control-s> searchAdr
    bind Entry <Control-g> auswahlAdr

    menubutton .f.menu.goto -text $mes(goto) -menu .f.menu.goto.m
    menu .f.menu.goto.m
    
    .f.menu.goto.m add command -label $mes(first)  -command {moveabsAdr 0}
    .f.menu.goto.m add command -label $mes(back10) -command {moverelAdr -10}
    .f.menu.goto.m add command -label $mes(back)   -command {moverelAdr -1}
    .f.menu.goto.m add command -label $mes(for)    -command {moverelAdr 1}
    .f.menu.goto.m add command -label $mes(for10)  -command {moverelAdr 10}
    .f.menu.goto.m add command -label $mes(last)   -command {moveabsAdr -1}
    pack .f.menu.goto -side left -padx 10
  
    if $newtclversion {
	.f.menu.goto.m entryconfig 1 -accel Home
	.f.menu.goto.m entryconfig 2 -accel " "
	.f.menu.goto.m entryconfig 3 -accel "Page Up"
	.f.menu.goto.m entryconfig 4 -accel "Page Down"
	.f.menu.goto.m entryconfig 5 -accel " "
	.f.menu.goto.m entryconfig 6 -accel End
    } else {
	.f.menu.goto.m entryconfig 0 -accel Home
	.f.menu.goto.m entryconfig 1 -accel " "
	.f.menu.goto.m entryconfig 2 -accel "Page Up"
	.f.menu.goto.m entryconfig 3 -accel "Page Down"
	.f.menu.goto.m entryconfig 4 -accel " "
	.f.menu.goto.m entryconfig 5 -accel End
    }

    bind Entry <Home>  "moveabsAdr  0"
    bind Entry <Prior> "moverelAdr -1"
    bind Entry <Next>  "moverelAdr  1"
    bind Entry <End>   "moveabsAdr -1"
    
    menubutton .f.menu.options -text $mes(options) -menu .f.menu.options.m
    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 cascade -label $mes(texconv) -menu .f.menu.options.m.tex
    .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 10

    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

    menu .f.menu.options.m.tex
    .f.menu.options.m.tex add radiobutton -label $mes(iso) -variable options(texconvert) -value 0
    .f.menu.options.m.tex add radiobutton -label $mes(tex) -variable options(texconvert) -value 1

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

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

    menubutton .f.menu.help -text $mes(help) -menu .f.menu.help.m
    menu .f.menu.help.m
    pack .f.menu.help -side right -padx 10
    .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(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 maxindex nbfound index bitmaps options
    global searchtype only_stdout mes found phones newtclversion

    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 $options(entrywidth) -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.delete -text $mes(delete)
    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.delete .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}\
    }
    .f.buttons.delete config -command deleteAction
    .f.buttons.add config -command addAction
    .f.buttons.change config -command updateAction
    .f.buttons.search config -command searchAdr
    .f.buttons.auswahl config -command auswahlAdr

    #
    # Listbox
    #

    frame .f.main.list -relief raised
    pack .f.main.list -side left -expand yes -fill y -padx 10
    frame .f.main.list.lb
    if $newtclversion {
	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 no 
	listbox .f.main.list.lb.box -relief sunken -width $options(listboxwidth) -height $options(listboxheight) -yscrollcommand ".f.main.list.lb.scroll set" 
	bind .f.main.list.lb.box <1> {tkListboxBeginSelect %W [%W index @%x,%y]; showAdr [.f.main.list.lb.box curselection]; .f.main.list.status.4.e delete 0 end}
    } else {
	button .f.main.list.title -text $mes(adressbook) -relief raised \
	    -font -Adobe-times-medium-r-normal--*-180-*-*-*-*-iso8859-1 \
	    -activebackground bisque -command showversion -padx 0 -pady 0
        pack .f.main.list.title -pady 2 -padx 1  -fill both -expand yes
	listbox .f.main.list.lb.box -relief sunken -geometry $options(listboxwidth)x$options(listboxheight) -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
    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

    frame .f.main.list.status  -height 3 -width $options(listboxwidth) -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 $options(listboxwidth) -relief raised
    label .f.main.list.status.1 -height 1 -width $options(listboxwidth) -relief raised 
    label .f.main.list.status.2 -height 1 -width $options(listboxwidth) -relief raised 
    pack .f.main.list.status.0 .f.main.list.status.1 .f.main.list.status.2 -expand yes -fill x
    loadlistbox
    setSelection 0
    .f.main.list.status.0 configure -text [format $mes(readend) $index]
    .f.main.list.status.1 configure -text [format $mes(records) $index]
    frame .f.main.list.status.3 -width $options(listboxwidth)
    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 $options(listboxwidth)
    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

    .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 -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]
    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 -padx 0 -pady 0
	button $a.[expr $i + 1] -text [format "%c" [expr $i+66]] -width 2 -padx 0 -pady 0
	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} {
	if $newtclversion {
    	    bind $a.$i <1> "abcAdr $i %t"
	    bind .f.main.list.status.4.e [format "%c" [expr $i + 65]] "tkEntryBackspace %W; abcAdr %A 0"
	    bind .f.main.list.status.4.e [format "%c" [expr $i + 97]] "tkEntryBackspace %W; abcAdr %A 0"
	} else {
    	    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
    if !$newtclversion {
	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)
    }
}

# 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 newtclversion

    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]
	if $newtclversion {
	    listbox .select.frame.f.list -width 30 -height 10 \
		-yscrollcommand ".select.frame.f.scroll set"
	} else {
	    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 "Copyright (C) 1995 Clemens Durka"
    label .showversion.frame.l4 -text "durka@informatik.tu-muenchen.de"
    label .showversion.frame.l5 -text "$mes(adressbook) comes with ABSOLUTELY NO WARRANTY"
    label .showversion.frame.l6 -text "This is free software, and you are welcome to redistribute it"
    label .showversion.frame.l7 -text "under the conditions of the GNU General Public Licence Version 2"
    label .showversion.frame.l8 -text " "
    label .showversion.frame.l9 -text "This is a beta version, which should already"
    label .showversion.frame.l10 -text "work, but some features are not complete."
    label .showversion.frame.l11 -text "Comments and Bugreports are very welcome."

    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 \
         .showversion.frame.l7 .showversion.frame.l8 .showversion.frame.l9 \
         .showversion.frame.l10 .showversion.frame.l11 \
            -ipadx 4m -side top -fill both -expand 1
    pack .showversion.dismiss -side bottom -fill x
}


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

proc loadAction {} {
    global adrfile mes select_op select_result somethingchanged newtclversion

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

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

	if {$somethingchanged} {
	    if $newtclversion {
		if {[tk_dialog .reloadSelection $mes(load) "$mes(closemes)" \
		    {} 0 $mes(continue) $mes(cancel)] == 0} {doloadAction}
	    } else {
		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 newtclversion

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

    if { "$select_result" != "" } {
	if [file exists $select_result] {
	    if $newtclversion {
		if {[tk_dialog .saveasSelection $mes(saveas) \
		    "$mes(overwrite) $select_result" \
		    {} 0 $mes(continue) $mes(cancel)] == 0} {dosaveasAction}
	    } else {
		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 newtclversion

    if {$somethingchanged} {
	if $newtclversion {
	    if {[tk_dialog .closeSelection $mes(close) "$mes(closemes)" \
		{} 0 $mes(close) $mes(cancel)] == 0} {docloseAction} 
	} else {
	    mkDialog .closeSelection "-text {$mes(closemes)} -aspect 400" \
		"$mes(close) {docloseAction}" "$mes(cancel) {}" 
	}
    } else {
	docloseAction
    }
}


proc docloseAction {} {
    global mes somethingchanged

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


proc importAction {} {
    global mes newtclversion

    if $newtclversion {
	tk_dialog .fileSelection $mes(import) "Not implemented yet." {} 0 OK
    } else {
	mkDialog .fileSelection {-text "Not implemented yet." -aspect 400} "OK {}"
    }
}


proc exportAction {} {
    global mes newtclversion

    if $newtclversion {
	tk_dialog .fileSelection $mes(export) "Not implemented yet." {} 0 OK
    } else {
	mkDialog .fileSelection {-text "Not implemented yet." -aspect 400} "OK {}"
    }
}


proc quitAction {} {
    global mes somethingchanged newtclversion

    if {$somethingchanged} {
	if $newtclversion {
	    if {[tk_dialog .quitSelection $mes(exit) "$mes(quitmes)" {} 0 \
		$mes(exit) $mes(cancel)] == 0} {exit} 
	} else {
	    mkDialog .quitSelection "-text {$mes(quitmes)} -aspect 400" "$mes(exit) {exit}" "$mes(cancel) {}" 
	}
    } else {
        exit
    }
}


proc printAction {} {
    global mes options possible_printopt

    set possible_printform {name nametel address addresstel almostever everything}
    set possible_printopt {text ascii latex ps}
    set possible_printtype {box line}
    set possible_printarea {all region selection}
    if [catch {toplevel .print}] {
	raise .print
    } else {
	wm title .print $mes(print)
	wm geometry .print +200+150
	frame .print.b -relief raised -border 1
	pack .print.b -fill both
	set body [frame .print.b.b]
	pack .print.b.b -fill both -padx 7 -pady 7

	set maxwidth 15
    	
	frame $body.0 -borderwidth 2 
	pack $body.0 -fill both
	label $body.0.l -text $mes(printform) -width $maxwidth
	pack $body.0.l -side left
	set f [frame $body.0.r -borderwidth 2]
	pack $f -side left
	foreach c $possible_printform {
	    radiobutton $f.$c -text $mes($c) -variable options(printform) -value $c	
	    pack $f.$c -side top -anchor w
	}
    
	frame $body.1 -borderwidth 2 
	pack $body.1 -fill both
	label $body.1.l -text $mes(output) -width $maxwidth
	pack $body.1.l -side left
	set f [frame $body.1.r -borderwidth 2]
	pack $f -side left
	foreach c $possible_printopt {
	    radiobutton $f.$c -text $mes($c) -variable options(printopt) -value $c	
	    pack $f.$c -side top -anchor w
	}
    
	set f [frame $body.2 -borderwidth 2]
	pack $f -fill both
	label $f.l -text $mes(addressas) -width $maxwidth
	pack $f.l -side left
	foreach c $possible_printtype {
	    radiobutton $f.$c -text $mes($c) -variable options(printtype) -value $c	
	    pack $f.$c -side left
	}
    
	set f [frame $body.3 -borderwidth 2]
	pack $f -fill both
	label $f.l -text $mes(region) -width $maxwidth
	pack $f.l -side left
	foreach c $possible_printarea {
	    radiobutton $f.$c -text $mes($c) -variable options(printarea) -value $c	
	    pack $f.$c -side left
	}

	set f [frame $body.4 -borderwidth 2]
	pack $f -fill both
	label $f.l1 -text $mes(from) -width $maxwidth
	label $f.l2 -text $mes(to) -width 8
	pack $f.l1 -side left
	entry $f.e1 -width 8 -relief sunken
	pack $f.e1 -side left -fill x -expand true
	$f.e1 insert 0 $options(from)
	pack $f.l2 -side left
	entry $f.e2 -width 8 -relief sunken
	pack $f.e2 -side left -fill x -expand true
	$f.e2 insert 0 $options(to)

	set f [frame $body.5 -borderwidth 2]
	pack $f -fill both
	label $f.l -text $mes(printfile) -width $maxwidth
	pack $f.l -side left
	entry $f.e -width 8 -relief sunken
	pack $f.e -side left -fill x -expand true
	$f.e insert 0 $options(printfile)

	set bot [frame .print.bot -border 1 -relief raised]
	pack $bot -fill both
	button $bot.ok -text $mes(print) -command {set options(from) [.print.b.b.4.e1 get]; set options(to) [.print.b.b.4.e2 get]; set options(printfile) [.print.b.b.5.e get]; destroy .print; printAdr}
	pack $bot.ok -side left -expand yes -padx 10 -pady 10 
	button $bot.cancel -text $mes(cancel) -command "destroy .print"
	pack $bot.cancel -side left -expand yes -padx 10
    }
}


#------------------------------------------
# Look for maxima
#------------------------------------------

proc lookmax {} {
    global adrbook nbfields maxlength maxindex

    for {set i 0} {$i <= $maxindex} {incr i} {
	set line $adrbook($i)
	for {set j 0} {$j < $nbfields} {incr j} {
	    if {[string length [lindex $line $j]] > $maxlength($j)} {
		set maxlength($j) [string length [lindex $line $j]]
	    }
	}
    }
}

#------------------------------------------
# Convert special chars to tex notation
#------------------------------------------

proc converttotex line {

    set result {}
    set index 0
    set end [string length $line]

    while {$index < $end} {
    	switch -exact -- [string index $line $index] {
	    "&"	    { append result {\&} }
	    "#"     { append result {\#} }
	    ""     { append result {\"a} }
	    ""     { append result {\"e} }
	    ""     { append result {\"\i} }
	    ""     { append result {\"o} }
	    ""     { append result {\"u} }
	    ""     { append result {\"A} }
	    ""     { append result {\"E} }
	    ""     { append result {\"I} } 
	    ""     { append result {\"O} }
	    ""     { append result {\"U} }
	    ""     { append result {\'a} }
	    ""     { append result {\'e} }
	    ""     { append result {\'\i} }
	    ""     { append result {\'o} }
	    ""     { append result {\'u} }
	    ""     { append result {\^a} }
	    ""     { append result {\^e} }
	    ""     { append result {\^\i} }
	    ""     { append result {\^o} }
	    ""     { append result {\^u} }
	    ""     { append result {\`a} }
	    ""     { append result {\`e} }
	    ""     { append result {\`\i} }
	    ""     { append result {\`o} }
	    ""     { append result {\`u} }
	    ""     { append result {\ss{}} }
	    ""     { append result {\AE{}} }
	    ""     { append result {\ae{}} }
	    ""     { append result {\OE{}} }
	    ""     { append result {\oe{}} }
	    ""     { append result {\O{}} }
	    ""     { append result {\o{}} }
	    ""     { append result {\AA{}} }
	    ""     { append result {\aa{}} }
	    ""     { append result {\L{}} }
	    ""     { append result {\l{}} }
	    ""     { append result {\c{C}} }
	    ""     { append result {\c{c}} }
	    ""     { append result {\~n} }
	    ""     { append result {\~N} }

	    default { append result [string index $line $index] }
	}
	incr index
    }
	
    return $result
}

#------------------------------------------
# Format the formatline
#------------------------------------------

proc formatline1 {fmt} {
    global fields countries options maxlength lgt

    set idx 0
    foreach a $fmt {
	set length 0
	foreach b $a {
	    switch -exact $b {
		","   -
		"-"   -
		"="   {
		    incr length
		}
		"fullcountry" {
		    incr length 20
		}
		"countryzipcity" {
		    incr length $maxlength($fields(zip))
		    incr length $maxlength($fields(city))
		    incr length 7
		}
		"zipcity" {
		    incr length $maxlength($fields(zip))
		    incr length $maxlength($fields(city))
		    incr length 6
		}
		default {
		    if {$maxlength($fields($b)) > 0} {
			incr length $maxlength($fields($b))
			incr length
		    }
		}
	    }
	}
	set lgt($idx) $length
	incr idx
    }
    return idx
}


#------------------------------------------
# Format one line of output
#------------------------------------------

proc formatline {line fmt sep conv opt} {
    global fields countries options maxlength lgt
     
    set result {}
    set putsep 0

    set c [lindex $line $fields(country)]
    if {![info exists countries($c,fullname)]} {
	set c $options(mycountry)
    }
    set ind [lsearch -exact $fmt zipcity]
    if { $ind > -1} {
	set city $options(zipformat,$countries($c,zipformat))
	if {($options(mycountry) != $c) && ([lsearch -exact $fmt "country ="] < 0) && ($countries($c,zipformat) == "eu")} {
	    set city "country - $city"
	}
	set fmt [lreplace $fmt $ind $ind $city]
    
	if {$options(mycountry) != $c} {lappend printline "fullcountry"}
    }

    set ind [lsearch -exact $fmt countryzipcity]
    if { $ind > -1} {
	set city $options(zipformat,$countries($c,zipformat))
	set fmt [lreplace $fmt $ind $ind "country = $city"]

	if {$options(mycountry) != $c} {lappend printline "fullcountry"}
    }

    set idx 0
    foreach a $fmt {
	set space 0
	set res {}
	foreach b $a {
	    if {$b == ","} {
	    	if {$space == 1} {
		    append res ","
		}
	    } elseif {$b == "-"} {
	    	if {$space == 1} { 
		    append res "-"
		    set space 0
		}
	    } elseif {$b == "="} {
	    	append res "-"
		set space 0
		if {$opt == "fill"} {
 puts hallo
		    set res [format "%4s" $res]
		}
	    } else {
	    	if {$b == "fullcountry"} {
		    if {$options(mycountry) != $c} {
			set contents $countries($c,fullname)
		    } else {
			set contents {}
		    }
		} else {
	    	    set contents [lindex $line $fields($b)]
		}
	    	if {$contents != {}} {
	    	    if {$space == 1} { 
			append res " " 
		    } 
		    if {$conv == "tex"} { 
			set contents [converttotex $contents]
		    }
	    	    append res $contents
		    set space 1
		    set putsep 1
		}
	    }
	}
	if {$opt == "fill"} {
	    append result [format "%-$lgt($idx)\s" $res]
	} else {
	    append result $res
	    if {($opt == "alwayssep") || ($putsep == 1)} {
		append result $sep
		set putsep 0
	    }
	}
	incr idx
    }
    return $result
}


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

proc printAdr {} {
    global mes options nbfound found adrbook fields

    if {$options(printarea) == "region"} {
    	set from $options(from)
	set to $options(to)
    } else {
    	set from 0
	set to [expr $nbfound - 1]
    }

    set f [open /tmp/addr_print.tmp w]

    set printopt $options(printtype)$options(printopt)

    # prolog for each printopt
    switch -exact $options(printopt) {
        text	{
	    if {$options(printtype) == "line"} {
		lookmax
		formatline1 $options(print,$options(printform))
	    }
	}
        ascii	{
	    if {$options(printtype) == "line"} {
		lookmax
		formatline1 $options(print,$options(printform))
	    }
	}
        latex	{
	    puts $f "\\documentclass{article}"
	    puts $f "\\setlength{\\oddsidemargin}{0,0cm}"
	    puts $f "\\setlength{\\topmargin}{0,0cm}"
	    puts $f "\\setlength{\\textwidth}{16cm}"
	    puts $f "\\begin{document}"
	    puts $f "\\footnotesize"
	    set s "\\begin{tabular}{"
	    set printline $options(print,$options(printform))
	    for {set i 0} {$i <= [llength $printline]} {incr i} {
		append s "l"
	    }
	    set ind [lsearch -exact $printline countryzipcity]
	    if {($ind > -1) && ($options(printtype) == "line")} {
		append s "l"
		set printline [lreplace $printline $ind $ind "country =" "zipcity"]
	    }
	    puts $f "$s}"
	}
        ps	{
	    if {$options(printtype) == "line"} {
		lookmax
		formatline1 $options(print,$options(printform))
	    }
	}
    }

    set i $from
    while {$i <= $to} {
    	set line $adrbook([lindex $found $i])

	switch -exact $printopt {
	    boxtext	{
		puts $f [formatline $line $options(print,$options(printform)) "\n" none none]
	    }
	    linetext	{
		puts $f [formatline $line $options(print,$options(printform)) "\t" none fill]
	    }
	    boxascii	{
		puts $f [formatline $line $options(print,$options(printform)) "\n" tex none]
	    }
	    lineascii	{
		puts $f [formatline $line $options(print,$options(printform)) "\t" tex fill]
	    }
	    boxlatex	{
		puts $f [formatline $line $printline " \\\\\n" tex none ]\\\\\\\\
	    }
	    linelatex	{
		puts $f [formatline $line $printline " & " tex alwayssep]\\\\
	    }
	    boxps	{
		puts $f [formatline $line $options(print,$options(printform)) "\t" none none]
	    }
	    lineps	{
		puts $f [formatline $line $options(print,$options(printform)) "\t" none fill]
	    }
	}

	incr i
    }

    # epilog for each printopt
    switch -exact $options(printopt) {
        text	{
	}
        ascii	{
	}
        latex	{
	    puts $f "\\end{tabular}"
	    puts $f "\\end{document}"
	}
        ps	{
	}
    }

    close $f

    # call further programms
    switch -exact $options(printopt) {
        text	{
	    exec mv /tmp/addr_print.tmp /tmp/addr_print.out
	}
        ascii	{
	    exec mv /tmp/addr_print.tmp /tmp/addr_print.out
	}
        latex	{
	    set cwd [pwd]
	    cd /tmp
	    exec cp /tmp/addr_print.tmp /tmp/addr_print.tex
	    exec $options(latex) /tmp/addr_print.tex
	    catch {exec $options(dvips) /tmp/addr_print.dvi}
	    exec mv /tmp/addr_print.ps  /tmp/addr_print.out
            cd $cwd
	}
        ps	{
	    catch {exec $options(a2ps) -1 -F6.0 -nL -p -8 /tmp/addr_print.tmp > /tmp/addr_print.out}
	}
    }
    
    # copy the temporary file to the final one, even if it is a pipe
    set f [open /tmp/addr_print.out r]
    set g [open $options(printfile) w]
    while {![eof $f]} {
	puts $g [gets $f]
    }
    close $g
    close $f

    # Comment the following line, if you want to modify the texfile
    # before printing.
    exec sh -c {rm /tmp/addr_print.*}
    
}



#------------------------------------------
# Print Addresslist old version
#------------------------------------------

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 != {} } { 
	    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
}


#------------------------------------------
# Delete a record
#------------------------------------------

proc deleteAction {} {
    global mes maxindex newtclversion currentindex

    if $newtclversion {
	if {[tk_dialog .deleteSelection $mes(delete) "$mes(deleterecord)" {} 0 OK $mes(cancel)] == 0} { \
	    deleterecord $currentindex; \
	    loadlistbox; \
	    setSelection $currentindex; \
	    showAdr $currentindex; \
	    .f.main.list.status.2 configure -text {[format $mes(recorddeleted) [expr $currentindex + 1]]} \
        }
    } else {
	mkDialog .deleteSelection "-text {$mes(deleterecord)} -aspect 400" "OK { \
	    deleterecord $currentindex; \
	    loadlistbox; \
	    setSelection $currentindex; \
	    showAdr $currentindex; \
	    .f.main.list.status.2 configure -text {[format $mes(recorddeleted) [expr $currentindex + 1]]} \
        }" "$mes(cancel) {}"
    }
}


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

proc addAction {} {
    global mes newtclversion

    if $newtclversion {
	if {[tk_dialog .addSelection $mes(add) "$mes(addrecord)" {} 0 OK $mes(cancel)] == 0} {addrecord}
    } else {
	mkDialog .addSelection "-text {$mes(addrecord)} -aspect 400" "OK {addrecord}" "$mes(cancel) {}"
    }
}    


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

proc updateAction {} {
    global mes currentindex newtclversion
    if $newtclversion {
	if {[tk_dialog .updateSelection $mes(update) "$mes(changerecord)" {} 0 OK $mes(cancel)] == 0} {deleterecord $currentindex; addrecord}
    } else {
	mkDialog .updateSelection "-text {$mes(changerecord)} -aspect 400" "OK {deleterecord $currentindex; addrecord}" "$mes(cancel) {}"
    }
}


#------------------------------------------
# Add record in databasearray adrbook
#------------------------------------------

proc addrecord {} {
    global adrbook options maxindex fields nbfields mes somethingchanged
    # Read in new address
    set line {}
    for {set i 0} {$i < $nbfields} {incr i} {
	lappend line [.f.main.entry.$i.entry get]
    }
    set a 0
    set b $maxindex
    set lb1 $fields(listboxentry1)
    set lb2 $fields(listboxentry2)
    set search1 [lindex $line $lb1]
    set search2 [lindex $line $lb2]
    # Binary Search for sorted insert (until a + 1 = b)
    while {$b - $a > 1} {
	set c [expr ($a+$b) / 2]
	if {[string compare [lindex $adrbook($c) $lb1] $search1] < 0} {
	    set a $c
	} else {
	    set b $c
	}
    }
    # Exact linear search with 2nd searchkat
    while {($a <= $maxindex) && \
	  (([string compare [lindex $adrbook($a) $lb1] $search1] < 0) || \
	   (([string compare [lindex $adrbook($a) $lb1] $search1] == 0) && \
            ([string compare [lindex $adrbook($a) $lb2] $search2] <= 0)))} {
        incr a
    }
    # Move array to make place for new entry
    incr maxindex
    for {set i $maxindex} {$i > $a} {} {
	set adrbook($i) $adrbook([incr i -1])
    }
    # Insert in databasearray at point a
    set adrbook($a) $line
    loadlistbox
    showAdr $a
    .f.main.list.status.2 configure -text [format $mes(recordchanged) [expr $a + 1]]    
    setSelection $a
    set somethingchanged 1
}

#------------------------------------------
# Delete record
#------------------------------------------

proc deleterecord {index} {
    global adrbook maxindex somethingchanged

    # move the rest of the array to avoid empty fields
    for {set i $index} {$i < $maxindex} {} {
	set adrbook($i) $adrbook([incr i])
    }
    incr maxindex -1
    set somethingchanged 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 newtclversion

    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]
    }
    if $newtclversion {
	.f.main.list.lb.box selection clear 0 end
	.f.main.list.lb.box selection set $i
    } else {
	.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 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 nbfields 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
	}
    }
}


#----------------------------------------------------
# LoadListbox
#----------------------------------------------------

proc loadlistbox {} {
    global adrbook maxindex found nbfound fields mes

    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.1 configure -text [format $mes(records) [expr $maxindex + 1]]

}

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

proc auswahlAdr {} {
    global mes

    loadlistbox
    .f.main.list.status.0 configure -text $mes(total)
    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 [expr $nbfound - 1] }
    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 {![info exists countries($coun,fullname)]} {
	set coun $options(mycountry)
    }
    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 currentindex options

    set printline {{mrmrs title} {firstname lastname} {addon} {street} {zipcity} {fullcountry}}
    if {$options(texconvert)} {
	puts [formatline $adrbook($currentindex) $printline "\n" tex none]
    } else {
	puts [formatline $adrbook($currentindex) $printline "\n" none none]
    }
}
  
#----------------------------------------------------
# help
#----------------------------------------------------

proc Help {topic {x 0} {y 0}} {
    global helpTopics helpCmds mes newtclversion

    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)
    }
    if $newtclversion {
	tk_dialog .help "$mes(adressbook) $mes(help)" "$mes(infoon) $topic:\n\n$msg" {} 0 OK
    } else {
	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
}

