#!/usr/local/bin/wish -f
global mf mfp
set mfp(tkmaillib) $env(HOME)/prog/tk/tkmail
set mfp(globalset) /usr/local/lib/tkmail/settings

set mfp(version) "1.6 p5"

# $Header: /usr2/master/tk/tkmail/tkmail,v 1.38 1994/04/26 13:57:31 raines Exp $
###########################################################################
# 
# 
#    TkMail -- A Tk/Tcl interface to Mail
# 	    		by Paul Raines (raines@bohr.physics.upenn.edu)
# 
###########################################################################
#  -*- Mode: tcl-mode -*- 

proc mf_defaultstart { } {
  global mf env

  # DEFAULT STARTUP ONLY SETTINGS
  # You must restart TkMail for these to take affect

  # name of BSD style mail command (do not put options here!)
  set mf(mail-command) Mail
  # name of mail delivery command (reads input for address)
  set mf(mail-deliver) "/usr/lib/sendmail -bm -t"
  # name of main MBOX
  set mf(mail-mbox) $env(HOME)/mbox
  # name of system inbox
  set mf(mail-system) /usr/spool/mail/[exec whoami]
  # name of folder directory
  set mf(mail-directory) $env(HOME)/Mail
  # maximum number of folders listed in menu
  set mf(menu-folders-max) 25
  # maximum depth of pull right menus
  set mf(menu-depth-max) 5
  # files in mf(mail-directory) directory to not put in menus
  set mf(menu-folders-ignore) ""
  # geometry of main reader
  set mf(viewer-geom) 600x720
  # whether to use emacs type bindings
  set mf(bind-emacs) 1
  # set to 1 for scroll bar on left, 0 for right
  set mf(disp-left-scroll) 1
  # key to press in order to access menu accelarators
  set mf(menu-key) <F1>
  # list of common addresses for composing (should be set in ~/.tkmail)
  set mf(menu-quick-send) {}
  # number messages displayed in header widget
  set mf(headlist-height) 8

}

# default user settings dynamically configurable
proc mf_defaultset {} {
  global mf env

  # USER SETTINGS
  #
  #   * spaces inclosed in {}'s are not just white-space and
  #       can cause errors in evaluation.
  #   * use of the $mf or $env arrays require you to replace
  #	  the surrounding {}'s with ""'s
  #   * other setting not listed here can be added, but changing
  #	  them will have unpredicable or no effect after startup

  # MAIL SETTINGS
  # temporary file directory
  set mf(mail-tmpdir) /usr/tmp
  # milliseconds to check mail
  set mf(mail-interval) 10000
  # file to record all outgoing messages in. Please see the mf_recordmsg
  # procedure below to see if you may need to hack it to give the
  # proper format for your mail folder.
  set mf(mail-record) {}
  # whether to record outgoing messages as originating from the
  # address sent to so that you see this address in the header
  set mf(mail-record-swap) 0
  # whether forwarded mail should be recorded in mf(mail-record)
  set mf(mail-record-forward) {1}
  # whether to incorporate mail automatically when detected
  set mf(mail-auto-incorp) 0
  # print usually ignored error messages to stderr
  set mf(mail-debug) 0
  # number of bytes between flushes for mail pipeline reads
  set mf(mail-flush) 1000
  # whether to ask to continue when reading in large messages
  set mf(mail-read-ask) 0
  # maximum number of lines before asking to how much to fetch
  set mf(mail-read-max) 200
  # name of file to read aliases from
  set mf(mail-alias-file) $env(HOME)/.mailrc
  # type of alias file format - "bsd" or "elm"
  set mf(mail-alias-type) {bsd}

  # VIEWER SETTTINGS
  # printing command where %F is the imaginary file to print
  set mf(viewer-print) "lpr %F"
  # bitmaps
      set mf(viewer-bitmap-nomail) "/usr/include/X11/bitmaps/flagdown"
      set mf(viewer-bitmap-mail) "/usr/include/X11/bitmaps/flagup"
      set mf(compose-icon-bitmap) "/usr/include/X11/bitmaps/letters"
  # command to eval for new mail (in case you have a better one like blt_bell)
  # set it to {} for no beep
  set mf(viewer-beep-new) {puts stderr "\007\007" nonewline}
  # command to eval for emtpy mailbox
  set mf(viewer-beep-empty) {}
  # command to eval for errors and notifications
  set mf(viewer-beep-error) {puts stderr "\007\007" nonewline}
  # either 'normal' or 'disabled' to allow message window editing
  set mf(viewer-state) normal
  # directory to run piped UNIX commands in
  set mf(viewer-pipe-dir) $env(HOME)

  # HEADER LISTBOX
  # if you want reverse time order in mail header, set to 1
  set mf(headlist-reverse) 0
  # formated header (needed for SUN's and IBM's for pretty layout)
  set mf(headlist-format) 1

  # ISPELL SETTINGS
  # whether your system has ispell
  set mf(ispell-present) 1

  # COMPOSE WINDOW SETTINGS
  # geometry of composition tool
  set mf(compose-geom) 600x530
  # whether to show the Cc and Bcc fields in compose
  set mf(compose-show-cc) 1
  # whether to store a copy of the last sent message for possible restore
  set mf(compose-save-send) 1
  # alternate editor command. If it is not an X windows editor, you
  # must use xterm (i.e. xterm  -e vi %F). %F is imaginary file name
  set mf(compose-alt-editor) "emacs %F"
  # whether to startup alt editor automatically
  set mf(compose-alt-auto) 0
  # alternate email addresses to strip from Cc and Bcc
  set mf(compose-alternates) ""
  # possible postfix to add to addresses that don't include a @machine part
  # you must include the '@' character in the string
  set mf(compose-addr-postfix) ""
  # whether the forward menu item and button should just ask for an address
  # to forward to or should bring up a compose window
  set mf(compose-quick-forward) 0
  # whether a subject should be required or not on outgoing messages
  set mf(compose-require-subject) 1

  # INSERTION OF MESSAGE SETTINGS
  # include file prefix
  set mf(insert-prefix) ">> "
  # text to automatically put at top of every composition
  set mf(insert-headers) {}
  # name of .signature to put at end of messages
  set mf(insert-signature) $env(HOME)/.signature
  # text to put before the signature file
  set mf(insert-prefix-sig) "--\n"
  # program to encode inserted files with when requested
  set mf(insert-encoder) uuencode
  # whether to automatically strip header of included messages
  set mf(insert-strip) 1
  # program to compress inserted files and suffix it uses
  set mf(insert-compress) compress
  set mf(insert-compress-suffix) Z

  # MAIL HEADER SETTINGS
  # header fields to strip out of display. This feature can end up
  # deleting message body if your headers are in a nonstandard format,
  # so set to {} if you are having problems
  set mf(header-strip) ""
  # whether to do MIME parsing
  set mf(header-mime) 0
  # configuration of headers in viewer as a text widget tag
  set mf(header-config) "-underline 1"

  # MENU SETTINGS
  # whether to use full address for <Sender> filenames
  set mf(menu-sender-full) 0
  # list of email address to file name pairs to override default
  set mf(menu-sender-list) ""
  # maximum number of folders to put in Recent menus
  set mf(menu-recent-max) 8
}

# MIME TESTING

# headers
  set mfp(mime,version) ""
  set mfp(mime,content) ""
  set mfp(mime,enc) ""
  set mfp(mime,id) ""
  set mfp(mime,desc) ""

# parsing
  set mfp(mime,type) ""
  set mfp(mime,subtype) ""
  set mfp(mime,params) ""
  set mfp(mime,name) ""
  set mfp(mime,charset) ""
  set mfp(mime,boundary) ""

# support programs
#  set mf(mime,base64enc) "encdec -b -e"
#  set mf(mime,base64dec) "encdec -b -d"


###############################################################
# DO NOT EDIT BELOW THIS LINE

# Private program variables
# name of user
    set mfp(user) [exec whoami]
# current name of folder file
    set mfp(file) ""
# name of folder file for last command
    set mfp(filelastcmd) ""
# modification time of folder after last command
    set mfp(filemtime) 0
# list of files in folder directory
    set mfp(foldfiles) ""
# toplevel widget
    set mfp(top) .mf
# header list holding & displaying widget
    set mfp(head) $mfp(top).head.list
# message holding & displaying widget
    set mfp(mesg) $mfp(top).mesg.txt
# header status label
    set mfp(hstat) $mfp(top).stat.folder
# message status label
    set mfp(mstat) $mfp(top).stat.mesg
# temp text processing widget
    set mfp(tmptxt) $mfp(top).tmptxt
# number of messages in folder
    set mfp(mesgnum) 0
# list of mesg status #'s
    set mfp(statlist) ""
# current message number
    set mfp(curnum) 0
# current message text index
    set mfp(curtndx) 0.0
# delete message list
    set mfp(delmesg) ""
# bitmaps
    set mfp(flag) -1
# compose window counter
    set mfp(compcnt) 0
# current message from
    set mfp(curfrom) ""
# email id of curfrom for quick message folder saving
    set mfp(fromname) ""
# current message Cc
    set mfp(curcc) ""
# current message subj
    set mfp(cursubj) ""
# cutbuffer
    set mfp(cutbuffer) ""
# system file last size
    set mfp(lastsize) 0
# save of text of last sent message
    set mfp(savesendtxt) ""
# search string for text
    set mfp(searchstr) ""
# last text widget searched in
    set mfp(lastsearch) ""
# settings for file insertion
    set mfp(ins_compress) 0
    set mfp(ins_encode) 0
    set mfp(ins_prefix) 0
# name of settings file read
    set mfp(setfile) ""
# command to cause Mail to return bad command error
    set mfp(bcmd) "xxx"
# result of bad command error to use as sentinel
    set mfp(sentinel) ""
# file id for writing to/reading from Mail command
    set mfp(fid) ""
# temp file to use to simulate blank folder
    set mfp(tfile) "dummyTkMail"
# list of folders in Recent menus
    set mfp(recentlist) ""
# index of last permanent item in Folder menu
    set mfp(fmenulast) 0
# list of widgets to put watch in for waiton and waitoff
    set mfp(waitlist) " $mfp(head) $mfp(mesg) "

### CONVENIENCE ROUTINES FOR LATER REMOVAL TO LIBRARY ######

# this is from Tom Phelps
proc lreverse {l} {
   set l2 ""
   for {set i [expr [llength $l]-1]} {$i>=0} {incr i -1} {
      lappend l2 [lindex $l $i]
   }
   return $l2
}

proc quotespecial { str } {
	regsub -all {\"} $str {\"} str
	return $str
}

proc unquotespecial { str } {
	regsub -all {\\\"} $str {"} str
	return $str
}

# get temp file
proc tmpfile { {str tmp} {dir ""} } {
    global env

    if {![string length $dir] || ![file isdirectory $dir]} {
	if {[info exists env(TMPDIR)]} {
	    set dir $env(TMPDIR)
	} else {
	    set dir /tmp
	}
    }

    if {![file writable $dir]} {
	error "$dir is not a writable directory"
    }

    set cnt 0
    set tfile [format "%s%04d" $str $cnt]
    while {[file exists $dir/$tfile]} {
	incr cnt
	if {$cnt>9999} {return 0}
	set tfile [format "%s%04d" $str $cnt]
    }
    return $dir/$tfile
}

proc TextSearch { tw string {sndx 1.0} {view 1}} {

    set sline [lindex [split $sndx .] 0]
    set schar [lindex [split $sndx .] 1]
    scan [$tw index end] %d numLines
    for {set i $sline} {$i <= $numLines} {incr i} {
        if {[regexp -indices $string \
		[$tw get $i.$schar [$tw index "$i.0 lineend"]] ndx]} {
            if {$view} {
                $tw mark set insert $i.[expr [lindex $ndx 1]+$schar+1]
                $tw yview -pickplace $i.0
	    }
            return $i.[expr [lindex $ndx 1]+$schar+1]
        }
        set schar 0
    }
    return 0.0
}

# setup up menus to allow mouse follow and F10 key operation
proc tk_autoMenuBar { frm } {

    set pinfo [pack info $frm]
    set mlist ""
    for {set i 0} { $i < [llength $pinfo]} {incr i 2} {
	lappend mlist [lindex $pinfo $i]
    }

    eval "tk_menuBar $frm $mlist"

}

############################################################

# check for new mail and set icon and beep accordingly
proc mf_checkmail {} {
    global mf mfp

    if { [file exists $mf(mail-system)] && ([file size $mf(mail-system)] != 0)} {
	if {[file size $mf(mail-system)] != $mfp(lastsize) \
	       && ([file mtime $mf(mail-system)] >= [file atime $mf(mail-system)])} {
	    eval $mf(viewer-beep-new)
	    mf_logmessage "New Mail has arrived!"
	} else {
	    $mfp(mstat) configure -text "You have new mail"
        }
	# only autoincorporate if in iconic state
	if {$mf(mail-auto-incorp) && ![winfo ismapped $mfp(top)]} { 
	    bind $mfp(top) <Map> {
		mf_incorporate
		bind $mfp(top) <Map> " "
	    }
	}
        if {$mfp(flag) != 1} {
	    if {[file exists $mf(viewer-bitmap-mail)]} {
	       wm iconbitmap $mfp(top) "@$mf(viewer-bitmap-mail)"
	    }
            set mfp(flag) 1
        }
    } else {
        if {$mfp(flag) != 0} {
	    # people with autoincorp still want to know if they got mail
            if {!$mf(mail-auto-incorp) || [winfo ismapped $mfp(top)]} {
	        if {[file exists $mf(viewer-bitmap-nomail)]} {
        	    wm iconbitmap $mfp(top) "@$mf(viewer-bitmap-nomail)"
		}
		eval $mf(viewer-beep-empty)
        	set mfp(flag) 0
 	    }
        }
    }
    set mfp(lastsize) [mf_filesize $mf(mail-system)]

}

# schedule a mail check
proc mf_schedule {} {
    global mf mfp
    
    mf_checkmail
    # check if person thought it was for seconds and not milliseconds
    if {$mf(mail-interval) < 1000} {set mf(mail-interval) [expr $mf(mail-interval)*1000]}
    after $mf(mail-interval) mf_schedule
}

# popup a error message and beep
proc mf_mailerror { str {master ""} } {
    global mf mfp

    eval $mf(viewer-beep-error)
    flush stderr
    mf_logmessage "ERROR: $str"
    if {![string length $master]} {set master $mfp(top)}

    if {[string first "\n" $str] > -1} {
	set w $mfp(top)_err
	if {![winfo exists $w]} {
	    ut_simpletext -name $w -title "TkMail ERROR" -master $master \
	        -grab 1 -leftscroll $mf(disp-left-scroll)
	    if {$mf(menu-key) != ""} {
		bind $w.txt $mf(menu-key)<KeyPress-c> "$w.bb.btn0 invoke"
            }
        } else {
	    ut_simpletext -name $w -grab 1
        }

	$w.txt configure -state normal
	$w.txt delete 1.0 end
	$w.txt insert 1.0 $str
	$w.txt configure -state disabled

	focus $w.txt
    } else {
        ut_getok -prompt "ERROR: $str" -master $master -showno 0
        focus $mfp(mesg)
    }
}

proc mf_filetime { file } {
    if {[file exists $file]} {return [file mtime $file]} else {return 0}
}

proc mf_filesize { file } {
    if {[file exists $file]} {return [file size $file]} else {return 0}
}

# check if current folder has been externally modified
proc mf_fmodcheck { {defstr ""} } {
    global mf mfp

    if {$mfp(filemtime) != [mf_filetime $mfp(file)] && $mfp(filemtime) != 0} {
	if {![string length $defstr]} {
	    set defstr "Folder $mfp(file) has been externally modified. Continue?" 
	}
	if {![ut_getok -prompt $defstr -nolabel "No" -master $mfp(top)]} {
	    return 0
	}
    }
    set mfp(filemtime) [mf_filetime $mfp(file)]
    return 1
}

# Incorporate new mail into the main mbox
proc mf_incorporate { } {
    global mf mfp

    # Make sure not empty
    if {[mf_filesize $mf(mail-system)] == 0} {
	eval $mf(viewer-beep-error)
	flush stderr
	if {[file exists $mf(viewer-bitmap-nomail)]} {
	    wm iconbitmap $mfp(top) "@$mf(viewer-bitmap-nomail)"
        }
	$mfp(mstat) configure -text "No new mail"
	return 0
    }

    mf_waiton
    if {[mf_procdelete] == -1} {
	mf_killcmdpipe $mfp(fid)
	set mfp(fid) [mf_getcmdpipe $mfp(file)]
    }
    
    # read in the system folder and determine number of new mesgs
    if {$mfp(fid) == ""} {
	set mfp(fid) [mf_getcmdpipe $mf(mail-system)]
    } else {
        mf_mailcmd res "folder $mf(mail-system)" $mfp(fid)
    }
    mf_mailcmd res "size \$" $mfp(fid)
    set newm 0
    if {![regexp {([0-9][0-9]*)[ ]*:[ ]*[0-9]} $res trash newm]} {
	mf_mailerror "Could not determine number of new messages from $res"
	mf_setupfolder $mfp(file) $mfp(curnum)
	mf_waitoff
	return 0
    }

    # copy new messages to mbox
    set msize [mf_filesize $mf(mail-mbox)]
    mf_mailcmd res "s ^-\$ $mf(mail-mbox)" $mfp(fid)

    # verify incorporation before deleting system folder
    if {![regexp {[^ ]+ \[.+\] [^ ]} $res] ||
           $msize == [mf_filesize $mf(mail-mbox)]} {
        mf_mailerror "Error incorporating new mail to $mf(mail-mbox)\n$res"
	mf_killcmdpipe $mfp(fid)
	puts stdout "Unsafe to continue"
	puts stdout "Error incorporating new mail to $mf(mail-mbox)\n$res"
        if {$tk_version<3.3} {destroy .}
        exit
    } else {
        mf_mailcmd res "d ^-$newm" $mfp(fid)
    }


    # return to the ~/mbox file and mark new messages
    mf_mailcmd res "folder $mf(mail-mbox)" $mfp(fid)
    mf_mailcmd res "size \$" $mfp(fid)
    set csize 0
    if {[regexp {([0-9][0-9]*)[ ]*:[ ]*[0-9]} $res trash csize]} {
        set fnew [expr $csize-$newm+1]
	if {$fnew > 0} {mf_mailcmd res "new $fnew-\$" $mfp(fid)}
    }

    if {$mf(headlist-reverse)} {
	mf_setupfolder $mf(mail-mbox) 1
    } else {
	mf_setupfolder $mf(mail-mbox) -$newm
    }
    mf_logmessage "Incorporated $newm new messages"
    catch "$mfp(head) yview -pickplace [$mfp(head) cursingle]"
    mf_waitoff
    return 1
}

# Read in folder headers and set view to message at ndx
proc mf_setupfolder { folder ndx } {
    global mf mfp

    if {![file exists $folder]} {
	if {$folder == $mf(mail-mbox)} {
	    exec touch $mf(mail-mbox)
	} else {
	    mf_mailerror "Folder $folder does not exist!"
	    return 0
	}
    } else {
        # check if locked
	if {$folder != $mfp(file) && 
	      ([file exists $folder.lock] || [file exists $folder.rolock])} {
	    set errmsg "A lock file exists on $mfp(file). This must be removed"
	    append errmsg "\nbefore it can be opened. The name of this file is either"
	    append errmsg "\n$mfp(file).lock or $mfp(file).rolock"
	    mf_mailerror $errmsg
	    return 0
	}
        # check if valid mail file
	if {[catch "open $folder r" tfid]} {
	    mf_mailerror "Cannot open file $folder\n$tfid"
	    return 0
	} else {
	    if {[mf_filesize $folder] > 0 && 
		    ![regexp {^>*From *([^ ]+) } [gets $tfid]]} {
		mf_mailerror "$folder is not a valid mail file"
		return 0
	    }
	}
	catch {close $tfid}
    }

    if {[mf_procdelete] == -1} {
	mf_killcmdpipe $mfp(fid)
	set mfp(fid) ""
    }

    mf_waiton

    set mfp(mesgnum) 0
    set mfp(curnum) 0

    $mfp(head) delete 0 end
    $mfp(mesg) configure -state normal
    $mfp(mesg) delete 1.0 end
    bind_cleanup $mfp(mesg)
    $mfp(mesg) configure -state $mf(viewer-state)

    # Ignore empty folders
    if {[mf_filesize $folder] == 0} {
	if {$mfp(fid) != ""} {
	    mf_closecmdpipe $mfp(fid)
	    set mfp(fid) ""
	}
	set mfp(file) $folder
	set mfp(filemtime) [mf_filetime $folder]
        $mfp(hstat) configure -text \
	    [string range $folder [expr [string length $folder]-30] end]
	set mfp(cursubj) ""
	set mfp(curfrom) ""
	set mfp(curcc) ""
	set mfp(curdate) ""
	set mfp(fromname) ""
	set mfp(curnum) 0
	mf_waitoff
	return 1
    }

    # open up pipe line for first time if needed
    if {$mfp(fid) == ""} {
	set mfp(fid) [mf_getcmdpipe $folder]
        set mfp(delmsg) ""
	mf_mailcmd res "size" $mfp(fid)
    } else {
	mf_mailcmd res "folder $folder" $mfp(fid)
    }

    if {![string length $res]} {
        mf_mailerror "Error opening $folder as a mail folder!"
	mf_mailcmd res2 "folder $mfp(file)" $mfp(fid)
	if {![string length $res] || ![string length $res2] } {
	    puts stderr "Serious error opening $mfp(file)!"
	    global tk_version
	    if {$tk_version<3.3} {destroy .}
	    exit
        }
	mf_waitoff
        return 0
    } else {
	set mfp(file) $folder
	set mfp(filemtime) [mf_filetime $folder]
    }
 
    $mfp(hstat) configure -text \
	[string range $folder [expr [string length $folder]-30] end]

    mf_mailcmd res "h" $mfp(fid)
    if {[string match "No applicable*" $res]} {
	$mfp(mstat) configure -text "Message 0 out of 0"
	mf_waitoff
	return 1
    }

    if {$mf(headlist-reverse)} {
	set res [exec sort -r +0.2 << $res ]
    }

    set res [split $res "\n"]
    foreach line $res {
	if {![string length $line]} continue
	set line [quotespecial $line]
	regsub {^>} $line { } line
	set status [string range $line 1 1]
	set line [string range $line 2 end]
	if {$mf(headlist-format)} {
	    if {[scan $line {%d %s %[ -~]} num from rest] == -1 ||
	        [catch {set line [format "%5d %-18.18s %s" \
		    $num $from $rest]} err]} {
		if {[string length $line] && $mf(mail-debug)} {
		    puts stderr "Failed to parse mesg header: >$line<"
		}
		continue
	    }
	}
	$mfp(head) insert end "${status}[unquotespecial $line]"
    }
    set mfp(mesgnum) [$mfp(head) size]

    if {$mfp(mesgnum)==0} {
	$mfp(mstat) configure -text "Message 0 out of 0"
	mf_waitoff
	return 1
    }
    if {$ndx < 0} {set ndx [expr $ndx+1+$mfp(mesgnum)]}
    if {$ndx > $mfp(mesgnum) || $ndx < 1} {
	mf_selmesg from [expr $mfp(mesgnum)-1]
    } else {
	mf_selmesg from [expr $ndx-1]
    }

    mf_waitoff
    return 1
}


# display a message in the mesg text widget
proc mf_dispmesg { ndx {button 1}} {
    global mf mfp

    # release delayed binding of button release
    bind $mfp(head) <ButtonRelease-$button> " "
    $mfp(mesg) configure -state normal
    $mfp(mesg) delete 1.0 end
    bind_cleanup $mfp(mesg)

    # check if mail file has been externally modified
    if {![mf_fmodcheck]} {return 0}

    # verify ndx is in range
    if {$ndx < 1 || $ndx > $mfp(mesgnum)} {
	$mfp(mstat) configure \
		-text "No messages or message $ndx out of range"
	$mfp(mesg) configure -state $mf(viewer-state)
	return 0
    }

    # check size of message
    set msize 0
    set getlines 0
    set mfid $mfp(fid)
    mf_mailcmd res "size $ndx" $mfp(fid)
    if {![regexp {[0-9]+[ ]*:[ ]*([0-9]+)[ ]*(/[ ]*[0-9]+)?} $res trash msize]} {
	mf_mailerror "Could not determine size of selected messages"
    } else {
        if {$msize > $mf(mail-read-max) && $mf(mail-read-ask)} {
	    update idletasks
	    set getlines [ut_getstr -master $mfp(top) -defstr $mf(mail-read-max) \
		-prompt "Message is $msize lines long. Fetch how many lines?" \
		-nolabel "Get All"]
	    if {![string length $getlines]} {set getlines 0}
	    if {[catch "expr ${getlines}+0"]} {set getlines 0}
	}
    }

    # get filedesc for pipe to mail program
    if {$getlines != 0} {
	set mfid [mf_getcmdpipe $mfp(file)]
    }

    # initialize header parsing variables
    set mfp(hdrlist) { subject reply-to to cc from mime-version content-type \
		  content-transfer-encoding content-id message-id \
		  content-description date}
    foreach hdr $mfp(hdrlist) { set mfp(hdr,$hdr) "" }
    set mfp(cursubj) ""
    set mfp(curfrom) ""
    set mfp(curcc) ""
    set mfp(curdate) ""
    set mfp(fromname) ""

    # read message and parse for display
    set tndx [$mfp(mesg) index insert]
    mf_mail2txt $mfp(mesg) "$ndx" $mfid mf_headparser $getlines
    set mfp(filemtime) [mf_filetime $mfp(file)]
    if {$tndx == [$mfp(mesg) index insert]} {
        # if nothing was inserted into the text widget, error
	mf_mailerror "Error getting message $ndx in $mfp(file)"
	return 0
    } else {
	set lline [lindex [split [$mfp(mesg) index end] .] 0]
    }
    # remove unread status of message in folder
    mf_mailcmd res "top $ndx" $mfp(fid)

    # set globals from parsing
    set mfp(cursubj) $mfp(hdr,subject)
    if {$mfp(hdr,from) != ""} {set mfp(curfrom) $mfp(hdr,from)}
    foreach addr $mf(compose-alternates) {
	regsub -all $addr $mfp(hdr,reply-to) { } mfp(hdr,reply-to)
    }
    set mfp(hdr,reply-to) [string trim $mfp(hdr,reply-to)]
    if {$mfp(hdr,reply-to) != ""} {set mfp(curfrom) $mfp(hdr,reply-to)}
    set mfp(curfrom) [mf_stripcomment $mfp(curfrom)]
    if {[regexp {<([^<>]*)>} $mfp(curfrom) trash mfrom]} {
	set mfp(curfrom) $mfrom
    }
    set mfp(curcc)  $mfp(hdr,cc)
    set mfp(hdr,to) [mf_stripcomment $mfp(hdr,to) 0]
    if {[llength $mfp(hdr,to)] > 1} {set mfp(curcc) "$mfp(curcc) $mfp(hdr,to)"}
    set mfp(curdate) $mfp(hdr,date)

    # get <Sender> filename for message
    set mfp(fromname) [lindex [split $mfp(curfrom) ","] 0]
    if {[string first ":" $mfp(fromname)] != -1} {
	set mfp(fromname) [lindex [split $mfp(fromname) ":"] 1]
    }
    if {$mf(menu-sender-full)} {
	set mfp(fromname) [string tolower $mfp(fromname)]
    } else {
	set mfp(fromname) [string tolower [lindex [split \
	    $mfp(fromname) "@"] 0] ]
    }
    foreach pair $mf(menu-sender-list) {
	if {[regexp [lindex $pair 0] $mfp(curfrom)]} {
	    set mfp(fromname) [lindex $pair 1]
	    break
	}
    }

    # notify user of message read
    $mfp(mstat) configure \
	-text "Message $ndx out of $mfp(mesgnum) from >$mfp(fromname)<"
    $mfp(mesg) configure -state $mf(viewer-state)

    # remove possible unread status symbol from listbox
    set tndx [expr [$mfp(head) cursingle]+1]
    $mfp(head)_text insert $tndx.2 " "
    $mfp(head)_text delete $tndx.1

    return 1
}

# select a message in the header list according to mode
proc mf_selmesg { mode ndx {dwait 0} {button 1}} {
    global mf mfp

    eval "$mfp(head) select $mode $ndx"

    set newcur [mf_head2num [$mfp(head) cursingle]]
    if {![string length $newcur]} {
	$mfp(head) select from $ndx
	set newcur [mf_head2num [$mfp(head) cursingle]]
    }
    
    # primary selection has changed
    if {$newcur != $mfp(curnum)} {
	if {$dwait} {
	    bind $mfp(head) <ButtonRelease-$button> "mf_dispmesg $newcur %b"
	} else {
	    mf_dispmesg $newcur
	}
	set mfp(curnum) $newcur
	$mfp(head) yview -pickplace $ndx
    }
    focus $mfp(mesg)
    return 1
}

# get message number from header
proc mf_head2num { tndx } {
    global mf mfp

    if {![string length $tndx]} {return ""}

    if {[regexp {[0-9][0-9]*} \
	[$mfp(head) get $tndx] ndx]} {
	return [string trim $ndx]
    } else {
	if {$mf(mail-debug)} {
	    puts stderr "Error getting message number on line $tndx"
	}
	return ""
    }
    
}

# process user specified deletions
proc mf_procdelete { } {
    global mf mfp

    set delmesg $mfp(delmesg)
    set mfp(delmesg) ""

    if {$mfp(fid) == ""} {return 0}
    if {![llength $delmesg]} {return 0}

    if {![mf_fmodcheck \
	    "Folder $mfp(file) has been externally modified. Delete marked messages?"]} {
	return -1
    }

    if {![string length $mfp(file)]} {return -1}

    mf_mailcmd res "d $delmesg" $mfp(fid)

    set ret [llength $delmesg]
    if {[string length $res] && [string first "eleting:" $res] == -1 &&
		      [string first "omplete" $res] == -1} {
        mf_mailerror "Error deleting messages. Mail's output: $res"
        return -1
    }
    return $ret
}

# safely quit tkmail
proc mf_quit { } {
    global mf mfp tk_version

    if {$mfp(fid) != ""} {
	if {[mf_procdelete] == -1} {
	    mf_killcmdpipe $mfp(fid)
	} else {
	    mf_closecmdpipe $mfp(fid)
	}
    }

    catch "exec rm $mfp(tfile)"
    if {$tk_version<3.3} {destroy .}
    exit
}

proc mf_cutedit { tw } {
    global mf mfp

    if {![mf_copyedit $tw]} return
    if {[catch "$tw delete sel.first sel.last"]} return
}

proc mf_copyedit { tw } {
    global mf mfp

    if {[winfo class $tw] == "Entry"} {
	if {[catch "$tw index sel.first" fndx]} {return 0}
	set lndx [$tw index sel.last]
	set mfp(cutbuffer) [$tw get]
	set mfp(cutbuffer) [string range $mfp(cutbuffer) $fndx $lndx]
    } else {
        if {[catch "$tw get sel.first sel.last" res]} {return 0}
	set mfp(cutbuffer) $res
    }
    return 1
}

proc mf_pasteedit { tw } {
    global mf mfp

    $tw insert insert $mfp(cutbuffer)
}

proc mf_getopts { cargs } {
    global mf mfp

    set cnt 0
    while {$cnt < [llength $cargs]} {
	set opt [lindex $cargs $cnt]
	case $opt {
	    { -i -iconic } { wm iconify $mfp(top) }
	    { -l -library } {
		incr cnt
		set opt [lindex $cargs $cnt]
		if {[file isdirectory $opt]} {
		    set mfp(tkmaillib) $opt
		} else {
		    puts stderr "Library directory $opt not found."
		}
	    }
	    { -g -global } {
		incr cnt
		set opt [lindex $cargs $cnt]
		if {[file exists $opt]} {
		    set mfp(globalset) $opt
		} else {
		    puts stderr "Global settings file $opt not found."
		}
	    }
	    { -p -personal } {
		incr cnt
		set opt [lindex $cargs $cnt]
		if {[file exists $opt]} {
		    set mfp(setfile) $opt
		} else {
		    puts stderr "Personal settings file $opt not found."
		}
	    }
	    { tkmail } { }
	    default { 
		if {[file exists $opt]} { 
		    set mfp(file) $opt
		} else {
		    puts stderr "Mail folder $opt not found."
		}
	    }
	}
	incr cnt 
    }
    
}

proc mf_waiton { } {
    global mf mfp

    foreach w $mfp(waitlist) {
	if {[set tcur [lindex [$w configure -cursor] 4]] != "watch"} {
            set mfp($w,cursor) $tcur
	    $w configure -cursor watch
	}
    }
    if {[winfo ismapped $mfp(top)]} {update idletasks}
}

proc mf_waitoff { } {
    global mf mfp

    foreach w $mfp(waitlist) {
	if {$mfp($w,cursor) != ""} {
	    $w configure -cursor $mfp($w,cursor)
        }
    }
    if {[winfo ismapped $mfp(top)]} {update idletasks}
}

proc mf_menucreate { m } {
    if {[winfo exists $m]} {
        $m delete 0 last
    } else {menu $m}
}

proc mf_buildfoldermenus { } {
    global mf mfp

    mf_waiton

    # setup menus of folders in user's folder directory
    if {$mfp(fmenulast) != [$mfp(top).menu.folder.m index last]} {
        $mfp(top).menu.folder.m delete [expr $mfp(fmenulast)+1] last
    }
    mf_menucreate $mfp(top).menu.mesg.m.copy
    mf_menucreate $mfp(top).menu.mesg.m.move
    mf_menucreate $mfp(top).bb.move.m

    if {$mf(menu-recent-max) > 0} {
	mf_menucreate $mfp(top).menu.folder.m.recent
	mf_menucreate $mfp(top).menu.mesg.m.copy.recent
	mf_menucreate $mfp(top).menu.mesg.m.move.recent
	mf_menucreate $mfp(top).bb.move.m.recent

	$mfp(top).menu.folder.m add cascade -label {Recent} \
	    -menu $mfp(top).menu.folder.m.recent
	$mfp(top).menu.mesg.m.copy add cascade -label {Recent} \
	    -menu $mfp(top).menu.mesg.m.copy.recent
	$mfp(top).menu.mesg.m.move add cascade -label {Recent} \
	    -menu $mfp(top).menu.mesg.m.move.recent
	$mfp(top).bb.move.m add cascade -label {Recent} \
	    -menu $mfp(top).bb.move.m.recent
    }

    if {[file isdirectory $mf(mail-directory)]} {

	$mfp(top).menu.mesg.m.move add command -label {<Sender>} \
	  -command {
	    global mf mfp
            if {$mfp(fromname) != ""} {
		mf_movemesg $mf(mail-directory)/$mfp(fromname)
	    } else {
		mf_mailerror "Could not determine filename to save to."
	    }
	  }
	$mfp(top).menu.mesg.m.move add separator
	$mfp(top).bb.move.m add command -label {<Sender>} \
	  -command {
	    global mf mfp
            if {$mfp(fromname) != ""} {
		mf_movemesg $mf(mail-directory)/$mfp(fromname)
	    } else {
		mf_mailerror "Could not determine filename to save to."
	    }
	  }
	$mfp(top).bb.move.m add separator
	$mfp(top).menu.mesg.m.copy add command -label {<Sender>} \
	  -command {
	    global mf mfp
            if {$mfp(fromname) != ""} {
		mf_copymesg $mf(mail-directory)/$mfp(fromname)
	    } else {
		mf_mailerror "Could not determine filename to save to."
	    }
	  }
	$mfp(top).menu.mesg.m.copy add separator

	mf_setfoldmenus $mf(mail-directory) "" -1

	$mfp(top).menu.mesg.m.move add separator
	$mfp(top).bb.move.m add separator
	$mfp(top).menu.mesg.m.copy add separator
    }

    $mfp(top).menu.mesg.m.move add command -label {Other . . .} \
      -command "ut_fsbox -okcmd mf_explicitmove -purpose Folder: -master $mfp(top)"
    $mfp(top).bb.move.m add command -label {Other . . .} \
      -command "ut_fsbox -okcmd mf_explicitmove -purpose Folder: -master $mfp(top)"
    $mfp(top).menu.mesg.m.copy add command -label {Other . . .} \
      -command "ut_fsbox -okcmd mf_explicitcopy -purpose Folder: -master $mfp(top)"

    mf_waitoff
}

proc mf_setfoldmenus { dir extmenu depth } {
    global mf mfp

    incr depth
    set dtmp [pwd]
    cd $dir
    set foldfiles [lsort [glob -nocomplain *]]
    set chopped 0
    if {[llength $foldfiles] > $mf(menu-folders-max)} {
	set foldfiles [lrange $foldfiles 0 $mf(menu-folders-max)]
	set chopped 1
    }

    set cnt 0
    foreach mfold $foldfiles {

      if {[lsearch $mf(menu-folders-ignore) $dir/$mfold] != -1} {
	  continue
      } elseif {[file isfile $mfold]} {
	 $mfp(top).menu.folder.m$extmenu add command -label $mfold \
	     -command "mf_setupfolder $dir/$mfold 1"
	 $mfp(top).menu.mesg.m.copy$extmenu add command -label $mfold \
	     -command "mf_copymesg $dir/$mfold"
	 $mfp(top).menu.mesg.m.move$extmenu add command -label $mfold \
	     -command "mf_movemesg $dir/$mfold"
	 $mfp(top).bb.move.m$extmenu add command -label $mfold \
	     -command "mf_movemesg $dir/$mfold"

      } elseif {[file isdirectory $mfold] && $depth < $mf(menu-depth-max) } {

	 mf_menucreate $mfp(top).menu.folder.m${extmenu}.f$cnt
	 $mfp(top).menu.folder.m$extmenu add cascade \
	     -label $mfold \
	     -menu $mfp(top).menu.folder.m${extmenu}.f$cnt

	 mf_menucreate $mfp(top).menu.mesg.m.copy${extmenu}.f$cnt
	 $mfp(top).menu.mesg.m.copy$extmenu add cascade \
	     -label $mfold \
	     -menu $mfp(top).menu.mesg.m.copy${extmenu}.f$cnt

	 mf_menucreate $mfp(top).menu.mesg.m.move${extmenu}.f$cnt
	 $mfp(top).menu.mesg.m.move$extmenu add cascade \
	     -label $mfold \
	     -menu $mfp(top).menu.mesg.m.move${extmenu}.f$cnt

	 mf_menucreate $mfp(top).bb.move.m${extmenu}.f$cnt
	 $mfp(top).bb.move.m$extmenu add cascade \
	     -label $mfold \
	     -menu $mfp(top).bb.move.m${extmenu}.f$cnt

	 mf_setfoldmenus $dir/$mfold ${extmenu}.f$cnt $depth
	 incr cnt
      }
   }

   if {$chopped} {
	 $mfp(top).menu.folder.m$extmenu add command -label "+++ chopped +++" \
	     -command "ut_fsbox -okcmd mf_explicitopen -purpose Folder: \
		   -master $mfp(top) -okargs 1 -dir $dir"
	 $mfp(top).menu.mesg.m.copy$extmenu add command -label "+++ chopped +++" \
	     -command "ut_fsbox -okcmd mf_explicitcopy -purpose Folder: \
		   -master $mfp(top) -dir $dir"
	 $mfp(top).menu.mesg.m.move$extmenu add command -label "+++ chopped +++" \
	     -command "ut_fsbox -okcmd mf_explicitmove -purpose Folder: \
		   -master $mfp(top) -dir $dir"
	 $mfp(top).bb.move.m$extmenu add command -label "+++ chopped +++" \
	     -command "ut_fsbox -okcmd mf_explicitmove -purpose Folder: \
		   -master $mfp(top) -dir $dir"
   }

   cd $dtmp
}

proc mf_addrecent { file } {
    global mf mfp

    if {![winfo exists $mfp(top).menu.folder.m.recent] || \
        ![file isfile $file] || \
	$file == $mf(mail-mbox)} {return 0}

    if {[set ndx [lsearch $mfp(recentlist) $file]] > -1} {
        set mfp(recentlist) [lreplace $mfp(recentlist) $ndx $ndx]
    }

    set mfp(recentlist) [lrange [linsert $mfp(recentlist) 0 $file] \
	0 [expr $mf(menu-recent-max)-1]]

    $mfp(top).menu.folder.m.recent delete 0 last
    $mfp(top).menu.mesg.m.copy.recent delete 0 last
    $mfp(top).menu.mesg.m.move.recent delete 0 last
    $mfp(top).bb.move.m.recent delete 0 last

    foreach folder $mfp(recentlist) {
	set mfold [file tail $folder]
	$mfp(top).menu.folder.m.recent add command -label $mfold \
	    -command "mf_setupfolder $folder 1"
	$mfp(top).menu.mesg.m.copy.recent add command -label $mfold \
	    -command "mf_copymesg $folder"
	$mfp(top).menu.mesg.m.move.recent add command -label $mfold \
	    -command "mf_movemesg $folder"
	$mfp(top).bb.move.m.recent add command -label $mfold \
	    -command "mf_movemesg $folder"
    }
}

proc mf_logmessage { str } {
    global mf mfp
    set w $mfp(top)_log

    if { ![winfo exists $w] } {
        ut_simpletext -name $w -title {Message Log} -leftscroll $mf(disp-left-scroll)
	if {$mf(menu-key) != ""} {
	    bind $w.txt $mf(menu-key)<KeyPress-c> "$w.bb.btn0 invoke"
        }
	wm withdraw $w
    }
    $mfp(mstat) configure -text $str
    $w.txt configure -state normal
    $w.txt insert end "$str\n"

}

proc mf_detachmsg { } {
  global mf mfp

  set cnt 0
  while {[winfo exists .mfd${cnt}]} {incr cnt}
  set w .mfd${cnt}
  ut_simpletext -name $w -title $mfp(cursubj) -leftscroll $mf(disp-left-scroll) \
      -buttons { {Close destroy} }
  $w.txt insert end [$mfp(mesg) get 1.0 end]
}

proc mf_adjheadlist { amount } {
  global mf mfp
  set tmp [expr [lindex [$mfp(head) configure -height] 4]+$amount]
  if {$tmp > 3} {
    $mfp(head) configure -height $tmp
  }
}

######### MAIN ##################

wm withdraw .

toplevel $mfp(top) -class TkMail
wm iconname $mfp(top) "TkMail"
wm title $mfp(top) "TkMail v$mfp(version)"
wm minsize $mfp(top) 400 400
wm protocol $mfp(top) WM_DELETE_WINDOW mf_quit

# load packages we definitely need and auto_load rest
source $mfp(tkmaillib)/disjoint.tk
source $mfp(tkmaillib)/bindings.tk
source $mfp(tkmaillib)/parse.tk
source $mfp(tkmaillib)/mailcmd.tk
# source $mfp(tkmaillib)/mailcmd2.tk
source $mfp(tkmaillib)/utils.tk

# get options from command line
mf_getopts $argv

# read in defaults settings
mf_defaultstart
mf_defaultset

# read in global settings file
if {[file exists $mfp(globalset)]} {
    source $mfp(globalset)
}

# read user defaults file before running any real code
if {[file exists $mfp(setfile)] && $mfp(setfile) != ""} {
    source $mfp(setfile)
} elseif {[file exists $env(HOME)/.tkmail]} {
    source $env(HOME)/.tkmail
    set mfp(setfile) $env(HOME)/.tkmail
} elseif {[file exists $env(HOME)/.tk/tkmail]} {
    source $env(HOME)/.tk/tkmail
    set mfp(setfile) $env(HOME)/.tk/tkmail
}

if {[info exists mf(mbox)] || [info exists mf(fdir)] || \
	[info exists mf(prefix)] || [info exists mf(system)]} {
    puts stderr "It appears that your $mfp(setfile) contains pre-TkMail v1.6 setting names."
    puts stderr "A sed script called newvar.sed should exist in $mfp(tkmaillib)"
    puts stderr "that can be used to update your settings file. To use it, type"
    puts stderr "    sed -f newvar.sed ~/.tkmail > tkmail.new"
    puts stderr "Check the new settings and file and then copy it over the old one."
    if {$tk_version<3.3} {destroy .}
    exit
}

if {[info exists auto_path]} {
    lappend auto_path $mfp(tkmaillib)
} else {
    set auto_path $mfp(tkmaillib)
}

# set binding options
set btp(prefix) $mf(insert-prefix)
set btp(error) mf_mailerror
set btp(beep) $mf(viewer-beep-error)

# read in aliases
mf_parsealiasfile

# checks
if {![string length $mf(insert-prefix)]} {
    puts stderr "Zero length mail prefix unacceptable!"
    return 1
}

# create temp text widget for use
text $mfp(top).tmptxt

frame $mfp(top).menu -relief raised
menubutton $mfp(top).menu.folder -text {Folder} -menu $mfp(top).menu.folder.m
menubutton $mfp(top).menu.edit -text {Edit} -menu $mfp(top).menu.edit.m
menubutton $mfp(top).menu.mesg -text {Mesg} -menu $mfp(top).menu.mesg.m
menubutton $mfp(top).menu.mail -text {Mail} -menu $mfp(top).menu.mail.m
menubutton $mfp(top).menu.opt  -text {Options} -menu $mfp(top).menu.opt.m
menubutton $mfp(top).menu.help -text {Help} -menu $mfp(top).menu.help.m

menu $mfp(top).menu.folder.m
$mfp(top).menu.folder.m add command -label {Open . . .} -accelerator {[o]} \
    -command "ut_fsbox -okcmd mf_explicitopen -purpose Folder: \
		-master $mfp(top) -okargs 1"
$mfp(top).menu.folder.m add command -label {Quit} -accelerator {[q]} \
    -command "mf_quit"
$mfp(top).menu.folder.m add separator
$mfp(top).menu.folder.m add command -label {Main Box} -accelerator {[b]} \
    -command "mf_setupfolder \$mf(mail-mbox) 1"
$mfp(top).menu.folder.m add command -label {Incorporate New Mail} -accelerator {[i]} \
    -command "mf_incorporate"
$mfp(top).menu.folder.m add command -label {Process Deletes}  -accelerator {[x]} \
    -command {
	global mfp
	if {[llength $mfp(delmesg)]} {
	    set tmp "Deleted [llength $mfp(delmesg)] messages from $mfp(file)"
	    set ndx [$mfp(head) cursingle]
	    if {![string length $ndx]} {set ndx 0}
	    if {[mf_procdelete] == -1} {
		mf_killcmdpipe $mfp(fid)
		set mfp(fid) [mf_getcmdpipe $mfp(file)]
		set tmp "Aborted delete and restored from $mfp(file)"
            }
            mf_setupfolder $mfp(file) [expr $ndx+1]
    	    mf_logmessage $tmp
	}
    }
$mfp(top).menu.folder.m add command -label {Rebuild Folder Menus} \
    -command "mf_buildfoldermenus"
$mfp(top).menu.folder.m add command -label {Reread Alias File} \
    -command "mf_parsealiasfile"
$mfp(top).menu.folder.m add separator
set mfp(fmenulast) [$mfp(top).menu.folder.m index last]

menu $mfp(top).menu.edit.m
$mfp(top).menu.edit.m add command -label {Cut} \
    -command "mf_cutedit $mfp(top).mesg.txt"
$mfp(top).menu.edit.m add command -label {Copy} \
    -command "mf_copyedit $mfp(top).mesg.txt"
$mfp(top).menu.edit.m add command -label {Paste} \
    -command "mf_pasteedit $mfp(top).mesg.txt"
$mfp(top).menu.edit.m add separator
$mfp(top).menu.edit.m add command -label {Search Mesg . . .} \
    -command "mf_searchtxt $mfp(mesg) 1 0"
$mfp(top).menu.edit.m add command -label {Search Headers . . .} \
    -command "mf_searchtxt $mfp(head) 1 1"
$mfp(top).menu.edit.m add command -label {Search Again} \
    -command "mf_searchtxt $mfp(mesg) 0 0"
$mfp(top).menu.edit.m add separator
$mfp(top).menu.edit.m add command -label {Save X Selection . . .} \
    -command "ut_fsbox -okcmd mf_save -okargs sel -purpose File: \
		master $mfp(top)"
$mfp(top).menu.edit.m add command -label {Print X Selection . . .} \
    -command {mf_print sel}
$mfp(top).menu.edit.m add command -label {TCL Evaluate X Sel} \
    -command {
	if {[catch {eval [selection_if_any]} res]} {
            mf_mailerror $res
            return 0
        }
    }
$mfp(top).menu.edit.m add command -label {UNIX Pipe X Sel . . .} \
    -command "mf_pipesel $mfp(top).mesg.txt"

menu $mfp(top).menu.mesg.m
$mfp(top).menu.mesg.m add command -label {Next} -accelerator {[n]} \
    -command {
	if {[set ndx [$mfp(head) cursingle]] < [expr [$mfp(head) size]-1]} {
	    mf_selmesg from [expr $ndx+1]
	}
    }
$mfp(top).menu.mesg.m add command -label {Prev} -accelerator {[p]} \
    -command {
	if {[set ndx [$mfp(head) cursingle]] > 0} {
	    mf_selmesg from [expr $ndx-1]
	}
    }
$mfp(top).menu.mesg.m add command -label {Delete} -accelerator {[d]} \
    -command "mf_delmesg"
$mfp(top).menu.mesg.m add command -label {Undelete All} -accelerator {[u]} \
    -command "mf_undelete"
$mfp(top).menu.mesg.m add cascade -label {Copy} -accelerator {[y]} \
    -menu $mfp(top).menu.mesg.m.copy
$mfp(top).menu.mesg.m add cascade -label {Move} -accelerator {[m]} \
    -menu $mfp(top).menu.mesg.m.move
$mfp(top).menu.mesg.m add separator
$mfp(top).menu.mesg.m add command -label {Save . . .} -accelerator {[s]} \
    -command "ut_fsbox -okcmd mf_explicitsave -okargs mesg -purpose File: \
		-master $mfp(top)"
$mfp(top).menu.mesg.m add command -label {Print . . .} -accelerator {[r]} \
    -command {mf_print mesg}
$mfp(top).menu.mesg.m add separator
$mfp(top).menu.mesg.m add command -label {Detach} -command "mf_detachmsg"
$mfp(top).menu.mesg.m add command -label {Split} \
    -command "pack after $mfp(top).mesg $mfp(top).mesg2 {top expand fill}; \
	      $mfp(top).mesg2.txt delete 1.0 end; \
	      $mfp(top).mesg2.txt insert end \[$mfp(top).mesg.txt get 1.0 end\]"
$mfp(top).menu.mesg.m add command -label {Unsplit} \
    -command "pack unpack $mfp(top).mesg2"
$mfp(top).menu.mesg.m add command -label {Quick Decode} \
    -command "mf_quickdecode $mfp(top).mesg.txt"

menu $mfp(top).menu.mail.m
$mfp(top).menu.mail.m add command -label {Compose} -accelerator {[C]} \
    -command {mf_compose {} {} $mfp(curnum) }
$mfp(top).menu.mail.m add command -label {Reply} -accelerator {[R]} \
    -command {global mfp; mf_reply $mfp(curfrom) 0}
$mfp(top).menu.mail.m add command -label {Forward} -accelerator {[F]} \
    -command {
	global mf mfp
	if {$mf(compose-quick-forward)} {
	    mf_forward
	} else {
	    mf_reply {} 3
	}
    }
$mfp(top).menu.mail.m add separator
$mfp(top).menu.mail.m add command -label {Gripe} \
    -command {
	global mf mfp
	$mfp(tmptxt) delete 1.0 end
	$mfp(tmptxt) insert end "TkMail version: $mfp(version)\n\n"
	catch "$mfp(tmptxt) insert end \"Macine/OS: [exec uname -a]\n\""
	catch "$mfp(tmptxt) insert end \"Tk Version: $tk_version\n\n\""
	catch "$mfp(tmptxt) insert end \"Version: $mfp(version)\n\n\""
	foreach name [array names mf] {
	    set val [eval "set mf($name)"]
	    $mfp(tmptxt) insert end "  mf($name) {$val}\n"
	}
	$mfp(tmptxt) insert end "------------------------------------\n"
	mf_compose raines@bohr.physics.upenn.edu "TkMail Gripe" \
	    $mfp(curnum) {} {} 2
    }
$mfp(top).menu.mail.m add command -label {Restore Last} \
    -command {mf_compose {} {} $mfp(curnum) $mfp(savesendtxt) {} 4}

menu $mfp(top).menu.opt.m
$mfp(top).menu.opt.m add checkbutton -label "Reverse Order" \
    -variable mf(headlist-reverse) -command {
	global mfp
        mf_setupfolder $mfp(file) 1
        }
$mfp(top).menu.opt.m add checkbutton -label "Format Headers" \
    -variable mf(headlist-format) -command {
        global mfp
	set ndx [$mfp(head) cursingle]
	if {![string length $ndx]} {set ndx 0}
        mf_setupfolder $mfp(file) [expr $ndx+1]
        }
$mfp(top).menu.opt.m add checkbutton -label "Auto-incorporate" \
    -variable mf(mail-auto-incorp)
$mfp(top).menu.opt.m add checkbutton -label "Save Last Compose" \
    -variable mf(compose-save-send)
$mfp(top).menu.opt.m add checkbutton -label "Ask on Long Mesg" \
    -variable mf(mail-read-ask)
$mfp(top).menu.opt.m add checkbutton -label "Full Addr for <Sender>" \
    -variable mf(menu-seneder-full)
$mfp(top).menu.opt.m add checkbutton -label "Strip Header on Insert" \
    -variable mf(insert-strip)
$mfp(top).menu.opt.m add checkbutton -label "Parse MIME:" \
    -variable mf(header-mime) -command {
	global mfp
	mf_dispmesg $mfp(curnum)
	}
$mfp(top).menu.opt.m add separator
$mfp(top).menu.opt.m add command -label "All Settings . . ." \
    -command { mf_dispopt }

# SETUP HELP MENU
menu $mfp(top).menu.help.m
$mfp(top).menu.help.m add command -label {Intro} -command "mf_disphelp TOP" \
    -accelerator {[h]}

set mfp(readme) [list "COMPATIBILITY" "GENERAL USAGE" "ALIASES" \
	"MOUSE BINDINGS" "KEY BINDINGS" "READER MENU" "COMPOSE MENU" \
	"PRINTING" "HEADER FIELD STRIPPING" "CC, BCC, and FCC" \
	"SETTINGS" "WIDGET CONFIGURATION" "IMPLEMENTATION NOTES" "BUGS" \
	"TODO" "COPYRIGHT" "DISCLAIMER"]

foreach topic $mfp(readme) {
    $mfp(top).menu.help.m add command -label [string tolower $topic] \
	    -command "mf_disphelp \{$topic\}"
}
$mfp(top).menu.help.m add separator
$mfp(top).menu.help.m add command -label {Show Log} \
	-command "mf_showlog"

# PACK MENU
pack append $mfp(top).menu $mfp(top).menu.folder {left} \
    $mfp(top).menu.edit {left} $mfp(top).menu.mesg {left} \
    $mfp(top).menu.mail {left} $mfp(top).menu.opt {left} \
    $mfp(top).menu.help {right}

# HEADLIST STATUS LINE
frame $mfp(top).stat
label $mfp(top).stat.folder -relief raised -anchor w -width 30
label $mfp(top).stat.mesg -relief raised
button $mfp(top).stat.grow -text {+} -command "mf_adjheadlist 1"
bind $mfp(top).stat.grow <ButtonRelease-3> \
    "tk_butUp3 %W; mf_adjheadlist 5"
button $mfp(top).stat.shrink -text {-} -command "mf_adjheadlist -1"
bind $mfp(top).stat.shrink <ButtonRelease-3> \
    "tk_butUp3 %W; mf_adjheadlist -5"
pack append $mfp(top).stat $mfp(top).stat.folder {left} \
    $mfp(top).stat.mesg {left expand fillx} \
    $mfp(top).stat.grow {left} $mfp(top).stat.shrink {left}

frame $mfp(top).head
scrollbar $mfp(top).head.yscroll -command "$mfp(head) yview" \
	  -relief raised
disjointlistbox $mfp(head) -yscroll "$mfp(top).head.yscroll set" \
    -wrap none -cursor left_ptr -relief sunken

bind $mfp(head) <Any-KeyPress> " "
bind $mfp(head) <Button-1> \
    "mf_selmesg from \[$mfp(head) nearest %y\] 1 %b"
bind $mfp(head) <B1-Motion> \
    "mf_selmesg to \[$mfp(head) nearest %y\] 1 %b"
bind $mfp(head) <Button-3> \
    "mf_selmesg at \[$mfp(head) nearest %y\] 1 %b"
bind $mfp(head) <B3-Motion> \
    "mf_selmesg at \[$mfp(head) nearest %y\] 1 %b"
bind $mfp(head) <Shift-1> \
    "mf_selmesg toggle \[$mfp(head) nearest %y\] 1 %b"
bind $mfp(head) <Control-1> \
    "mf_selmesg to \[$mfp(head) nearest %y\] 1 %b"
bind $mfp(head) <Control-B1-Motion> \
    "mf_selmesg to \[$mfp(head) nearest %y\] 1 %b"

set mfp(b2-time) 0
set mfp(b2-y) 0
bind $mfp(head) <Button-2> {
    global mfp
    %W scan mark %x %y
    set mfp(b2-time) %t
    set mfp(b2-y) %y
}
bind $mfp(head) <ButtonRelease-2> {
    global mfp
    if {[expr %t-$mfp(b2-time)]<1000} {
	mf_selmesg clear [$mfp(head) nearest $mfp(b2-y)] 0
    }
}

frame $mfp(top).bb
button $mfp(top).bb.incorp -text "Incorp" \
	-command "$mfp(top).menu.folder.m invoke 4"
button $mfp(top).bb.save -text "Save" -command "$mfp(top).menu.mesg.m invoke 7"
menubutton $mfp(top).bb.move -text {Move} -menu $mfp(top).bb.move.m \
	-relief raised
button $mfp(top).bb.del -text "Delete" -command "$mfp(top).menu.mesg.m invoke 2"
button $mfp(top).bb.comp -text "Compose" -command "$mfp(top).menu.mail.m invoke 0"
button $mfp(top).bb.reply -text "Reply" -command "$mfp(top).menu.mail.m invoke 1"
button $mfp(top).bb.detach -text "Split" -command "$mfp(top).menu.mesg.m invoke Split*"
# button $mfp(top).bb.forw -text "Forward" -command "$mfp(top).menu.mail.m invoke 2"
button $mfp(top).bb.quit -text "Quit" -command "$mfp(top).menu.folder.m invoke 1"

bind Button <2> {tk_butDown %W}
bind Button <ButtonRelease-2> {tk_butUp3 %W}
bind Button <3> {tk_butDown %W}
bind Button <ButtonRelease-3> {tk_butUp3 %W}
proc tk_butUp3 w {
    global tk_priv
    $w config -relief $tk_priv(relief)
}

# include message with no prefix, no address
bind $mfp(top).bb.comp <ButtonRelease-2> {tk_butUp3 %W; mf_reply {} 3}

# include message with no prefix, with address
bind $mfp(top).bb.reply <ButtonRelease-2> \
	{global mfp; tk_butUp3 %W; mf_reply $mfp(curfrom) 3}

# detach current message
bind $mfp(top).bb.detach <ButtonRelease-2> "tk_butUp3 %W; $mfp(top).menu.mesg.m invoke Detach*"
  
# include message with prefix, no address
bind $mfp(top).bb.comp <ButtonRelease-3> \
	{tk_butUp3 %W; mf_reply {} 1}

# include message with prefix, with address
bind $mfp(top).bb.reply <ButtonRelease-3> {global mfp; tk_butUp3 %W; mf_reply $mfp(curfrom) 1}

# unsplit current viewer
bind $mfp(top).bb.detach <ButtonRelease-3> "tk_butUp3 %W; $mfp(top).menu.mesg.m invoke Unsplit*"
  
pack append $mfp(top).bb $mfp(top).bb.incorp {left expand fill} \
    $mfp(top).bb.save {left expand fill} \
    $mfp(top).bb.move {left expand fill} \
    $mfp(top).bb.del {left expand fill} \
    $mfp(top).bb.comp {left expand fill} \
    $mfp(top).bb.reply {left expand fill} \
    $mfp(top).bb.detach {left expand fill} \
    $mfp(top).bb.quit {left expand fill}

frame $mfp(top).mesg
scrollbar $mfp(top).mesg.yscroll -command "$mfp(top).mesg.txt yview" \
	  -relief raised
text $mfp(top).mesg.txt -yscroll "$mfp(top).mesg.yscroll set" \
    -relief sunken -bd 2

# set menu state key
if {$mf(menu-key) != ""} {
    bind Text $mf(menu-key) { }
    bind Text $mf(menu-key)<Any-KeyPress> {
	global mf
	if {"%A" != ""} {eval $mf(viewer-beep-error) }
    }
}

bind $mfp(top).mesg.txt $mf(menu-key)<KeyPress-o> "$mfp(top).menu.folder.m invoke {Open*}"
bind $mfp(top).mesg.txt $mf(menu-key)<KeyPress-q> "$mfp(top).menu.folder.m invoke {Quit}"
bind $mfp(top).mesg.txt $mf(menu-key)<KeyPress-b> "$mfp(top).menu.folder.m invoke {Main*}"
bind $mfp(top).mesg.txt $mf(menu-key)<KeyPress-i> "$mfp(top).menu.folder.m invoke {Incor*}"
bind $mfp(top).mesg.txt $mf(menu-key)<KeyPress-x> "$mfp(top).menu.folder.m invoke {Proc*}"
bind $mfp(top).mesg.txt $mf(menu-key)<KeyPress-n> "$mfp(top).menu.mesg.m invoke {Next}"
bind $mfp(top).mesg.txt $mf(menu-key)<KeyPress-p> "$mfp(top).menu.mesg.m invoke {Prev}"
bind $mfp(top).mesg.txt $mf(menu-key)<KeyPress-d> "$mfp(top).menu.mesg.m invoke {Delete}"
bind $mfp(top).mesg.txt $mf(menu-key)<KeyPress-u> "$mfp(top).menu.mesg.m invoke {Undel*}"
bind $mfp(top).mesg.txt $mf(menu-key)<KeyPress-y> \
    "ut_fsbox -okcmd mf_copymesg -purpose Folder: -master $mfp(top)"
bind $mfp(top).mesg.txt $mf(menu-key)<KeyPress-m> \
    "ut_fsbox -okcmd mf_movemesg -purpose Folder: -master $mfp(top)"
bind $mfp(top).mesg.txt $mf(menu-key)<KeyPress-s> "$mfp(top).menu.mesg.m invoke {Save*}"
bind $mfp(top).mesg.txt $mf(menu-key)<KeyPress-r> "$mfp(top).menu.mesg.m invoke {Print*}"
bind $mfp(top).mesg.txt $mf(menu-key)<KeyPress-C> "$mfp(top).menu.mail.m invoke {Compose}"
bind $mfp(top).mesg.txt $mf(menu-key)<KeyPress-R> "$mfp(top).menu.mail.m invoke {Reply}"
bind $mfp(top).mesg.txt $mf(menu-key)<KeyPress-F> "$mfp(top).menu.mail.m invoke {Forward}"
bind $mfp(top).mesg.txt $mf(menu-key)<KeyPress-h> "$mfp(top).menu.help.m invoke 0"

frame $mfp(top).mesg2
scrollbar $mfp(top).mesg2.yscroll -command "$mfp(top).mesg2.txt yview" \
    -relief raised
text $mfp(top).mesg2.txt -yscroll "$mfp(top).mesg2.yscroll set" \
    -relief sunken -bd 2

pack append $mfp(top) $mfp(top).menu {top fillx} \
    $mfp(top).stat {top fillx} \
    $mfp(top).head {top fillx} \
    $mfp(top).bb {top fillx} \
    $mfp(top).mesg {top expand fill}

# setup better bindings
bind_motiftext Text
bind_motifentry Entry

bind Text <Shift-Control-KeyPress-S> \
	"mf_searchtxt %W 1"
bind Text <Control-KeyPress-s> \
	"mf_searchtxt %W 0"

if {$mf(bind-emacs)} {
    bind_emacstext Text
    bind_emacsentry Entry
    bind Text <Control-Shift-Y> "mf_selprefix %W emacs"
} else {
    bind Text <Meta-KeyPress-x> "mf_cutedit %W"
    bind Text <Meta-KeyPress-c> "mf_copyedit %W"
    bind Text <Meta-KeyPress-v> "mf_pasteedit %W"
    bind Text <Shift-Meta-KeyPress-V> "mf_selprefix %W cutb"

    bind Entry <Meta-KeyPress-x> "mf_cutedit %W"
    bind Entry <Meta-KeyPress-c> "mf_copyedit %W"
    bind Entry <Meta-KeyPress-v> "mf_pasteedit %W"
}

bind Text <Shift-Meta-Button-2> "mf_selprefix %W xsel"

###################################################################

# configure widgets to user settings
$mfp(head) configure -height $mf(headlist-height)
eval "$mfp(mesg) tag configure headers $mf(header-config)"
    
if {$mf(disp-left-scroll)} {
    pack append $mfp(top).head $mfp(top).head.yscroll {left filly} \
	$mfp(head) {expand fill}
    pack append $mfp(top).mesg $mfp(top).mesg.yscroll {left filly} \
	$mfp(top).mesg.txt {expand fill}
    pack append $mfp(top).mesg2 $mfp(top).mesg2.yscroll {left filly} \
	$mfp(top).mesg2.txt {expand fill}
} else {
    pack append $mfp(top).head $mfp(head) {left expand fill} \
	$mfp(top).head.yscroll {left filly}
    pack append $mfp(top).mesg $mfp(top).mesg.txt {left expand fill} \
	$mfp(top).mesg.yscroll {left filly}
    pack append $mfp(top).mesg2 $mfp(top).mesg2.txt {left expand fill} \
	$mfp(top).mesg2.yscroll {left filly}
}

# append mf(menu-quick-send) contents to Mesg menu
if {[llength $mf(menu-quick-send)] != 0 } {
    $mfp(top).menu.mail.m add separator
    foreach addr $mf(menu-quick-send) {
        $mfp(top).menu.mail.m add command -label $addr \
            -command "mf_compose $addr {} $mfp(curnum)"
    }
}

mf_buildfoldermenus

tk_autoMenuBar $mfp(top).menu

wm geometry $mfp(top) $mf(viewer-geom)
if {[file exists $mf(viewer-bitmap-nomail)]} {
    wm iconbitmap $mfp(top) "@$mf(viewer-bitmap-nomail)"
}

# source users mf_viewer_hook procedure if defined
if {[info procs mf_viewer_hook] == "mf_viewer_hook"} {
    mf_viewer_hook $mfp(top)
}

if {$mfp(file)==""} { set mfp(file) $mf(mail-mbox) }
#check for lock file
if {[file exists $mfp(file).lock] || [file exists $mfp(file).rolock]} {
    puts stderr "A lock file exists on $mfp(file). This must be removed"
    puts stderr "before tkmail can run. The name of this file is either"
    puts stderr "$mfp(file).lock or $mfp(file).rolock"
    if {$tk_version<3.3} {destroy .}
    exit
}

set mfp(fid) ""
if {![mf_setupfolder $mfp(file) 1]} {
    if {$tk_version<3.3} {destroy .}
    exit
}
mf_schedule

if {[file isdirectory $mf(mail-directory)]} {cd $mf(mail-directory)}
focus $mfp(top).mesg.txt


# Local Variables: ***
# mode:tcl ***
# End: ***
