I find myself in situations all the time where I have to reply to a text file as an email. It gets annoying mannually typing all the >'s so I wrote this bad (*-terisk) little Tk deal to deal with the problem: 
#!perl

# ===TODO===
#
# ****FIX THE TEST TO SEE IF THERE IS TEXT IN THE Text WIDGET****
# -cracker proof the Save File As and margin entries bwo -validate
# -on a really ambitious and slow day let the user define the Text fon
+t, background, etc.

use warnings;
# use strict;
use Tk;
require Tk::LabFrame;
use Text::Autoformat;
use Text::Wrap qw($columns &wrap);

my $mw = MainWindow->new();
my $frame1 = $mw -> LabFrame ( -label => "Paste Original Email Here",
                   -padx => 5,
                   -pady => 5,
                   ) -> pack( -fill => "both" );
my $text = $frame1 -> Scrolled("Text", -scrollbars => 'e',
                       -wrap => "word",
                       ) -> pack( -fill => "both");
my $frame2 = $frame1 -> Frame -> pack ( -side => "left",
                        -expand => 1,
                    -fill => "both",
                        );
my $click = $frame2 -> Button ( -text => "Make Reply",
                -command => sub { if (eval($text -> get("1.0"))) {
                    &flip_lab;
                    my $new_text = &mung_email;
                    $text -> delete ('1.0', 'end');
                    $text -> insert ('end', $new_text);
                    &flip_click;
                        } }
                  ) -> pack;
my $frame3 = $frame1 -> Frame -> pack ( -side => "right",
                        -expand => 1,
                    -fill => "both",
                        );
$frame3 -> Button ( -text => "Clear Text",
            -command => sub { 
                $text -> delete ('1.0', 'end'); 
                if ($click -> cget(-text) eq "Copy to Clipboard") {
                  &flip_click;
                  &flip_lab;
                }
                },
          ) -> pack;

my $frame4 = $mw -> LabFrame (-label => "Options and Actions") -> pack
+( -side => "bottom",
                                -fill => "both",
                                );
my $frame5 = $frame4 -> Frame -> pack ( -side => "bottom",
                    -fill => "both",
                    );
$frame5 -> Label ( -text => "Reply Marker" ) -> pack ( -side => "left"
+ );
my $reply_marker = $frame5 -> Entry ( -width => 3 ) -> pack ( -side =>
+ "left" );
$reply_marker -> insert ('end', ">");
my $file_action = "Append";
foreach ("Make New", "Append") {
  $frame5 -> Radiobutton ( -text => "$_",
               -value => "$_",
               -variable => \$file_action,
               ) -> pack( -side => "right" );
}

my $file_name_entry;
$frame4 -> Button ( -text => "Make .txt File",
            -command => sub {
                my $action_marker = ">";
                $action_marker = ">>" if ($file_action eq "Append");
                if ( $file_name_entry->get() ) {
                  open WRITE, $action_marker . $file_name_entry->get()
+ . "\.txt";
                  if ($file_action eq "Append") {
                    print WRITE "\n==============================\n";
                  }
                  print WRITE $text->get("1.0", "end");
                  close WRITE;
                }
                }
            ) -> pack (-side => "right");
$file_name_entry = $frame4 -> Entry -> pack (-side => "right");
$frame4 -> Label (-text => "Save As") ->pack (-side => "right");

$frame4 -> Label ( -text => "Left Margin" ) -> pack ( -side => "left" 
+);
my $left_margin = $frame4 -> Entry ( -width => 3 ) -> pack (-side => "
+left");
$left_margin -> insert ('end', 1);
$frame4 -> Label ( -text => "Right Margin" ) -> pack ( -side => "left"
+ );
my $right_margin = $frame4 -> Entry ( -width => 3 ) -> pack (-side => 
+"left");
$right_margin -> insert ('end', 60);
                      
$text->focus;
MainLoop;

sub mung_email_with_autoformat {
  my $rough_draft = autoformat ($text -> get('1.0', 'end'), {left => $
+left_margin -> get(),
                                 right => $right_margin -> get(),
                                 },
                );
  my @lines = split ("\n", $rough_draft);
  my $final_draft;
  foreach (@lines) {
    $final_draft .= $reply_marker->get() . "$_\n";
  }
  return $final_draft;
}

sub mung_email {
  $columns = $right_margin -> get();
  my $left_space;
  foreach (1..$left_margin->get()) {
    $left_space .= " ";
  }
  my $rough_draft = $text -> get('1.0', 'end');
  $rough_draft =~ s/([^\s])\n/$1 /g;
  $rough_draft =~ s/\n/\n\n/g;
  $rough_draft = wrap($left_space, $left_space, $rough_draft);
  my @lines = split ("\n", $rough_draft);
  my $final_draft;
  foreach (@lines) {
    $final_draft .= $reply_marker->get() . "$_\n";
  }
  return $final_draft;
}

sub flip_click {
  if ($click->cget(-text) eq "Make Reply") {
    $click -> configure ( -text => "Copy to Clipboard",
              -command => sub { 
                $mw->clipboardClear;
                $mw->clipboardAppend( $text -> get('1.0', 'end') );
                    }
            );
  } else {
    $click -> configure ( -text => "Make Reply",
              -command => sub { if (eval($text -> get("1.0"))) {
                &flip_lab;
                my $new_text = &mung_email;
                $text -> delete ('1.0', 'end');
                $text -> insert ('end', $new_text );
                &flip_click;
                    } }
            );
  }
}

sub flip_lab {
  if ($frame1 -> cget (-label) eq "Paste Original Email Here") {
    $frame1 -> configure ( -label => "Type Your Reply" )
  } else {
    $frame1 -> configure ( -label => "Paste Original Email Here" );
  }
}

[download]

and that's where I hit some snags. After looking to no avail I thought I should TTFM (Toss the freaking manual). But first, I'm seeking perl wisdom.

First problem--I've got this nasty eval test to see if there is any text in the Tk::Text widget: if (eval($text -> get("1.0"))). Why even bother with it? Because Text::Autoformat freaks out of the Text widget is empty. But it's ugly, it's mostly wrong, and it doesn't work if ", >, #, or m are in the 1.0 possition. So, forget that. I need something better! The manpages said how to retrieve text, but nothing about a test to see if the thing is empty. So, problem number one, any takers?

Problem number two: I wanted to use Text::Autoformat. I like Text::Autoformat. But suppose some moron sends a reply marked with ">" that happens to be 100 characters wide (bone head!). Autoformat sees it as a quote and doesn't pare it down regardless of what -right is set to. Any workaround?

So, to deal with that I down-graded to Text::Wrap. Which squeezes too-long reply lines down to the appropriate width, but then bad things like this happen:

> > I think that it's fun to make my replies too long. That way people
+ have to write Tk deals > to deal with it.
> And since they're willing to > deal with it than I can continue > to
> > be a jerk!

[download]

See the problem with that one? My first thought was to make an array of each paragraph, check to see if each line in each paragraph started with a ">" and if it did then strip those, squeeze the paragraph to how ever wide I want it, then add a "> > " to each line in that paragraph. That's one way to do it, but doesn't strike me as lazy enough for this language. So, lazier still I'll just ask, any ideas?

The monks at the monestary make my life a happier place.

In reply to Checking Tk::Text, problems with Text::Autoformat and finally Text::Wrap by BubbaMonk

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.