# mail.tk - support file for TkMail (accessed through tclIndex)
#	    commands for user operations on mail
#
# $Header: /u/ra/raines/src/tk/tkmail2/mail.tk,v 1.5 1995/06/28 17:30:37 raines Exp $
if $mfp(debug) {puts stderr "mail.tk sourced"}

proc mfv:insert-prefix { str } {
  # insert prefix at beginning of lines of text string <str>
  global mf mfp
  
  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 "$mf(insert-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 [bt:get-cut 1]
  } else  {
    set str [selection_if_any]
  }
  $tw insert insert [mfv:insert-prefix $str]
}

proc mfv:quick-decode { tw } {
  # scan text widget <tw> for uuencoded files and decode them
  global mf mfp mfdb 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 [mfv:search-text $tw {^begin [0-9]* } \
			-regexp 1 -sndx $endx -view 0]] != 0.0} {
    puts stderr "Found uuencoded stuff at $bndx"
    incr dcnt
    set endx [mfv:search-text $tw "^end" -regexp 1 -sndx $bndx -view 0]
    if {$endx == 0.0} {
      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

    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"
    button $w.bb.home -text "Home" -width 10 \
	-command "mfv:search-home $top"
    button $w.bb.dismiss -text "dismiss" -width 10 \
	-command "wm withdraw $w; catch {focus $savefocus}"
    pack $w.bb.search $w.bb.home $w.bb.dismiss -side left -padx 20 -pady 20

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

      if {$topclass == "MailCompose"} {
	  set mfp($top,search,where) $top.comp.txt
      } else {
	  set mfp($top,search,where) $top.txt
      }
      button $w.bb.replace -text "Replace" -width 10 \
	  -command "mfv:replace $top $w 0" -state disabled
      button $w.bb.repl_all -text "Replace All" -width 10 \
	  -command "mfv:replace $top $w 1" -state disabled
      pack $w.bb.replace $w.bb.repl_all -after $w.bb.search \
	  -side left -padx 20 -pady 20

      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

      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]
      focus:register $w $wlist "$w.bb.search invoke" "$w.bb.dismiss invoke"
      foreach subw $wlist {
	bind $subw [mfv:menu-key c] "$w.mod.case invoke"
	bind $subw [mfv:menu-key r] "$w.mod.regexp invoke"
	bind $subw [mfv:menu-key b] "$w.mod.back invoke"
      }

    } else {
      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]
      focus:register $w $wlist "$w.bb.search invoke" "$w.bb.dismiss invoke"
      foreach subw $wlist {
	bind $subw [mfv:menu-key c] "$w.mod.case invoke"
	bind $subw [mfv:menu-key r] "$w.mod.regexp invoke"
	bind $subw [mfv:menu-key b] "$w.mod.back invoke"
	bind $subw [mfv:menu-key m] "$w.where1.mesg invoke"
	bind $subw [mfv:menu-key l] "$w.where1.head invoke"
	bind $subw [mfv:menu-key f] "$w.where2.folder invoke"
	bind $subw [mfv:menu-key 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
  }
  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
    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]}

  if {$mfp($top,search,where) == "$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 $mfp($top,search,where)] == "Text"} {
    focus $mfp($top,search,where)
    $mfp($top,search,where) tag remove sel 1.0 end
    if {[mfv:search-text $mfp($top,search,where) [$w.str.ent get] \
	     -nocase $mfp($top,search,case) -regexp $mfp($top,search,regexp) \
	     -back $mfp($top,search,back) -tags sel] == 0.0} {
      eval $mf(viewer-beep-error); return 0
    }
  } else {
    mfv:error-mesg "Can't handle $mfp($top,search,where) yet" $top
    return 0
  }
  return 1
}

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

  j:parse_args { {sndx ""} {view 1} {nocase 0} {regexp 0} {back 0} {tags ""} }
  
  if {[catch {set sndx [$tw index $sndx]}]} { set sndx [$tw index insert] }
  set sline [lindex [split $sndx .] 0]
  set schar [lindex [split $sndx .] 1]

  if {$nocase} { set string [string tolower $string] }
  if {$back} {
    set stopcond "\$i > 0"
    set itercmd "incr i -1"
    set begadj "linestart"
    set endadj "+$schar chars"
    set direct last
    set schar 0
  } else {
    scan [$tw index end] %d numLines
    set stopcond "\$i <= $numLines"
    set itercmd "incr i"
    set begadj "+$schar chars"
    set endadj "lineend"
    set direct first
  }
  for {set i $sline} $stopcond $itercmd {
    set txtstr [$tw get [$tw index "$i.0 $begadj"] [$tw index "$i.0 $endadj"]]
    if {$nocase} { set txtstr [string tolower $txtstr] }
    if {$regexp} {
      if {[set found [regexp -indices $string $txtstr ndx]] } {
	set endndx [expr [lindex $ndx 1]+$schar+1]
	set begndx [expr [lindex $ndx 0]+$schar]
      }
    } else {
      if {[set ndx [string $direct $string $txtstr]] != -1} {
	set found 1
	set begndx [expr $ndx+$schar]
	set endndx [expr $ndx+$schar+[string length $string]]
      } else { set found 0 }
    }
    if {$found} {
      if {$tags == "sel"} {
	bt:mark-region $tw $i.$begndx $i.$endndx
      } else {
	foreach tag $tags {
	  catch {$tw tag remove $tag 1.0 end}
	  $tw tag add $tag $i.$begndx $i.$endndx
	}
      }
      if {$view} {
	if {$back} {
	  $tw mark set insert $i.$begndx
	} else {
	  $tw mark set insert $i.$endndx
	}
	$tw yview -pickplace insert
	return [$tw index insert]
      }
      return $i.$endndx
    }
    set schar 0
    set begadj "linestart"
    set endadj "lineend"
  }
  return 0.0
}

proc mfv:auto-incorp { } {
  global mf mfp mfdb

  foreach viewer $mfp(toplist) {
    if {[mfdb:same-files $mf(mail-mbox) [keylget mfp($viewer) file]]} {
      if {![winfo ismapped $viewer]} { 
	bind $viewer <Map> "mfv:mail-incorp $viewer 0" 
      }
    }
  }

  set scnt 0
  if {[mfdb:mail-incorp $mf(mail-system) $mf(mail-mbox) scnt]} {
    mfv:error-mesg $mfdb(last-error) $mfp(curtop)
  }
  incr mfp(auto-incorped) $scnt
}

proc mfv:mail-incorp { top {newf 0} {source ""} {target ""} {show 1}} {
  # incorporate new mail loading mbox into viewer <top>
  # if <newf> true, open up new viewer for mbox using <top> only for messages
  # if <show>, immediately display the first new message 
  global mf mfp mfdb

  mfv:wait-on
  if {![string length $source]} { set source $mf(mail-system) }
  if {![string length $target]} { set target $mf(mail-mbox) }

  if {$target == $mf(mail-mbox)} {
    set mfp(auto-incorped) 0
  }

  set sourcelist {}
  foreach sfile $source {
    if {[mfdb:file-test -s $sfile]} {
      lappend sourcelist $sfile
    }
  }

  set vlist {}
  foreach viewer $mfp(toplist) {
    bind $viewer <Map> { }
    if {[mfdb:same-files $target [keylget mfp($viewer) file]]} {
      lappend vlist $viewer
    }
  }

  if [llength $vlist] {
    set newm [expr [mfdb:folder-num-mesgs $target]-[keylget mfp($viewer) mesgnum]]
  } else { set newm 0 }

  if {[llength $sourcelist]} {
    foreach sfile $sourcelist {
      set scnt 0
      if {[mfdb:mail-incorp $sfile $target scnt]} {
	mfv:error-mesg $mfdb(last-error) $top
	if {!$newm} {mfv:wait-off; return 0}
      }
      incr newm $scnt
    }
  }

  if {!$newm} {
    $top.$mfp(mstat) configure -text "No mail in $sfile"
    mfv:wait-off; return 0
  }

  if {[lempty $vlist] && $newf} {
    mfv:explicit-open $top $target -1 1
    mfv:notify-popup-clear
  } else {
    if {[lempty $vlist]} {
      if {$show} {
	mfv:setup-folder $top $target -1
	mfv:notify-popup-clear
      }
    } else {
      foreach viewer $vlist {
	mfv:update-summary $top $viewer $target
      }
      if {[lsearch $vlist $top] != -1} {
	set viewer $top
      }
      if {!$mf(headlist-reverse-moveup) && $mfp($viewer,reverse)} {
	mfv:select-mesg $viewer from 0
      } else {
	mfv:goto-newest $viewer
      }
      if {$show} {
	mfv:notify-popup-clear
	wm deiconify $viewer
	raise $viewer
      }
    }
  }
  mfv:log-mesg $top "Incorporated $newm new msgs"
  mfv:wait-off
  return $newm
}

proc mfv:update-summary { top viewer target } {
  global mf mfp mfdb

  set total [mfdb:folder-num-mesgs $target]
  keylget mfp($viewer) mesgnum mesgnum

  if {$total == $mesgnum} return

  if {$mfp($viewer,sort) == "normal"} {
    if {[mfdb:folder-summary $target lsum $mfp($viewer,reverse) normal [incr mesgnum] $total]} {
      mfv:error-mesg $mfdb(last-error) $top
    }
    if {$mfp($viewer,reverse)} {
      eval "$viewer.$mfp(head) insert 0 $lsum"
    } else {
      eval "$viewer.$mfp(head) insert end $lsum"
    }
  } else {
    if {[mfdb:folder-summary $target lsum $mfp($viewer,reverse) $mfp($viewer,sort)]} {
      mfv:error-mesg $mfdb(last-error) $top
    }
    $viewer.$mfp(head) delete 0 end
    eval "$viewer.$mfp(head) insert end $lsum"
  }
  keylset mfp($viewer) mesgnum $total

}

proc mfv:goto-newest { viewer } {
  global mf mfp
  
  if {$mfp($viewer,reverse)} {
    set ndx [mfv:search-text $viewer.$mfp(head)_text {^ N *[0-9]+} \
	       -sndx end -back 1 -regexp 1]
  } else {
    set ndx [mfv:search-text $viewer.$mfp(head)_text {^ N *[0-9]+} \
	       -sndx 1.0 -regexp 1]
  }
  set ndx [expr [lindex [split $ndx .] 0]-1]

  if {$ndx > -1} {
    mfv:select-mesg $viewer from $ndx
  }
}

proc mfv:goto-mesg { viewer msg {goto 1} } {
  global mf mfp

  set ndx [mfv:search-text $viewer.$mfp(head)_text "^>*\[NU \]*$msg " \
	   -sndx 1.0 -regexp 1]

  if {$ndx == 0.0} {
    mfv:select-mesg $viewer from 0
  } else {
    set ndx [expr [lindex [split $ndx .] 0]-1]
    if {$goto} {
      mfv:select-mesg $viewer from $ndx
    } else {
      $viewer.$mfp(head) select from $ndx
    }
  }
}

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

  mfv:wait-on
  keylget mfp($top) file folder

  if {[mfdb:proc-deletes $folder $sorted $mfp($top,sort)]} {
    mfv:error-mesg $mfdb(last-error) $top
    mfv:wait-off
    return 0
  }

  foreach viewer $mfp(toplist) {
    if {[mfdb:same-files $folder [keylget mfp($viewer) file]]} {

      set ndx [mfv:cursingle $viewer]

      if {[mfdb:folder-summary $folder lsum $mfp($viewer,reverse) $mfp($viewer,sort)]} {
	mfv:error-mesg $mfdb(last-error) $top
	mfv:wait-off
	return 0
      }
      $viewer.$mfp(head) delete 0 end
      eval "$viewer.$mfp(head) insert end $lsum"

      # set new viewer specific database items
      set mesgnum [$viewer.$mfp(head) size]
      keylset mfp($viewer) mesgnum $mesgnum

      if {$mesgnum==0} {
	$viewer.$mfp(mstat) configure -text "Message 0 out of 0"
	mfv:wait-off
	return 0
      }

      if {[$viewer.$mfp(head) size] > 0} {
	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]]
	} else {
	  mfv:select-mesg $viewer from [incr ndx -1]
	}
	$viewer.$mfp(mstat) configure \
	    -text "Message [mfv:head-to-num $viewer $ndx] out of $mesgnum"
      } else { $viewer.$mfp(mstat) configure -text {No messages} }
    }
  }
  
  mfv:wait-off
  raise $top
  return 1
}

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

  keylget mfp($top) file folder

  set dsel [$top.$mfp(head) curselection]
  if {[lempty $dsel]} {
    eval $mf(viewer-beep-error)
    flush stderr
    $top.$mfp(mstat) configure -text "No messages to delete"
    return 0
  }
  set ndx [lindex $dsel 0]
  if $mf(headlist-reverse-moveup) {
    if {$mfp($top,reverse) && $ndx > 1} {incr ndx -1}
  }

  foreach tndx $dsel {
    lappend dellist [mfv:head-to-num $top $tndx]
  }
  if {[set stat [mfdb:mesg-delete $folder $dellist]]} {
    # DIRTY
    mfv:error-mesg $mfdb(last-error) $top
    return $stat
  }

  foreach tndx [lsort -integer -decreasing $dsel] {    
    lappend mfp($top,delmesg) [mfv:head-to-num $top $tndx]
    $top.$mfp(head) delete $tndx
    if {[$top.$mfp(head) size] == 0} {
      keylset mfp($top) curnum 0
      mfv:display-mesg $top ""
      return 1
    }
  }
  
  if {[$top.$mfp(head) size] == 0} {
    $top.$mfp(mesg) delete 1.0 end
    keylset mfp($top) curnum 0
  } else {
    if {$ndx < [$top.$mfp(head) size]} {
      $top.$mfp(head) select from $ndx
    } else {
      $top.$mfp(head) select from [expr [$top.$mfp(head) size]-1]
    }
    keylset mfp($top) curnum [mfv:head-to-num $top [mfv:cursingle $top]]
    mfv:display-mesg $top [keylget mfp($top) curnum]
    catch "$top.$mfp(head) yview -pickplace [mfv:cursingle $top]"  
  }
  
  return 1
}

proc mfv:mesg-undelete-last { top } {
  # undelete last deleted message
  global mf mfp mfdb

  keylget mfp($top) file folder
  if {[set ndx [llength $mfp($top,delmesg)]] < 1} {
    mfv:error-mesg "No messages left to undelete" $top
    return 1
  }
  set msg [lindex $mfp($top,delmesg) [incr ndx -1]]
  return [mfv:mesg-undelete $top $msg]
}

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

  if [lempty $msg] { return 1 }

  keylget mfp($top) file folder

  set newlist {}
  if {$msg == "all"} {
    set mstart [lindex $mfp($top,delmesg) 0]
    if {[set stat [mfdb:mesg-undelete $folder $mfp($top,delmesg)]]} {
      mfv:error-mesg $mfdb(last-error) $top
      return $stat
    }
    set mfp($top,delmesg) {}
  } else {
    set mstart [lindex $msg 0]
    if {[set stat [mfdb:mesg-undelete $folder $msg]]} {
      mfv:error-mesg $mfdb(last-error) $top
      return $stat
    }
    foreach num $mfp($top,delmesg) {
      if {[lsearch -exact $msg $num] == -1} {
	lappend newlist $num
      }
    }
    set mfp($top,delmesg) $newlist
  }

  if {[set stat [mfdb:folder-summary $folder lsum $mfp($top,reverse) $mfp($top,sort)]]} {
    # DIRTY
    mfv:error-mesg $mfdb(last-error) $top
    mfv:wait-off
    return $stat
  }

  foreach viewer $mfp(toplist) {
    if {[mfdb:same-files $folder [keylget mfp($viewer) file]]} {
      set mfp($viewer,delmesg) $newlist
      $viewer.$mfp(head) delete 0 end
      eval "$viewer.$mfp(head) insert end $lsum"
      if {$viewer == $mfp(curview)} {mfv:goto-mesg $viewer $mstart}
    }
  }

  return 0
}

proc mfv:save { top filename {type mesg} {tw ""}} {
  # save currently selected messages in viewer <top> to nonfolder <filename>
  # if <type> is "xsel", current X selection is saved
  global mf mfp mfdb

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

  foreach top $mfp(toplist) {
    if {[mfdb:same-files $filename [keylget mfp($top) file]]} {
      mfv:error-mesg "Can't do a SAVE to a mail folder. Try COPY." $top
      return 0
    }
  }

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

  case $type {
    { mesg } {
      keylget mfp($top) file folder
      set savelist {}
      foreach ndx [$top.$mfp(head) curselection] {
	set num [mfv:head-to-num $top $ndx]
	lappend savelist $num
	if {[mfdb:mesg-save $folder $num $filename]} {
	  mfv:error-mesg $mfdb(last-error) $top
	  return 0
	}
      }
      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 0
      }
      if {[mfdb:var-to-file str $filename]} {
	mfv:error-mesg $mfdb(last-error) $top
	return 0
      }
      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 0
      }
      if {[mfdb:text-to-file $tw $filename]} {
	mfv:error-mesg $mfdb(last-error) $top
	return 0
      }
      set res "Saved contents of $tw to $filename"
    }
    default { mfv:error-mesg "Invalid save type" $top; return 0}
  }
  
  mfv:log-mesg $top $res
  return 1
}

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

  if {![mfv:ask-create $filename -master $top]} {return 0}
  
  set copylist {}
  keylget mfp($top) file folder

  foreach ndx [$top.$mfp(head) curselection] {
    set num [mfv:head-to-num $top $ndx]
    lappend copylist $num
    pdebug "$folder $num $filename"
    if {[mfdb:mesg-save $folder $num $filename 0]} {
      # DIRTY
      mfv:error-mesg $mfdb(last-error) $top
      return 0
    }
  }

  foreach viewer $mfp(toplist) {
    if {[mfdb:same-files $filename [keylget mfp($viewer) file]]} {
      keylget mfp($viewer) mesgnum mesgnum
      set newnum [expr $mesgnum+[llength $copylist]]
      incr mesgnum
      if {$mfp($viewer,sort) == "normal"} {
	if {[mfdb:folder-summary $filename lsum 0 normal $mesgnum $newnum]} {
	  mfv:error-mesg $mfdb(last-error) $top
	}
	if {$mfp($viewer,reverse)} {
	  eval "$viewer.$mfp(head) insert 0 $lsum"
	} else {
	  eval "$viewer.$mfp(head) insert end $lsum"
	}
      } else {
	if {[mfdb:folder-summary $filename lsum $mfp($viewer,reverse) $mfp($viewer,sort)]} {
	  mfv:error-mesg $mfdb(last-error) $top
	}
	$viewer.$mfp(head) delete 0 end
	eval "$viewer.$mfp(head) insert end $lsum"
      }
      keylset mfp($viewer) mesgnum $mesgnum
    }
  }

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

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

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

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

  pack $w.noprompt -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

  pack $w.pipetype.discard $w.pipetype.replace $w.pipetype.append -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 mfdb_hdr mfdb
  
  set pipecall {}
  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(toplist) {
	$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 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)]
  
  case $type {
    { mesg } {
      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
      }
      foreach pmsg $pipelist {
	if {[mfdb:mesg-save [keylget mfp($top) file] $pmsg $tfile $dostrip]} {
	  mfv:error-mesg "ERROR: can't get message" $top
	  return 0
	}
      }
    }
    { xsel } { 
      if {[set str [selection_if_any]] == ""} {
	mfv:error-mesg "No X selection exists to print" $top
	return 0
      }
      if {[catch "open $tfile w" tfid]} {
	mfv:error-mesg "ERROR: $tfid" $top
	return 0
      }
      puts $tfid $str
      catch {close $tfid}
    }
    { tw } { 
      if {[catch "open $tfile w" tfid]} {
	mfv:error-mesg "ERROR: $tfid" $top
	return 0
      }
      puts $tfid [$tw get 1.0 end]
      catch {close $tfid}
    }
    default { 
      mfv:error-mesg "Invalid pipe type" $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 {$type == "mesg"} {
      set prdate {UNKNOWN}; keylget mfdb_hdr($top.$mfp(mesg)) date prdate
      set prfrom {UNKNOWN}; keylget mfdb_hdr($top.$mfp(mesg)) from prfrom
      set prsubj {UNKNOWN}; keylget mfdb_hdr($top.$mfp(mesg)) subject prsubj
    } 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"
  }
  
  set cmd "exec $pcmd"
  if {[catch $cmd res]} {
    mfv:error-mesg $res $top
    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 sel.first"]} {
	bt:text-replace $tw "$res\n" sel.first sel.last
      }
    } elseif {$mfp(pipe-type) == 2} {
      if {![catch "$tw mark set insert sel.last"]} {
	bt:text-insert $tw "$res\n"
      }
    }
  }

  set cmd {exec /bin/rm $tfile}
  if {[catch "eval $cmd" res]} {
    mfv:error-mesg $res $top
    return 0
  }
  
  return 1
}

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

  if {[lempty $top]} {set top $mfp(top)}
  set tfile [tmpfile tkmail $mf(mail-tmpdir)]
  keylget mfp($top) file folder
  if {[lempty $msg] && ![keylget mfp($top) curnum msg]} {
    mfv:error-mesg "Could not determine current message" $top
    return
  }
  mfdb:mesg-save $folder $msg $tfile 0

  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"
    }
    set prdate {UNKNOWN}; keylget mfdb_hdr($top.$mfp(mesg)) date prdate
    set prfrom {UNKNOWN}; keylget mfdb_hdr($top.$mfp(mesg)) from prfrom
    set prsubj {UNKNOWN}; keylget mfdb_hdr($top.$mfp(mesg)) subject 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 "XTERM: $res" $top
  }
  catch {exec /bin/rm $tfile}
}

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> {global mfp; 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 [mfv:search-text $w.txt ^$section -sndx 1.0 -view 0 -regexp 1]
  } else {
    set loc 1.0
  }
  $w.txt yview $loc
  $w.txt mark set insert $loc
  focus $w.txt
}

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

  if [lempty $vlist] { set vlist $mfp(toplist) }
  foreach viewer $vlist {

    if {![$viewer.$mfp(head) size]} continue

    if {[set stat [mfdb:folder-summary [keylget mfp($viewer) file] lsum $mfp($viewer,reverse) $mfp($viewer,sort)]]} {
      mfv:error-mesg $mfdb(last-error)
      return 1
    } else {
      set cur [mfv:head-to-num $viewer [mfv:cursingle $viewer]]

      $viewer.$mfp(head) delete 0 end
      eval "$viewer.$mfp(head) insert end $lsum"

      if $cur {mfv:goto-mesg $viewer $cur 0}
    }
  }
  return 0
}

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

  if {[lempty $folder]} return
  if {![mfdb:file-test -r $folder]} {
    mfv:error-mesg "File $folder not readable" $top
    return 0
  }

  if {$new} {
    mfv:wait-on
    mfv:new-viewer $folder 0 0 $ndx
  } else {
    if [mfv:setup-folder $top $folder $ndx] {return 0}
  }
  if {$add} {
    mfv:add-recent $folder
  }
  return 1
}

proc mfv:explicit-save { top folder type} {
  if {[lempty $folder]} return
    if {[mfv:save $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 {
      be:$op $w
    }
    Text {
      bt:$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 {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]}
  }
}
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]
  }
}

proc mfv:stext-save { w } {
  mfv:save $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:split-mesg-view { top } {
  global mf mfp

  set newheight [expr [lindex [$top.mesg.yscroll get] 1]/2]
  $top.mesg.txt configure -height $newheight
  $top.mesg2.txt configure -height $newheight

  pack $top.sep2 -after $top.mesg -side top -fill x
  pack $top.mesg2 -after $top.sep2 -side top -expand true -fill both
  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
}

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

  set newheight [lindex [$top.mesg.yscroll get] 1]
  incr newheight [lindex [$top.mesg2.yscroll get] 1]
  $top.mesg.txt configure -height [incr newheight 1]
  pack forget $top.mesg2
  pack forget $top.sep2
  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.$mfp(mesg) -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> {global mfp; set mfp(curtop) %W}
  # mfdb:mesg-to-text $filename $msg $w.txt end 
  mfv:copy-text-withtags $top.$mfp(mesg) $w.txt 1 1

  # source users mfv:detach-hook procedure if defined
  if {[info procs mfv:detach-hook] == "mfv:detach-hook"} {
    mfv:detach-hook $w
  }

}

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

  set scr [lindex [lindex [$w configure -yscroll] 4] 0]
  set mfp(sash-hh)  [lindex [$scr get] 1]
  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 -y $y \
      -relwidth 0.95
  place configure $top.handle$n -in $top -relx 0.8 -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 scr [lindex [lindex [$top.mesg2.txt configure -yscroll] 4] 0]
  set hh [lindex [$scr get] 1]

  $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 \
      -relwidth 0.95
  place configure $top.handle2 -in $top.sep2 -relx 0.8 -rely 0.4 \
      -anchor center
}

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 \
      -relwidth 0.95
  place configure $top.handle1 -in $top.sep1 -relx 0.8 -rely 0.4 \
      -anchor center
}

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 mfdb

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

  if {[mfdb:file-test -e $filename]} {
    if {![mfdb:file-test -w $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 != "/" && ![mfdb:file-test -e $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:same-files { file1 file2 } {
  # check if <file1> and <file2> are really the same file

  file stat $file1 stat1
  file stat $file2 stat2
  if {$stat1(dev) == $stat2(dev) && \
	$stat1(ino) == $stat2(ino)} {return 1}
  return 0
}

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

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

proc mfv:toggle-video { args } {
  foreach tw $args {
    set backgr [lindex [$tw configure -background] 4]
    $tw configure -background \
	[lindex [$tw configure -foreground] 4]
    $tw configure -foreground $backgr
    if {[lsearch [$tw tag names] headers] > -1} {
      set backgr [lindex [$tw tag configure headers -background] 4]
      $tw tag configure headers -background \
	  [lindex [$tw tag configure headers -foreground] 4]
      $tw tag configure headers -foreground $backgr
    }
  }
}

proc mfv:toggle-fixed-font { top tw } {
  global mf mfp

  if $mfp($top,fixed) {
    set fntbase "[lindex $mf(mime-font-fixed) 0]-[lindex $mf(mime-font-fixed) 1]"
    set fntsize [lindex $mf(mime-font-fixed) 2]
  } else {
    set fntbase "[lindex $mf(mime-font-default) 0]-[lindex $mf(mime-font-default) 1]"
    set fntsize [lindex $mf(mime-font-default) 2]
  }
  if {[set font [mfv:get-font $tw $fntbase medium r $fntsize us-ascii]] != "fixed"} {
    $tw configure -font $font
  } else {
    puts stderr "Couldn't get font for $fntbase-$fntsize"
  }
}

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> {global mfp; set mfp(curtop) %W}
    bind $w <Visibility> {global mfp; 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(toplist) {
      $viewer.menu.mail.m add command -label $alias \
	  -command "mfv:compose -viewer $top -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
      }
    }
  }
}

