#!/usr/local/bin/perl
#
# Copyright (C) 1992 by Gustaf Neumann, Stefan Nusser
#
#      Wirtschaftsuniversitaet Wien,
#      Abteilung fuer Wirtschaftsinformatik
#      Augasse 2-6,
#      A-1090 Vienna, Austria
#      neumann@wu-wien.ac.at, nusser@wu-wien.ac.at
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appears in all copies and that both that
# copyright notice and this permission notice appear in all supporting
# documentation.  This software is provided "as is" without expressed or
# implied warranty.
#
# Date: Mon, Apr 13 1992
# Author: Gustaf Neumann
# Version: 0.97
#

%privOptions = (
	"f", "folder: name of the mail folder",
	"p", "print command: such as 'mp | lpr'",
	"s", "signature file: such as ~/.elm/signature",
	"F", ": fast startup mode",
	"C", ": prefer files for communication",
	"r", ": read only mode",
	);
$options = "u";

$WafeLib = $ENV{'WAFELIB'} || "/usr/lib/X11/wafe";
require "$WafeLib/perl/wafe.pl";
require 'wafe_mu.pl';

$mailIncludePrefix = $mailIncludePrefix || " |> ";
$incomingMailbox = $incomingMailbox 
    || $ENV{'MAIL'} 
    || "/usr/spool/mail/$wafe_mu'user";
$mailbox = $opt_f || $incomingMailbox;
$printCommand = $opt_p || $printCommand || "mp | multi | lpr";

$mailSpoolFile = &wafe'tmpFile('mailtext'); #'
$faceDir = $faceDir || "$WafeLib/faces";
$opt_u = $opt_u || 5; # check Mailbox every n seconds

### obsolete: $fast = $opt_F;
$useXPM = (!defined($noXPM) && $wafe'Packages =~ /\bXPM\b/); #'

if ($opt_C) {
    $subjectFile = &wafe'tmpFile("mailsubjects"); #'
    open(SUBJECTS,">$subjectFile") && print SUBJECTS "\n" && close(SUBJECTS);
}


#
# readMailBox ( $fromByte )
# reads a Mailbox and builds corresponding perl arrays

sub readMailBox {
    local($fromByte) = @_;
    local($encoding);
    return if ($MailBoxSize = -s $mailbox) == 0 || $MailBoxSize <= $fromByte;

    &wafe_mu'exclusiveLock(MBOX); #'
    &Xui('makeBusy subjects true');
    seek(MBOX,$fromByte,0) if $fromByte>0;

    $/ = ''; $*=1; 
    while (<MBOX>) {

	if (/^From /) {
            if ($ContentType[$count]) {
                 $Body[$count] = 
                   &wafe_mu'MimeDecode($ContentType[$count],$Body[$count]); #'
            }
	    $count++;
	    &Xui("mailcount $count") if $count % 7 == 0;
            $encoding = $contentEncoding = $ContentType[$count] = '';
	    $Subject[$count] = 
		$To[$count] = 
		    $From[$count] =
			$Cc[$count] = 
			    $Date[$count] = 
				$Priority[$count] = 
				    $Status[$count] = 
					$ReplyTo[$count] = 
					    $Body[$count] = ''
						if $Header[$Count];
            $Deleted[$count] = 0;
	    $Header[$count] = $_;
	    s/\n\s+/ /g;
	    for (split("\n")) {
#		print "LINE: <$_>\n";
		$Subject[$count] =  $1,next if m/^Subject: *(.*)$/;
	 	$To[$count] =       $1,next if m/^To: *(.*)$/;
		$From[$count] =     $1,next if m/^From: *(.*)$/; 
		$Cc[$count] =       $1,next if m/^Cc: *(.*)$/;
		$Date[$count] =     $1,next if m/^Date: *(.*)$/;
    		$Priority[$count] = $1,next if m/^Priority: *(.*)$/;
		$Status[$count] =   $1,next if m/^Status: *(\S+)/;
		$ReplyTo[$count] =  $1,next if m/^Reply\-To: *(.*)$/;
		$ContentType[$count] .= "\$type='$1';" 
		    if m/^Content\-[Tt]ype: *(.*)$/;
		$ContentType[$count] .= "\$encoding='$1';" 
		    if m/^Content\-[Tt]ransfer-[Ee]ncoding: *(.*)$/;
		$encoding = $1 if m/^X-Encoding:\s*(\S+)\s*$/;
	    }
            $unread++ if $Status[$count] !~ m/R/;
            if (($From[$count]=~ /\.se(\s|\b)/ && 
		 $defaultMailEncoding =~ /Swe/i) ||
#                ($To[$count]=~ /g11|g13/) ||  # Dov's very private option...
		    ($encoding eq 'SweAscii')) {
                     $Subject[$count] = &wafe_mu'SweDecode($Subject[$count]);
                     $Header[$count] = &wafe_mu'SweDecode($Header[$count]);
                     $encoding= 'SweAscii';
            }
            elsif ($encoding eq 'TeX') {
                $Subject[$count] = &wafe_mu'TeXdecode($Subject[$count]);
                $Header[$count] = &wafe_mu'TeXdecode($Header[$count]);
            }
	} else {
            $_ = &wafe_mu'TeXdecode($_) if $encoding eq 'TeX';
            $_ = &wafe_mu'SweDecode($_) if $encoding eq 'SweAscii';
	    $Body[$count] .= $_; 
	}
    }
 
    if ($ContentType[$count]) {
	$Body[$count] = 
             &wafe_mu'MimeDecode($ContentType[$count],$Body[$count]);
    }

    &wafe_mu'unLock(MBOX); #'
    &Xui('stopReporter; makeBusy subjects false');
    $/ = "\n"; $*=0; 
    &setIcon();
}

#
# writeSubjects
# is used only in "fast-mode" and 
# generates a file containing the subject entries of the mailbox

sub writeSubjects {
    local($low,$high,$spattern,$bpattern) = @_;
    local($i,$line,$status);
    &Xui('makeBusy subjects true');
    $subjectLines = '';
    for ($low .. $high) {
        $i = $low + $high - $_;
        $line = &subjectLine($i); 
        next if ($spattern && $Subject[$i] !~ /$spattern/i 
		 && $From[$i] !~ /$spattern/i);
        next if ($bpattern && $Body[$i] !~ /$bpattern/i);
        $line = substr($line . '          ' x 6,0,90);

        $status = ($Status[$i] =~ /R/ ? ' ' : 'N')
                . ($Deleted[$i] ? 'D ':'  ');
        $subjectLines .= 
	    ' ' . substr($line,0,4) . $status . substr($line,4) . "\n" ;
        
    }
    if ($opt_C) {
        open(SUBJECTS,">$subjectFile") || die "cannot open $subjectFile for writing";
        print SUBJECTS $subjectLines;
        close(SUBJECTS);
        &Xui("sV subjects type file string $subjectFile"); 
    } else {
        &wafe'tunnel('COMM',$subjectLines, #'
		     'sV subjects type string string $COMM');
    }
    &Xui('makeBusy subjects false');
}

#
# subjectLine($i)
# returns a single formatted subject line of the Mailbox entry $i

sub subjectLine {
    local($i) = @_;
    local($day,$asciimonth,$year,$h,$m,$name,$addr);
    $Date[$i] =~ /(\d+) +(\S+) +(\d+)\D+(\d+):(\d+)/;
    $day=$1; $asciimonth = $2; $year=($3>100) ? $3 : 1900+$3; $h=$4; $m=$5;

    ($name,$addr) = &wafe_mu'nameAddress( $ReplyTo[$i] || $From[$i]); #'
    $name = $addr unless $name;
    unless ($name) { 
	$Header[$i] =~ m/^\s*From\s+(\S+)\s+/;
	$name = $1 || $wafe_mu'user; #'
	$From[$i] = $name; 
    }
   return sprintf( "%3d %-3s %2d %-18s %-6s %s", $i+1, $asciimonth, $day, 
                        substr($name,0,18), 
			'('.($Body[$i] =~ tr/\n/\n/) .')', $Subject[$i]);
}

#
# displayMail()
# displays the current mail in the textwidget mailbody
# by (optionally) writing it to the file $mailSpoolFile

sub displayMail {
    local($contents);
    $contents = ($FullHeader ? $Header[$currentMail] : '').$Body[$currentMail] 
	    unless $currentMail == -1;

    unless ($opt_C) {
	&wafe'tunnel("COMM",$contents,"sV mailbody type string string \$COMM"); #'
    } else {
       $asciiText{$mailSpoolFile} = $contents;
       &wafe'fileTransaction($mailSpoolFile, 
           "open(TMP, '>$mailSpoolFile') || die \"can't open $mailSpoolFile for writing!\";"
          .'print TMP  $main\'asciiText{"'.$mailSpoolFile.'"};' #'
          .'close(TMP);'
          ."&wafe'setWidgetToFile('mailbody','$mailSpoolFile');" #'
       );
    }
}

#
# deleteMail($i)
# marks Mailbox entry $i as deleted or undeleted
# depending on its state

sub deleteMail {
    local($doWith) = @_;
    return &warn("nothing selected and no current mail!") if $doWith < 0;
    $Deleted[$doWith] = !$Deleted[$doWith];
    local($delLine) = $doWith +1;
    $*=1; $subjectLines =~ /^\s*$delLine\D/; $*=0;
    local($pos) = length($`);
    local($char) = $Deleted[$doWith] ? 'D' : ' ';
    &Xui('doTextReplace subjects '.($pos+6).' '.($pos+7)." {$char}");
    $dirty = 1;
    &wafe'sensitive(!$SendMode && $dirty,('update')); #'
}


#
# sendMode($mode)
# handles changes of the sendmode state and
# and refreshes the mail dieplay if not sendmode
$lastPixName = '';
sub sendMode {
    local($sendmode) = @_;

    unless ($sendmode) {
        local($from, $subject, $pixName);

	if ($currentMail != -1) {
	    $from = $ReplyTo[$currentMail] || $From[$currentMail];
	    $subject = $Subject[$currentMail];
	    local($fromname,$fromaddr) = &wafe_mu'nameAddress($from); #'
	    ($pixName) = $fromaddr =~ m/([a-zA-Z0-9_\-\.\+]+)@?.*/;
	}
	&displayMail();
        &Xui('sV FromInfo label '.&TclQuote($from)
            .';sV SubjectInfo label '.&TclQuote($subject)
            .";sV DateInfo label {$Date[$currentMail]}");
	if ($pixName ne $lastPixName) {
	    local($cmd);
	    foreach ("$faceDir/$pixName.xpm",
		     "$faceDir/\L$pixName.xpm",
		     "$faceDir/$pixName.xbm",
		     "$faceDir/\L$pixName.xbm") {
		$cmd = "changePixmap bild bitmap $_", last 
		    if /\.xpm$/ && $useXPM && -r;
		$cmd = "sV bild bitmap $_", last 
		    if !/\.xpm$/ && -r;
	    }
	    &Xui($cmd ? $cmd : "sV bild bitmap None");
	    $lastPixName = $pixName;
        }
    }

    &Xui('sV mailbody editType '
         .($sendmode ? 'edit wrap never' : 'read wrap line'));
    &wafe'sensitive($currentMail != -1 && !$sendmode,                  #'
                    ('reply','forward','header','delete'));
    &wafe'sensitive($currentMail != -1 && !$sendmode && $currentCC ne '',    #'
                    ('replyAll'));
    &wafe'sensitive($currentMail != -1 || $sendmode,('print','save')); #'
    &wafe'sensitive($sendmode,('send'));                               #'
    &wafe'sensitive(!$sendmode,('mail'));                              #'
    &wafe'sensitive(!$sendmode && ! $opt_r,('quit'));                  #'
    &wafe'sensitive(!$sendmode && $dirty,('update'));                  #'
    $SendMode = $sendmode;
}


sub checkMailBoxSize {
    local($rc) = 0;
    if ($MailBoxSize !=  -s $mailbox) {
	local($new) = -s $mailbox;
	&warn("Size of mailbox $mailbox changed from $MailBoxSize to $new Next: $count");

        if ($new > $MailBoxSize && !$shrunk) {
	    open(MBOX,"<$mailbox") || die "can't open $mailbox for reading\n";
	    &readMailBox($MailBoxSize);
	    close(MBOX);
            &writeSubjects($[,$count,$spattern,$bpattern);   
	    &info('New mail arrived');   
	    $rc = 1;
	} else {
	    &info('Your Mailbox SHRUNK! abort recommended!');
	    $shrunk = 1;
	    $opt_r = 1;
	    &wafe'sensitive(0,('quit')); #'
	    $rc = -1;
	}
    }
    return $rc;
}

sub getCC {	
    local($potentialCC) = $To[$currentMail];
    local($CC,$ccName,$ccAddr,$toName,$toAddr);
    local($TO) = $ReplyTo[$currentMail] || $From[$currentMail];
    $potentialCC .= ",$Cc[$currentMail]"
	unless $Cc[$currentMail] eq '';
 
    local($toName,$toAddr) = &wafe_mu'nameAddress( $TO ); #'
    # remove current user from cc if included
    foreach $adressee (split(/, */,$potentialCC)) {
	($ccName,$ccAddr) = &wafe_mu'nameAddress( $adressee );
        unless ( $ccAddr =~ /^$wafe_mu'user\b/ || $ccAddr eq $toAddr ) {
	    $CC .= ',' unless $CC eq '';
	    $CC .= $adressee;
	}
    }
    return $CC;
}

$icon = '';
sub setIcon {
    local($newIcon) = $unread>0 ? 'mailfull' : 'mailempty';
    $icon = $newIcon, &Xui("sV topLevel iconPixmap $icon") 
	unless $icon eq $newIcon;
}

#
# set default resources 
&wafe'setResources('',%textResources); #'

#
# the following settings are used several times
$textatt = "type file scrollVertical always string";
$every_hlabel = "justify left borderWidth 0 $backGround" 
    . ' top ChainTop bottom chainTop left chainLeft';	
$const_hlabel = "$every_hlabel  right chainLeft $boldFont";
$var_hlabel = "label {} $every_hlabel right chainRight " . $normalFont; 


####################### tcl setup ##################
&Xui(<<'__');
#
# returns the first words of a selection

proc Selection {selection} {
    foreach line [split [string trimright $selection] \n] {
        lappend lines [lindex $line 0]
    }
    return $lines
}

#
# if something is selected return the List of ids, else -1

proc oneOrMany {w tcl} {
  XawTextGetSelectionPos $w from to
  if $from!=$to {
    set result [Selection [XawTextRead $w $from $to]]
  } else { 
    set result -1
  }
  eval $tcl
}

proc startReporter {} {
  global reporter
  set reporter [addTimeOut 500 {
    if [window info] {sV info label "Reading mail $mailCounter ..."}
    startReporter }]
}
proc stopReporter {} {
  global reporter mailCounter
    if [info exists reporter]    { removeTimeOut $reporter }
    if [info exists mailCounter] { unset mailCounter }
}
proc mailcount {n} {
  global reporter mailCounter
  if ![info exists reporter] { startReporter }
  set mailCounter $n
}
proc makeBusy {widget state} {
   if [window $widget] {setBusy $widget $state}
}

proc textSearch {w string dir} {
  XawTextSetInsertionPoint $w [expr [XawTextGetInsertionPoint $w]+1]
  set XawTextSearch(ptr) $string
  set XawTextSearch(length) [string length $string]
  set XawTextSearch(firstPos) 0
  set ip [XawTextSearch $w $dir XawTextSearch]
  if {$ip<0} { 
    XawTextSetInsertionPoint $w [expr [XawTextGetInsertionPoint $w]-1]
    return 0
  } else { 
    XawTextSetInsertionPoint $w $ip
    XawTextSetSelection $w $ip [expr $ip+$XawTextSearch(length)]
    return $ip
  }
}

proc textSearchTop {w string dir} {
  while 1 {
    if ![set ip [textSearch $w $string $dir]] return
    # was the string at the begin of the line?
    if $ip==[XawTextSourceScan $w $ip EOL left 1 false] {
      sV $w displayPosition $ip
      callActionProc $w {} scroll-one-line-up
      callActionProc $w {} scroll-one-line-up
      callActionProc $w {} next-line
      callActionProc $w {} scroll-one-line-up
      callActionProc $w {} next-line
      return
    }
    callActionProc $w {} next-line
  }
}


# ----------- expanding and grabbing of aliases ----------------
proc expandAlias {w} {
  global beginAlias endAlias
  set ip [XawTextGetInsertionPoint $w]
  set bl [XawTextSourceScan $w $ip EOL left 1 false]
  set el [XawTextSourceScan $w $ip EOL right 1 false]
  set line [XawTextRead $w $bl $el]
  if {[string match "To:*" $line] || \
      [string match "Cc:*" $line] || \
      [string match "Bcc:*" $line]} {
     set linePos [expr $ip-$bl]
     set begin [string range $line 0 $linePos]
     set end [string range $line $linePos end]
     append end " "
     set i [string last " " $begin]
     set j [string last , $begin]
     set bw [expr {$i>-1 && $i>$j ? $i : $j}]
     if $bw==-1 {set bw [string first :]}
     set i [string first " " $end]
     set j [string first , $end]
     set ew [expr {$j>-1 && $j<$i ? $j : $i}]
     incr ew $linePos
     incr bw 1
     set word [string range $line $bw $ew]
     if [string match {} word] return
     echo "expandAlias $w $word"
     set beginAlias [expr $bl+$bw]
     set endAlias [expr $bl+$ew]
     XawTextSetSelection $w $beginAlias $endAlias
  } else {
     callActionProc $w {} insert-string 0x09
  }
}

proc replaceAlias {w string} {
  global beginAlias endAlias
  set len [string length $string]
  set XawTextSearch(ptr) $string
  set XawTextSearch(length) $len
  set XawTextSearch(firstPos) 0
  XawTextReplace $w $beginAlias $endAlias XawTextSearch
  sV $w insertPosition [expr $beginAlias+$len]
}

# adding aliases
proc addAlias {alias name address} {
  global fields currentField
  if ![set S [widgetId addAliasShell]] {
    mergeResources topLevel {
	*addAliasShell*Text*editType edit 
	*addAliasShell*Text*displayCaret false 
        *addAliasShell*left chainLeft 
	*addAliasShell*right chainLeft 
	*addAliasShell*Text.right chainRight 
	*addAliasShell*Text.width 320
	*addAliasShell*Form.right chainRight 
	*addAliasShell*Label.width  80 
	*addAliasShell*Label.justify right 
	*addAliasShell*Label.borderWidth 0
	*addAliasShell*Command.bottom chainBottom
	*addAliasShell*Command.top chainBottom
	*addAliasShell*Command.left chainLeft
	*addAliasShell*Command.right chainLeft
    }

    set S [TransientShell addAliasShell paned]
    set T [Form aliasForm $S]
    set F [Form aliasInnerForm $T right chainRight bottom chainBottom]
      Label  l_alias $F 
      Text   alias   $F fromHoriz $F*l_alias

      Label  l_name  $F fromVert $F*alias
      Text   name    $F fromHoriz $F*l_name fromVert $F*alias

      Label  l_email $F fromVert $F*name
      Text   email   $F fromHoriz $F*l_email fromVert $F*name

    Command quit  $T callback "popdown $S"  fromVert $F
    Command add   $T callback "newAlias $S" fromHoriz $T*quit fromVert $F
    callback $S popupCallback positionCursor 0

    set fields [list [widgetId $S*alias] [widgetId $S*name] \
		[widgetId $S*email]]
    foreach f $fields {
      action $f override "\
	<Key>Return: exec(nextField $T) \n\
	<Key>Tab:    exec(nextField $T) \n\
	<Btn1Down>:  exec(gotoField $T %W)"
    }
  } 
  set currentField 0
  turnOn $S.aliasForm $S*alias
  sV $S*name  string $name
  sV $S*alias string $alias
  sV $S*email string $address
  popup $S none
}

proc newAlias {S} {
  global fields
  set command newAlias
  foreach f $fields { append command \t[gV $f string] }
  echo $command
  popdown $S
}

# set field inactive or active
proc turnOff {f}   { sV $f displayCaret false }
proc turnOn  {s f} { sV $f displayCaret true;setKeyboardFocus $s $f }

# jump to the next field from the field list
proc nextField {s} { global currentField fields
    turnOff [lindex $fields $currentField]
    set currentField [expr ($currentField+1)%[llength $fields]]
    turnOn $s [lindex $fields $currentField]
}

# jump to the next field from the field list
proc gotoField {s f} { global currentField fields
    turnOff [lindex $fields $currentField]
    set currentField [lsearch $fields $f]
    turnOn $s $f
}


#
# remove character denoting unread mail (fast mode)

proc markInText {w} {
  sV $w editType edit
  XawTextGetSelectionPos $w from to
  set text(firstPos) 0; set text(length) 1; set text(ptr) " ";
  XawTextReplace $w [expr $from+5] [expr $from+6] text
  sV $w editType read
}

proc doTextReplace {w from to string} {
  sV $w editType edit
  set text(firstPos) 0; set text(length) [string length $string]
  set text(ptr) $string
  XawTextReplace $w $from $to text
  sV $w editType read
}

mergeResources topLevel {
    *mail.label Mail
    *quit.label Quit
    *abort.label Abort
    *update.label Update
    *reply.label Reply
    *replyAll.label ReplyAll
    *forward.label Forward
    *header.label Header
    *delete.label Delete
    *print.label Print
    *save.label Save
    *send.label Send
    *configButton.label Config
    *savequit.label cancel 
    *savemenu*Dialog.label {File name or folder name:}
    *sgreplabel.label Subjectgrep:
    *bgreplabel.label Bodygrep:
    *From.label From:
    *Subject.label Subject:
    *Date.label Date:
    *l_alias.label Alias:
    *l_name.label Name:
    *l_email.label Email:
    *TransientShell*quit.label Dismiss
    *TransientShell*add.label AddAlias
}
__
### now we need perl variable substitutions
&TclCmd(<<"__");
#
# standard button settings
proc simpleButton {name father args} {
     eval Command \$name \$father $buttonAtts \$args}

proc simpleButtonCB {name father args} {
     eval simpleButton \$name \$father \$args {callback {echo %w}}}

#
# Widget Tree of the appliction
#         height 220 $backGround # preferredPaneSize 220 

Paned paned topLevel orientation vertical width 635
  Form infoForm paned {
     showGrip true borderWidth 0 defaultDistance 0 $backGround
  }
  Label info infoForm {
     $normalFont $infoColors
     width 635 label ""
     left chainLeft right chainRight top chainTop bottom chainTop
  }
  Label sgreplabel infoForm {
     fromVert info borderWidth 0 $backGround $boldFont
     left chainLeft right chainLeft top chainTop bottom chainTop
  }
  Text sgrep infoForm {
     fromVert info fromHoriz sgreplabel displayCaret false 
     $normalFont $backGround editType edit width 191 borderWidth 0
     left chainLeft right chainLeft top chainTop bottom chainTop
  }
  action sgrep override {\\
     <Enter>: exec(sV %W $highLight displayCaret true)
     <Leave>: exec(sV %W $backGround displayCaret false)
     <Key>Return: exec(echo "sgrep [gV %W string]")
  }
  Label bgreplabel infoForm {
     fromVert info fromHoriz sgrep borderWidth 0 $backGround $boldFont
     left chainRight right chainRight top chainTop bottom chainTop
  }
  Text bgrep infoForm {
     $normalFont $backGround editType edit width 197 borderWidth 0
     displayCaret false
     fromVert info fromHoriz bgreplabel 
     top chainTop bottom chainTop left chainRight right chainRight
  }
  action bgrep override {\\
     <Enter>: exec(sV %W $highLight displayCaret true)
     <Leave>: exec(sV %W $backGround displayCaret false)
     <Key>Return: exec(echo "bgrep [gV %W string]")
  }
  MenuButton configButton infoForm {
      menuName config $buttonAtts 
      fromVert info fromHoriz bgrep 
      left chainRight right chainRight top chainTop bottom chainTop
  }
  Text subjects infoForm {
     bottom chainBottom top chainTop rightMargin 0
     scrollVertical always height 200 width 635 fromVert sgreplabel
     type string string "" $textFont $roColors cursor hand2
  }
  XawTextSetSelectionArray subjects selectLine selectNull
  action subjects override {\\
     <Btn1Down>:   select-start() select-end(CUT_BUFFER0) \\
	           exec(echo read [fetchBuffer subjects 0];markInText %w) \\
                   select-start() extend-adjust() next-line()
     <Btn1Up>:     no-op()
     <Btn1Motion>: no-op()
     <Key>d:       exec(oneOrMany %w {echo "delete \$result"})
     ~Ctrl<Key>s:  exec(oneOrMany %w \\
                   {global mail; set mail \$result; popup savemenu none})
     <Btn2Down>:   exec(sV %w cursor pencil) select-start()
     <Btn2Motion>: extend-adjust()
     <Btn2Up>:     extend-end(CUT_BUFFER0) exec(sV %w cursor hand2)
     <Btn3Up>:     no-op()
     <Btn3Down>:   no-op()
     <Btn3Motion>: no-op()
  }

  Form headerf paned defaultDistance 0 min 65 max 65 $backGround
     Label From     headerf $const_hlabel vertDistance 3
     Label FromInfo headerf width 488 $var_hlabel fromHoriz From vertDistance 3
     Label Subject  headerf $const_hlabel fromVert From
     Label SubjectInfo  headerf \\
                    width 470 $var_hlabel fromHoriz Subject fromVert From
     Label Date     headerf $const_hlabel fromVert Subject
     Label DateInfo headerf \\
                    width 491 $var_hlabel fromHoriz Date fromVert Subject
     Label bild     headerf \\
                    $backGround borderWidth 0 width 65 height 65 label {} \\
                    horizDistance 541 right chainRight left chainRight 

  Text mailbody paned $textatt {/dev/null} height 350 \\
     autoFill true showGrip false $roColors $normalFont

  Box buttons paned min 26 max 26 $backGround showGrip false hSpace 3
    simpleButtonCB quit   buttons
    simpleButtonCB abort  buttons
    simpleButtonCB update buttons sensitive false

    foreach b {mail reply replyAll forward} {
      simpleButtonCB \$b buttons sensitive false
      action \$b override {<Btn3Up> : exec(echo "%w u")}
    }
    sV mail sensitive true
    simpleButtonCB header buttons sensitive false
    simpleButtonCB delete buttons sensitive false
    simpleButtonCB print  buttons sensitive false

    simpleButton save buttons \\
        sensitive false callback {set mail -1; popup savemenu none}

    TransientShell savemenu buttons $backGround
    callback savemenu popupCallback positionCursor 45

     Dialog savetext savemenu  \\
          value {}  $backGround
     sV savetext.label $backGround $boldFont $threeD
     simpleButton savequit savetext callback {popdown savemenu} 

     action savetext.value  override \\
         "<Key>Return : exec(sendsave) XtMenuPopdown(savemenu)"

   simpleButtonCB send buttons sensitive false
__

#### the following commands do not need perl variable substitutions
&Xui(<<'__');
# send string "save xxxx" to the application and maintain 
# the global variable mail
proc sendsave {} { global mail
  echo "save {$mail} [gV savetext value]"
  set mail -1
}

#
# save and restore display position and caret of a text widget
proc savePos {w} {
  global displayPosition insertPosition
  set displayPosition($w) [gV $w displayPosition]
  set insertPosition($w) [gV $w insertPosition]
}
proc restorePos {w} {
  global displayPosition insertPosition
  sV $w \
      displayPosition $displayPosition($w) \
      insertPosition $insertPosition($w)
}

#
# initialize global variables

set maxmail -1
set currentMail 5000
__

##################### uff, back in perl ############################

&wafe'applyActions('mailbody',(@textActions,
             '<Key>Tab : exec(expandAlias %W)',
             'Ctrl<Key>a : exec(echo getAddress)',
             'Ctrl<Key>w : exec(sV %W editType edit)',
             'Ctrl<Key>n : exec(textSearchTop %W ------- right)',
             "Ctrl<Key>f : exec(sV %W $textFont)",
             "Ctrl<Key>v : exec(sV %W $normalFont)",
             ));
&wafe'applyActions('subjects',@textActions);
$opt_r = $opt_r || 
    ($mailbox eq $incomingMailbox && -r "$tmpDir/mbox.$wafe_mu'user");
&wafe'sensitive(!$opt_r,("quit"));
&wafe_mu'createConfig("configButton","configButton",
		      ("mailIncludePrefix","printCommand","signatureFile",
                       "defaultMailHost","defaultMailEncoding"));

&Xui('realize; deleteWindowProtocol quit');
&Xui('catch {auto_load XawTextRead}');
&wafe'setResources('',( #'
    '*addAliasShell*Command', $buttonAtts,
    '*addAliasShell*Label', "$backGround $boldFont",
    '*addAliasShell*Form*Text', $roColors,
    '*addAliasShell*Form', $backGround,
));
#
# read in mailbox

$mailbox = &wafe_mu'folderName('Mail',$mailbox); #'
$unread = 0;
$count=-1;
if (open(MBOX,"<$mailbox")) {
	&readMailBox(0);
	close(MBOX);
}
&info( ($opt_r ? 'Mailbox is READ ONLY!  ' : '') . "mailbox $mailbox "
      .($count== -1? 'is empty' : 'contains '. ($count+1).' entries'));

&writeSubjects($[,$count,$spattern,$bpattern);

#
# the application is mapped to the screen, let see, what it talks to us.
#

$currentMail = -1; 
$FullHeader = 0;
$SendMode = 0;
$pos=0;

while(1) {
    $_ = &wafe'readTimeout($opt_u); #'
#   print "RECEIVED: $currentMail <$_> \n";
    if (/^read\s+(\d+)/) {
        $currentMail = $1;
        &warn('Finish writing your mail before you read another mail!'), next
	    if $SendMode;

	&info("Current message is $currentMail");
        $currentMail-- ;

	if (!$Status[$currentMail] || $Status[$currentMail] eq "O") {
	    if ($Status[$currentMail]) {
		$Header[$currentMail] =~ s/Status: .*/Status: OR/o; 
	    } else {
		$Header[$currentMail] = 
		    substr($Header[$currentMail],0,
                        length($Header[$currentMail])-1) 
			. "Status: OR\n\n";
	    }
            $unread--;
	    &setIcon();
	    $Status[$currentMail] = 'OR';
            $dirty = 1;
            &wafe'sensitive(!$SendMode && $dirty,('update')); #'
	}
        &sendMode(0);

        ($name,$fromaddr) = &wafe_mu'nameAddress(  #'
	      $ReplyTo[$currentMail] || $From[$currentMail] );
        $fromaddr =~ m/([a-zA-Z0-9_\-\.\+]+)@?.*/;
    
        &wafe'sensitive(($currentCC = &getCC()) ne "",('replyAll'));   #'
    }

    if (/^header/) {
	$FullHeader = !$FullHeader;
        &displayMail();
    }

    if (/^(reply|forward|replyAll)\b\s*(\w*)/) {
	local($answerType,$urgent) = ($1,$2);
        local($TO) = $ReplyTo[$currentMail] || $From[$currentMail];
        &wafe_mu'returnMail(  #'
	      $mailSpoolFile,'mailbody',$answerType,$urgent,
	      $TO, $answerType eq 'replyAll' ? $currentCC : '',
	      $Subject[$currentMail],$Date[$currentMail],$Body[$currentMail]);
    }

    if (/^mail\s*(\w*)/) {
        $urgent = ($1 ne '');

	open(MAILTEXT,">$mailSpoolFile") || 
             die("can't open $mailSpoolFile for writing\n"); 
	print MAILTEXT "To: \nSubject: \n";
	print MAILTEXT "Priority: Urgent\n" if $urgent;
	print MAILTEXT "Date: ", &wafe_mu'mailDateNow(), "\n\n\n"; #'
        print MAILTEXT "\n\n--\n$wafe_mu'signature" if $wafe_mu'signature; #'
	close(MAILTEXT);

        &Xui("sV mailbody type file string $mailSpoolFile");
        &sendMode(1);
	&Xui('callActionProc mailbody {} end-of-line');
    }

    &wafe_mu'send($mailSpoolFile,'mailbody') if /^send/; #'

    &wafe_mu'expandAlias($1,$2) if /^expandAlias\s(\S+)\s(\S.*)$/; 
    &wafe_mu'addNewAlias($1,$2,$3) if /^newAlias\t([^\t]*)\t([^\t]*)\t(.*)$/;

    if (/^getAddress/) {
        local($sender) = ($SendMode || $currentMail == -1) ?
	    "" : $ReplyTo[$currentMail] || $From[$currentMail];
	&wafe_mu'popupAliasDialog($sender, #'
	     "callActionProc mailbody {} beginning-of-line");
    }

    if (/^print\s*(\d*)/) {
        &info("printing with $printCommand ...");

        local($i) =  $1 ne '' ? $1 : $currentMail;
        local($content) = ($SendMode && $1 eq '') ?
                     &wafe_mu'widgetContent($mailSpoolFile,'mailbody') :
		     $Header[$i] . $Body[$i];
#                     (&wafe_mu'SweEncode($Header[$i] . $Body[$i]),1);

        (&wafe_mu'printArgInto($content,"|$printCommand") && #'
               &info("File printed")) || 
               &warn("cannote print using $printCommand");
    }

    if (/^save\s+\{(\-?\d+.*)\}\s+(.*)/) {
        local($doWith) =$1;
        local($name) = $2 || (($SendMode && $1 == -1) ? 'outgoing':'incoming');
        $target = &wafe_mu'folderName('Mail',$name); #'
        local($ptarget) = ($target =~ /^\|/ ? $target : ">>$target");

	foreach (reverse split(" ",$doWith)) { 
	    local($i) =  $_ != -1 ? $_-1 : $currentMail;
	    local($content,$del) = ($SendMode && $_ == -1) ?
		(&wafe_mu'fromHeader($wafe_mu'user, 
                       &wafe_mu'widgetContent($mailSpoolFile,'mailbody')),0) :
	               ("\n" . $Header[$i] . $Body[$i],1);

	    (&wafe_mu'printArgInto($content,$ptarget) &&
               &info("Mail saved into $target")) 
            ||  ( &warn("Mail cannot be saved into $target") && ($del = 0));
            &deleteMail($i) if $del;
        }
    }

    if (($spattern) = /^sgrep\s+(.*)$/) {
	&info("Seaching for pattern \"$spattern\" in Subject Lines ...");   
        $spattern =~ s/(\W)/\\\1/g;
        &writeSubjects($[,$count,$spattern,$bpattern);   
	&info('');   
    }
    if (($bpattern) = /^bgrep\s+(.*)$/) {
	&info("Seaching for pattern \"$bpattern\" in Mailbodies ...");   
        $bpattern =~ s/(\W)/\\\1/g;
        &writeSubjects($[,$count,$spattern,$bpattern);   
	&info('');   
    }

    if (/^delete\s*(-?\d*.*)/) {
        &Xui('oneOrMany subjects {echo "delete $result"}'), next 
              if $1 eq '';
        $1 = '' if $1 =~ /[^\d -]/;     #selection is messed up
	if ($1 eq '' || $1 == -1) { &deleteMail($currentMail); }
	else { foreach (split(" ",$1)) { &deleteMail($_-1); } }
    }

    if (($varname) = /^setconfig\s*(\S+)$/) {
        local($value);
        eval '$value = $'."$varname;"; #'
        &Xui("sV configsetvaltext value {$value};popup configsetvalmenu none");
        undef $varname; 
    }
    if (($varname,$value) = /^setPerl\s(\S+)\s(.*)$/) {
        eval "\$$varname = \"".$value.'";';
        undef $varname; undef $value;
    }


    if (/^(quit|abort|update)/) {
        if ($SendMode) { 
             &sendMode(0);
	} else {
            local($saveMailBox) = (($1 eq 'quit' && $dirty) || $1 eq 'update');
            local($terminate) = ($1 eq 'quit' || $1 eq 'abort');
	    local($newCount) = 0;

	    if ($saveMailBox) {
		local($rc);
		&info('Saving mailbox ...');
		open(SMBOX, "<$mailbox");
		&wafe_mu'exclusiveLock(SMBOX); #'
		seek(SMBOX,0,2);
#		print STDERR "SIZES= $MailBoxSize, ",  -s $mailbox,"\n";
	        while ($MailBoxSize != -s $mailbox) {
		    $rc = &checkMailBoxSize();
		    last if $rc == -1;
#		    print STDERR "SIZES= $MailBoxSize, ", -s $mailbox,"\n";
#		    seek(SMBOX,0,2);
		}
		close(SMBOX);
		&Xui('makeBusy subjects true');
		if ($rc != -1) {
		    open(SMBOX, ">$mailbox");
		    for ( $[ .. $count ) {
			unless ($terminate || $newCount == $_) {
			    $Header[$newCount]      = $Header[$_];
			    $Body[$newCount]        = $Body[$_];
			    $Subject[$newCount]     = $Subject[$_];
			    $To[$newCount]          = $To[$_];
			    $From[$newCount]        = $From[$_];
			    $Cc[$newCount]          = $Cc[$_];
			    $Date[$newCount]        = $Date[$_];
			    $Priority[$newCount]    = $Priority[$_];
			    $Status[$newCount]      = $Status[$_];
			    $ReplyTo[$newCount]     = $ReplyTo[$_];
			    $ContentType[$newCount] = $ContentType[$_];
			    $Deleted[$newCount]     = $Deleted[$_];
			    $currentMail = $newCount if $_ == $currentMail;
			}
			if ($Deleted[$_]) {
			    $currentMail=-1,&sendMode(0) 
				if $currentMail == $newCount;
			    $unread--,&setIcon() if ($Status[$_] !~ m/R/);
			} else {
			    print SMBOX $Header[$_], $Body[$_]; 
			    $newCount ++;
			}
		    }
		    close(SMBOX);
		    $MailBoxSize = -s $mailbox;
		    &info('Mailbox saved.');
		}
		&wafe_mu'unLock(SMBOX); #'
		&Xui('makeBusy subjects false');
	    }
	    if ($terminate) {
		&wafe'cleanup();  #'
		&Xui('quit');
		exit;
	    } else {
		$newCount--;
		unless ($count == $newCount) {
		    $count = $newCount;
		    &writeSubjects($[,$count,$spattern,$bpattern);   
		}
                $dirty = 0;
                &wafe'sensitive(!$SendMode && $dirty,('update')); #'
	    }
	}
    }

    &checkMailBoxSize();
    &wafe'unlockTextWidget();
# print "RECEIVED: <<$_>> $unread, $count, $#Header, $MailBoxSize, ".(-s $mailbox)."\n";

}

