# mail.tk - support file for TkMail (accessed through tclIndex)
#	    commands for user operations on mail
#
# $Header: /u/ra/raines/cvs/tk/tkmail2/mail.tk,v 1.9 1995/12/14 00:49:40 raines Exp $
if $mfp(debug) {puts stderr "mail.tk sourced"}

proc mfv:insert-prefix { str {prefix {}} } {
  # insert prefix at beginning of lines of text string <str>
  global mf mfp
  
  if {![string length $prefix]} {
    set prefix $mf(insert-prefix)
  }

  set cmpl 0
  set tndx [expr [string length $str]-1]
  if {[string index $str $tndx] == "\n"} {
    set str [string range $str 0 [expr $tndx-1]]
    set cmpl 1
  }
  
  set str2 ""
  foreach line [split $str "\n"] {
    lappend str2 "$prefix$line"
  }
  
  if {$cmpl} {
    lappend str2 ""
  }
  return [join $str2 "\n"]
  
}

proc mfv:prefix-sel { tw {type xsel} } {
  # insert into text widget <tw> current selection of <type> xsel or emacs with prefix
  global mf mfp
  
  if { $type == "emacs" } {
    set str [tkTextGetBufferText 1]
  } else  {
    set str [selection_if_any]
  }
  tkTextInsert $tw insert [mfv:insert-prefix $str]
}

proc mfv:quick-decode { tw } {
  # scan text widget <tw> for uuencoded files and decode them
  global mf mfp env
  
  set top [winfo toplevel $tw]
  set dcnt 0
  set files ""
  set endx 1.0
  set olddir [pwd]
  mfv:wait-on

  set endx 1.0
  while {[set bndx \
	  [$tw search -regexp {^begin [0-9]* } $endx end]] != ""} {
    incr dcnt
    set endx [$tw search -regexp "^end" $bndx end]
    if {$endx == ""} {
      mfv:error-mesg "Can't find uuencode ending." [winfo toplevel $tw]
      mfv:wait-off
      cd $olddir
      return 0
    }
    set bndx [$tw index "$bndx linestart"]
    set endx [$tw index "$endx lineend + 1 c"]
    
    cd $mf(viewer-pipe-dir)
    set cmd "exec uudecode << \\\[$tw get $bndx $endx\\\]"
    if {[catch "eval $cmd" res]} {
      mfv:error-mesg $res $top
      mfv:wait-off
      cd $olddir
      return 0
    }
        
    lappend files [lrange [$tw get $bndx "$bndx lineend"] 2 end]
  }
  
  if {$dcnt == 0} {
    mfv:error-mesg "Can't find uuencode beginning." [winfo toplevel $tw]
    mfv:wait-off
    cd $olddir
    return 0
  } else {
    mfv:log-mesg [winfo toplevel $tw] "Uudecoded $dcnt files: $files"
  }
  mfv:wait-off
  cd $olddir
  return 1
}

proc mfv:search-prompt { top } {
  global mf mfp
  set top [winfo toplevel $top]
  set topclass [winfo class $top]
  set w ${top}_search
  set savefocus [focus]
  
  if { ![winfo exists $w] } {

    toplevel $w -class MailSearch
    wm title $w "TkMail v$mfp(version) Text Search"
    wm minsize $w 220 80
    wm protocol $w WM_DELETE_WINDOW "wm withdraw $w"
    wm withdraw $w

    set mfp($top,search,case) 0
    set mfp($top,search,regexp) 0
    set mfp($top,search,back) 0

    frame $w.str
    label $w.str.lbl -text "Search for:" -width 15 -anchor e
    entry $w.str.ent -relief sunken
    pack $w.str.lbl -side left -pady 10 
    pack $w.str.ent -side left -expand true -fill x -padx 10 -pady 10

    if {$topclass == "MailCompose" || $topclass == "UTSimpleText"} {
      frame $w.repl
      label $w.repl.lbl -text "Replace with:" -width 15 -anchor e
      entry $w.repl.ent -relief sunken
      pack $w.repl.lbl -side left -pady 10
      pack $w.repl.ent -side left -expand true -fill x -padx 10 -pady 10
    }

    frame $w.mod
    checkbutton $w.mod.case -text "Case insensitive" \
	-variable mfp($top,search,case) -width 20 -relief flat
    checkbutton $w.mod.regexp -text "Regular expression" \
	-variable mfp($top,search,regexp) -width 20 -relief flat
    checkbutton $w.mod.back -text "Backward" \
	-variable mfp($top,search,back) -width 20 -relief flat
    pack $w.mod.case $w.mod.regexp $w.mod.back -side left -pady 10

    frame $w.bb
    button $w.bb.search -text "Search" -width 10 \
	-command "mfv:search $top $w"
    bind $w.str.ent <Return> "$w.bb.search invoke"
    if {$topclass == "MailCompose" || $topclass == "UTSimpleText"} {
      button $w.bb.replace -text "Replace" -width 10 \
	  -command "mfv:replace $top $w"
      button $w.bb.repl_all -text "Replace All" -width 10 \
	  -command "while {\[mfv:replace $top $w\]} { }"
    }
    button $w.bb.home -text "Reset" -width 10 \
	-command "mfv:search-home $top"
    button $w.bb.dismiss -text "dismiss" -width 10 \
	-command "wm withdraw $w; catch {focus $savefocus}"

    if {$topclass == "MailCompose" || $topclass == "UTSimpleText"} {

      if {$topclass == "MailCompose"} {
	  set mfp($top,search,where) $top.comp.txt
      } else {
	  set mfp($top,search,where) $top.txt
      }
      pack $w.bb.search $w.bb.replace $w.bb.repl_all \
	  $w.bb.home $w.bb.dismiss -side left -padx 5 -pady 5

      pack $w.str $w.repl -side top -expand true -fill x -padx 10
      pack $w.mod $w.bb -side top

      set wlist [list $w.str.ent $w.repl.ent $w.mod.case \
	       $w.mod.regexp $w.mod.back $w.bb.search \
	       $w.bb.replace $w.bb.repl_all $w.bb.home \
	       $w.bb.dismiss]

      foreach subw $wlist {
	mfv:bind-menu-key $subw c "$w.mod.case invoke"
	mfv:bind-menu-key $subw r "$w.mod.regexp invoke"
	mfv:bind-menu-key $subw b "$w.mod.back invoke"
      }

    } else {
      pack $w.bb.search $w.bb.home $w.bb.dismiss -side left -padx 15 -pady 15
      set mfp($top,search,where) $top.$mfp(mesg)

      frame $w.where1
      radiobutton $w.where1.mesg -text "current Message" -anchor w \
	  -variable mfp($top,search,where) -value $top.$mfp(mesg) -width 20
      radiobutton $w.where1.head -text "header List" -anchor w \
	  -variable mfp($top,search,where) -value $top.$mfp(head)_text -width 20
      pack $w.where1.mesg $w.where1.head -side left
      frame $w.where2
      radiobutton $w.where2.folder -text "current Folder" -anchor w \
	  -variable mfp($top,search,where) -value folder -width 20 \
	  -state disabled
      radiobutton $w.where2.mdir -text "mail Directory" -anchor w \
	  -variable mfp($top,search,where) -value mdir -width 20 \
	  -state disabled
      pack $w.where2.folder $w.where2.mdir -side left

      pack $w.str -side top -expand true -fill x -padx 10
      pack $w.where1 $w.where2 $w.mod $w.bb -side top

      set wlist [list $w.str.ent $w.where1.mesg $w.where1.head \
		     $w.where2.folder $w.where2.mdir $w.mod.case \
		     $w.mod.regexp $w.mod.back $w.bb.search \
		     $w.bb.home $w.bb.dismiss]

      foreach subw $wlist {
	mfv:bind-menu-key $subw c "$w.mod.case invoke"
	mfv:bind-menu-key $subw r "$w.mod.regexp invoke"
	mfv:bind-menu-key $subw b "$w.mod.back invoke"
	mfv:bind-menu-key $subw m "$w.where1.mesg invoke"
	mfv:bind-menu-key $subw l "$w.where1.head invoke"
	mfv:bind-menu-key $subw f "$w.where2.folder invoke"
	mfv:bind-menu-key $subw m "$w.where2.mdir invoke"
      }
    }
  } else {
    $w.bb.dismiss configure -command "wm withdraw $w; catch {focus $savefocus}"
  }
  
  if {![winfo ismapped $w]} {
    set geom [split [winfo geom $top] x]
    set twidth [lindex $geom 0]
    set geom [split [lindex $geom 1] +]
    wm geom $w \
	+[expr [lindex $geom 1]+$twidth/3]+[expr [lindex $geom 2]+[lindex $geom 0]/2]
    wm deiconify $w
    raise $w
  }
  $top.$mfp(head)_text mark set insert 1.0
  focus $w.str.ent
  return 0
}

proc mfv:search-home { top } {
  global mf mfp

  if {$mfp($top,search,where) == "$top.$mfp(head)_text"} {
    mfv:select-mesg $top from 0
    $top.$mfp(head)_text mark set insert 1.0
    return 1
  }
  if {[winfo class $mfp($top,search,where)] != "Text"} {
    mfv:error-mesg "Can't handle $mfp($top,search,where) yet" $top
    return 0
  }
  if {$mfp($top,search,back)} {
    $mfp($top,search,where) mark set insert end
    set height [lindex [$mfp($top,search,where) configure -height] 4]
    incr height -2
    $mfp($top,search,where) yview "end -$height lines"
  } else {
    $mfp($top,search,where) mark set insert 1.0
    $mfp($top,search,where) yview 1.0
  }
  return 1
}

proc mfv:search { top w } {
  global mf mfp
  set top [winfo toplevel $top]

  if {![winfo exists $w]} {return [mfv:search-prompt $top]}
  set tw $mfp($top,search,where)

  if {$tw == "$top.$mfp(head)_text"} {
    if {[set ndx [mfv:search-text $top.$mfp(head)_text [$w.str.ent get] \
		      -nocase $mfp($top,search,case) \
		      -regexp $mfp($top,search,regexp) \
		      -back $mfp($top,search,back)]] == 0.0} {
      eval $mf(viewer-beep-error); return 0
    } else {
      mfv:select-mesg $top from [expr [lindex [split $ndx .] 0]-1]
      if $mfp($top,search,back) {
	$top.$mfp(head)_text mark set insert "$ndx linestart"
      } else {
	$top.$mfp(head)_text mark set insert "$ndx lineend"
      }	
    }
  } elseif {[winfo class $tw] == "Text"} {
    focus $tw
    $tw tag remove sel 1.0 end
    if {[mfv:search-text $tw [$w.str.ent get] \
	     -nocase $mfp($top,search,case) -regexp $mfp($top,search,regexp) \
	     -back $mfp($top,search,back) -tags sel] == 0.0} {
      set mfp($top,search,last) {0.0 0.0}
      eval $mf(viewer-beep-error); return 0
    }
    set mfp($top,search,last) [list [$tw index sel.first] [$tw index sel.last]]
  } else {
    mfv:error-mesg "Can't handle $tw yet" $top
    return 0
  }
  return 1
}

proc mfv:replace { top w } {
  global mfp

  set tw $mfp($top,search,where)
  if {![catch "$tw index sel.first"]} {
    set cur [list [$tw index sel.first] [$tw index sel.last]]
    if {$mfp($top,search,last) == $cur} {
      tkTextReplace $tw sel.first sel.last [$w.repl.ent get]
    }
  }
  return [mfv:search $top $w]
}

proc mfv:search-text { tw string args} {

  j:parse_args { {sndx ""} {view 1} {nocase 0} {regexp 0} {back 0} {tags ""} }

  set sw {}
  set endx end
  if $back {
    append sw " -backwards"
    set endx 1.0
  }
  if $regexp { append sw " -regexp" }
  if $nocase { append sw " -nocase" }
  if {[catch {set sndx [$tw index $sndx]}]} { set sndx [$tw index insert] }

  set cnt 0
  set ndx [eval "$tw search $sw -count cnt {$string} $sndx $endx"]

  if [string length $ndx] {
    set last [$tw index $ndx+${cnt}c]
    if {$tags == "sel"} {
      tkTextMarkRegion $tw $ndx $last
    } else {
      foreach tag $tags {
	catch {$tw tag remove $tag 1.0 end}
	$tw tag add $tag $ndx $last
      }
    }
    if {$view} {
      if {$back} {
	$tw mark set insert $ndx
      } else {
	$tw mark set insert $last
      }
      $tw see insert
      return [$tw index insert]
    }
    return $last
  } else {
    return 0.0
  }
}

proc mfv:save-folder { top {sorted 0}} {
  # processes deletes (save and reload) for folder in viewer <top>
  global mf mfp

  mfv:wait-on
  keylget mfp($top) fid fid

  if {$sorted || [llength [$fid info modified]]} {
    if $sorted {
      set sortkeys $mfp($top,sort)
      if {$sortkeys == "user-defined"} {
	set sortkeys $mf(headlist-sort)
      }
      set res [mfv:folder-safe-save $fid -sorted $sortkeys]
    } else { set res [mfv:folder-safe-save $fid] }
    if $res {
      if {$res != 2} {
	mfv:error-mesg $mfp(last-error) $top
      }
      mfv:wait-off
      return 1
    }
  }


  if [keylget mfp($fid) viewers vlist] {
    foreach viewer $vlist { 
      set ndx [mfv:cursingle $viewer]

      if {[catch "mfv:reset-summary $viewer" res]} {
	mfv:error-mesg $res $top
	mfv:wait-off
	return 1
      }

      # set new viewer specific database items
      set mesgnum [$fid info count]
      keylset mfp($viewer) mesgnum $mesgnum

      if {$mesgnum==0} {
	mfv:empty-viewer $viewer
	mfv:wait-off
	return 0
      } else {
	incr ndx
	if {$ndx == 0} {set ndx 1}
	if {$ndx < 0} {set ndx [expr $ndx+1+$mesgnum]}
	if {$ndx > $mesgnum || $ndx < 1} {
	  mfv:select-mesg $viewer from [set ndx [expr $mesgnum-1]] 1
	} else {
	  mfv:select-mesg $viewer from [incr ndx -1] 1
	}
	$viewer.$mfp(mstat) configure \
	    -text "Message [mfv:head-to-num $viewer $ndx] out of $mesgnum"
      } 
# XXX Debian Begin
# else { $viewer.$mfp(mstat) configure -text {No messages} }      
# XXX Debian End

    }
  }

  mfv:wait-off
  return 0
}

proc mfv:mesg-mark-unread { top } {
  global mf mfp

  keylget mfp($top) fid fid

  set dsel [$top.$mfp(head) curselection]
  foreach lndx $dsel {
    set msg [mfv:head-to-num $top $lndx]
    $fid message flag $msg read 0
    $fid message flag $msg old 1
  }

  foreach viewer [keylget mfp($fid) viewers] { 
    mfv:reset-summary $viewer
  }
}

proc mfv:mesg-delete { top } {
  # delete currently selected messages in viewer <top>
  global mf mfp

  keylget mfp($top) fid fid

  set dsel [$top.$mfp(head) curselection]
  if {[lempty $dsel]} {
    eval $mf(viewer-beep-error)
    $top.$mfp(mstat) configure -text "No messages selected"
    return 1
  }

  set ndx [lindex $dsel 0]
  if $mf(headlist-reverse-moveup) {
    if {$mfp($top,reverse) && $ndx > 0} {incr ndx -1}
  }
  set dsel [lsort -integer -decreasing $dsel]

  foreach lndx $dsel {
    set msg [mfv:head-to-num $top $lndx]
    lappend mfp($fid,delmesg) $msg
    set dmsg($lndx) $msg
    $fid message delete $msg
  }

  foreach viewer [keylget mfp($fid) viewers] { 
    if {$viewer != $top && $mfp($viewer,sort) != $mfp($top,sort)} {
      mfv:reset-summary $viewer
      continue
    }
    if {$mfp($viewer,hidedel)} {    
      foreach lndx $dsel {
	$viewer.$mfp(head) delete $lndx
      }
      if {[$viewer.$mfp(head) size] == 0} {
	  mfv:display-mesg $viewer ""
	  return 0
      } else {
	set curnum [keylget mfp($viewer) curnum]
	if [$fid message flag $curnum deleted] {
	  $viewer.$mfp(head) selection clear
	  if {$ndx < [$viewer.$mfp(head) size]} {
	    $viewer.$mfp(head) selection set $ndx
	  } else {      
	    $viewer.$mfp(head) selection set [expr [$viewer.$mfp(head) size]-1]
	  }
	  set curnum [mfv:head-to-num $viewer [mfv:cursingle $viewer]]
	}
	mfv:goto-mesg $viewer $curnum
      }
    } else {
      foreach lndx $dsel {
	$viewer.$mfp(head) replace $lndx [$fid message summary $dmsg($lndx)]
	eval "$viewer.$mfp(head) item configure $lndx $mf(headlist-deleted-config)"
      }
      set curnum [mfv:head-to-num $top [mfv:cursingle $top]]
      incr curnum
      if {$curnum <= [$fid info count]} {
	mfv:goto-mesg $top $curnum
      }
    }
  }
  
  return 0
}

proc mfv:mesg-undelete { top } {
  # undelete messages <msg> in folder of viewer <top>
  # <msg> can be "all" which is default
  global mf mfp

  set udsel [$top.$mfp(head) curselection]
  if {[lempty $udsel]} {
    eval $mf(viewer-beep-error)
    $top.$mfp(mstat) configure -text "No messages selected"
    return 1
  }

  keylget mfp($top) fid fid

  foreach lndx $udsel {
    set msg [mfv:head-to-num $top $lndx]
    lappend msglist $msg
    set dmsg($lndx) $msg
    $fid message undelete $msg
  }
  set mfp($fid,delmesg) [$fid info deleted]

  foreach viewer [keylget mfp($fid) viewers] { 
    if {$viewer != $top && $mfp($viewer,sort) != $mfp($top,sort)} {
      mfv:reset-summary $viewer
      continue
    }
    if $mfp($viewer,hidedel) {
      mfv:reset-summary $viewer
    } else {
      foreach lndx $udsel {
	$viewer.$mfp(head) replace $lndx [$fid message summary $dmsg($lndx)]
	$viewer.$mfp(head) item clear $lndx
      }
    }
  }

  return 0
}

# if <type> is "mesg", saves body of currently selected messages in 
#   viewer <top> to nonfolder <filename>
# if <type> is "xsel", current X selection is saved
# if <type> is "tw", text widget content is saved
proc mfv:write { top filename {type mesg} {tw ""}} {
  global mf mfp

  if {[lempty $filename]} {return 1}

  if [string length [mfv_util folderid $filename]] {
    mfv:error-mesg "Can't write non-mesg data to a mail folder." $top
    return 1
  }

  if {![mfv:ask-create $filename \
	    -master $top -askovrw 1 -askf 0]} {return 1}

  case $type {
    { mesg } {
      keylget mfp($top) fid fid
      set savelist {}
      foreach ndx [$top.$mfp(head) curselection] {
	set num [mfv:head-to-num $top $ndx]
	lappend savelist $num
	if {[catch "$fid message mimepart $num write 0 $filename" res]} {
	  mfv:error-mesg $res $top
	  return 1
	}
      }
      set res "Saved [llength $savelist] msgs to $filename"
    }
    { xsel } { 
      if {[lempty [set str [selection_if_any]]]} {
	mfv:error-mesg "No X selection exists to save" $top
	return 1
      }
      if {[mfv:var-to-file str $filename]} {
	mfv:error-mesg $mfp(last-error) $top
	return 1
      }
      set res "Saved selection to $filename"
    }
    { tw } {
      if {[lempty $tw]} {
	mfv:error-mesg "No text widget with the name $tw to print from" $top
	return 1
      }
      if {[mfv:text-to-file $tw $filename]} {
	mfv:error-mesg $mfp(last-error) $top
	return 1
      }
      set res "Saved contents of $tw to $filename"
    }
    default { mfv:error-mesg "Invalid save type" $top; return 1}
  }
  
  mfv:log-mesg $top $res
  return 0
}

proc mfv:mesg-copy { top filename } {
  # copy currently selected mesgs in viewer <top> to folder <filename>
  global mf mfp
  
  if {[lempty $filename]} {return 1}

  if {![mfv:ask-create $filename -master $top]} {return 1}

  mfv:wait-on
  set copylist {}
  keylget mfp($top) fid fid
  set tid [mfv_util folderid $filename]

  foreach ndx [$top.$mfp(head) curselection] {
    lappend copylist [mfv:head-to-num $top $ndx]
  }

  if {[catch {$fid write $copylist $filename} res]} {
    if {[string length $tid] && [string first $tid $res] > -1} {
      mfv:folder-crash $tid
    }
    mfv:error-mesg $res $top
    return 1
  }

  if {[string length $tid]} {
    if {[catch "$tid check" newm]} {
      mfv:folder-crash $tid
      mfv:error-mesg $newm
      return 1
    }
    if {[info exists mfp($tid)]} {
      foreach viewer [keylget mfp($tid) viewers] { 
	mfv:reset-summary $viewer
      }
    } 
  }

  mfv:log-mesg $top "Copied [llength $copylist] msgs to $filename"
  return 0
}

proc mfv:mesg-move { top filename } {
  # move currently selected mesgs in viewer <top> to folder <filename>
  global mf mfp
  
  if {[lempty $filename]} {return 1}

  if {![mfv:mesg-copy $top $filename]} {
    mfv:mesg-delete $top
    return 0
  }
  return 1
}

proc mfv:incorp {{top {}}} {
  global mfp mf

  set res 0
  if {![winfo exists $top]} { set top [mfv:current-top] }

  if [file exists $mfp(inbox)] {
    if ![catch "file stat $mfp(inbox) stat" res] {
      if {$stat(size) > 0} {
	if ![string length [set fid [mfv_util folderid $mfp(mbox)]]] {
	  if [catch {mfv_open -id mbox_tmp $mfp(mbox)} fid] {
	    mfv:error-mesg $fid $top
	    return -1
	  }
	}
	if [catch {mfv:incorp-internal $top $fid} res] {
	  mfv:error-mesg $res $top
	  return -1
	}
	catch {mfv_close mbox_tmp}  
      }
    } else {
      mfv:error-mesg "Can't stat $mfp(inbox) -- $res" $top
      return -1
    }
  }

  return $res
}

proc mfv:incorp-internal {top fid} {
  global mfp mf

  mfv:wait-on
  if [string length [set inboxfid [mfv_util folderid $mfp(inbox)]]] {
    if {[mfv:folder-safe-save $inboxfid] ||
	[catch "mfv_close $inboxfid" res]} {
      mfv:folder-crash $inboxfid
      mfv:error-mesg $res $top
      return -1
    }
  }

  # Lock inbox as we plan to delete it
  if {[mfv_util lock $mfp(inbox)] != 0} {
    mfv:error-mesg [mfv_util lockerror] $top
    return -1
  }

  set result 0
  if [catch "$fid append $mfp(inbox)" cnt] {
    mfv:error-mesg $cnt $top
    if {[string first "folderID" $cnt] > 0} {
      mfv:folder-crash $fid
    }
    set result -1
  } else {
    set result $cnt

    if [catch {open $mfp(inbox) w} res] {
      mfv:error-mesg "WARNING: could not empty $mfp(inbox) -- $res" $top
    } else { catch {close $res} }

    mfv:newlist-remove $mfp(inbox)
    if [keylget mfp($fid) viewers vlist] {
      foreach rview $vlist { 
	mfv:reset-summary $rview
	$rview.$mfp(mstat) configure -text "$cnt new messages"    
	if !$mfp($rview,newmail) {
	  catch {wm iconbitmap $rview "@$mf(viewer-bitmap-nomail)"}
	}
      }
    }

    if [string length $inboxfid] {
      if [catch "mfv_open -id $inboxfid $mfp(inbox)" newfid] {
	mfv:folder-crash $inboxfid
	mfv:error-mesg $res $top
	set result -1
      } else {
	if {$newfid != $inboxfid} {
	  mfv:folder-crash $inboxfid
	  mfv:error-mesg "Cannot reopen InBox!" $top
	  set result -1
	} else {
	  if [keylget mfp($inboxfid) viewers vlist] {
	    foreach rview $vlist { 
	      mfv:reset-summary $rview
	    }
	  }
	}
      }
    }
  }

  mfv:file-unlock $mfp(inbox)
  return $result
}

proc mfv:mbox {top} {
  global mfp mf

  set fid [keylget mfp($top) fid]
  set folder [keylget mfp($top) file]

  if {![samefile $mfp(mbox) $folder]} {
    mfv:goto-new-mail $mfp(mbox) $top
    return 0
  }

  if {[catch {mfv:incorp $top} cnt]} {
    mfv:error-mesg $cnt $top
    return 1
  }
  if {$cnt < 0} {return 1}
  if {$cnt > 0} {
    mfv:goto-newest $top NU
  } else {
    if {$mf(mail-auto-incorp) && [llength [$fid info new]]} {
      mfv:goto-newest $top NU
    } else {
      $top.$mfp(mstat) configure -text "No mail in InBox"    
    }
  }

  if !$mfp($top,newmail) {mfv:cancel-new-mail $top}
  return 0
}


proc mfv:print-callback { w } {
  global mf mfp

  checkbutton $w.noprompt -variable mfp(print-noprompt) -pady 10 \
      -text "No prompt for command in future" -relief flat

  checkbutton $w.separate -variable mfp(print-separate) -pady 10 \
      -text "Start each message on new page" -relief flat

  pack $w.noprompt $w.separate -after $w.ent -side top
}

proc mfv:print { top {type mesg} {tw ""}} {
  return [mfv:pipe $top $type $tw 1]
}

proc mfv:pipe-callback { w } {
  global mf mfp

  frame $w.pipetype
  radiobutton $w.pipetype.discard -variable mfp(pipe-type) -pady 10 \
      -text "Discard" -relief flat -value 0
  radiobutton $w.pipetype.replace -variable mfp(pipe-type) -pady 10 \
      -text "Replace" -relief flat -value 1
  radiobutton $w.pipetype.append -variable mfp(pipe-type) -pady 10 \
      -text "Append" -relief flat -value 2
  radiobutton $w.pipetype.xterm -variable mfp(pipe-type) -pady 10 \
      -text "XTerm" -relief flat -value 3

  pack $w.pipetype.discard $w.pipetype.replace \
      $w.pipetype.append $w.pipetype.xterm -side left
  pack $w.pipetype -after $w.ent -side top
}

proc mfv:pipe { top {type mesg} {tw ""} {print 0} {pcmd {}} {ptype 0} } {
  # if <type> is "xsel", pipe current X selection
  # if <type> is "tw", pipe contents of text widget <tw> 
  global mf mfp
  
  set pipecall {}
  set mfp(pipe-type) 0
  set dir $mf(viewer-pipe-dir)
  if {[lempty $top]} {set top $mfp(curtop)}
  set topclass [winfo class $top]

  if $print {
    set dostrip 1
    if $mfp(print-noprompt) {
      set pcmd $mf(viewer-print)
    } else {
      set pcmd [ut:getstr -prompt "Print command (use %F for filename):" \
		    -default $mf(viewer-print) -callback mfv:print-callback]
    }

    if $mfp(print-noprompt) {
      foreach viewer $mfp(viewlist) {
	$viewer.menu.mesg.m entryconfigure {Print*} -label Print
	$viewer.menu.edit.m entryconfigure {Print X*} -label {Print X Selection}
      }
    }
  } else {
    set dostrip 0
    if {$type == "xsel" && [selection own] == $tw} {
      set pipefirst [$tw index sel.first]
      set pipelast [$tw index sel.last]
      set pipecall mfv:pipe-callback
      set mfp(pipe-type) $ptype
    } elseif {$type != "xsel"} {
      set pipefirst 1.0
      set pipelast [$tw index end]
      set pipecall mfv:pipe-callback
      set mfp(pipe-type) $ptype
    }      
    if [lempty $pcmd] {
      set pcmd [ut:getstr -prompt "Pipe command (use %F for filename):" \
		    -callback $pipecall]
    }
  }
    
  if {[lempty $pcmd]} {return 0}
  if $print { set mf(viewer-print) $pcmd }
  
  set tfile [tmpfile tkmail $mf(mail-tmpdir)]
  set formfeed "\x0c"

  set err {}
  case $type {
    { mesg } {
      if {$topclass == "MailView"} {
	set pipelist ""
	foreach ndx [$top.$mfp(head) curselection] {
	  lappend pipelist [mfv:head-to-num $top $ndx]
	}
	if {$pipelist == ""} {
	  mfv:error-mesg "No selected messages" $top
	  return 0
	}
	set msgcnt [llength $pipelist]
	foreach pmsg $pipelist {
	  #TODO: header strip
	  set fid [keylget mfp($top) fid]
	  if {[catch "$fid message write $pmsg $tfile temporary" res]} {
	    mfv:error-mesg $res $top
	    return 0
	  }
	  if {$msgcnt > 1 && $mfp(print-separate)} {
	    if [mfv:var-to-file formfeed $tfile] {
	      mfv:error-mesg "ERROR: $mfp(last-error)" $top
	      return 0
	    }
	    incr msgcnt -1
	  }

	}
      } elseif {$topclass == "MailCompose"} {
	set tw $top.comp.txt
	set pipefirst [$tw index "headerend lineend + 1 c"]
	set pipelast [$tw index end]
	if [mfv:text-to-file $tw $tfile temporary $pipefirst end] {
	  set err $mfp(last-error)
	}
      } else {
	mfv:error-mesg "Can only use pipe mesg for MailView and MailCompose windows" $top
	return
      }
    }
    { xsel } { 
      if {[set str [selection_if_any]] == ""} {
	mfv:error-mesg "No X selection exists to print" $top
	return 0
      }
      if [mfv:var-to-file str $tfile temporary] { set err $mfp(last-error) }
    }
    { tw } { 
      if [mfv:text-to-file $tw $tfile temporary] { set err $mfp(last-error) }
    }
    default { 
      mfv:error-mesg "Invalid pipe type" $top; return 0 
    }
  }

  if [string length $err] {
    mfv:error-mesg "ERROR: $err" $top
    return 0
  }
  
  if {[regsub -all {([^%]|^)%([FDWS])} $pcmd "\\1\004\\2\004" pcmd]} {
    regsub -all {%%} $pcmd {%} pcmd
    if {![regsub -all "\004F\004" $pcmd $tfile pcmd]} {
      set pcmd "cat $tfile | $pcmd"
    }
    if {$topclass == "MailView"} {
      set prdate [mfv:viewer-get-field $top date UNKNOWN]
      set prfrom [mfv:viewer-get-field $top from UNKNOWN]
      set prsubj [mfv:viewer-get-field $top subject UNKNOWN]
    } elseif {$topclass == "MailCompose"} {
      set prfrom [$top.to.ent get]
      set prsubj [$top.subj.ent get]
      set prdate [exec date "+%a %h %d %T 19%y"]
    } else {
      set prdate [exec date "+%a %h %d %T 19%y"]
      set prfrom TkMail; set prsubj TkMail
    }
    regsub -all "\004D\004" $pcmd $prdate pcmd
    regsub -all "\004W\004" $pcmd $prfrom pcmd
    regsub -all "\004S\004" $pcmd $prsubj pcmd
  } else {
    set pcmd "cat $tfile | $pcmd"
  }

  if {$mfp(pipe-type) == 3} {
    set x [expr [winfo rootx $top]+10]
    set y [expr [winfo rooty $top]+10]
    if {[catch {exec xterm -geometry +$x+$y -title "TkMail: $pcmd" -e \
		    sh -c "cd $dir; $pcmd; echo; echo ; \
		    echo -n XTERM FINISHED. TYPE RETURN TO RETURN TO TKMAIL\\>; \
		    read line" } res]} {
      mfv:error-mesg "ERROR running \"$pcmd\" in xterm:\n\t$res" $top
      catch {exec rm $tfile}
      return 0
    }
    if {[file readable ${tfile}.out]} {
      if [string length $pipecall] {
	if {[catch {open ${tfile}.out r} tfid]} {
	  mfv:error-mesg "ERROR: $tfid" $top
	  return 0
	}
	if {![catch {$tw mark set insert $pipefirst}]} {
	  tkTextReplace $tw $pipefirst $pipelast [read $tfid]
	}
	catch {close $tfid}
      } 
      catch {exec rm ${tfile}.out}
    }
  } else {
    if {[catch {exec sh -c "cd $dir; $pcmd"} res]} {
      set errmsg "Error running \"$pcmd\":\n\t$res\n"
      append errmsg "Note that output to stderr from command will cause tkmail\n"
      append errmsg "to believe an error occured. Therefore, you might need to\n"
      append errmsg "modify your command to suppress stderr output. You may also\n"
      append errmsg "need to put double quotes around %S,%W,%D substitutions.\n"
      mfv:error-mesg $errmsg $top
      catch {exec rm $tfile}
      return 0
    }
  }

  if $print {
    mfv:log-mesg $top "Finished print: $pcmd => $res"
  } else {
    mfv:log-mesg $top "Finished pipe: $pcmd"
  }

  if [string length $pipecall] {
    if {$mfp(pipe-type) == 1} {
      if {![catch {$tw mark set insert $pipefirst}]} {
	tkTextReplace $tw $pipefirst $pipelast "$res\n"
      }
    } elseif {$mfp(pipe-type) == 2} {
      if {![catch {$tw mark set insert $pipelast}]} {
	tkTextInsert $tw insert "$res\n"
      }
    }
  }

  catch {exec rm $tfile}
  return 1
}

proc mfv:xterm-command { top cmd {msg {}} {dir {}} } {
  global mf mfp

  if {[lempty $top]} {set top $mfp(curtop)}
  if {[lempty $dir]} {set dir $mf(viewer-pipe-dir)}
  set tfile [tmpfile tkmail $mf(mail-tmpdir)]

  set topclass [winfo class $top]
  if {$topclass == "MailView"} {
    keylget mfp($top) fid fid
    if {[lempty $msg] && ![keylget mfp($top) curnum msg]} {
      mfv:error-mesg "Could not determine current message" $top
      return
    }
    if [catch "$fid message write $msg $tfile temporary" res] {
      mfv:error-mesg $res $top
      return
    }
  } elseif {$topclass == "MailCompose"} {
    set tw $top.comp.txt
    set start [$tw index "headerend lineend + 1 c"]
    if [mfv:text-to-file $tw $tfile temporary $start end] {
      mfv:error-mesg "ERROR: $mfp(last-error)" $top
      return 0
    }
  } else {
    mfv:error-mesg "Can only use mfv:xterm-command for MailView and MailCompose windows" $top
    return
  }

  if {[regsub -all {([^%]|^)%([FDWS])} $cmd "\\1\004\\2\004" cmd]} {
    regsub -all {%%} $cmd {%} cmd
    if {![regsub -all "\004F\004" $cmd $tfile cmd]} {
      set cmd "cat $tfile | $cmd"
    }
    if {$topclass == "MailView"} {
      set prdate [mfv:viewer-get-field $top date UNKNOWN]
      set prfrom [mfv:viewer-get-field $top from UNKNOWN]
      set prsubj [mfv:viewer-get-field $top subject UNKNOWN]
    } elseif {$topclass == "MailCompose"} {
      set prfrom [$top.to.ent get]
      set prsubj [$top.subj.ent get]
      set prdate [exec date "+%a %h %d %T 19%y"]
    }
    regsub -all {["$]} $prdate {\\\0} prdate
    regsub -all {["$]} $prfrom {\\\0} prfrom
    regsub -all {["$]} $prsubj {\\\0} prsubj

    regsub -all "\004D\004" $cmd $prdate cmd
    regsub -all "\004W\004" $cmd $prfrom cmd
    regsub -all "\004S\004" $cmd $prsubj cmd
  } else {
    set cmd "cat $tfile | $cmd"
  }

  set x [expr [winfo rootx $top]+10]
  set y [expr [winfo rooty $top]+10]
  if {[catch {exec xterm -geometry +$x+$y -title "TkMail: $cmd" -e \
		  sh -c "cd $dir; $cmd; echo; echo ; \
	          echo -n XTERM FINISHED. TYPE RETURN TO RETURN TO TKMAIL\\>; \
	          read line" } res]} {
    mfv:error-mesg "ERROR running \"$cmd\" in xterm:\n\t$res" $top
  }
  catch {exec rm $tfile}

  if {[file readable ${tfile}.out] && $topclass == "MailCompose"} {
    if {[catch {open ${tfile}.out r} tfid]} {
      mfv:error-mesg "ERROR: $tfid" $top
      return 0
    }
    tkTextReplace $tw $start [$tw index end] [read $tfid]
    catch {close $tfid}
    catch {exec rm ${tfile}.out}
  }
}

set mfp(helpwindow) .NONE
proc mfv:display-help {top section} {
  # display help window for <section>
  global mf mfp
  set w $mfp(helpwindow)
  
  if { ![winfo exists $w] } {
    
    if {[catch {open $mfp(tkmaillib)/help.txt r} fid]} {
      mfv:error-mesg "Cannot open $mfp(tkmaillib)/help.txt"
      return 0
    }

    set w [ut:simpletext -master $top -title "TkMail Help" \
      -leftscroll $mf(disp-left-scroll) -focus $top \
      -buttons {{Print mfv:print %W tw %W.txt} {Search mfv:search-prompt %W} {Cancel}}]

    set mfp(helpwindow) $w
    bind $w <FocusIn> "set mfp(curtop) $w"
    
    if [catch {$w.txt insert end [read $fid]} error] {
      mfv:error-mesg $error
      catch {close $fid}
      after 20 destroy $w
      if {$mfp(curtop) == $w} {set mfp(curtop) $mfp(curview)}
      return 0
    }
    close $fid

  } else { wm deiconify $w; raise $w }
  
  $w.txt configure -state disabled
  
  if {$section != "TOP"} {
    set loc [$w.txt search -regexp ^$section 1.0 end]
  } else {
    set loc 1.0
  }
  $w.txt see $loc
  $w.txt mark set insert $loc
  focus $w.txt
}

proc mfv:reset-headlist { {vlist {}} } {
  global mf mfp

  if [lempty $vlist] { set vlist $mfp(viewlist) }
  foreach viewer $vlist {
    if {![$viewer.$mfp(head) size]} continue
    mfv:reset-summary $viewer
  }
  return 0
}

proc mfv:explicit-open { top folder {ndx {}} {new 0} {add 1}} {
  global mfp mf

  if {[lempty $folder]} return
  if {![file readable $folder] && ![samefile $mfp(inbox) $folder]} {
    mfv:error-mesg "File $folder not readable" $top
    return 0
  }

  if {$new || $mfp($top,lock)} {
    mfv:wait-on
    mfv:new-viewer $folder 0 $ndx
  } else {
    if [mfv:setup-folder $top $folder $ndx] {return 0}
  }
  if {$add} {
    mfv:add-recent $folder
  }
  return 1
}

proc mfv:explicit-write { top folder type} {
  if {[lempty $folder]} return
    if {![mfv:write $top $folder $type]} {
        mfv:add-recent $folder
    }
}

proc mfv:explicit-move { top folder } {
  if {[lempty $folder]} return
    if {![mfv:mesg-move $top $folder]} {
        mfv:add-recent $folder
    }
}

proc mfv:explicit-copy { top folder } {
  if {[lempty $folder]} return
    if {![mfv:mesg-copy $top $folder]} {
        mfv:add-recent $folder
    }
}

proc mfv:edit-op { op } {
  set w [focus]
  switch -exact -- [winfo class $w] {
    Entry {
      tkEntry$op $w
    }
    Text {
      tkText$op $w
    }
    default {
      mfv:error-mesg "Unclear which widget to $op to."
    }
  }
}

proc mfv:tcl-eval-sel { } {
  # evaluate current X selection as Tcl command
  global mfp
  if {[catch {uplevel #0 eval \[selection_if_any\]} res]} {
    mfv:error-mesg $res $mfp(curtop)
    return 0 
  }
  return 1
}

proc mfv:select-next { top } {
  global mfp
  # select next mesg in viewer <top>
  if {[set ndx [mfv:cursingle $top]] < [expr [$top.$mfp(head) size]-1]} {
    if {$ndx > -1} {mfv:select-mesg $top from [expr $ndx+1] 1}
  }
}
proc mfv:select-prev { top } {
  global mfp
  # select previous mesg in viewer <top>
  if {[set ndx [mfv:cursingle $top]] > 0} {
    mfv:select-mesg $top from [expr $ndx-1] 1
  }
}

proc mfv:stext-save { w } {
  mfv:write $w [ut:fsbox -master $w] tw $w.txt
  return 0
}

proc mfv:stext-cancel { w } {
  global mfp
  catch "unset mfp($w)"
  return 1
}

proc mfv:get-text-lines { tw } {
  set lh [lindex [$tw bbox @1,1] 3]
  set th [winfo height $tw]
  return [expr $th/$lh]
}
  
proc mfv:toggle-horiz { top } {
  global mf mfp

  if $mfp($top,horiz) {
    pack $top.hbar -before $top.mesg -side bottom -fill x
    $top.mesg.txt configure -wrap none
  } else {
    pack forget $top.hbar
    $top.mesg.txt configure -wrap word
  }

  if ![catch {pack info $top.mesg2}] {
    if $mfp($top,horiz) {
      pack $top.hbar2 -before $top.mesg2 -side bottom -fill x
      $top.mesg2.txt configure -wrap none
    } else {
      pack forget $top.hbar2
      $top.mesg2.txt configure -wrap word
    }
  }
}

proc mfv:split-mesg-view { top } {
  global mf mfp

  if [catch {pack info $top.mesg2}] {

    set newheight [expr [mfv:get-text-lines $top.mesg.txt]/2]
    $top.mesg.txt configure -height $newheight
    $top.mesg2.txt configure -height $newheight

    if $mfp($top,horiz) {
      pack $top.hbar2 -before $top.hbar -side bottom -fill x
      pack $top.mesg2 -after $top.hbar2 -side bottom -expand true -fill both
      $top.mesg.txt configure -wrap none
    } else {
      pack $top.mesg2 -before $top.mesg -side bottom -expand true -fill both
      $top.mesg.txt configure -wrap word
    }
    pack $top.sep2 -after $top.mesg2 -side bottom -fill x
    place configure $top.line2 -in $top.sep2 -relx 0.03 -rely 0.4 \
	-relwidth 0.95
    place configure $top.handle2 -in $top.sep2 -relx 0.8 -rely 0.4 \
	-anchor center


    $top.mesg2.txt delete 1.0 end
    mfv:copy-text-withtags $top.mesg.txt $top.mesg2.txt 1 1

  } else {

    set newheight [mfv:get-text-lines $top.mesg.txt]
    incr newheight [mfv:get-text-lines $top.mesg2.txt]
    $top.mesg.txt configure -height [incr newheight 1]
    pack forget $top.mesg2
    pack forget $top.sep2
    pack forget $top.hbar2
    place forget $top.line2
    place forget $top.handle2
  }
}

proc mfv:detach-mesg { top } {
  # detach current mesg in viewer <top> to individual window
  global mf mfp
  keylget mfp($top) curnum msg
  keylget mfp($top) file filename

  set cnt 0
  while {[winfo exists .mf_detach$cnt]} {incr cnt}
  set w .mf_detach$cnt

  ut:simpletext -name $w -master $top -title "TkMail: $filename $msg" \
      -leftscroll $mf(disp-left-scroll) -focus $top -class MailView \
      -buttons {{Print mfv:print %W tw %W.txt} {Save mfv:stext-save %W} \
		    {Cancel mfv:stext-cancel %W}}

  set mfp($w) $mfp($top)

  $w.txt configure -font [lindex [$top.$mfp(mesg) configure -font] 4]

  bind $w <FocusIn> "set mfp(curtop) $w"
  mfv:copy-text-withtags $top.$mfp(mesg) $w.txt 1 1

  # source users mfv:detach-hook procedure if defined
  mfv:run-hooks viewer-detach-hook $w

}

proc mfv:sash-begin { top w n } {
  global mf mfp

  set mfp(sash-hh) [mfv:get-text-lines $w]
  set mfp(sash-beg) [winfo rooty $top.line$n]
  set mfp(sash-ppl) [expr [winfo height $w]/$mfp(sash-hh)]
  set mfp(sash-min) [expr [winfo rooty $w]+3*$mfp(sash-ppl)]
  set mfp(sash-max) [expr [winfo rooty $top]+[winfo height $top]-50]
}

proc mfv:sash-draw { top y n } {
  global mf mfp

  if {$y < $mfp(sash-min) || $y > $mfp(sash-max)} return

  set topy [winfo rooty $top]
  incr y -$topy

  place configure $top.line$n -in $top -relx 0.03 -rely 0 -y $y \
      -relwidth 0.95
  #place configure $top.handle$n -in $top -relx 0.8 -rely 0 -y $y \
  #    -anchor center

  raise $top.line$n
  #raise $top.handle$n
}

proc mfv:sash-split-end { top } {
  global mf mfp

  set sashy [winfo rooty $top.line2]
  set adj [expr round((1.0*$sashy-$mfp(sash-beg))/$mfp(sash-ppl))]

  set hh [mfv:get-text-lines $top.mesg2.txt]

  $top.mesg.txt configure -height [expr $mfp(sash-hh)+$adj]
  $top.mesg2.txt configure -height [expr $hh-$adj]

  place configure $top.line2 -in $top.sep2 -relx 0.03 -rely 0.4 \
      -y 0 -relwidth 0.95
  place configure $top.handle2 -in $top.sep2 -relx 0.8 -rely 0.4 \
      -y 0 -anchor center
  raise $top.line2
  raise $top.handle2
}

proc mfv:sash-end { top } {
  global mf mfp

  set sashy [winfo rooty $top.line1]
  set adj [expr (1.0*$sashy-$mfp(sash-beg))/$mfp(sash-ppl)]
  mfv:adj-headlist $top [expr round($adj)]

  place configure $top.line1 -in $top.sep1 -relx 0.03 -rely 0.4 \
      -y 0 -relwidth 0.95
  place configure $top.handle1 -in $top.sep1 -relx 0.8 -rely 0.4 \
      -y 0 -anchor center
  raise $top.line1
  raise $top.handle1
}

proc mfv:adj-headlist { top amount } {
  # adjust header listbox of viewer <top> by <amount> in height
  global mf mfp
  set tmp [expr [lindex [$top.$mfp(head) configure -height] 4]+$amount]
  if {$tmp > 3} {
    $top.$mfp(head) configure -height $tmp
  }
}

proc mfv:ask-create { filename args} {
  # Create an empty file if <filename> does not exist and create any
  # directories needed with user confirmation
  global mf mfp

  j:parse_args {
    {master ""}
    {askf 1}
    {askd 1}
    {askovrw 0}}
  if {[lempty $master] && [winfo exists $mfp(curtop)]} { set master $mfp(curtop) }

  if {[file exists $filename]} {
    if {![file writable $filename]} {
      mfv:error-mesg "mfv:askcreate: File $filename not writable" $master
      return 0
    }
    if {$askovrw && ![ut:getok -master $master \
	    -prompt "Append to existing file ($filename)?"]} {
      return 0
    }
    return 1
  }

  set dlist ""
  set fname [file tail $filename]
  set cdir [file dirname $filename]
  while {$cdir != "." && $cdir != "/" && ![file exists $cdir]} {
    set dlist [linsert $dlist 0 [file tail $cdir]]
    set cdir [file dirname $cdir]
  }

  if {[string length $cdir]} {set cdir $cdir/}
  foreach dname $dlist {
    if {$askd && ![ut:getok -master $master \
	     -prompt "Create new directory ${cdir}$dname?"]} {
      return 0
    }
    if {[catch {exec mkdir ${cdir}$dname} res]} {
      mfv:error-mesg $res $master
      return 0
    }
    set cdir ${cdir}${dname}/
  }

  if {$askf} {
    if {![ut:getok -master $master \
	      -prompt "Create new file ${cdir}$fname?"]} {return 0}
  }

  return 1
}

proc mfv:ispell-text { tw {twtop 1.0}} {
  global mf

  set opts [list $mf(ispell-main-dictionary) 0 1 $mf(ispell-personal-dictionary) \
		0 $mf(ispell-addopts)]
  return [tkispell_text $tw $opts $mf(ispell-binary) $twtop]
}

proc mfv:alias-current { top } {
  global mf mfp

  set w .mf_alias

  if {![winfo exists $w]} {

    toplevel $w -class MailAlias
    wm title $w "Alias Current"
    wm minsize $w 90 150
    wm protocol $w WM_DELETE_WINDOW "wm withdraw $w"
    bind $w <FocusIn> "set mfp(curtop) $w"
    bind $w <Visibility> "set mfp(curtop) $w"
    
    frame $w.alias -bd 5
    label $w.alias.lbl -text "Alias:" -width 12
    entry $w.alias.ent -relief sunken
    pack $w.alias.lbl -side left
    pack $w.alias.ent -side left -expand 1 -fill x

    frame $w.descr -bd 5
    label $w.descr.lbl -text "Descr:" -width 12
    entry $w.descr.ent -relief sunken
    pack $w.descr.lbl -side left
    pack $w.descr.ent -side left -expand 1 -fill x

    frame $w.addr -bd 5
    label $w.addr.lbl -text "Address:" -width 12
    entry $w.addr.ent -relief sunken
    pack $w.addr.lbl -side left
    pack $w.addr.ent -side left -expand 1 -fill x

    frame $w.bb -bd 5
    button $w.bb.accept -text "Accept"  \
	-command "mfv:alias-current-save $w"
    button $w.bb.cancel -text "Cancel" \
	-command "wm withdraw $w"
    pack $w.bb.accept $w.bb.cancel -side left \
	-expand 1 -fill x -padx 5 -pady 5

    pack $w.alias $w.descr $w.addr $w.bb \
	-in $w -side top -fill x

  }

  $w.alias.ent delete 0 end
  $w.descr.ent delete 0 end
  if {$mf(mail-alias-type) == "bsd"} {
    pack forget $w.descr
  } else {
    pack $w.descr -after $w.alias -side top -fill x
  }
  
  $w.addr.ent delete 0 end
  $w.addr.ent insert end [mfv:get-from $top.$mfp(mesg)]

  focus $w.alias.ent
  wm deiconify $w; raise $w
}

proc mfv:alias-current-save { w } {
  global mf mfp env

  set alias [$w.alias.ent get]
  set descr [$w.descr.ent get]
  set addr [$w.addr.ent get]

  if {$mf(mail-alias-type) == "elm"} {
    set file $mf(mail-alias-file)
    if {![string length $file]} {
      set file "$mfp(homedir)/.elm/aliases.text"
      if {![file isdirectory $mfp(homedir)/.elm]} {
	exec mkdir $mfp(homedir)/.elm
      }
    }
    set line "\n$alias = $descr = $addr"
  } else {
    set file $mf(mail-alias-file)
    if {![string length $file]} {
      set file "$mfp(homedir)/.mailrc"
    }
    set line "\na $alias $addr"
  }

  set fid [open $file a+]
  if {$fid < 1} {
    mfv:error-mesg "Can't open $file" $w
    return
  }

  puts $fid $line
  close $fid

  lappend mfp(aliasnames) $alias
  lappend mfp(aliasdesc) $descr
  lappend mfp(aliasaddr) $addr

  if {$mf(menu-quick-send) == "@aliases"} {
    foreach viewer $mfp(viewlist) {
      $viewer.menu.mail.m add command -label $alias \
	  -command "mfv:compose -viewer $viewer -sendto {$addr}"
    }
  }

  wm withdraw $w

}

proc mfv:copy-text-withtags {from to {withprops 0} {withbindings 0}} {

  $to delete 1.0 end
  $to insert 1.0 [$from get 1.0 end]

  foreach item [$from mark names] {
    $to mark set $item [$from index $item]
  }

  foreach item [$from tag names] {
    set range [$from tag ranges $item]
    set length [llength $range]
    for {set i 0} {$i < $length} {incr i 2} {
      $to tag add $item [lindex $range $i] [lindex $range [expr $i+1]]
    }

    if {$withprops} {
      foreach prop [$from tag configure $item] {
	$to tag configure $item [lindex $prop 0] [lindex $prop 4]
      }
    }

    if {$withbindings} {
      foreach binding [$from tag bind $item] {
	set cmd [$from tag bind $item $binding]
	regsub -all $from $cmd $to cmd
	$to tag bind $item $binding $cmd
      }
    }
  }
}