#!/goodies/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";

#$spellCommand = "spell | sort -u" unless $spellCommand;
$spellCommand = "ispell -l | sort -u" unless $spellCommand;

$mailSpoolFile = &wafe'tmpFile('mailtext'); #'
$spellSpoolFile = &wafe'tmpFile('spell'); #'

$faceDir = "$WafeLib/faces" unless $faceDir;
$opt_u = 5 unless $opt_u; # check Mailbox every n seconds

$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; # in perl5 we should use m//m but we keep $* for compatibility with 
          # perl4
    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:\s*(.*)$/;
	 	$To[$count] =       $1,next if m/^To:\s*(.*)$/;
		$From[$count] =     $1,next if m/^From:\s*(.*)$/; 
		$Cc[$count] =       $1,next if m/^Cc:\s*(.*)$/;
		$Date[$count] =     $1,next if m/^Date:\s*(.*)$/;
    		$Priority[$count] = $1,next if m/^Priority:\s*(.*)$/;
		$Status[$count] =   $1,next if m/^Status:\s*(\S+)/;
		$ReplyTo[$count] =  $1,next if m/^Reply\-To:\s*(.*)$/;
		$ContentType[$count] .= "\$type='$1';" 
		    if m/^Content\-[Tt]ype:\s*(.*)$/;
		$ContentType[$count] .= "\$encoding='$1';" 
		    if m/^Content\-[Tt]ransfer-[Ee]ncoding:\s*(.*)$/;
		$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);
    &info("Scanning Mailbox...");
    &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) {
	$name = &headerField($i,'From') || $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]);
}

sub headerField {
    local($mailNr,$Tag) = @_;
    ($_ = $Header[$mailNr]) =~ s/\n\s+/ /g;
    $* = 1; m/^\s*$Tag\s+(\S+)$/; $* = 0;
    return $1;
}

#
# 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')); #'
    &updateDeleteState($doWith)
	if ($currentMail==$doWith);
}

sub updateDeleteState {
    local($mailNr) = @_;
    &Xui('sV state label '.($Deleted[$mailNr] ? 'Deleted' : '{}'));
}
   

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

    unless ($sendmode) {
        local($from, $pixName);
        local($subject,$date,$extra,$extraTag) = ('{}','{}','{}','{}');

	if ($currentMail != -1) {
	    $from    = $ReplyTo[$currentMail] || $From[$currentMail];
	    $subject = &TclQuote($Subject[$currentMail]);
	    $date    = &TclQuote($Date[$currentMail]);
	    local($fromname,$fromaddr) = &wafe_mu'nameAddress($from); #'
	    ($pixName) = $fromaddr =~ m/([a-zA-Z0-9_\-\.\+]+)@?.*/;

	    local($myNm,$myAddr) = &wafe_mu'nameAddress( $To[$currentMail] );#'
	    if ($myAddr && $myAddr !~ /^$wafe_mu'user\b/) { #'
		$extraTag = 'To:';
		$extra = &TclQuote($To[$currentMail]);
	    } elsif ($_ = &headerField($currentMail,'Apparently-To:')) {
		$extraTag = 'Apparently-To:';
		$extra = &TclQuote($_);
	    } elsif ($Cc[$currentMail]) {
		$extraTag = 'Cc:';
		$extra = &TclQuote($Cc[$currentMail]);
	    }
	}
	&displayMail();
        &Xui('labelDeselect'
            .';sV FromInfo label '.&TclQuote($from)
            .';sV SubjectInfo label '.$subject
            .';sV DateInfo label '. $date
            .';sV extraTag label '.$extraTag
            .';sV extra label '.$extra
	     );
	&updateDeleteState($currentMail);

	if ($pixName ne $lastPixName) {
	    local($cmd);
	    foreach ("$faceDir/$pixName.xpm",
		     "$faceDir/\L$pixName.xpm",
		     "$faceDir/$pixName.xbm",
		     "$faceDir/\L$pixName.xbm") {
                if (-r) {
		    if (/\.xpm$/) {
			$cmd = "changePixmap bild bitmap $_", $lastPixXPM = 1,
			    last if $useXPM;
		    } else {
                       # be sure to erase shape mask
                       $cmd  = "changePixmap bild bitmap None;" if $lastPixXPM;
                       $cmd .= "sV bild bitmap $_";
		       $lastPixXPM = 0;
                       last;
                    }
                }
	    }
	    if ($cmd eq "") {
		$cmd  = "changePixmap bild bitmap None;" if $lastPixXPM;
		$cmd .= "sV bild bitmap None";
		$lastPixXPM = 0;
	    }
	    &Xui("catch {$cmd}");
	    $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);
    if ($useXPM) {
	$newIcon = $unread>0 ? 'mfull.xpm' : 'mempty.xpm';
	$icon = $newIcon, &Xui("changePixmap topLevel iconPixmap $icon") 
	    unless $icon eq $newIcon;
    } else {
	$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
$every_hlabel = "justify left $backGround" 
    . ' top chainTop bottom chainTop left chainLeft';	
$const_hlabel = $every_hlabel.' right chainLeft '.$boldFont;
$var_hlabel =   $every_hlabel.' label {} 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
}

proc whenTextRO {w button char} {
  if {[string compare edit [gV $w editType]] && [gV $button sensitive]} {
    callCallbacks $button callback
  } else {  
    callActionProc $w {} insert-string $char
  }
}

proc whenSensitive {w button} {
  if [gV $button sensitive] { callCallbacks $button callback } 
}

# 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:
    *next.label Next
    *dismiss.label Dismiss
    *TransientShell*quit.label Dismiss
    *TransientShell*add.label AddAlias
    *additional*Label.internalHeight 0
    *Label.borderWidth 0
}
__
### 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 $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 $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 skipAdjust true $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 internalWidth 0 internalHeight 0 \\
                    $backGround width 65 height 65 label {} \\
                    horizDistance 561 right chainRight left chainRight

  Text mailbody paned height 350 autoFill true \\
    showGrip false scrollVertical always type string string {} \\
    $roColors $normalFont

  Form additional paned showGrip false $backGround skipAdjust true
     Label extraTag additional font -*-fixed-medium-r-*-*-10-*-*-*-*-*-*-* \\
                    label {                 } resizable true right chainLeft \\
                    $every_hlabel $backGround
     Label extra    additional font -*-fixed-medium-r-*-*-10-*-*-*-*-*-*-* \\
                    label {} width 450 right chainRight \\
                    $every_hlabel $backGround fromHoriz extraTag 
     Label state    additional font -*-fixed-medium-r-*-*-10-*-*-*-*-*-*-* \\
                    label {       } justify left $backGround \\
                    fromHoriz extra left chainRight right chainRight

  Box buttons paned skipAdjust true $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(<<'__');
proc spellErrors {file textWidget} {
  set sh [TransientShell spellErrors topLevel]
  callback spellErrors popupCallback position info:100/15
  Form spellForm $sh
  Viewport spellView $sh.spellForm allowVert true height 200
  List spellList $sh*spellView \
      callback "spellSearch $sh $textWidget \"%s\" 1" \
      left chainLeft right chainRight top chainTop bottom chainBottom
  XawListChange $sh*spellList 0 0 1 File $file
  Command dismiss $sh.spellForm fromVert $sh*spellView \
      callback "destroyWidget $sh" \
      left chainLeft right chainLeft top chainBottom bottom chainBottom
  Command next $sh.spellForm fromVert $sh*spellView fromHoriz $sh*dismiss \
      sensitive false \
      callback "spellSearch $sh $textWidget {} 0" \
      left chainLeft right chainLeft top chainBottom bottom chainBottom
  popup $sh none
}

proc spellSearch {sh textW word first} {
  if $first {
     sV $sh*next sensitive true
     XawTextSetInsertionPoint $textW 0
  } else {
     XawTextSetInsertionPoint $textW [expr [XawTextGetInsertionPoint $textW]+1]
     set word [set [XawListShowCurrent $sh*spellList](string)]
  }
  set XawTextSearch(ptr) $word
  set XawTextSearch(length) [string length $word]
  set XawTextSearch(firstPos) 0
  set ip [XawTextSearch $textW right XawTextSearch]
  if {$ip<0} { 
    XawTextSetInsertionPoint $textW [expr [XawTextGetInsertionPoint $textW]-1]
    sV $sh*next sensitive false
    bell $sh 0
  } else { 
    XawTextSetInsertionPoint $textW $ip
    XawTextSetSelection $textW $ip [expr $ip+$XawTextSearch(length)]
  }
}
# key events in the following widges should be directed into the mailbody
 foreach w {headerf buttons additional} { setKeyboardFocus $w mailbody }

# 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)
}


# begin label selection code
foreach l {FromInfo SubjectInfo DateInfo extra} {
    action $l override { <Btn1Down>: exec(labelSelect %W) }
}

set selectedLabel {}
proc labelDeselect {} {
  global selectedLabel
  if [string compare "" $selectedLabel] { invert $selectedLabel }
  set selectedLabel {}
}

proc labelSelect {w} {
  global selectedLabel
  if ![string compare $w $selectedLabel] { 
      labelDeselect
      return
  } 
  labelDeselect
  if [string match "" [set contents [gV $w label]]] { return }
  invert $w
  ownSelection $w [gV $w label] labelDeselect NULL 
  set selectedLabel $w
}

proc invert {w} {
  sV $w background [gV $w foreground] foreground [gV $w background]

}
# end label selection code
sV topLevel iconName Mail
#
# initialize global variables

set maxmail -1
set currentMail 5000
__

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

&wafe'applyActions('mailbody',(@textActions,
             'None<Key>d : exec(whenTextRO %W delete   %a)',
             'None<Key>h : exec(whenTextRO %W header   %a)',
             'None<Key>m : exec(whenTextRO %W mail     %a)',
             'None<Key>r : exec(whenTextRO %W reply    %a)',
             'Shift<Key>r: exec(whenTextRO %W replyAll %a)',
             'None<Key>f : exec(whenTextRO %W forward  %a)',
             'None<Key>p : exec(whenTextRO %W print    %a)',
             'None<Key>s : exec(whenTextRO %W save     %a)',
             "Ctrl $meta<Key>Return: exec(whenSensitive %W send)",
             '<Key>Escape: exec(echo back)',
             '<Key>Tab :   exec(expandAlias %W)',
             'Ctrl<Key>a : exec(echo getAddress)',
             'Ctrl<Key>p : exec(echo spell)',
             '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",
		      ("printCommand","spellCommand", 
		       "mailIncludePrefix","signatureFile",
		       "replyTo", "defaultMailHost","defaultMailEncoding"));

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

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



#
# 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 "Reply-To: $main'replyTo\n" if $main'replyTo; #'
	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 (/^spell/) {
      local($content) = &wafe_mu'widgetContent($mailSpoolFile,'mailbody'); #'
      local($errors) = &wafe_mu'spellArg($content,$spellCommand,$spellSpoolFile);#'
      # print "errors=$errors.\n";
      if ($errors > 0) {
	  &Xui("spellErrors $spellSpoolFile mailbody");
      } elsif ($errors == -1) {
	  &info("could not execute SpellCommand '$spellCommand'");
      } else {
	  &info("No spelling errors found");
      }
    }

    &sendMode(0) if /^back/ && $SendMode;

    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);
                    &info('');
		}
                $dirty = 0;
                &wafe'sensitive(!$SendMode && $dirty,('update')); #'
	    }
	}
    }

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

}

