BubbaMonk has asked for the wisdom of the Perl Monks concerning the following question:

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.

Replies are listed 'Best First'.
Re: Checking Tk::Text, problems with Text::Autoformat and finally Text::Wrap
by rcseege (Pilgrim) on Oct 17, 2006 at 02:43 UTC

    1: Check for data in Text widget -there are other ways, but I think this is the most efficient.

    use Tk;

my $mw = MainWindow->new;
my $text = $mw->Text->pack;

my $bFrame = $mw->Frame->pack(qw/-side bottom/);

$bFrame->Button(
   -text => "Check Text",
   -command => sub {
      if ($text->index('end - 1c') == 1) {
         print "Text is empty\n";
      } else {
         print "Text contains data\n";
      }
})->pack(qw/-side left/);

$bFrame->Button(
   -text => "Clear Text",
   -command => sub {
      $text->delete("1.0", 'end');
})->pack(qw/-side left/);

MainLoop;

    [download]

    In your sub it looks like you want something like:

       if ($text->index('end - 1c') > 1) { ... }

    [download]

    As for 2, It looks to me like "right" and "left" set margins -- they are not intended for wrapping text. You probably want the break option, which can support break_wrap, break_at, and break_TeX. It looks like break_wrap might be what you're looking for. Also check the Text::Reform module (which Autotext uses) for more info

    Rob
[reply]
[d/l]
[select]
      Hey, Rob! Thanks for the answers; much appreciated! So much so I'm going to make three more logins just so I can upvote you more! I'm thinking paco, pAco and pacO....

      I haven't looked yet, but I'd speculate that break probably won't pull off what I want, either. I'm guessing it would treat the >'s as regular characters dumping them in the middle of lines. Maybe I'll just have to write a new module and they can shove it into Perl 6. Oh, no, working under a deadline! I've got about what, six years to finish it in time? ;)

      Thanks again. BM
[reply]
[d/l]

Back to Seekers of Perl Wisdom