update

1 files changed, 171 insertions, 0 deletions

diff --git a/bin/mutt-trim b/bin/mutt-trim
new file mode 100755
index 0000000..2378ea6
--- /dev/null
+++ b/bin/mutt-trim
@@ -0,0 +1,171 @@
+#!/usr/bin/perl
+#
+# "Beautify" quoted message and make it "ready-to-reply". Originally by Michael Velten.
+
+use utf8;
+
+# keep quotes nested up to 3rd level
+my $ind_max = 3;
+# # put 1 empty line between first and following quote
+# my $gap = 1;
+
+my $name     = '[[:alpha:]]+([\'`-][[:alpha:]]+|[.])*';
+my $fullname = '\b(' . $name . '[,]?\s+)*' . $name . '\b';
+
+# Possible reply greetings (regexes) (note that '> ' will be prefixed)
+my @greetings = (
+    'Dear\s+' . $fullname . '([,.]|\s*!)?',
+    '[Hh](ello|i|ey)' . '(\s+' . $fullname . ')?' . '([,.]|\s*!)?',
+    'Sehr geehrter?\s+' . $fullname . '([,.]|\s*!)?',
+    'Lieber?\s+' . $fullname . '([,.]|\s*!)?',
+    'Guten Tag' . '(\s+' . $fullname . ')?' . '([,.]|\s*!)?',
+    '[Hh]allo' . '(\s+' . $fullname . ')?' . '([,.]|\s*!)?',
+    '[Mm]oin' . '(\s+' . $fullname . ')?' . '([,.]|\s*!)?',
+    '[Mm]esdames(,| et) [Mm]essieurs([,.]|\s*!)?',
+    'M(adame)\s+' . $fullname . '([,.]|\s*!)?',
+    'M(onsieur)\s+' . $fullname . '([,.]|\s*!)?',
+    '[Cc]her\s+' . $fullname . '([,.]|\s*!)?',
+    '[Cc]hère\s+' . $fullname . '([,.]|\s*!)?',
+    '[Bb]onjour' . '(\s+' . $fullname . ')?' . '([,.]|\s*!)?',
+    '[Ss]alut' . '(\s+' . $fullname . ')?' . '([,.]|\s*!)?',
+    'Senhor(ita|a)?' . '(\s+' . $fullname . ')?' . '([,.]|\s*!)?',
+    'Sra?\.?' . '(\s+' . $fullname . ')?' . '([,.]|\s*!)?',
+    'Car(íssim)?[ao]s?' . '(\s+' . $fullname . ')?' . '([,.]|\s*!)?',
+    'Prezad(íssim)?[ao]s?' . '(\s+' . $fullname . ')?' . '([,.]|\s*!)?',
+    'Estimad(íssim)?[ao]s?' . '(\s+' . $fullname . ')?' . '([,.]|\s*!)?',
+    '[Bb]om [Dd]ia' . '(\s+' . $fullname . ')?' . '([,.]|\s*!)?',
+    '[Bb]oa ([Tt]arde|[Nn]oite)' . '(\s+' . $fullname . ')?' . '([,.]|\s*!)?',
+    '[Oo](i|lá|la)' . '(\s+' . $fullname . ')?' . '([,.]|\s*!)?',
+    '[Aa]l[ôo]' . '(\s+' . $fullname . ')?' . '([,.]|\s*!)?',
+    '[Hh]ola' . '(\s+' . $fullname . ')?' . '([,.]|\s*!)?',
+    'Se[ñ]or(ita|a)?' . '(\s+' . $fullname . ')?' . '([,.]|\s*!)?',
+    );
+
+# Possible reply "greetouts" (regexes) (note that '> ' will be prefixed)
+my @greetouts = (
+    '([Ww]ith )?(([Kk]ind|[Bb]est|[Ww]arm) )?([Rr]egards|[Ww]ishes)([,.]|\s*!)?',
+    '[Bb]est([,.]|\s*!)?',
+    '[Cc]heers([,.]|\s*!)?',
+    '[Mm]it ([Vv]iel|[Bb]est|[Ll]ieb|[Ff]reundlich)en [Gg]r([ü]|ue)([ß]|ss)en([,.]|\s*!)?',
+    '(([Vv]iel|[Bb]est|[Ll]ieb|[Ff]reundlich)e )?[Gg]r([ü]|ue)([ß]|ss)e([,.]|\s*!)?',
+    '(([[Bb]est|[Ll]ieb|[Ff]reundlich)e[rn] )?[Gg]ru([ß]|ss)([,.]|\s*!)?',
+    '[Mm]it (([[Bb]est|[Ll]ieb|[Ff]reundlich)em )?[Gg]ru([ß]|ss)([,.]|\s*!)?',
+    '([LV]|MF)G([,.]|\s*!)?',
+    '(([Tt]rès|[Bb]ien) )?([Cc]ordi|[Aa]mic)alement([,.]|\s*!)?',
+    '[Aa]miti[é]s?([,.]|\s*!)?',
+    '[Aa]tenciosamente([,.]|\s*!)?',
+    '[Aa]tt([,.]|\s*!)?',
+    '[Aa]abraços?([,.]|\s*!)?',
+    '[Aa]tentamente([,.]|\s*!)?',
+    '[Cc]ordialmente([,.]|\s*!)?',
+    );
+
+my $word = '[[:alpha:]]+([\'`-][[:alpha:]]+)*';
+
+# my $saw_greeting = 0;
+# my $saw_leadin = 0;
+# my $saw_greetout = 0;
+my $saw_own_sig = 0;
+my $saw_blank_line = 0;
+my $inds_other_sig = 0;
+my $quote_header = 0;
+my $extra_pref = '';
+# my $prev_inds = 0;
+
+my (@mail, @purged_mail);
+
+my $msg = shift;
+die "Usage: $0 MAIL" unless $msg;
+open(MAIL, "+<:encoding(UTF-8)", $msg)  or die "$0: Can't open $msg: $!";
+push(@mail, $_) while <MAIL>;   # Read whole mail
+
+# Process whole mail
+LINE:
+foreach my $line (@mail) {
+
+# Treat non-quoted lines as is
+  if ($line !~ /^>/) {
+    push(@purged_mail, $line);
+    next LINE;
+  }
+
+# Keep all lines after my own signature unmodified
+  if ($line =~ /^--\s?$/ || $saw_own_sig) {
+    $saw_own_sig = 1;
+    push(@purged_mail, $line);
+    next LINE;
+  }
+
+  # $line =~ tr/\xA0/ /;
+# tighten "> > " to ">> "
+  my ($pref, $suff) = $line =~ /^([>[:space:]]+)(.*)$/;
+  $pref =~ s/(>\s*(?!$))/>/g;
+# reduce multiple pre- and post-blanks to one post-blank
+  $pref =~ s/^\s*(>+)\s*/$1 /;
+  $line = $pref . $suff . "\n";
+
+# prepend additional '>' for each Outlook quote header
+  if ($line =~ /^>+ [-_=]{3,}\s*$word(\s+$word)*\s*[-_=]{3,}$/) {
+    $quote_header = 1;
+    next LINE;
+  }
+# first line after Outlook quote header that does not start with ...:
+  if ($quote_header == 1 && $line !~ /^>+ ([-*]\s*)?$word(\s+$word)*\s*:\s+/) {
+    $extra_pref = '>' . $extra_pref;
+    $quote_header = 0;
+  }
+  $pref = $extra_pref . $pref;
+  $line = $pref . $suff . "\n";
+
+# skip line if number of '>'s is greater than $ind_max
+  my $inds = $pref =~ tr/>//;
+  next LINE if $inds > $ind_max;
+
+# Remove other signatures
+  if ($line =~ /^>+ --\s?$/) {
+    $inds_other_sig = $inds;
+  }
+  if ($inds == $inds_other_sig) {
+    next LINE;
+  } else {
+    $inds_other_sig = 0;
+  }
+
+# Remove quoted greeting
+  # unless ($saw_greeting) {
+    foreach my $greeting (@greetings) {
+      if ($line =~ /^>+ $greeting$/) {
+        # $saw_greeting = 1;
+        next LINE;
+      }
+    }
+  # }
+
+# Remove quoted "greetout"
+  # unless ($saw_greetout) {
+    foreach my $greetout (@greetouts) {
+      if ($line =~ /^>+ $greetout$/) {
+        # $saw_greetout = 1;
+        next LINE;
+      }
+    }
+  # }
+
+# Remove quoted filler lines
+  if ($line =~ /^>+ \s*(-*|_*|=*|\+*|#*|\**)$/) {
+    next LINE;
+  }
+
+# Insert $gap empty lines between different quote levels
+  # $line = "\n" x $gap . $line if $prev_inds < $inds;
+  # $prev_inds = $inds;
+
+# Save purged line
+  push(@purged_mail, $line);
+}
+
+# Overwrite original mail with purged mail
+truncate(MAIL, 0);
+seek(MAIL, 0, 0);
+print MAIL @purged_mail;
+close(MAIL);