#
#  TkRat software and its included text is Copyright 1996,1997,1998
#  by Martin Forssn
#
#  The full text of the legal notices is contained in the file called
#  COPYRIGHT, included with this distribution.

#
# Version numbers
#
set tkrat_version 1.1
set tkrat_version_date 19980113

# The version history
set ratHistory {0.50 0.51 0.52 0.53 0.54 0.55 0.56 0.57 0.58 0.59
		0.60 0.61 0.62 0.63 0.64 0.65 0.66 0.67 0.68 0.69
		0.70 0.71 0.72 0.73 0.74 0.75 1.0 1.0.1 1.0.2 1.0.3
		1.0.4 1.0.5 1.1}

# The id counter
set idCnt 0

#
# The incoming mailbox
#
set inbox ""

#
# The after ids
#
set expAfter {}
set logAfter {}

#
# The backlog for the statusline
#
set statusBacklog {}

#
# The default font (this will be changed as soon as we have loaded the options)
#
set defaultFont fixed

#
# If we have updated any placement positions
#
set ratPlaceModified 0

#
# The current color set
#
set currentColor {gray85 black}

# First remove the ugly small window during startup
wm withdraw .
update idletasks

# Counters which keeps track of the list of messages for RatLog
set ratLogBottom 0
set ratLogTop 0

# Make return move forward in entries
bind Entry <Return> {focus [tk_focusNext %W]}

# RatLog:
# See ../doc/interface
proc RatLog {level message {duration time}} {
    global statusText option logAfter ratLogBottom ratLogTop ratLog \
	   statusBacklog option statusId

    switch $level {
    0		{set n BABBLE:}
    1		{set n PARSE:}
    2		{set n INFO:}
    3		{set n WARN:}
    4		{set n ERROR:}
    5		{set n FATAL:}
    default	{set n $level:}
    }
    set ratLog($ratLogTop) [format "%-8s %s" $n $message]
    incr ratLogTop
    if {$ratLogTop > [expr $ratLogBottom+$option(num_messages)]} {
	for {} {$ratLogTop > [expr $ratLogBottom+$option(num_messages)]} \
		{incr ratLogBottom} {
	    unset ratLog($ratLogBottom)
	}
    }
    if { 3 < $level} {
	# Fatal
	Popup $message
    } else {
	if $level {
	    if [string length $logAfter] {
		lappend statusBacklog $message
	    } else {
		set statusText $message
		if [string compare explicit $duration] {
		    set logAfter [after [expr $option(log_timeout)*1000] \
					RatLogAfter]
		} else {
		    set statusId $ratLogTop
		}
	    }
	    update idletasks
	}
    }
    return $ratLogTop
}

# RatLogAfter --
#
# Show the next queued messagefor log display (if any).
#
# Arguments:

proc RatLogAfter {} {
    global statusText logAfter statusBacklog option statusId

    if [llength $statusBacklog] {
	set statusText [lindex $statusBacklog 0]
	set statusBacklog [lrange $statusBacklog 1 end]
	set logAfter [after [expr $option(log_timeout)*1000] RatLogAfter]
    } else {
	set statusText ""
	set logAfter {}
    }
    set statusId ""
}


# RatClearLog --
#
# Remove an explicit log message
#
# Arguments:
# id - the id of the message to remove

proc RatClearLog {id} {
    global statusText statusId

    if ![string compare $id $statusId] {
	set statusId ""
	set statusText ""
    }
}

# GetRatLog --
#
# Return the saved log messages
#
# Arguments:

proc GetRatLog {} {
    global ratLogBottom ratLogTop ratLog

    set result {}
    for {set i $ratLogBottom} {$i < $ratLogTop} {incr i} {
	lappend result $ratLog($i)
    }

    return $result
}

# RatLogin
# See ../doc/interface
proc RatLogin {host trial user prot} {
    global t idCnt

    set id login[incr idCnt]
    set w .$id
    upvar #0 $id hd
    set hd(user) $user
    set oldFocus [focus]

    # Create toplevel
    toplevel $w
    wm transient $w .
    wm title $w $t(login)

    # Populate window
    label $w.label -text "$t(opening) $prot $t(mailbox_on) $host"
    frame $w.user
    label $w.user.label -text $t(user): -width 10 -anchor e
    entry $w.user.entry -textvariable ${id}(user) -width 20
    if [string length $hd(user)] {
	 $w.user.entry configure -state disabled
    }
    pack $w.user.label $w.user.entry -side left
    frame $w.passwd
    label $w.passwd.label -text $t(passwd): -width 10 -anchor e
    entry $w.passwd.entry -textvariable ${id}(passwd) -width 20 -show {-}
    pack $w.passwd.label $w.passwd.entry -side left

    OkButtons $w $t(ok) $t(cancel) "set ${id}(done)"

    pack $w.label  -side top -padx 5 -pady 5
    pack $w.user \
	 $w.passwd \
	 $w.buttons -side top -fill both -pady 2
    
    Place $w ratLogin
    focus $w.passwd.entry
    grab $w

    tkwait variable ${id}(done)

    RecordPos $w ratLogin
    catch {focus $oldFocus}
    destroy $w
    update idletasks
    if { 1 == $hd(done) } {
	set r [list $hd(user) $hd(passwd)]
    } else {
	set r {{} {}}
    }
    unset hd
    return $r
}

# Popup --
#
# Show a message which the user has to acknowledge
#
# Arguments:
# message -	The message to show

proc Popup {message} {
    global t

    RatDialog ! $message {} 0 $t(continue)
    update idletasks
}

# RatDialog --
#
# This looks almost like the tk dialog, except that it uses a message
# instead of a label and it doesn't set the font.
#
# This procedure displays a dialog box, waits for a button in the dialog
# to be invoked, then returns the index of the selected button.
#
# Arguments:
# title -	Title to display in dialog's decorative frame.
# text -	Message to display in dialog.
# bitmap -	Bitmap to display in dialog (empty string means none).
# default -	Index of button that is to display the default ring
#		(-1 means none).
# args -	One or more strings to display in buttons across the
#		bottom of the dialog box.

proc RatDialog {title text bitmap default args} {
    global tkPriv idCnt

    # 1. Create the top-level window and divide it into top
    # and bottom parts.

    set w .dialog[incr idCnt]
    catch {destroy $w}
    toplevel $w -class Dialog
    wm title $w $title
    wm iconname $w Dialog
    wm protocol $w WM_DELETE_WINDOW { }

    frame $w.bot -relief raised -bd 1
    pack $w.bot -side bottom -fill both
    frame $w.top -relief raised -bd 1
    pack $w.top -side top -fill both -expand 1

    # 2. Fill the top part with bitmap and message (use the option
    # database for -wraplength so that it can be overridden by
    # the caller).

    option add *Dialog.msg.wrapLength 3i widgetDefault
    message $w.msg -justify left -text $text -aspect 600
    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
    if {$bitmap != ""} {
	label $w.bitmap -bitmap $bitmap
	pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
    }

    # 3. Create a row of buttons at the bottom of the dialog.

    set i 0
    foreach but $args {
	button $w.button$i -text $but -command "set tkPriv(button) $i"
	if {$i == $default} {
	    frame $w.default -relief sunken -bd 1
	    raise $w.button$i $w.default
	    pack $w.default -in $w.bot -side left -expand 1 -padx 3m -pady 2m
	    pack $w.button$i -in $w.default -padx 2m -pady 2m
	} else {
	    pack $w.button$i -in $w.bot -side left -expand 1 \
		    -padx 3m -pady 2m
	}
	incr i
    }

    # 4. Create a binding for <Return> on the dialog if there is a
    # default button.

    if {$default >= 0} {
	bind $w <Return> "
	    $w.button$default configure -state active -relief sunken
	    update idletasks
	    after 100
	    set tkPriv(button) $default
	"
    }

    # 5. Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display and de-iconify it.

    wm withdraw $w
    update idletasks
    set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
	    - [winfo vrootx [winfo parent $w]]]
    set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
	    - [winfo vrooty [winfo parent $w]]]
    wm geom $w +$x+$y
    wm deiconify $w

    # 6. Set a grab and claim the focus too.

    set oldFocus [focus]
    set oldGrab [grab current $w]
    if {$oldGrab != ""} {
	set grabStatus [grab status $oldGrab]
    }
    grab $w
    if {$default >= 0} {
	focus $w.button$default
    } else {
	focus $w
    }

    # 7. Wait for the user to respond, then restore the focus and
    # return the index of the selected button.  Restore the focus
    # before deleting the window, since otherwise the window manager
    # may take the focus away so we can't redirect it.  Finally,
    # restore any grab that was in effect.

    tkwait variable tkPriv(button)
    catch {focus $oldFocus}
    destroy $w
    if {$oldGrab != ""} {
	if {$grabStatus == "global"} {
	    grab -global $oldGrab
	} else {
	    grab $oldGrab
	}
    }
    return $tkPriv(button)
}

# RatText --
#
# Display a text to the user
#
# Arguments:
# title -	Title to display in text's decorative frame.
# text -	Message to display in text.

proc RatText {title text} {
    global idCnt t

    regsub -all "\a" $text {} text

    # Create identifier
    set id rattext[incr idCnt]
    set w .$id

    # Create toplevel
    toplevel $w
    wm title $w $title

    # Message part
    button $w.button -text $t(close) -command "RecordPos $w ratText; \
	    RecordSize $w.text ratText; destroy $w"
    text $w.text -yscroll "$w.scroll set" -relief sunken -bd 1
    Size $w.text ratText
    scrollbar $w.scroll -relief sunken -bd 1 \
	    -command "$w.text yview"
    pack $w.button -side bottom -padx 5 -pady 5
    pack $w.scroll -side right -fill y
    pack $w.text -expand 1 -fill both
    $w.text insert end $text\n
    $w.text configure -state disabled
    Place $w ratText
}

# Place --
#
# Place a window just as the user left it last time it was used.
#
# Arguments:
# w  - Window to place
# id - Identifier

proc Place {w id} {
    global ratPlace ratPlaceO option

    if { [info exists ratPlace($id)] && $option(keep_pos)} {
	wm geom $w $ratPlace($id)
    } else {
	switch $id {
	folder	{ set ratPlaceO($id) $option(main_geometry) }
	compose	{ set ratPlaceO($id) $option(compose_geometry) }
	watcher	{ set ratPlaceO($id) $option(watcher_geometry) }
	default {
		wm withdraw $w
		update idletasks
		set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
			- [winfo vrootx [winfo parent $w]]]
		set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
			- [winfo vrooty [winfo parent $w]]]
		set ratPlaceO($id) +$x+$y
	    }
	}
	wm geom $w $ratPlaceO($id)
	wm deiconify $w
	# The geometry may be expressed with minuses.
	regsub {[0-9]+x[0-9]+} [wm geom $w] {} ratPlaceO($id)
    }
}

# RecordPos --
#
# Record a window's position
#
# Arguments:
# w  - Window to place
# id - Identifier

proc RecordPos {w id} {
    global ratPlace ratPlaceModified ratPlaceO option

    # Should we really do this?
    if !$option(keep_pos) {
	return
    }

    # Get geometry and make sure it is within limits
    regsub {[0-9]+x[0-9]+} [wm geom $w] {} geom
    regsub {[0-9]+x[0-9]+([-+]+)([0-9]+)([-+]+)([0-9]+)} \
	    [wm geom $w] {\1 \2 \3 \4} geom
    set x [lindex $geom 1]
    if [regexp {[-+]-} [lindex $geom 0]] {
	set width [winfo width $w]
    } else {
	set width [winfo screenwidth $w]
    }
    while {$x > $width} {
	incr x -$width
    }
    set y [lindex $geom 3]
    if [regexp {[-+]-} [lindex $geom 0]] {
	set height [winfo height $w]
    } else {
	set height [winfo screenheight $w]
    }
    while {$y > $height} {
	incr y -$height
    }
    set geom "[lindex $geom 0]${x}[lindex $geom 2]${y}"
    if [info exists ratPlaceO($id)] {
	if [string compare $ratPlaceO($id) $geom] {
	    set ratPlace($id) $geom
	    set ratPlaceModified 1
	}
	unset ratPlaceO($id)
    } elseif [info exists ratPlace($id)] {
	if [string compare $ratPlace($id) $geom] {
	    set ratPlace($id) $geom
	    set ratPlaceModified 1
	}
    } else {
	set ratPlace($id) $geom
	set ratPlaceModified 1
    }
}

# Size --
#
# Resize a listbox or text
#
# Arguments:
# w  - The window handler for this listbox/text
# id - The identifier

proc Size {w id} {
    global ratSize ratSizeO ratSizeP ratSizeB option

    if {[info exists ratSize($id)] && $option(keep_pos)
	    && 0 != [lindex $ratSize($id) 0] && 0 != [lindex $ratSize($id) 1]} {
	set width [lindex $ratSize($id) 0]
	set height [lindex $ratSize($id) 1]
    } else {
	switch $id {
	folderM 	{set width  80; set height  30}
	watcher		{set width  60; set height  10}
	compose		{set width  80; set height  24}
	source		{set width  80; set height  30}
	seeLog		{set width  80; set height  20}
	vFolderDef	{set width 450; set height 600}
	gFolderL 	{set width  80; set height  10}
	expList		{set width  30; set height  10}
	giveCmd		{set width  80; set height   4}
	cmdList		{set width  20; set height  10}
	dbcheckList	{set width  80; set height  10}
	extView		{set width  80; set height  40}
	aliasChooser	{set width  30; set height  15}
	msgList		{set width 400; set height 400}
	prefCanvas	{set width 600; set height 500}
	keyCanvas	{set width 470; set height 500}
	pgpError	{set width  60; set height  12}
	ratText		{set width  80; set height  20}
	pgpGet		{set width  80; set height  20}
	aliasList	{set width  80; set height  20}
	aliasText	{set width  30; set height   5}
	bookList	{set width  20; set height  10}
	subjlist	{set width  20; set height   9}
	helptext	{set width  80; set height  40}
	}
	set ratSizeO($id) [list $width $height]
    }
    $w configure -width $width -height $height
    # Remembering information of this window:
    #  ratSizeB	-    the size of the total borders in one axis (in pixels)
    #  ratSizeP -    the size of each character
    set bd [expr 2*([$w cget -borderwidth] \
		    +[$w cget -highlightthickness])]
    set ratSizeB($id) $bd
    set ratSizeP($id) [list [expr ([winfo reqwidth $w]-$bd)/$width] \
		            [expr ([winfo reqheight $w]-$bd)/$height]]
}


# RecordSize --
#
# Remember the size of an listbox or text
#
# Arguments:
# w  - The window handler for this listbox/text
# id - The identifier

proc RecordSize {w id} {
    global ratSize ratSizeO ratPlaceModified ratSizeP ratSizeB option

    # Should we really do this?
    if !$option(keep_pos) {
	return
    }

    set val [list \
	    [expr ([winfo width $w]-$ratSizeB($id))/[lindex $ratSizeP($id) 0]] \
    	    [expr ([winfo height $w]-$ratSizeB($id))/[lindex $ratSizeP($id) 1]]]

    # Ignore unmapped windows
    if { 0 >= [lindex $val 0] || 0 >= [lindex $val 1]} {
	return
    }
    if [info exists ratSizeO($id)] {
	if [string compare $ratSizeO($id) $val] {
	    set ratSize($id) $val
	    set ratPlaceModified 1
	}
	unset ratSizeO($id)
    } elseif [info exists ratSize($id)] {
	if [string compare $ratSize($id) $val] {
	    set ratSize($id) $val
	    set ratPlaceModified 1
	}
    } else {
	set ratSize($id) $val
	set ratPlaceModified 1
    }
}

# SavePos
#
# Save positions
#
# Arguments:

proc SavePos {} {
    global ratPlace ratPlaceModified option ratSize

    if { 0 != $ratPlaceModified} {
	set f [open $option(ratatosk_dir)/placement w]
	foreach p [array names ratPlace] {
	    puts $f "set ratPlace($p) [list $ratPlace($p)]"
	}
	foreach p [array names ratSize] {
	    puts $f "set ratSize($p) [list $ratSize($p)]"
	}
	close $f
	set ratPlaceModified 0
    }
}

# ReadPos --
#
# Read saved window positions
#
# Arguments:

proc ReadPos {} {
    global option ratPlace ratSize

    if [file readable $option(ratatosk_dir)/placement] {
	source $option(ratatosk_dir)/placement
    }
}


# OkButtons
#
# Build two buttons and let the left one be surrounded by a frame. The
# buttons will be created inside a $w.buttons frame (the frame will
# also be created). The $w window will also be bound so that a press
# on the Return key also sets the ${id}(done) to 1.
#
# Arguments:
# w      -	Window in which to build the frame
# t1, t2 -	The text in the two buttons
# id     -	The variable ${id}(done) will be set when the buttons
#		are pressed (the left button sets it to 1 and the
#		right to 0).

proc OkButtons {w t1 t2 cmd} {
    frame $w.buttons
    frame $w.buttons.def -relief sunken -bd 1
    button $w.buttons.def.ok -text $t1 -command "$cmd 1"
    pack $w.buttons.def.ok -padx 4 -pady 4
    button $w.buttons.cancel -text $t2 -command "$cmd 0"
    pack $w.buttons.def \
	 $w.buttons.cancel -side left -expand 1
    bind $w <Return> "$cmd 1"
}

# Expire --
#
# Run the database expiration
#
# Arguments:

proc Expire {} {
    global option t inbox vFolderDef expAfter valueFont idCnt

    # Prepare for next expiration
    set expAfter [after [expr $option(expire_interval)*24*60*60*1000] Expire]

    if { 0 == [string length $inbox] } {
	set vfolder $vFolderDef(0)
	switch [lindex $vfolder 1] {
	dbase {
		set inb [RatOpenFolder dbase [lindex $vfolder 3] \
			 [lindex $vfolder 5] [lindex $vfolder 4] and keywords \
			 [lindex $vfolder 3]]
	    }
	imap {
		set inb [RatOpenFolder std [lindex $vfolder 3] \
				       [lindex $vfolder 4] IMAP]
	    }
	pop3 {
		set inb [RatOpenFolder std [lindex $vfolder 3] \
				       [lindex $vfolder 4] POP3]
	    }
	default {
		set inb [RatOpenFolder std [lindex $vfolder 3]]
	    }
	}
    } else {
	set inb $inbox
    }
    set id [RatLog 2 $t(db_expire) explicit]
    if [catch {RatExpire $inb [RatTildeSubst $option(dbase_backup)]} result] {
	RatClearLog $id
	Popup "$t(dbase_error): $result"
	return
    }
    RatClearLog $id
    if { 0 == [string length $inbox] } {
	$inb close
    }
    set scanned [lindex $result 0]
    set deleted [lindex $result 1]
    set backup [lindex $result 2]
    set inbox [lindex $result 3]
    set custom [lindex $result 4]

    if { 0 != $deleted || 0 != $backup || 0 != $inbox} {
	set w .exp[incr idCnt]
	toplevel $w
	wm title $w $t(expire)
	label $w.lab -text $t(expire_result):
	grid $w.lab -columnspan 2
	label $w.lab_scan -text $t(scanned): -anchor e
	label $w.val_scan -text [format %5d $scanned] \
		-width 10 -font $valueFont -anchor w
	grid $w.lab_scan -column 0 -row 1 -sticky e
	grid $w.val_scan -column 1 -row 1 -sticky w
	label $w.lab_delete -text $t(deleted): -anchor e
	label $w.val_delete -text [format %5d $deleted] -font $valueFont
	grid $w.lab_delete -column 0 -row 2 -sticky e
	grid $w.val_delete -column 1 -row 2 -sticky w
	label $w.lab_backup -text $t(backedup): -anchor e
	label $w.val_backup -text [format %5d $backup] -font $valueFont
	grid $w.lab_backup -column 0 -row 3 -sticky e
	grid $w.val_backup -column 1 -row 3 -sticky w
	label $w.lab_inbox -text $t(inbox): -anchor e
	label $w.val_inbox -text [format %5d $inbox] -font $valueFont
	grid $w.lab_inbox -column 0 -row 4 -sticky e
	grid $w.val_inbox -column 1 -row 4 -sticky w
	button $w.but -text $t(dismiss) -command "destroy $w"
	grid $w.but -column 0 -columnspan 2 -row 5
    }
}

# RatBind --
#
# Bind the specified keys to the specified function
#
# Arguments:
# w        - Window to bind in
# keylist  - Index into options array to get key combinations
# function - Function to bind the keys to
# menu     - The menu to configure (if any)
# eindex   - Index of the entry in the menu

proc RatBind {w keylist function {menu {}}} {
    global option

    foreach k $option($keylist) {
	if [info exists a] {
	    if {[string length $k] < [string length $a]} {
		set a $k
	    }
	} else {
	    set a $k
	}
	if {0 < [regsub < $k <Alt- altkey]} {
	    bind $w $altkey { }
	}
	bind $w $k $function
    }
    if {[string length $menu]} {
	if [info exists a] {
	    regsub Key- [string trim $a <>] {} key
	    if {0 != [regexp Shift- $key]} {
		set l [split $key -]
		set end [lindex $l end]
		if { 1 == [string length $end] && 
			[string compare [string tolower $end] \
					[string toupper $end]]} {
		    set l [lreplace $l end end [string toupper $end]]
		    set key [join $l -]
		    regsub Shift- $key {} key
		}
	    }
	    regsub Control- $key {^} key
	} else {
	    set key ""
	}
	[lindex $menu 0] entryconfigure [lindex $menu 1] -accelerator $key
    }
}


# MailSteal --
#
# Steal back mail that has been kidnapped by other programs.
#
# Arguments:
# handler - The handler of the folder window which has the inbox
# ask     - A boolean which says if we should ask the user for confirmation

proc MailSteal {handler ask} {
    global option t inbox

    if { 0 == [file readable $option(ms_netscape_pref_file)] 
	    || 0 == [string length $inbox]} {
	return
    }
    set dir ""
    set fh [open $option(ms_netscape_pref_file) r]
    while {0 == [eof $fh]} {
	gets $fh line
	if ![string compare MAIL_DIR: [lindex $line 0]] {
	    set dir [RatTildeSubst [lindex $line 1]]
	    break
	}
    }
    close $fh
    if { ![string length $dir] || ![file readable $dir/Inbox]} {
	return
    }

    if {$option(ms_netscape_mtime) != [file mtime $dir/Inbox]} {
	if { 1 == $ask } {
	    set ask [RatDialog ! $t(netscape_steal) {} \
				0 $t(steal_back) $t(nothing)] } {
	}
	if {0 == $ask} {
	    set f [RatOpenFolder std $dir/Inbox]
	    set max [lindex [$f info] 1]
	    for {set i 0} {$i < $max} {incr i} {
		$inbox insert [$f get $i]
		$f setFlag $i deleted 1
	    }
	    $f close
	    Sync $handler 0
	}
	set option(ms_netscape_mtime) [file mtime $dir/Inbox]
	SaveOptions
    }
}

# CalculateFontWidth --
#
# Calculate the default font width
#
# Arguments:
# w - The text widget to use

proc CalculateFontWidth {w} {
    global defaultFontWidth

    set state [$w cget -state]
    $w configure -state normal
    $w insert 1.0 m
    update idletasks
    set defaultFontWidth [lindex [$w bbox 1.0] 2]
    $w delete 1.0
    $w configure -state $state
}

# SetColor --
#
# Set the color scheme
#
# Arguments:
# baseColor  - The base color for the new scheme.
# foreground - The new foreground color

proc SetColor {baseColor {foreground black}} {
    global currentColor

    if {2 == [winfo cells .]} {
	return
    }
    if {[list $baseColor $foreground] == $currentColor} {
	return
    }

    switch $baseColor {
    bisque {tk_bisque}
    default {tk_setPalette background $baseColor foreground $foreground}
    }
}

# SetIcon --
#
# Set the icon bitmap
#
# Arguments:
# w    - window to set the icon for
# icon - the name of the icon

proc SetIcon {w icon} {
    global env

    switch $icon {
    normal {
	    if [file readable $env(LIBDIR)/tkrat.xbm] {
		wm iconbitmap $w @$env(LIBDIR)/tkrat.xbm
		wm iconmask $w @$env(LIBDIR)/tkratmask.xbm
	    }
	}
    small {
	    if [file readable $env(LIBDIR)/tkrat_small.xbm] {
		wm iconbitmap $w @$env(LIBDIR)/tkrat_small.xbm
		wm iconmask $w @$env(LIBDIR)/tkrat_smallmask.xbm
	    }
	}
    none {
	    wm iconbitmap $w ""
	    wm iconmask $w ""
	}
    }
}

# FixMenu --
#
# Fixes a menu if it is to big to fit on the screen. This should be called
# as a postcommand and it will only check one menu, no cacades etc.
#
# Arguments:
# m -	The menu to fix

proc FixMenu {m} {
    set height [winfo screenheight $m]

    if { [$m yposition last] > $height} {
	global t

	# Calculate breakpoint. We assue all entries are of uniform height
	set i [expr ([$m index last]*$height)/[$m yposition last]-1]
	$m insert $i cascade -label $t(more) -menu $m.m
	if ![winfo exists $m.m] {
	    menu $m.m -postcommand "FixMenu $m.m"
	} else {
	    $m.m delete 1 end
	}
	incr i
	while {$i <= [$m index last]} {
	    switch [$m type $i] {
	    separator {
		    $m.m add separator
		}
	    command {
		    $m.m add command \
			    -label [$m entrycget $i -label] \
			    -command [$m entrycget $i -command]
		}
	    cacade {
		    $m.m add cascade \
			    -label [$m entrycget $i -label] \
			    -menu [$m entrycget $i -menu]
		}
	    }
	    $m delete $i
	}
    }
}


# AliasRead --
#
# Read aliases from default file.
#
# Arguments:

proc AliasRead {} {
    global option aliasBook

    set as $option(addrbooks)
    if $option(use_system_aliases) {
	lappend as $option(system_aliases)
    }
    foreach a $as {
	set book [lindex $a 0]
	set aliasBook(changed,$book) 0
	switch [lindex $a 1] {
	    tkrat {
		    set f [lindex $a 2]
		    if [file readable $f] {
			RatAlias read $f
		    }
		    set dir [file dirname $f]
		    if {([file isfile $f] && [file writable $f])
			    || (![file exists $f] && [file isdirectory $dir]
				&& [file writable $dir])} {
			set aliasBook(writable,$book) 1
		    } else {
			set aliasBook(writable,$book) 0
		    }
		}
	    mail {
		    ReadMailAliases [lindex $a 2] $book
		    set aliasBook(writable,$book) 0
		}
	    elm  {
		    ReadElmAliases [lindex $a 2] $book
		    set aliasBook(writable,$book) 0
		}
	    pine {
		    ReadPineAliases [lindex $a 2] $book
		    set aliasBook(writable,$book) 0
		}
	}
    }
}


# FindAccelerators --
#
# Finds suitable accelerator keys for a bunch of strings. The result is
# an array where the keys are the different ids and the contents are
# the index of the character to use as accelerator.
#
# Arguments:
# var	- Name of array (in callers context) to place result in
# ids	- List of ids of strings to search

proc FindAccelerators {var ids} {
    upvar $var result
    global t

    set used ""
    foreach id $ids {
	set tot [string length $t($id)]
	set sub [string length [string trimleft $t($id) $used]]
	if {$sub > 0} {
	    set result($id) [expr $tot - $sub]
	    set used ${used}[string index $t($id) $result($id)]
	} else {
	    set result($id) -1
	}
    }
}


# bgerror --
#
# This is a modified version of bgerror. It allows one to include the
# stack trace in a bug report message.
#
# Arguments:
# err -			The error message.

proc bgerror {err} {
    global errorInfo t
    set info $errorInfo
    set button [tk_dialog .bgerrorDialog "Error in Tcl Script" \
	    "Error: $err" error 0 OK $t(send_bug) "Skip Messages" "Stack Trace"]
    if {$button == 0} {
	return
    } elseif {$button == 1} {
	SendBugReport [list [list "Stack Trace: $err" "$info"]]
	return
    } elseif {$button == 2} {
	return -code break
    }

    set w .bgerrorTrace
    catch {destroy $w}
    toplevel $w -class ErrorTrace
    wm minsize $w 1 1
    wm title $w "Stack Trace for Error"
    wm iconname $w "Stack Trace"
    button $w.ok -text OK -command "destroy $w"
    text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" \
	    -setgrid true -width 60 -height 20
    scrollbar $w.scroll -relief sunken -command "$w.text yview"
    pack $w.ok -side bottom -padx 3m -pady 2m
    pack $w.scroll -side right -fill y
    pack $w.text -side left -expand yes -fill both
    $w.text insert 0.0 $info
    $w.text mark set insert 0.0

    # Center the window on the screen.

    wm withdraw $w
    update idletasks
    set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
	    - [winfo vrootx [winfo parent $w]]]
    set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
	    - [winfo vrooty [winfo parent $w]]]
    wm geom $w +$x+$y
    wm deiconify $w

    # Be sure to release any grabs that might be present on the
    # screen, since they could make it impossible for the user
    # to interact with the stack trace.

    if {[grab current .] != ""} {
	grab release [grab current .]
    }
}

##########################################
# Here we actually start to do something #
##########################################

# Check for correct installation
if ![file readable $env(LIBDIR)/tclIndex] {
    puts "TkRat is incorrectly installed. The file \"$env(LIBDIR)/tclIndex\"is missing"
    exit 1
}

# Initialize
InitFonts
OptionsInit
InitMessages $option(language) t
OptionsRead
InitCharsetAliases

# Update the default font
foreach l [GetLanguages] {
    if ![string compare [lindex $l 0] $option(language)] {
	set langCharset [lindex $l 2]
	set defaultFont [GetFont $langCharset $option(fontsize) {}]
	if ![RatEncodingCompat $langCharset $option(charset)] {
	    option add *font [GetFont $langCharset $option(fontsize) bold]
	    option add *entry.font [GetFont $langCharset $option(fontsize) {}]
	    option add *text.font [GetFont $langCharset $option(fontsize) {}]
	    set valueFont $defaultFont
	} else {
	    set valueFont -Adobe-Helvetica-Medium-R-Normal-*-$option(fontsize)-*
	    option add *font \
		    -Adobe-Helvetica-Bold-R-Normal--$option(fontsize)-*
	    option add *entry.font \
		    -Adobe-Helvetica-Medium-R-Normal--$option(fontsize)-*
	    option add *text.font \
		    -*-Courier-Medium-R-Normal--$option(fontsize)-*
	}
	break
    }
}

# Change the color
eval "SetColor $option(color_set)"

# Reinitialize language (if needed)
if [string compare $option(language) $currentLanguage_t] {
    InitMessages $option(language) t
}

# Make sure our config directory exists
if ![file isdirectory $option(ratatosk_dir)] {
    set but [RatDialog $t(need_tkrat_dir_title) \
	   "$t(need_tkrat_dir1) \"$option(ratatosk_dir)\". \
	   $t(need_tkrat_dir2)" {} 0 $t(create) $t(dont_create) $t(abort)]
    switch $but {
    0 {
	   catch "exec mkdir [RatTildeSubst $option(ratatosk_dir)]" result
	   if [string length $result] {
	       Popup [concat "$t(failed_create) \"$option(ratatosk_dir)\":" \
			     "$result.\n$t(do_without_dir)"]
	   }
      }
    1 {
	   Popup $t(do_without_dir)
	   set option(send_cache) $option(tmp)/send.$env(USER)
      }
    2 {exit 0}
    }
}

# Convert some old values
if [info exists option(last_version_date)] {
    if {$option(last_version_date) < 19960908 && $option(smtp_verbose) == 2} {
	set option(smtp_verbose) 3
    }
    if {$option(last_version_date) < 19961020} {
	if ![catch {set fh [open $option(dsn_directory)/index r]}] {
	    set keep {}
	    set remove {}
	    while { -1 != [gets $fh line]} {
		lappend keep [lindex $line 0]
		foreach e [lindex $line 3] {
		    lappend keep [lindex $e 2]
		}
	    }
	    close $fh
	    foreach f [lsort \
		    [glob -nocomplain $option(dsn_directory)/\[0-9a-f\]*]] {
		if { -1 == [lsearch $keep [file tail $f]]} {
		    catch {exec rm -f $f}
		}
	    }
	    unset remove
	    unset keep
	}
    }
    if {$option(last_version_date) < 19970112} {
	global ratPlace ratSize ratPlaceModified
	ReadPos
	catch {unset ratPlace(aliasList)}
	catch {unset ratPlace(aliasEdit)}
	catch {unset ratPlace(aliasCreate)}
	catch {unset ratSize(aliasList)}
	set ratPlaceModified 1
	SavePos
    }

    # Add port number to imap folders
    if {$option(last_version_date) < 19970209} {
	AddImapPorts
    }

    # Convert log timeout to seconds
    if {$option(last_version_date) < 19970601} {
	if {$option(log_timeout) > 100} {
	    set option(log_timeout) [expr $option(log_timeout)/1000]
	}
    }

    # Convert to new address book specification
    if {$option(last_version_date) < 19970731
	    && [info exists option(aliases_file)]} {
	set option(addrbooks) [list [list Personal tkrat $option(aliases_file)]]
	unset option(aliases_file)
    }

    # Convert to new cache options
    if {$option(last_version_date) < 19970827} {
	if [info exists option(pgp_pwkeep)] {
	    if {0 != $option(pgp_pwkeep)} {
		set option(cache_pgp) 1
	    } else {
		set option(cache_pgp) 0
	    }
	    set option(cache_pgp_timeout) $option(pgp_pwkeep)
	}
	if [info exists option(keep_conn)] {
	    if {0 != $option(keep_conn)} {
		set option(cache_conn) 1
	    } else {
		set option(cache_conn) 0
	    }
	    set option(cache_conn_timeout) $option(keep_conn)
	}
    }
}

# Check which version the user last used
if ![string length $option(last_version)] {
    InfoWelcome

    # Reinitialize language (if needed)
    if [string compare $option(language) $currentLanguage_t] {
	InitMessages $option(language) t
	# Update the default font
	foreach l [GetLanguages] {
	    if ![string compare [lindex $l 0] $option(language)] {
		set langCharset [lindex $l 2]
		set defaultFont [GetFont $langCharset 0 {}]
		if ![RatEncodingCompat $langCharset $option(charset)] {
		    option add *font [GetFont $langCharset 0 bold]
		    set valueFont $defaultFont
		} else {
		    set valueFont -Adobe-Helvetica-Medium-R-Normal--*-120-*
		}
		break
	    }
	}
    }
    set option(last_version) $tkrat_version
    set option(last_version_date) $tkrat_version_date
    SaveOptions
} else {
    set io [lsearch -exact $ratHistory $option(last_version)]
    set ic [lsearch -exact $ratHistory $tkrat_version]
    if {$io < $ic && -1 != $io && $option(info_changes)} {
	InfoChanges
    }
    if {$option(last_version_date) < $tkrat_version_date} {
	set option(last_version_date) $tkrat_version_date
	set option(last_version) $tkrat_version
	SaveOptions
    }
}

# Check dbase
if [file readable $option(dbase_dir)/index.ver] {
    FixDbase
}

# Convert old options
if [file readable $option(ratatosk_dir)/ratatoskrc.gen] {
    FixOldOptions
}

# Create send cache
if {![file isdirectory $option(send_cache)] &&
	[catch {exec mkdir [RatTildeSubst $option(send_cache)]} result]} {
    Popup "$t(failed_to_create_send_cache) '$option(send_cache)': $result"
}

# Check tk version
if { "8.0" == $tk_patchLevel && 1 == $option(warn_tk80)} {
    Warn warn_tk80
    if {0 == $option(warn_tk80)} {
	SaveOptions
    }
}

# Read list of vfolders
VFolderRead

# Read aliases
AliasRead

# Should we scan aliases?
if { 3 > $option(scan_aliases) } {
    ScanAliases
}

# Read user procedures
ReadUserproc

# Read window positions
ReadPos

# Read saved expressions
if [file readable $option(ratatosk_dir)/expressions] {
    ExpRead
}

# Initialize balloon help system
InitMessages $option(language) balText
BalloonInit b balText

# Set main window attributes
wm title . $option(main_window_name)
wm iconname . $option(icon_name)
SetIcon . $option(icon)

# Create a frame and create a folder window in it
frame .f
pack .f -expand 1 -fill both
set handler [FolderWindowInit .f]
update idletasks
bind .f <Destroy> RatCleanup
Place . folder
if $option(iconic) {
    wm iconify .
} else {
    wm deiconify .
}

# Redo bindings for entry and text to make the selection work more
# intuitive
bind Entry <1> { 
    tkEntryButton1 %W %x
}
bind Text <1> {
    tkTextButton1 %W %x %y
}

# Calculate font width
CalculateFontWidth [set ${handler}(text)]

# Open the default folder
VFolderOpen $handler $vFolderDef($vFolderInbox)

if { 0 <= [expr [RatDaysSinceExpire]-$option(expire_interval)]} {
    Expire
} else {
    set expAfter [after \
	[expr ($option(expire_interval)-[RatDaysSinceExpire])*24*60*60*1000] \
	Expire]
}

# Check for stolen mail
if {$option(mail_steal)} {
    MailSteal $handler 1
}

# Check for deferred mail
RatSend init
