#!/usr/bin/env perl
#
# fmb - format mail body
#
# $Id$

# see also ./bodyof

use warnings;
use strict;
use Getopt::Std;

my $nr_columns = $ENV{COLUMNS}    // 80;
my $margin     = $ENV{FMB_MARGIN} // 10;
my $dotspaces = ' ' x ( ( $ENV{FMB_DOTSPACES} // 2 ) + 0 );

my %opt;
getopts( 'v', \%opt );

sub ehm
{
  $opt{v} and warn join( ' ', @_ ), "\n";
}

if ( !@ARGV )
{
  format_body();
}
else
{
  foreach my $F (@ARGV)
  {
    close(STDIN);

    if ( !open( STDIN, '<', $F ) )
    {
      warn "cannot read $F, skipping it\n";
    }
    else
    {
      format_body();
    }
  }
}

sub format_body
{
  my ( $prev_q_prefix, $prev_bullet, @section );
  $prev_bullet = '';

  while (<>)
  {
    if (s#([\r\n]*)$##)
    {
      $/ = $1;
    }

    if (
/^([^\w()"'*]*[|>*]\s+|\s*)((?:(?:\d+|[ivxIVX]+|[a-zA-Z])[.)]|[+*-])\s+|\s*)|()()\s*/
     )
    {
      # match the (possibly empty) quotation prefix
      my ( $q_prefix, $bullet, $rest ) =
       map { defined $_ ? $_ : '' } ( $1, $2, $' );

      if ( !defined($prev_q_prefix) )
      {
        # the first section starts here
        ehm(
"starting first section with prefix '$q_prefix', bullet '$bullet', line $rest"
        );
        $prev_q_prefix = $q_prefix;
        $prev_bullet   = $bullet;
        @section       = ($rest);
      }
      elsif ( $prev_q_prefix eq $q_prefix && !$bullet && !$prev_bullet )
      {
        # the section continues
        ehm(
"continuing unbulleted section with prefix '$q_prefix', bullet '$bullet', line $rest"
        );
        push( @section, $rest );
      }
      elsif ( !$bullet
        && $prev_bullet
        && length($q_prefix) >= length( $prev_q_prefix . $prev_bullet ) )
      {
        # the prefix changes because a bulleted item is continuing,
        # so the section continues
        ehm(
"continuing bulleted section with prefix '$q_prefix', bullet '$bullet', line $rest"
        );
        push( @section, $rest );
      }
      else
      {
        # the prefix changes: the next section starts here
        ehm(
          "new section with prefix '$q_prefix', bullet '$bullet', line $rest");
        print_wrapped( $prev_q_prefix, $prev_bullet, \@section );
        $prev_q_prefix = $q_prefix;
        $prev_bullet   = $bullet;
        @section       = ($rest);
      }
    }
    else
    {
      die 'unreachable code reached';
    }
  }

  print_wrapped( $prev_q_prefix, $prev_bullet, \@section )
   if defined $prev_q_prefix;
}

sub print_wrapped
{
  my ( $q_prefix, $bullet, $lines ) = @_;

  # remove trailing whitespace and newlines
  my @lines = map { s/\s*$//; $_ } @$lines;
  # join all nonempty paragraphs together
  my @par = ();

  my $bullet_to_print = $bullet;

  foreach my $i ( 0 .. $#lines )
  {
    my $l = $lines[$i];
    #ehm( "processing line: $l");

    if ( $l eq '' )
    {
      if (@par)
      {
        print_filled( $q_prefix, $bullet_to_print, join( ' ', @par ) );
        $bullet_to_print = ' ' x length($bullet);
        @par             = ();
      }
      print_filled( $q_prefix, $bullet_to_print, $l );
      $bullet_to_print = ' ' x length($bullet);
    }
    else
    {
      push( @par, $l );
    }
  }

  if (@par)
  {
    print_filled( $q_prefix, $bullet_to_print, join( ' ', @par ) );
  }
}

sub print_filled
{
  my ( $q_prefix, $bullet, $text ) = @_;
  #ehm( "print_filled($q_prefix, $bullet, $text)");

  if ( $text !~ /\S/ )
  {
    print_piece( $q_prefix, $bullet, '' );
    return;
  }

  if ( $dotspaces ne ' ' )
  {
    $text =~ s/(\S\.)\s+(\S)/$1$dotspaces$2/g;
  }

  my $max_wrap_pos = $nr_columns - $margin - length( $q_prefix . $bullet );

  my $bullet_to_print = $bullet;

  while (1)
  {
    if ( length($text) > $max_wrap_pos && $text =~ /\s/ )
    {
      my $piece = substr( $text, 0, $max_wrap_pos );
      my $rest = substr( $text, length($piece) );

      if ( my ( $l, $r ) = $piece =~ /^(.*\S)\s+(.*)/ )
      {
        #ehm( "short piece is $l");
        print_piece( $q_prefix, $bullet_to_print, $l );
        $text = $r . $rest;
      }
      elsif ( ($l) = $text =~ /^(.*\S)\s+/ )
      {
        #ehm( "long piece is $l");
        print_piece( $q_prefix, $bullet_to_print, $l );
        $text = $';
      }
      else
      {
        die 'reached unreacheable code';
      }

      $bullet_to_print = ' ' x length($bullet);
    }
    else
    {
      #ehm( "last piece is $text");
      print_piece( $q_prefix, $bullet_to_print, $text );
      last;
    }
  }
}

sub print_piece
{
  #ehm( "print_piece($_[0], $_[1]), $_[2]");
  print STDOUT @_, $/;
}