# mime.tk - support file for TkMail 
#	    commands for MIME operations
#
# $Header: /u/ra/raines/src/tk/tkmail2/mime.tk,v 1.2 1995/05/22 18:10:16 raines Exp $

proc mfv:parse-mime-in { folder msg tw prefix textonly } {
  global mfdb mfdb_hdr mf mfp

  set top [winfo toplevel $tw]
  set fntbase "[lindex $mf(mime-font-default) 0]-[lindex $mf(mime-font-default) 1]"
  set fntsize [lindex $mf(mime-font-default) 2]
  set tagcnt 0
  set multinum 0
  set curmulti 0
  set curtype mixed
  set mimelevel {}
  set already {}
  set digestfile {}
  set digestlist {}

  while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} {
    if {[string first $mfdb(signalexfile) $line] == 0} {
      if [set ret [mfdb:exfile-to-text $tw $prefix]] {
	mfv:perl-abort
	return 255
      }      
    } elseif {[string first $mfdb(signalmime) $line] == 0} {
      foreach var {type subtype} {
	if {[string first $mfdb(signalend) [set $var [gets stdin]]] == 0} {
	  puts stderr "ERROR parsing MIME message for $var"
	  mfv:perl-abort
	  return 255
	}
      }
      if {$type == "multipart"} {
	if {$subtype == "end"} {
	  if {$curtype == "parallel" && !$textonly} {
	    set tndx [$tw index insert]
	    $tw insert insert "        Click here to play all the above parallel items\n\n"
	    $tw tag add mime$tagcnt "$tndx +7 chars" "$tndx lineend"
	  }
	  $tw insert insert  "${prefix}MIME MULTIPART $curmulti: END\n"
	  $tw insert insert "${prefix}\n"
	  set ndx [llast $mimelevel]
	  set curtype [lindex [lindex $mimelevel $ndx] 0]
	  set curmulti [lindex [lindex $mimelevel $ndx] 1]
	  set mimelevel [lreplace $mimelevel $ndx $ndx]
	} else {
	  lappend mimelevel [list $curtype $curmulti]
	  incr multinum
	  set curmulti $multinum
	  set curtype $subtype
	  $tw insert insert "${prefix}\n"
	  $tw insert insert "${prefix}MIME MULTIPART $curmulti: List of $curtype items\n"
	}
      } else {
	foreach var {param id desc tmpfile} {
	  if {[string first $mfdb(signalend) [set $var [gets stdin]]] == 0} {
	    puts stderr "ERROR parsing MIME message for $var"
	    mfv:perl-abort
	    return 255
	  }
	}
	set start [$tw index insert]
	if {"$type/$subtype" == "message/rfc822" && $tmpfile != "" && 
	    $curtype == "digest"} {
	  if {!$textonly} { lappend digestlist $tmpfile }
	  $tw insert insert "${prefix}   <$curmulti> digest message extracted\n"
	} elseif {$tmpfile != ""} {
	  $tw insert insert "${prefix}    <$curmulti> $type/$subtype:$desc\n"
	  if {[string first "external:" $tmpfile] == 0} {
	    set accesstype "unknown"
	    regexp -nocase {access-type=\"*([^;\"]+)} $tmpfile trash accesstype
	    $tw insert insert "${prefix}         External body part with $accesstype access\n"
	    if {[regexp -nocase {expiration=\"*([^;\"]+)} $tmpfile trash expire]} {
	      $tw insert insert "${prefix}         Expiration: $expire\n"
	    }
	    if {[regexp -nocase {size=\"*([^;\"]+)} $tmpfile trash size]} {
	      $tw insert insert "${prefix}         Size: $size bytes\n"
	    }
	    if {[regexp -nocase {name=\"*([^;\"]+)} $tmpfile trash name]} {
	      $tw insert insert "${prefix}         Name: $name\n"
	    }
	  }
	  if {!$textonly} {
	    if {[lsearch -exact $already $curmulti] == -1} {
	      mfv:mime-new-tag $tw [incr tagcnt]
	      lappend already $curmulti
	    } elseif {$curtype != "parallel"} {
	      mfv:mime-new-tag $tw [incr tagcnt]
	    }
	    set tndx [$tw index insert]
	    if {$curtype != "parallel"} {
	      if {"$type/$subtype" == "message/partial"} {
		$tw insert insert "         CLICK HERE to extract this part for later assembly\n"
		$tw tag add mime$tagcnt "$tndx +8 chars" "$tndx +19 chars"
	      } elseif {"$type/$subtype" == "message/rfc822"} {
		$tw insert insert "         CLICK HERE to process this enclosed message in place\n"
		$tw tag add mime$tagcnt "$tndx +8 chars" "$tndx +19 chars"
	      } else {
		$tw insert insert "         CLICK HERE to run appropriate viewer\n"
	      }
	      $tw tag add mime$tagcnt "$tndx +8 chars" "$tndx +19 chars"
	    }
	    set stop [$tw index "$tndx lineend"]
	    set cmd "mfv:mime-external-view $type $subtype {$param} {$tmpfile} $folder $msg $tw $start $stop mime$tagcnt"
	    if [catch {set pcmd [$tw tag bind mime$tagcnt <1>]}] {
	      $tw tag bind mime$tagcnt <1> $cmd
	      append cmd { 1}
	      $tw tag bind mime$tagcnt <Shift-1> $cmd
	    } else {
	      $tw tag bind mime$tagcnt <1> "$pcmd; $cmd"
	      append cmd { 1}
	      $tw tag bind mime$tagcnt <Shift-1> "$pcmd; $cmd"
	    }
	  }
	  if {$curtype == "mixed"} { $tw insert insert "${prefix}\n" }
	}
	if {"$type/$subtype" == "text/enriched"} {
	  set charset us-ascii
	  regexp {charset=\"*([^;\"]+)} $param trash charset
	  mfv:parse-enriched $tw $charset $prefix $textonly 0
	} elseif {"$type/$subtype" == "text/richtext"} {
	  set charset us-ascii
	  regexp {charset=\"*([^;\"]+)} $param trash charset
	  mfv:parse-enriched $tw $charset $prefix $textonly 1
	} else {
	  while {[string first $mfdb(signalmimeend) [set line [gets stdin]]] != 0} {
	    if {[string first $mfdb(signalend) $line] == 0} break
	    $tw insert insert $prefix$line\n
	  }
	}
	if {"$type/$subtype" == "text/plain"} {
	  if {[regexp {charset=\"*([^;\"]+)} $param trash charset]} {
	    if {[set font [mfv:get-font $tw $fntbase medium r $fntsize $charset]] != "fixed"} {
	      $tw tag configure $charset -font $font
	      $tw tag add $charset $start "insert -1 char"
	    }
	  }
	}
	update idletasks
      }
    } else {
      $tw insert insert $prefix$line\n
    }
    if {[string first $mfdb(signalend) $line] == 0} break
  }
  set stat [mfdb:get-status $line]

  if {[llength $digestlist]} {
    if {[ut:getok -master $top \
	     -prompt "This messages contains a digest. Write it to a folder?"]} {
      cd $mf(mail-directory)
      set digestfile [mfv:get-filename -master $top]
      if {[string length $digestfile]} {
	set mfp(perlfree) 1
	if {[set nstat [mfv:mail-incorp $top 1 $digestlist $digestfile]]} {
	  set stat $nstat      
	  $tw insert insert "\nMIME: ERROR writing digest messages to $digestfile"
	} else {
	  $tw insert insert "\nMIME: [llength $digestlist] digest messages written to $digestfile"
	}
      }
    }
  }

  return $stat
}

proc mfv:mime-new-tag { tw num } {
  catch "$tw tag delete mime$num"
  $tw tag configure mime$num -borderwidth 2 -relief raised \
      -background [lindex [.mf0.bb.quit configure -background] 4] \
      -font [lindex [.mf0.bb.quit configure -font] 4]
  $tw tag bind mime$num <Enter> "%W configure -cursor left_ptr"
  $tw tag bind mime$num <Leave> "%W configure -cursor xterm"
}

proc mfv:mime-partial-incorp { top file } {
  global mf mfp

  keylget mfp($top) file folder
  set stat [mfv:mail-incorp $top 0 $file $folder]
}

proc mfv:mime-external-view { type subtype param file folder msg tw start stop tag {prompt 0}} {
  global mf mfp mfdb

  set top [winfo toplevel $tw]
  mfv:wait-on
  set ftype "$type/$subtype"

  if {[string first "external:" $file] == 0} {
    set extparam $file
    regexp -nocase {access-type=\"*([^;\"]+)} $extparam trash accesstype
    regexp -nocase {name=\"*([^;\"]+)} $extparam trash name
    regexp {ENCODING=\"*([^;\"]+)} $extparam trash enc
    regexp {FILE-ID=\"*([^;\"]+)} $extparam trash fid
    regexp {FILEPOS=\"*([^;\"]+)} $extparam trash filepos

    if {$accesstype == "local-file"} {
      set file $name
    } else {
      mfv:error-mesg "Sorry. Can't handle external type $accesstype yet" $top
      mfv:wait-off; return 255
    }

    if {$enc == "base64" || $enc == "quoted-printable"} {
      puts stdout "mfdb:mime-decode\t$enc\t$file\t$fid\t$filepos"
      flush stdout
      while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} {
	set file $line
      }
      if {[set stat [mfdb:get-status $line]]} {
	mfv:error-mesg $mfdb(last-error) $top
	mfv:wait-off; return $stat
      }
    }
  }

  if {$ftype == "text/plain"} {
    $tw configure -state normal
    $tw delete $start $stop
    $tw mark set insert $start
    set stat [mfdb:file-to-text $file $tw $start {}]

    set fntbase "[lindex $mf(mime-font-default) 0]-[lindex $mf(mime-font-default) 1]"
    set fntsize [lindex $mf(mime-font-default) 2]
    if {[regexp {charset=\"*([^;\"]+)} $param trash charset]} {
      if {[set font [mfv:get-font $tw $fntbase medium r $fntsize $charset]] != "fixed"} {
	$tw tag configure $charset -font $font
	$tw tag add $charset $start "insert -1 char"
      }
    }

    if {[string match ".mf*$mfp(mesg)" $tw]} {
      $tw configure -state $mf(viewer-state)
    }
    mfv:wait-off; return $stat
  }

  if {$ftype == "text/enriched"} {
    $tw configure -state normal
    $tw delete $start $stop
    $tw mark set insert $start

    puts stdout "mfdb:file-read\t$filename"
    flush stdout

    $tw mark set insert $ndx
    set charset us-ascii
    regexp {charset=\"*([^;\"]+)} $param trash charset
    set stat [mfv:parse-enriched $tw $charset {} 0]

    if {[string match ".mf*$mfp(mesg)" $tw]} {
      $tw configure -state $mf(viewer-state)
    }
    mfv:wait-off; return $stat
  }

  if {$ftype == "message/partial"} {
    pdebug "Extracting message/partial with $file\n"
    puts stdout "mfdb:parse-partial\t$file"
    flush stdout
    if {[string first $mfdb(signalend) [set line [gets stdin]]] == 0} {
      if {[set stat [mfdb:get-status $line]]} {
	mfv:error-mesg $mfdb(last-error) $top
      }
      mfv:wait-off; return $stat
    } else {
      set tmpfile $line
    }
    if {[string first $mfdb(signalend) [set line [gets stdin]]] == 0} {
      if {[set stat [mfdb:get-status $line]]} {
	mfv:error-mesg $mfdb(last-error) $top
      }
      mfv:wait-off; return $stat
    } else {
      set mesg $line
    }
    $tw configure -state normal
    $tw mark set insert "$start +1 line"
    $tw delete insert "$stop lineend"
    if {[string length $tmpfile]} {
      $tw insert insert "         All parts have been fully reassambled as $tmpfile\n"
      $tw insert insert "         You can open it as a separate folder using Open... menu item\n"
      set tndx [$tw index insert]
      $tw insert insert "         or you can CLICK HERE to move the message to the end of this folder\n"
      $tw tag add $tag "$tndx +19 chars" "$tndx +30 chars"
      $tw tag bind $tag <1> "mfv:mime-partial-incorp $top $tmpfile"
    } else {
      $tw insert insert $mesg
    }
    if {[string match ".mf*$mfp(mesg)" $tw]} {
      $tw configure -state $mf(viewer-state)
    }
    while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} { }
    if {[set stat [mfdb:get-status $line]]} { 
      mfv:error-mesg $mfdb(last-error) $top
    }
    mfv:wait-off; return $stat
  }

  if {$ftype == "message/rfc822"} {
    pdebug "Processing enclosed message/rfc822 with $file\n"
    $tw configure -state normal
    $tw mark set insert $start
    $tw delete insert "$stop lineend"
    puts stdout "mfdb:parse-rfc822\t$file"
    flush stdout
    set stat [mfv:parse-mime-in $tw "" 0]
    if {[string match ".mf*$mfp(mesg)" $tw]} {
      $tw configure -state $mf(viewer-state)
    }
    if {$stat} { 
      mfv:error-mesg $mfdb(last-error) $top
    }
    mfv:wait-off; return $stat
  }

  if {$ftype == "application/octet-stream" &&
      [string first "\004" $file] == 0} {
    pdebug "Processing enclosed appl/octet with $file\n"
    set encfile [lindex [split $file \t] 3]
    set putdir [ut:getstr -prompt "Where should the file $encfile be placed?" \
		    -master $top -fc 1]
    if {![string length $putdir]} {
      mfv:wait-off; return 255
    }
    if {![mfdb:file-test -d $putdir]} {
      mfv:error-mesg "$putdir is not a directory" $top
      mfv:wait-off; return 255
    }
    if {[mfdb:file-test -e $putdir/$encfile]} {
      if {![ut:getok -master $top -prompt "Overwrite existing file $encfile?"]} {
	mfv:wait-off; return 0
      }
    }
    puts stdout "mfdb:parse-enc-octet\t[string range $file 1 end]\t$putdir"
    flush stdout
    while {[string first $mfdb(signalend) [set line [gets stdin]]] != 0} { }
    if {[set stat [mfdb:get-status $line]]} { 
      mfv:error-mesg $mfdb(last-error) $top
    }
    mfv:wait-off; return $stat
  }

  set cmd $mf(mime-external-default)
  foreach rule $mf(mime-external-viewers) {
    if {[regexp -nocase "^${ftype}$" [lindex $rule 0]]} {
      set cmd [lindex $rule 1]
      break
    }
    if {[regexp -nocase "^${type}$" [lindex $rule 0]]} {
      set cmd [lindex $rule 1]
    }
  }
  if {![string length [string trim $cmd]] || 
      [regexp -nocase "@prompt" $cmd] || $prompt} {
    return [mfv:mime-to-file $top $tw $ftype $file $stop $start]
  }
  if {[regsub -all {([^%]|^)%([FTtAS])} $cmd "\\1\004\\2\004" cmd]} {
    regsub -all {%%} $cmd {%} cmd
    if {![regsub -all "\004F\004" $cmd $file cmd]} {
      append cmd " $file" 
    }
    regsub -all "\004T\004" $cmd "'$ftype; $param'" cmd
    regsub -all "\004t\004" $cmd $ftype cmd
    mfdb:mesg-get-header $folder $msg "From" whofrom
    regsub -all "\004A\004" $cmd "'$whofrom'" cmd
    mfdb:mesg-get-header $folder $msg "Subject" subject
    regsub -all "\004S\004" $cmd "'$subject'" cmd

  } else {
    regsub -all {%%} $cmd {%} cmd
    append cmd " $file" 
  }
  if {[set pid [mfdb:run-command $cmd]]} {
    mfv:log-mesg $top "Forked process $pid: ran $cmd in background"
  } else {
    mfv:error-mesg $mfdb(last-error)
    mfv:wait-off; return 1
  }
  mfv:wait-off; return 0
}

proc mfv:mime-to-file { top tw ftype file stop start} {
  set encfile [ut:getstr -prompt "Into what file should the enclosed be placed?" \
		  -master $top -fc 1]
  if {![string length $encfile]} {
    mfv:wait-off; return 255
  }
  set putdir [file dirname $encfile]
  set encfile [file tail $encfile]
  if {![mfdb:file-test -d $putdir]} {
    mfv:error-mesg "$putdir is not a directory" $top
    mfv:wait-off; return 255
  }
  if {[mfdb:file-test -e $putdir/$encfile]} {
    if {![ut:getok -master $top -prompt "Overwrite existing file $encfile?"]} {
      mfv:wait-off; return 0
    }
  }
  set ndx [$tw index "$stop linestart"]
  $tw delete $ndx "$stop lineend"
  $tw insert $ndx "        $ftype contents written to $putdir/$encfile"
  mfv:log-mesg $top "$ftype contents written to $putdir/$encfile"
  if {[catch {exec mv $file $putdir/$encfile} res]} {
    mfv:error-mesg "Error executing 'mv $file $putdir/$encfile':\n$res"
    mfv:wait-off; return 1
  }
  mfv:wait-off; return 0
}

proc mfv:get-font {tw base weight slant size charset} {

  set charset [string tolower $charset]
  if {$charset == "us-ascii"} { 
    set charset *
  } elseif {[regexp {iso-8859-([1-9])} $charset trash num]} {
    set charset "iso8859-$num"
  }

  set font "-$base-$weight-$slant-normal-*-$size-*-*-*-*-*-$charset"
  if {![catch "$tw tag configure test -font \$font" res]} {
    return $font
  }

  if {$weight == "medium"} {
    set font "-$base-regular-$slant-normal-*-$size-*-*-*-*-*-$charset"
    if {![catch "$tw tag configure test -font \$font"]} {
      return $font
    }
  }

  if {$slant == "i"} {
    set font "-$base-$weight-o-normal-*-$size-*-*-*-*-*-$charset"
    if {![catch "$tw tag configure test -font \$font"]} {
      return $font
    }
    if {$weight == "medium"} {
      set font "-$base-regular-o-normal-*-$size-*-*-*-*-*-$charset"
      if {![catch "$tw tag configure test -font \$font"]} {
	return $font
      }
    }
  }

  if {$charset != "*"} {
    return [mfv:get-font $tw $base $weight $slant $size *]
  }
  return fixed
}

proc mfv:set-tag-font {tw font under} {
  if {[lsearch [$tw tag names] t$under-$font] > -1} return
  $tw tag configure t$under-$font -font $font -underline $under
}

proc mfv:parse-enriched {tw charset prefix textonly {richtext 0}} {
  global mf mfp mfdb

  set tagslist {}
  set tagstart [$tw index insert]
  set weight medium
  set slant r
  set fntbase "[lindex $mf(mime-font-default) 0]-[lindex $mf(mime-font-default) 1]"
  set fntsize [lindex $mf(mime-font-default) 2]
  set curfont [mfv:get-font $tw $fntbase medium r $fntsize $charset]
  set curtag t0-$curfont
  mfv:set-tag-font $tw $curfont 0

  set chars 0
  set on 1
  set charsetlist $charset

  set nofill 0
  set just {0 0 0}
  set bold 0
  set italic 0
  set fixed 0
  set smaller 0
  set bigger 0
  set underline 0
  set excerpt 0
  set param 0

  set indent 0
  set indenttxt $prefix
  set indentlen [string length $indenttxt]
  set indentright 0
  set max 72

  set retstat 0
  while {[string first $mfdb(signalmimeend) [set line [gets stdin]]] != 0} {
    if {[string first $mfdb(signalend) $line] == 0} {
      set retstat [mfdb:get-status $line]
      break
    }
    if {$on && (([lempty $line] && !$richtext) || $nofill)} {
      $tw insert insert \n
      set chars 0
      continue
    }
    append line " "
    while {[set ndx [string first "<" $line]] > -1} {
      set skipit 0
      set str [string range $line 0 [expr $ndx-1]]
      set line [string range $line [incr ndx] end]
      if {[string first "<" $line] == 0} {
	append str "<"
	set line [string range $line 1 end]
	set skipit 1
      }
      if {[set len [string length $str]] && $on} {
	if {!$chars} {
	  $tw insert insert $indenttxt
	  set chars $indentlen
	}
	set lastchar [expr $max-$chars]
	while {$len > $lastchar} {
	  while {![string match {[ 	]} [string index $str $lastchar]] &&
		 $lastchar > 0} {
	    incr lastchar -1
	  }
	  if {$lastchar < 1} {
	    set lastchar [expr $max-$chars]
	    while {![string match {[ 	]} [string index $str $lastchar]] &&
		   $lastchar < $len} {
	      incr lastchar
	    }
	  }
	  $tw insert insert [string range $str 0 $lastchar]
	  incr lastchar
	  set str [string trimleft [string range $str $lastchar end]]
	  set len [string length $str]
	  $tw insert insert "\n$indenttxt"
	  set chars $indentlen
	  set lastchar [expr $max-$chars]
	}
	$tw insert insert $str
	incr chars $len
      }
      if {$skipit} continue
      while {[set ndx [string first ">" $line]] < 0} {
	set addline [gets stdin]
	if {[string first $mfdb(signalmimeend) $addline] == 0 ||
	    [string first $mfdb(signalend) $addline] == 0} {
	  mfv:error-msg "Error parsing enriched text" [winfo toplevel $tw]
	  return
	}
	append line $addline
      }
      set format [string trim [string tolower [string range $line 0 [expr $ndx-1]]]]
      set line [string range $line [incr ndx] end]
      if {!$chars} {
	set line [string trimleft $line]
      }
      set update 0
      switch -regexp $format {
	{^lt} {
	  $tw insert insert {<}
	}
	{^nl} {
	  $tw insert insert \n
	}
	{^np} {
	  $tw insert insert \n\n\n
	}
	{/paragraph} {
	  $tw insert insert \n\n
	}
	{paragraph} {
	  if [$tw compare "insert linestart" != insert] {
	    $tw insert insert \n\n
	  } elseif [$tw compare "insert -1 line linestart" != "insert -1 line end"] {
	    $tw insert insert \n
	  }
	}
	{(/us-ascii|/iso-8859-.*)} {
	  set charsetlist [lreplace $charsetlist 0 0]
	  if [llength $charsetlist] {
	    set charset [lindex $charsetlist 0]
	    set update 1
	  } else {
	    set charsetlist $charset
	  }
	}
	{(us-ascii|iso-8859-.*)} {
	  set charsetlist [linsert $charsetlist 0 $format]
	  set charset us-ascii
	  set update 1
	}
	{/bold} {
	  incr bold -1
	  if {!$bold} {set weight medium; set update 1}
	}
	{bold} {
	  if {!$bold} {set weight bold; set update 1}
	  incr bold
	}
	{/italic} {
	  incr italic -1
	  if {!$italic} {set slant r; set update 1}
	}
	{italic} {
	  if {!$italic} {set slant i; set update 1}
	  incr italic
	}
	{/underline} {
	  incr underline -1
	  if {!$underline} {set update 1}
	}
	{underline} {
	  if {!$underline} {set update 1}
	  incr underline
	}
	{/fixed} {
	  incr fixed -1
	  if {!$fixed} {
	    set fntbase "[lindex $mf(mime-font-default) 0]-[lindex $mf(mime-font-default) 1]"
	    set update 1
	  }
	}
	{fixed} {
	  if {!$fixed} {
	    set fntbase "[lindex $mf(mime-font-fixed) 0]-[lindex $mf(mime-font-fixed) 1]"
	    set update 1
	  }
	  incr fixed
	}
	{/smaller} {
	  incr fntsize 2
	  set update 1
	  incr smaller -1
	}
	{smaller} {
	  incr fntsize -2
	  set update 1
	  incr smaller
	}
	{/bigger} {
	  incr fntsize -2
	  set update 1
	  incr smaller -1
	}
	{bigger} {
	  incr fntsize 2
	  set update 1
	  incr smaller
	}
	{/nofill} {
	  set just [lreplace $just 0 0]
	  set nofill [lindex $just 0]
	  if {$on} {
	    $tw insert insert \n
	    set chars 0
	  }
	}
	{nofill} {
	  set just [linsert $just 0 1]
	  set nofill 1
	  if {$on} {
	    $tw insert insert \n
	    set chars 0
	  }
	}
	{/center} {
	  set just [lreplace $just 0 0]
	  set nofill [lindex $just 0]
	  if {$on} {
	    $tw insert insert \n
	    set chars 0
	  }
	}
	{center} {
	  set just [linsert $just 0 0]
	  set nofill 0
	  if {$on} {
	    $tw insert insert \n
	    set chars 0
	  }
	}
	{/flush.*} {
	  set just [lreplace $just 0 0]
	  set nofill [lindex $just 0]
	  if {$on} {
	    $tw insert insert \n
	    set chars 0
	  }
	}
	{flush.*} {
	  set just [linsert $just 0 0]
	  set nofill 0
	  if {$on} {
	    $tw insert insert \n
	    set chars 0
	  }
	}
	{(/indentright|^outdentright)} {
	  incr indentright -1
	  incr max 4
	}
	{(indentright|/outdentright)} {
	  incr indentright
	  incr max -4
	}
	{(/indent|^outdent)} {
	  incr indent -1
	  if {$indent < 0} {
	    set indent 0
	  } else {
	    set indenttxt [string range $indenttxt 0 [expr $indentlen-5]]
	    set indentlen [string length $indenttxt]
	  }
	}
	{(indent|/outdent)} {
	  incr indent
	  append indenttxt "    "
	  set indentlen [string length $indenttxt]
	  if {!$chars && $on} {
	    $tw insert insert $indenttxt
	    set chars $indentlen
	  }
	}
	{(/excerpt|/signature)} {
	  incr indent -1
	  set indenttxt [string range $indenttxt 0 [expr $indentlen-5]]
	  set indentlen [string length $indenttxt]
	  incr indentright -1
	  incr max 4
	}
	{(excerpt|signature)} {
	  incr indent
	  append indenttxt "    "
	  set indentlen [string length $indenttxt]
	  incr indentright
	  incr max -4
	}
	{(/comment|/param|/heading|/footing)} {
	  set on 1
	}
	{(comment|param|heading|footing)} {
	  set on 0
	}
      }
      if {$update} {
	lappend tagslist [list $curtag $tagstart [$tw index insert]]
	set tagstart [$tw index insert]
	set curfont [mfv:get-font $tw $fntbase $weight $slant $fntsize $charset]
	mfv:set-tag-font $tw $curfont $underline
	set curtag t$underline-$curfont
      }
    }
    if {[set len [string length $line]] && $on} {
      if {!$chars} {
	$tw insert insert $indenttxt
	set chars $indentlen
      }
      set lastchar [expr $max-$chars]
      while {$len > $lastchar} {
	while {![string match {[ 	]} [string index $line $lastchar]] &&
	       $lastchar > 0} {
	  incr lastchar -1
	}
	if {$lastchar < 1} {
	  set lastchar [expr $max-$chars]
	  while {![string match {[ 	]} [string index $line $lastchar]] &&
		 $lastchar < $len} {
	    incr lastchar
	  }
	}
	$tw insert insert "[string range $line 0 $lastchar]\n$indenttxt"
	incr lastchar
	set line [string trimleft [string range $line $lastchar end]]
	set len [string length $line]
	set chars $indentlen
	set lastchar [expr $max-$chars]
      }
      $tw insert insert $line
      incr chars $len
    }

  }
  foreach tagspec $tagslist {
    $tw tag add [lindex $tagspec 0] [lindex $tagspec 1] [lindex $tagspec 2] 
  }
  return $retstat
}

proc mfv:mime-attach { mfc type subtype {params {}} {enc {}} {file {}} {desc {}}} {
  global mf mfp

  if {!$mfp($mfc,mime)} {
    set mfp($mfc,bound) [mfdb:boundary]
    set bound "$mfp($mfc,bound)-0"
    $mfc.comp.txt insert 1.0 "Content-Transfer-Encoding: 7bit\n"
    $mfc.comp.txt insert 1.0 "Content-Type: multipart/mixed; boundary=\"$bound\"\n"
    $mfc.comp.txt insert 1.0 "Mime-Version: 1.0\n"

    $mfc.comp.txt mark set insert "headerend +1 line linestart"
    $mfc.comp.txt insert insert "This is  a multimedia message in MIME  format.  If you are reading this\n"
    $mfc.comp.txt insert insert "prefix, your mail reader does  not understand MIME or is not currently\n"
    $mfc.comp.txt insert insert "configured to parse MIME messages.  You may wish to look into\n"
    $mfc.comp.txt insert insert "upgrading to a mail reader that does.\n\n"
    $mfc.comp.txt insert insert "--$bound\n"
    $mfc.comp.txt insert insert "Content-Type: text/plain; charset=us-ascii\n\n"
    
    $mfc.comp.txt mark set insert end
    $mfc.comp.txt insert insert "\n--$bound--\n"
    $mfc.comp.txt mark set multiend "end -4c"
    $mfc.comp.txt insert insert "\nDO NOT DELETE the above boundary line."
    $mfc.comp.txt insert insert "\nAnything placed after this line will be ignored by MIME readers.\n"
    set mfp($mfc,mime) 1

  } else {
    set bound "$mfp($mfc,bound)-0"
  }
  $mfc.comp.txt mark set insert "multiend linestart"
  $mfc.comp.txt insert insert "--$bound\n"
  $mfc.comp.txt insert insert "Content-Type: $type/$subtype"
  if {[string length $params]} {
    foreach param $params {
      set start [$mfc.comp.txt index insert]
      $mfc.comp.txt insert insert "; $param"
      if {[lindex [split [$mfc.comp.txt index insert] .] 1] > 72} {
	$mfc.comp.txt insert "$start +1 char" "\n\t"
      }
    }
  } else { 
    $mfc.comp.txt insert insert "\n"
  }
  if {[string length $enc]} {
    $mfc.comp.txt insert insert "Content-Transfer-Encoding: $enc\n"
  }
  if {[string length $desc]} {
    $mfc.comp.txt insert insert "Content-Description: $desc\n"
  }
  $mfc.comp.txt insert insert "\n\n\n\n"
  $mfc.comp.txt mark set insert "insert -2 char"

  if {[string length $file]} {
    $mfc.comp.txt insert insert "  ATTACHED FILE ($enc): $file  \n"
    $mfc.comp.txt tag configure attachedfile -borderwidth 2 -relief raised \
      -background [lindex [$mfc.bb.cancel configure -background] 4] \
      -font [lindex [$mfc.bb.cancel configure -font] 4]
    $mfc.comp.txt mark set insert "insert -1 line"
    $mfc.comp.txt tag add attachedfile insert "insert lineend"
    $mfc.comp.txt mark set insert "insert +1 line"
  }
  $mfc.comp.txt yview -pickplace insert
}

proc mfv:mime-attach-select {mfc} {
  global mf mfp


  set w .mime_attach
  toplevel $w -class MailMime
  wm minsize $w 400 260
  wm protocol $w WM_DELETE_WINDOW "$w.bb.quit invoke"
  set xpos [expr [winfo rootx $mfc]+[winfo width $mfc]/3]
  set ypos [expr [winfo rooty $mfc]+[winfo height $mfc]/3]
  wm geometry $w +${xpos}+${ypos}

  wm title $w "Mime Attachment for $mfc"

  frame $w.type -borderwidth 5
  ut:combo-create -frame $w.type -default text -editable 1 \
      -deflist {text message application image audio video} \
      -command {mfv:mime-type-select %W %E} -label "Type:" \
      -labelwidth 12

  frame $w.subtype -borderwidth 5
  ut:combo-create -frame $w.subtype -default plain -editable 1 \
      -deflist {plain enriched} -label "Subtype:" \
      -labelwidth 12

  frame $w.enc -borderwidth 5
  ut:combo-create -frame $w.enc -default 7bit -editable 1 \
      -deflist {7bit quoted-printable base64} -label "Encoding:" \
      -labelwidth 12

  frame $w.param -borderwidth 5
  label $w.param.lbl -text "Parameters:" -width 12 -anchor e
  entry $w.param.ent -relief sunken
  pack $w.param.lbl -side left
  pack $w.param.ent -side left -fill x -expand true -ipady 2

  frame $w.desc -borderwidth 5
  label $w.desc.lbl -text "Description:" -width 12 -anchor e
  entry $w.desc.ent -relief sunken
  pack $w.desc.lbl -side left
  pack $w.desc.ent -side left -fill x -expand true -ipady 2

  frame $w.file -borderwidth 5
  label $w.file.lbl -text "File:" -width 12 -anchor e
  entry $w.file.ent -relief sunken
  button $w.file.btn -text ">>" -width 2 \
	  -command "set val \[$w.file.ent get\]
		    $w.file.ent delete 0 end
		    $w.file.ent insert 0 \[mfv:get-filename -master $w -cancelvalue \$val \]"
  pack $w.file.lbl -side left
  pack $w.file.ent -side left -fill x -expand true -ipady 2
  pack $w.file.btn -side left -padx 5

  frame $w.bb -borderwidth 5
  button $w.bb.ok -text "Attach" -width 8 \
      -command "mfv:mime-attach-done $w $mfc; grab release $w; destroy $w"
  button $w.bb.cancel -text Cancel -width 8 \
      -command "grab release $w; destroy $w"
  pack $w.bb.ok $w.bb.cancel -side left -padx 10 -pady 5

  pack $w.type $w.subtype $w.enc $w.param $w.desc \
      $w.file -side top -fill x -expand true -padx 10
  frame $w.sep -bd 2 -height 4 -relief sunken
  pack $w.sep -side top -fill x -expand true -pady 5
  pack $w.bb -side top

  focus:register $w [list $w.type.ent $w.subtype.ent $w.enc.ent \
      $w.param.ent $w.desc.ent $w.file.ent $w.bb.ok $w.bb.cancel] \
      "$w.bb.ok invoke" "$w.bb.cancel invoke"

  bind $w.file.ent <Key-Tab> {
    set f [%W get]
    %W delete 0 end
    %W insert end [j:expand_filename $f]
  }

  after 20 grab $w
  set savefocus [focus]
  focus $w.type.ent
  tkwait window $w
  grab release $w
  focus $savefocus
}

# {text message application image audio video}
proc mfv:mime-type-select { w type } {

  set def {}
  set deflist {}
  set enc 7bit

  set type [string tolower $type]
  switch -exact $type {

    {text} {
      set def plain
      set deflist {plain enriched}
      set enc 7bit
    }
    {message} {
      set def external-body
      set deflist {external-body rfc822}
      set enc 7bit
    }
    {application} {
      set def octet-stream
      set deflist {octet-stream postscript}
      set enc base64
    }
    {image} {
      set def gif
      set deflist {gif jpeg}
      set enc base64
    }
    {audio} {
      set def basic
      set deflist basic
      set enc base64
    }
    {video} {
      set def mpeg
      set deflist mpeg
      set enc base64
    }
  }

  ut:combo-reset [string trimright $w type]subtype $def $deflist 0
  ut:combo-reset [string trimright $w type]enc $enc {7bit quoted-printable base64} 0

}

proc mfv:mime-attach-done { w mfc } {

  set type [ut:combo-get $w.type]
  set subtype [ut:combo-get $w.subtype]
  set enc [ut:combo-get $w.enc]

  set params [$w.param.ent get]
  set desc [$w.desc.ent get]
  set file [j:expand_filename [$w.file.ent get]]

  mfv:mime-attach $mfc $type $subtype $params $enc $file $desc
}
