[catagits/Gitalist.git] / local-lib5 / lib / perl5 / Pod / Simple / RTF.pm


require 5;
package Pod::Simple::RTF;

#sub DEBUG () {4};
#sub Pod::Simple::DEBUG () {4};
#sub Pod::Simple::PullParser::DEBUG () {4};

use strict;
use vars qw($VERSION @ISA %Escape $WRAP %Tagmap);
$VERSION = '2.02';
use Pod::Simple::PullParser ();
BEGIN {@ISA = ('Pod::Simple::PullParser')}

use Carp ();
BEGIN { *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG }

$WRAP = 1 unless defined $WRAP;

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub _openclose {
 return map {;
   m/^([-A-Za-z]+)=(\w[^\=]*)$/s or die "what's <$_>?";
   ( $1,  "{\\$2\n",   "/$1",  "}" );
 } @_;
}

my @_to_accept;

%Tagmap = (
 # 'foo=bar' means ('foo' => '{\bar'."\n", '/foo' => '}')
 _openclose(
  'B=cs18\b',
  'I=cs16\i',
  'C=cs19\f1\lang1024\noproof',
  'F=cs17\i\lang1024\noproof',

  'VerbatimI=cs26\i',
  'VerbatimB=cs27\b',
  'VerbatimBI=cs28\b\i',

  map {; m/^([-a-z]+)/s && push @_to_accept, $1; $_ }
   qw[
       underline=ul         smallcaps=scaps  shadow=shad
       superscript=super    subscript=sub    strikethrough=strike
       outline=outl         emboss=embo      engrave=impr   
       dotted-underline=uld          dash-underline=uldash
       dot-dash-underline=uldashd    dot-dot-dash-underline=uldashdd     
       double-underline=uldb         thick-underline=ulth
       word-underline=ulw            wave-underline=ulwave
   ]
   # But no double-strikethrough, because MSWord can't agree with the
   #  RTF spec on whether it's supposed to be \strikedl or \striked1 (!!!)
 ),

 # Bit of a hack here:
 'L=pod' => '{\cs22\i'."\n",
 'L=url' => '{\cs23\i'."\n",
 'L=man' => '{\cs24\i'."\n",
 '/L' => '}',

 'Data'  => "\n",
 '/Data' => "\n",

 'Verbatim'  => "\n{\\pard\\li#rtfindent##rtfkeep#\\plain\\s20\\sa180\\f1\\fs18\\lang1024\\noproof\n",
 '/Verbatim' => "\n\\par}\n",
 'VerbatimFormatted'  => "\n{\\pard\\li#rtfindent##rtfkeep#\\plain\\s20\\sa180\\f1\\fs18\\lang1024\\noproof\n",
 '/VerbatimFormatted' => "\n\\par}\n",
 'Para'    => "\n{\\pard\\li#rtfindent#\\sa180\n",
 '/Para'   => "\n\\par}\n",
 'head1'   => "\n{\\pard\\li#rtfindent#\\s31\\keepn\\sb90\\sa180\\f2\\fs#head1_halfpoint_size#\\ul{\n",
 '/head1'  => "\n}\\par}\n",
 'head2'   => "\n{\\pard\\li#rtfindent#\\s32\\keepn\\sb90\\sa180\\f2\\fs#head2_halfpoint_size#\\ul{\n",
 '/head2'  => "\n}\\par}\n",
 'head3'   => "\n{\\pard\\li#rtfindent#\\s33\\keepn\\sb90\\sa180\\f2\\fs#head3_halfpoint_size#\\ul{\n",
 '/head3'  => "\n}\\par}\n",
 'head4'   => "\n{\\pard\\li#rtfindent#\\s34\\keepn\\sb90\\sa180\\f2\\fs#head4_halfpoint_size#\\ul{\n",
 '/head4'  => "\n}\\par}\n",
   # wordpad borks on \tc\tcl1, or I'd put that in =head1 and =head2

 'item-bullet'  => "\n{\\pard\\li#rtfindent##rtfitemkeepn#\\sb60\\sa150\\fi-120\n",
 '/item-bullet' => "\n\\par}\n",
 'item-number'  => "\n{\\pard\\li#rtfindent##rtfitemkeepn#\\sb60\\sa150\\fi-120\n",
 '/item-number' => "\n\\par}\n",
 'item-text'    => "\n{\\pard\\li#rtfindent##rtfitemkeepn#\\sb60\\sa150\\fi-120\n",
 '/item-text'   => "\n\\par}\n",

 # we don't need any styles for over-* and /over-*
);


#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub new {
  my $new = shift->SUPER::new(@_);
  $new->nix_X_codes(1);
  $new->nbsp_for_S(1);
  $new->accept_targets( 'rtf', 'RTF' );

  $new->{'Tagmap'} = {%Tagmap};

  $new->accept_codes(@_to_accept);
  $new->accept_codes('VerbatimFormatted');
  DEBUG > 2 and print "To accept: ", join(' ',@_to_accept), "\n";
  $new->doc_lang(
    (  $ENV{'RTFDEFLANG'} || '') =~ m/^(\d{1,10})$/s ? $1
    : ($ENV{'RTFDEFLANG'} || '') =~ m/^0?x([a-fA-F0-9]{1,10})$/s ? hex($1)
                                      # yes, tolerate hex!
    : ($ENV{'RTFDEFLANG'} || '') =~ m/^([a-fA-F0-9]{4})$/s ? hex($1)
                                      # yes, tolerate even more hex!
    : '1033'
  );

  $new->head1_halfpoint_size(32);
  $new->head2_halfpoint_size(28);
  $new->head3_halfpoint_size(25);
  $new->head4_halfpoint_size(22);
  $new->codeblock_halfpoint_size(18);
  $new->header_halfpoint_size(17);
  $new->normal_halfpoint_size(25);

  return $new;
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

__PACKAGE__->_accessorize(
 'doc_lang',
 'head1_halfpoint_size',
 'head2_halfpoint_size',
 'head3_halfpoint_size',
 'head4_halfpoint_size',
 'codeblock_halfpoint_size',
 'header_halfpoint_size',
 'normal_halfpoint_size',
 'no_proofing_exemptions',
);


#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub run {
  my $self = $_[0];
  return $self->do_middle if $self->bare_output;
  return
   $self->do_beginning && $self->do_middle && $self->do_end;
}


#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub do_middle {      # the main work
  my $self = $_[0];
  my $fh = $self->{'output_fh'};
  
  my($token, $type, $tagname, $scratch);
  my @stack;
  my @indent_stack;
  $self->{'rtfindent'} = 0 unless defined $self->{'rtfindent'};
  
  while($token = $self->get_token) {
  
    if( ($type = $token->type) eq 'text' ) {
      if( $self->{'rtfverbatim'} ) {
        DEBUG > 1 and print "  $type " , $token->text, " in verbatim!\n";
        rtf_esc_codely($scratch = $token->text);
        print $fh $scratch;
        next;
      }

      DEBUG > 1 and print "  $type " , $token->text, "\n";
      
      $scratch = $token->text;
      $scratch =~ tr/\t\cb\cc/ /d;
      
      $self->{'no_proofing_exemptions'} or $scratch =~
       s/(?:
           ^
           |
           (?<=[\cm\cj\t "\[\<\(])
         )   # start on whitespace, sequence-start, or quote
         ( # something looking like a Perl token:
          (?:
           [\$\@\:\<\*\\_]\S+  # either starting with a sigil, etc.
          )
          |
          # or starting alpha, but containing anything strange:
          (?:
           [a-zA-Z'\x80-\xFF]+[\$\@\:_<>\(\\\*]\S+
          )
         )
        /\cb$1\cc/xsg
      ;
      
      rtf_esc($scratch);
      $scratch =~
         s/(
            [^\cm\cj\n]{65}        # Snare 65 characters from a line
            [^\cm\cj\n\x20]{0,50}  #  and finish any current word
           )
           (\x20{1,10})(?![\cm\cj\n]) # capture some spaces not at line-end
          /$1$2\n/gx     # and put a NL before those spaces
        if $WRAP;
        # This may wrap at well past the 65th column, but not past the 120th.
      
      print $fh $scratch;

    } elsif( $type eq 'start' ) {
      DEBUG > 1 and print "  +$type ",$token->tagname,
        " (", map("<$_> ", %{$token->attr_hash}), ")\n";

      if( ($tagname = $token->tagname) eq 'Verbatim'
          or $tagname eq 'VerbatimFormatted'
      ) {
        ++$self->{'rtfverbatim'};
        my $next = $self->get_token;
        next unless defined $next;
        my $line_count = 1;
        if($next->type eq 'text') {
          my $t = $next->text_r;
          while( $$t =~ m/$/mg ) {
            last if  ++$line_count  > 15; # no point in counting further
          }
          DEBUG > 3 and print "    verbatim line count: $line_count\n";
        }
        $self->unget_token($next);
        $self->{'rtfkeep'} = ($line_count > 15) ? '' : '\keepn' ;     

      } elsif( $tagname =~ m/^item-/s ) {
        my @to_unget;
        my $text_count_here = 0;
        $self->{'rtfitemkeepn'} = '';
        # Some heuristics to stop item-*'s functioning as subheadings
        #  from getting split from the things they're subheadings for.
        #
        # It's not terribly pretty, but it really does make things pretty.
        #
        while(1) {
          push @to_unget, $self->get_token;
          pop(@to_unget), last unless defined $to_unget[-1];
           # Erroneously used to be "unshift" instead of pop!  Adds instead
           # of removes, and operates on the beginning instead of the end!
          
          if($to_unget[-1]->type eq 'text') {
            if( ($text_count_here += length ${$to_unget[-1]->text_r}) > 150 ){
              DEBUG > 1 and print "    item-* is too long to be keepn'd.\n";
              last;
            }
          } elsif (@to_unget > 1 and
            $to_unget[-2]->type eq 'end' and
            $to_unget[-2]->tagname =~ m/^item-/s
          ) {
            # Bail out here, after setting rtfitemkeepn yea or nay.
            $self->{'rtfitemkeepn'} = '\keepn' if 
              $to_unget[-1]->type eq 'start' and
              $to_unget[-1]->tagname eq 'Para';

            DEBUG > 1 and printf "    item-* before %s(%s) %s keepn'd.\n",
              $to_unget[-1]->type,
              $to_unget[-1]->can('tagname') ? $to_unget[-1]->tagname : '',
              $self->{'rtfitemkeepn'} ? "gets" : "doesn't get";
            last;
          } elsif (@to_unget > 40) {
            DEBUG > 1 and print "    item-* now has too many tokens (",
              scalar(@to_unget),
              (DEBUG > 4) ? (q<: >, map($_->dump, @to_unget)) : (),
              ") to be keepn'd.\n";
            last; # give up
          }
          # else keep while'ing along
        }
        # Now put it aaaaall back...
        $self->unget_token(@to_unget);

      } elsif( $tagname =~ m/^over-/s ) {
        push @stack, $1;
        push @indent_stack,
         int($token->attr('indent') * 4 * $self->normal_halfpoint_size);
        DEBUG and print "Indenting over $indent_stack[-1] twips.\n";
        $self->{'rtfindent'} += $indent_stack[-1];
        
      } elsif ($tagname eq 'L') {
        $tagname .= '=' . ($token->attr('type') || 'pod');
        
      } elsif ($tagname eq 'Data') {
        my $next = $self->get_token;
        next unless defined $next;
        unless( $next->type eq 'text' ) {
          $self->unget_token($next);
          next;
        }
        DEBUG and print "    raw text ", $next->text, "\n";
        printf $fh "\n" . $next->text . "\n";
        next;
      }

      defined($scratch = $self->{'Tagmap'}{$tagname}) or next;
      $scratch =~ s/\#([^\#]+)\#/${$self}{$1}/g; # interpolate
      print $fh $scratch;
      
      if ($tagname eq 'item-number') {
        print $fh $token->attr('number'), ". \n";
      } elsif ($tagname eq 'item-bullet') {
        print $fh "\\'95 \n";
        #for funky testing: print $fh '', rtf_esc("\x{4E4B}\x{9053}");
      }

    } elsif( $type eq 'end' ) {
      DEBUG > 1 and print "  -$type ",$token->tagname,"\n";
      if( ($tagname = $token->tagname) =~ m/^over-/s ) {
        DEBUG and print "Indenting back $indent_stack[-1] twips.\n";
        $self->{'rtfindent'} -= pop @indent_stack;
        pop @stack;
      } elsif( $tagname eq 'Verbatim' or $tagname eq 'VerbatimFormatted') {
        --$self->{'rtfverbatim'};
      }
      defined($scratch = $self->{'Tagmap'}{"/$tagname"}) or next;
      $scratch =~ s/\#([^\#]+)\#/${$self}{$1}/g; # interpolate
      print $fh $scratch;
    }
  }
  return 1;
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub do_beginning {
  my $self = $_[0];
  my $fh = $self->{'output_fh'};
  return print $fh join '',
    $self->doc_init,
    $self->font_table,
    $self->stylesheet,
    $self->color_table,
    $self->doc_info,
    $self->doc_start,
    "\n"
  ;
}

sub do_end {
  my $self = $_[0];
  my $fh = $self->{'output_fh'};
  return print $fh '}'; # that should do it
}

###########################################################################

sub stylesheet {
  return sprintf <<'END',
{\stylesheet
{\snext0 Normal;}
{\*\cs10 \additive Default Paragraph Font;}
{\*\cs16 \additive \i \sbasedon10 pod-I;}
{\*\cs17 \additive \i\lang1024\noproof \sbasedon10 pod-F;}
{\*\cs18 \additive \b \sbasedon10 pod-B;}
{\*\cs19 \additive \f1\lang1024\noproof\sbasedon10 pod-C;}
{\s20\ql \li0\ri0\sa180\widctlpar\f1\fs%s\lang1024\noproof\sbasedon0 \snext0 pod-codeblock;}
{\*\cs21 \additive \lang1024\noproof \sbasedon10 pod-computerese;}
{\*\cs22 \additive \i\lang1024\noproof\sbasedon10 pod-L-pod;}
{\*\cs23 \additive \i\lang1024\noproof\sbasedon10 pod-L-url;}
{\*\cs24 \additive \i\lang1024\noproof\sbasedon10 pod-L-man;}

{\*\cs25 \additive \f1\lang1024\noproof\sbasedon0 pod-codelbock-plain;}
{\*\cs26 \additive \f1\lang1024\noproof\sbasedon25 pod-codelbock-ital;}
{\*\cs27 \additive \f1\lang1024\noproof\sbasedon25 pod-codelbock-bold;}
{\*\cs28 \additive \f1\lang1024\noproof\sbasedon25 pod-codelbock-bold-ital;}

{\s31\ql \keepn\sb90\sa180\f2\fs%s\ul\sbasedon0 \snext0 pod-head1;}
{\s32\ql \keepn\sb90\sa180\f2\fs%s\ul\sbasedon0 \snext0 pod-head2;}
{\s33\ql \keepn\sb90\sa180\f2\fs%s\ul\sbasedon0 \snext0 pod-head3;}
{\s34\ql \keepn\sb90\sa180\f2\fs%s\ul\sbasedon0 \snext0 pod-head4;}
}

END

   $_[0]->codeblock_halfpoint_size(),
   $_[0]->head1_halfpoint_size(),
   $_[0]->head2_halfpoint_size(),
   $_[0]->head3_halfpoint_size(),
   $_[0]->head4_halfpoint_size(),
  ;
}

###########################################################################
# Override these as necessary for further customization

sub font_table {
  return <<'END';  # text font, code font, heading font
{\fonttbl
{\f0\froman Times New Roman;}
{\f1\fmodern Courier New;}
{\f2\fswiss Arial;}
}

END
}

sub doc_init {
   return <<'END';
{\rtf1\ansi\deff0

END
}

sub color_table {
   return <<'END';
{\colortbl;\red255\green0\blue0;\red0\green0\blue255;}
END
}


sub doc_info {
   my $self = $_[0];

   my $class = ref($self) || $self;

   my $tag = __PACKAGE__ . ' ' . $VERSION;
   
   unless($class eq __PACKAGE__) {
     $tag = " ($tag)";
     $tag = " v" . $self->VERSION . $tag   if   defined $self->VERSION;
     $tag = $class . $tag;
   }

   return sprintf <<'END',
{\info{\doccomm
%s
 using %s v%s
 under Perl v%s at %s GMT}
{\author [see doc]}{\company [see doc]}{\operator [see doc]}
}

END

  # None of the following things should need escaping, I dare say!
    $tag, 
    $ISA[0], $ISA[0]->VERSION(),
    $], scalar(gmtime),
  ;
}

sub doc_start {
  my $self = $_[0];
  my $title = $self->get_short_title();
  DEBUG and print "Short Title: <$title>\n";
  $title .= ' ' if length $title;
  
  $title =~ s/ *$/ /s;
  $title =~ s/^ //s;
  $title =~ s/ $/, /s;
   # make sure it ends in a comma and a space, unless it's 0-length

  my $is_obviously_module_name;
  $is_obviously_module_name = 1
   if $title =~ m/^\S+$/s and $title =~ m/::/s;
    # catches the most common case, at least

  DEBUG and print "Title0: <$title>\n";
  $title = rtf_esc($title);
  DEBUG and print "Title1: <$title>\n";
  $title = '\lang1024\noproof ' . $title
   if $is_obviously_module_name;

  return sprintf <<'END', 
\deflang%s\plain\lang%s\widowctrl
{\header\pard\qr\plain\f2\fs%s
%s
p.\chpgn\par}
\fs%s

END
    ($self->doc_lang) x 2,
    $self->header_halfpoint_size,
    $title,
    $self->normal_halfpoint_size,
  ;
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#-------------------------------------------------------------------------

use integer;
sub rtf_esc {
  my $x; # scratch
  if(!defined wantarray) { # void context: alter in-place!
    for(@_) {
      s/([F\x00-\x1F\-\\\{\}\x7F-\xFF])/$Escape{$1}/g;  # ESCAPER
      s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
    }
    return;
  } elsif(wantarray) {  # return an array
    return map {; ($x = $_) =~
      s/([F\x00-\x1F\-\\\{\}\x7F-\xFF])/$Escape{$1}/g;  # ESCAPER
      $x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
      $x;
    } @_;
  } else { # return a single scalar
    ($x = ((@_ == 1) ? $_[0] : join '', @_)
    ) =~ s/([F\x00-\x1F\-\\\{\}\x7F-\xFF])/$Escape{$1}/g;  # ESCAPER
             # Escape \, {, }, -, control chars, and 7f-ff.
    $x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
    return $x;
  }
}

sub rtf_esc_codely {
  # Doesn't change "-" to hard-hyphen, nor apply computerese style-smarts.
  # We don't want to change the "-" to hard-hyphen, because we want to
  #  be able to paste this into a file and run it without there being
  #  dire screaming about the mysterious hard-hyphen character (which
  #  looks just like a normal dash character).
  
  my $x; # scratch
  if(!defined wantarray) { # void context: alter in-place!
    for(@_) {
      s/([F\x00-\x1F\\\{\}\x7F-\xFF])/$Escape{$1}/g;  # ESCAPER
      s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
    }
    return;
  } elsif(wantarray) {  # return an array
    return map {; ($x = $_) =~
      s/([F\x00-\x1F\\\{\}\x7F-\xFF])/$Escape{$1}/g;  # ESCAPER
      $x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
      $x;
    } @_;
  } else { # return a single scalar
    ($x = ((@_ == 1) ? $_[0] : join '', @_)
    ) =~ s/([F\x00-\x1F\\\{\}\x7F-\xFF])/$Escape{$1}/g;  # ESCAPER
             # Escape \, {, }, -, control chars, and 7f-ff.
    $x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
    return $x;
  }
}

%Escape = (
  map( (chr($_),chr($_)),       # things not apparently needing escaping
       0x20 .. 0x7E ),
  map( (chr($_),sprintf("\\'%02x", $_)),    # apparently escapeworthy things
       0x00 .. 0x1F, 0x5c, 0x7b, 0x7d, 0x7f .. 0xFF, 0x46),

  # We get to escape out 'F' so that we can send RTF files thru the mail
  # without the slightest worry that paragraphs beginning with "From"
  # will get munged.

  # And some refinements:
  "\cm"  => "\n",
  "\cj"  => "\n",
  "\n"   => "\n\\line ",

  "\t"   => "\\tab ",     # Tabs (altho theoretically raw \t's are okay)
  "\f"   => "\n\\page\n", # Formfeed
  "-"    => "\\_",        # Turn plaintext '-' into a non-breaking hyphen
  "\xA0" => "\\~",        # Latin-1 non-breaking space
  "\xAD" => "\\-",        # Latin-1 soft (optional) hyphen

  # CRAZY HACKS:
  "\n" => "\\line\n",
  "\r" => "\n",
  "\cb" => "{\n\\cs21\\lang1024\\noproof ",  # \\cf1
  "\cc" => "}",
);
1;

__END__

=head1 NAME

Pod::Simple::RTF -- format Pod as RTF

=head1 SYNOPSIS

  perl -MPod::Simple::RTF -e \
   "exit Pod::Simple::RTF->filter(shift)->any_errata_seen" \
   thingy.pod > thingy.rtf

=head1 DESCRIPTION

This class is a formatter that takes Pod and renders it as RTF, good for
viewing/printing in MSWord, WordPad/write.exe, TextEdit, etc.

This is a subclass of L<Pod::Simple> and inherits all its methods.

=head1 FORMAT CONTROL ATTRIBUTES

You can set these attributes on the parser object before you
call C<parse_file> (or a similar method) on it:

=over

=item $parser->head1_halfpoint_size( I<halfpoint_integer> );

=item $parser->head2_halfpoint_size( I<halfpoint_integer> );

=item $parser->head3_halfpoint_size( I<halfpoint_integer> );

=item $parser->head4_halfpoint_size( I<halfpoint_integer> );

These methods set the size (in half-points, like 52 for 26-point)
that these heading levels will appear as.

=item $parser->codeblock_halfpoint_size( I<halfpoint_integer> );

This method sets the size (in half-points, like 21 for 10.5-point)
that codeblocks ("verbatim sections") will appear as.

=item $parser->header_halfpoint_size( I<halfpoint_integer> );

This method sets the size (in half-points, like 15 for 7.5-point)
that the header on each page will appear in.  The header
is usually just "I<modulename> p. I<pagenumber>".

=item $parser->normal_halfpoint_size( I<halfpoint_integer> );

This method sets the size (in half-points, like 26 for 13-point)
that normal paragraphic text will appear in.

=item $parser->no_proofing_exemptions( I<true_or_false> );

Set this value to true if you don't want the formatter to try
putting a hidden code on all Perl symbols (as best as it can
notice them) that labels them as being not in English, and
so not worth spellchecking.

=item $parser->doc_lang( I<microsoft_decimal_language_code> )

This sets the language code to tag this document as being in. By
default, it is currently the value of the environment variable
C<RTFDEFLANG>, or if that's not set, then the value
1033 (for US English).

Setting this appropriately is useful if you want to use the RTF
to spellcheck, and/or if you want it to hyphenate right.

Here are some notable values:

  1033  US English
  2057  UK English
  3081  Australia English
  4105  Canada English
  1034  Spain Spanish
  2058  Mexico Spanish
  1031  Germany German
  1036  France French
  3084  Canada French
  1035  Finnish
  1044  Norwegian (Bokmal)
  2068  Norwegian (Nynorsk)

=back

If you are particularly interested in customizing this module's output
even more, see the source and/or write to me.

=head1 SEE ALSO

L<Pod::Simple>, L<RTF::Writer>, L<RTF::Cookbook>, L<RTF::Document>,
L<RTF::Generator>

=head1 COPYRIGHT AND DISCLAIMERS

Copyright (c) 2002 Sean M. Burke.  All rights reserved.

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=head1 AUTHOR

Sean M. Burke C<sburke@cpan.org>

=cut
Commit	Line	Data
3fea05b9	1
	2	require 5;
	3	package Pod::Simple::RTF;
	4
	5	#sub DEBUG () {4};
	6	#sub Pod::Simple::DEBUG () {4};
	7	#sub Pod::Simple::PullParser::DEBUG () {4};
	8
	9	use strict;
	10	use vars qw($VERSION @ISA %Escape $WRAP %Tagmap);
	11	$VERSION = '2.02';
	12	use Pod::Simple::PullParser ();
	13	BEGIN {@ISA = ('Pod::Simple::PullParser')}
	14
	15	use Carp ();
	16	BEGIN { *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG }
	17
	18	$WRAP = 1 unless defined $WRAP;
	19
	20	#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	21
	22	sub _openclose {
	23	return map {;
	24	m/^([-A-Za-z]+)=(\w[^\=]*)$/s or die "what's <$_>?";
	25	( $1, "{\\$2\n", "/$1", "}" );
	26	} @_;
	27	}
	28
	29	my @_to_accept;
	30
	31	%Tagmap = (
	32	# 'foo=bar' means ('foo' => '{\bar'."\n", '/foo' => '}')
	33	_openclose(
	34	'B=cs18\b',
	35	'I=cs16\i',
	36	'C=cs19\f1\lang1024\noproof',
	37	'F=cs17\i\lang1024\noproof',
	38
	39	'VerbatimI=cs26\i',
	40	'VerbatimB=cs27\b',
	41	'VerbatimBI=cs28\b\i',
	42
	43	map {; m/^([-a-z]+)/s && push @_to_accept, $1; $_ }
	44	qw[
	45	underline=ul smallcaps=scaps shadow=shad
	46	superscript=super subscript=sub strikethrough=strike
	47	outline=outl emboss=embo engrave=impr
	48	dotted-underline=uld dash-underline=uldash
	49	dot-dash-underline=uldashd dot-dot-dash-underline=uldashdd
	50	double-underline=uldb thick-underline=ulth
	51	word-underline=ulw wave-underline=ulwave
	52	]
	53	# But no double-strikethrough, because MSWord can't agree with the
	54	# RTF spec on whether it's supposed to be \strikedl or \striked1 (!!!)
	55	),
	56
	57	# Bit of a hack here:
	58	'L=pod' => '{\cs22\i'."\n",
	59	'L=url' => '{\cs23\i'."\n",
	60	'L=man' => '{\cs24\i'."\n",
	61	'/L' => '}',
	62
	63	'Data' => "\n",
	64	'/Data' => "\n",
65
66	'Verbatim' => "\n{\\pard\\li#rtfindent##rtfkeep#\\plain\\s20\\sa180\\f1\\fs18\\lang1024\\noproof\n",
67	'/Verbatim' => "\n\\par}\n",
68	'VerbatimFormatted' => "\n{\\pard\\li#rtfindent##rtfkeep#\\plain\\s20\\sa180\\f1\\fs18\\lang1024\\noproof\n",
69	'/VerbatimFormatted' => "\n\\par}\n",
70	'Para' => "\n{\\pard\\li#rtfindent#\\sa180\n",
71	'/Para' => "\n\\par}\n",
72	'head1' => "\n{\\pard\\li#rtfindent#\\s31\\keepn\\sb90\\sa180\\f2\\fs#head1_halfpoint_size#\\ul{\n",
73	'/head1' => "\n}\\par}\n",
74	'head2' => "\n{\\pard\\li#rtfindent#\\s32\\keepn\\sb90\\sa180\\f2\\fs#head2_halfpoint_size#\\ul{\n",
75	'/head2' => "\n}\\par}\n",
76	'head3' => "\n{\\pard\\li#rtfindent#\\s33\\keepn\\sb90\\sa180\\f2\\fs#head3_halfpoint_size#\\ul{\n",
77	'/head3' => "\n}\\par}\n",
78	'head4' => "\n{\\pard\\li#rtfindent#\\s34\\keepn\\sb90\\sa180\\f2\\fs#head4_halfpoint_size#\\ul{\n",
79	'/head4' => "\n}\\par}\n",
80	# wordpad borks on \tc\tcl1, or I'd put that in =head1 and =head2
81
82	'item-bullet' => "\n{\\pard\\li#rtfindent##rtfitemkeepn#\\sb60\\sa150\\fi-120\n",
83	'/item-bullet' => "\n\\par}\n",
84	'item-number' => "\n{\\pard\\li#rtfindent##rtfitemkeepn#\\sb60\\sa150\\fi-120\n",
85	'/item-number' => "\n\\par}\n",
86	'item-text' => "\n{\\pard\\li#rtfindent##rtfitemkeepn#\\sb60\\sa150\\fi-120\n",
87	'/item-text' => "\n\\par}\n",
88
89	# we don't need any styles for over-* and /over-*
90	);
91
92
93	#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
94	sub new {
95	my $new = shift->SUPER::new(@_);
96	$new->nix_X_codes(1);
97	$new->nbsp_for_S(1);
98	$new->accept_targets( 'rtf', 'RTF' );
99
100	$new->{'Tagmap'} = {%Tagmap};
101
102	$new->accept_codes(@_to_accept);
103	$new->accept_codes('VerbatimFormatted');
104	DEBUG > 2 and print "To accept: ", join(' ',@_to_accept), "\n";
105	$new->doc_lang(
106	( $ENV{'RTFDEFLANG'} \|\| '') =~ m/^(\d{1,10})$/s ? $1
107	: ($ENV{'RTFDEFLANG'} \|\| '') =~ m/^0?x([a-fA-F0-9]{1,10})$/s ? hex($1)
108	# yes, tolerate hex!
109	: ($ENV{'RTFDEFLANG'} \|\| '') =~ m/^([a-fA-F0-9]{4})$/s ? hex($1)
110	# yes, tolerate even more hex!
111	: '1033'
112	);
113
114	$new->head1_halfpoint_size(32);
115	$new->head2_halfpoint_size(28);
116	$new->head3_halfpoint_size(25);
117	$new->head4_halfpoint_size(22);
118	$new->codeblock_halfpoint_size(18);
119	$new->header_halfpoint_size(17);
120	$new->normal_halfpoint_size(25);
121
122	return $new;
123	}
124
125	#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
126
127	__PACKAGE__->_accessorize(
128	'doc_lang',
129	'head1_halfpoint_size',
130	'head2_halfpoint_size',
131	'head3_halfpoint_size',
132	'head4_halfpoint_size',
133	'codeblock_halfpoint_size',
134	'header_halfpoint_size',
135	'normal_halfpoint_size',
136	'no_proofing_exemptions',
137	);
138
139
140	#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
141	sub run {
142	my $self = $_[0];
143	return $self->do_middle if $self->bare_output;
144	return
145	$self->do_beginning && $self->do_middle && $self->do_end;
146	}
147
148
149	#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
150
151	sub do_middle { # the main work
152	my $self = $_[0];
153	my $fh = $self->{'output_fh'};
154
155	my($token, $type, $tagname, $scratch);
156	my @stack;
157	my @indent_stack;
158	$self->{'rtfindent'} = 0 unless defined $self->{'rtfindent'};
159
160	while($token = $self->get_token) {
161
162	if( ($type = $token->type) eq 'text' ) {
163	if( $self->{'rtfverbatim'} ) {
164	DEBUG > 1 and print " $type " , $token->text, " in verbatim!\n";
165	rtf_esc_codely($scratch = $token->text);
166	print $fh $scratch;
167	next;
168	}
169
170	DEBUG > 1 and print " $type " , $token->text, "\n";
171
172	$scratch = $token->text;
173	$scratch =~ tr/\t\cb\cc/ /d;
174
175	$self->{'no_proofing_exemptions'} or $scratch =~
176	s/(?:
177	^
178	\|
179	(?<=[\cm\cj\t "\[\<\(])
180	) # start on whitespace, sequence-start, or quote
181	( # something looking like a Perl token:
182	(?:
183	[\$\@\:\<\*\\_]\S+ # either starting with a sigil, etc.
184	)
185	\|
186	# or starting alpha, but containing anything strange:
187	(?:
188	[a-zA-Z'\x80-\xFF]+[\$\@\:_<>\(\\\*]\S+
189	)
190	)
191	/\cb$1\cc/xsg
192	;
193
194	rtf_esc($scratch);
195	$scratch =~
196	s/(
197	[^\cm\cj\n]{65} # Snare 65 characters from a line
198	[^\cm\cj\n\x20]{0,50} # and finish any current word
199	)
200	(\x20{1,10})(?![\cm\cj\n]) # capture some spaces not at line-end
201	/$1$2\n/gx # and put a NL before those spaces
202	if $WRAP;
203	# This may wrap at well past the 65th column, but not past the 120th.
204
205	print $fh $scratch;
206
207	} elsif( $type eq 'start' ) {
208	DEBUG > 1 and print " +$type ",$token->tagname,
209	" (", map("<$_> ", %{$token->attr_hash}), ")\n";
210
211	if( ($tagname = $token->tagname) eq 'Verbatim'
212	or $tagname eq 'VerbatimFormatted'
213	) {
214	++$self->{'rtfverbatim'};
215	my $next = $self->get_token;
216	next unless defined $next;
217	my $line_count = 1;
218	if($next->type eq 'text') {
219	my $t = $next->text_r;
220	while( $$t =~ m/$/mg ) {
221	last if ++$line_count > 15; # no point in counting further
222	}
223	DEBUG > 3 and print " verbatim line count: $line_count\n";
224	}
225	$self->unget_token($next);
226	$self->{'rtfkeep'} = ($line_count > 15) ? '' : '\keepn' ;
227
228	} elsif( $tagname =~ m/^item-/s ) {
229	my @to_unget;
230	my $text_count_here = 0;
231	$self->{'rtfitemkeepn'} = '';
232	# Some heuristics to stop item-*'s functioning as subheadings
233	# from getting split from the things they're subheadings for.
234	#
235	# It's not terribly pretty, but it really does make things pretty.
236	#
237	while(1) {
238	push @to_unget, $self->get_token;
239	pop(@to_unget), last unless defined $to_unget[-1];
240	# Erroneously used to be "unshift" instead of pop! Adds instead
241	# of removes, and operates on the beginning instead of the end!
242
243	if($to_unget[-1]->type eq 'text') {
244	if( ($text_count_here += length ${$to_unget[-1]->text_r}) > 150 ){
245	DEBUG > 1 and print " item-* is too long to be keepn'd.\n";
246	last;
247	}
248	} elsif (@to_unget > 1 and
249	$to_unget[-2]->type eq 'end' and
250	$to_unget[-2]->tagname =~ m/^item-/s
251	) {
252	# Bail out here, after setting rtfitemkeepn yea or nay.
253	$self->{'rtfitemkeepn'} = '\keepn' if
254	$to_unget[-1]->type eq 'start' and
255	$to_unget[-1]->tagname eq 'Para';
256
257	DEBUG > 1 and printf " item-* before %s(%s) %s keepn'd.\n",
258	$to_unget[-1]->type,
259	$to_unget[-1]->can('tagname') ? $to_unget[-1]->tagname : '',
260	$self->{'rtfitemkeepn'} ? "gets" : "doesn't get";
261	last;
262	} elsif (@to_unget > 40) {
263	DEBUG > 1 and print " item-* now has too many tokens (",
264	scalar(@to_unget),
265	(DEBUG > 4) ? (q<: >, map($_->dump, @to_unget)) : (),
266	") to be keepn'd.\n";
267	last; # give up
268	}
269	# else keep while'ing along
270	}
271	# Now put it aaaaall back...
272	$self->unget_token(@to_unget);
273
274	} elsif( $tagname =~ m/^over-/s ) {
275	push @stack, $1;
276	push @indent_stack,
277	int($token->attr('indent') * 4 * $self->normal_halfpoint_size);
278	DEBUG and print "Indenting over $indent_stack[-1] twips.\n";
279	$self->{'rtfindent'} += $indent_stack[-1];
280
281	} elsif ($tagname eq 'L') {
282	$tagname .= '=' . ($token->attr('type') \|\| 'pod');
283
284	} elsif ($tagname eq 'Data') {
285	my $next = $self->get_token;
286	next unless defined $next;
287	unless( $next->type eq 'text' ) {
288	$self->unget_token($next);
289	next;
290	}
291	DEBUG and print " raw text ", $next->text, "\n";
292	printf $fh "\n" . $next->text . "\n";
293	next;
294	}
295
296	defined($scratch = $self->{'Tagmap'}{$tagname}) or next;
297	$scratch =~ s/\#([^\#]+)\#/${$self}{$1}/g; # interpolate
298	print $fh $scratch;
299
300	if ($tagname eq 'item-number') {
301	print $fh $token->attr('number'), ". \n";
302	} elsif ($tagname eq 'item-bullet') {
303	print $fh "\\'95 \n";
304	#for funky testing: print $fh '', rtf_esc("\x{4E4B}\x{9053}");
305	}
306
307	} elsif( $type eq 'end' ) {
308	DEBUG > 1 and print " -$type ",$token->tagname,"\n";
309	if( ($tagname = $token->tagname) =~ m/^over-/s ) {
310	DEBUG and print "Indenting back $indent_stack[-1] twips.\n";
311	$self->{'rtfindent'} -= pop @indent_stack;
312	pop @stack;
313	} elsif( $tagname eq 'Verbatim' or $tagname eq 'VerbatimFormatted') {
314	--$self->{'rtfverbatim'};
315	}
316	defined($scratch = $self->{'Tagmap'}{"/$tagname"}) or next;
317	$scratch =~ s/\#([^\#]+)\#/${$self}{$1}/g; # interpolate
318	print $fh $scratch;
319	}
320	}
321	return 1;
322	}
323
324	#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
325	sub do_beginning {
326	my $self = $_[0];
327	my $fh = $self->{'output_fh'};
328	return print $fh join '',
329	$self->doc_init,
330	$self->font_table,
331	$self->stylesheet,
332	$self->color_table,
333	$self->doc_info,
334	$self->doc_start,
335	"\n"
336	;
337	}
338
339	sub do_end {
340	my $self = $_[0];
341	my $fh = $self->{'output_fh'};
342	return print $fh '}'; # that should do it
343	}
344
345	###########################################################################
346
347	sub stylesheet {
348	return sprintf <<'END',
349	{\stylesheet
350	{\snext0 Normal;}
351	{\*\cs10 \additive Default Paragraph Font;}
352	{\*\cs16 \additive \i \sbasedon10 pod-I;}
353	{\*\cs17 \additive \i\lang1024\noproof \sbasedon10 pod-F;}
354	{\*\cs18 \additive \b \sbasedon10 pod-B;}
355	{\*\cs19 \additive \f1\lang1024\noproof\sbasedon10 pod-C;}
356	{\s20\ql \li0\ri0\sa180\widctlpar\f1\fs%s\lang1024\noproof\sbasedon0 \snext0 pod-codeblock;}
357	{\*\cs21 \additive \lang1024\noproof \sbasedon10 pod-computerese;}
358	{\*\cs22 \additive \i\lang1024\noproof\sbasedon10 pod-L-pod;}
359	{\*\cs23 \additive \i\lang1024\noproof\sbasedon10 pod-L-url;}
360	{\*\cs24 \additive \i\lang1024\noproof\sbasedon10 pod-L-man;}
361
362	{\*\cs25 \additive \f1\lang1024\noproof\sbasedon0 pod-codelbock-plain;}
363	{\*\cs26 \additive \f1\lang1024\noproof\sbasedon25 pod-codelbock-ital;}
364	{\*\cs27 \additive \f1\lang1024\noproof\sbasedon25 pod-codelbock-bold;}
365	{\*\cs28 \additive \f1\lang1024\noproof\sbasedon25 pod-codelbock-bold-ital;}
366
367	{\s31\ql \keepn\sb90\sa180\f2\fs%s\ul\sbasedon0 \snext0 pod-head1;}
368	{\s32\ql \keepn\sb90\sa180\f2\fs%s\ul\sbasedon0 \snext0 pod-head2;}
369	{\s33\ql \keepn\sb90\sa180\f2\fs%s\ul\sbasedon0 \snext0 pod-head3;}
370	{\s34\ql \keepn\sb90\sa180\f2\fs%s\ul\sbasedon0 \snext0 pod-head4;}
371	}
372
373	END
374
375	$_[0]->codeblock_halfpoint_size(),
376	$_[0]->head1_halfpoint_size(),
377	$_[0]->head2_halfpoint_size(),
378	$_[0]->head3_halfpoint_size(),
379	$_[0]->head4_halfpoint_size(),
380	;
381	}
382
383	###########################################################################
384	# Override these as necessary for further customization
385
386	sub font_table {
387	return <<'END'; # text font, code font, heading font
388	{\fonttbl
389	{\f0\froman Times New Roman;}
390	{\f1\fmodern Courier New;}
391	{\f2\fswiss Arial;}
392	}
393
394	END
395	}
396
397	sub doc_init {
398	return <<'END';
399	{\rtf1\ansi\deff0
400
401	END
402	}
403
404	sub color_table {
405	return <<'END';
406	{\colortbl;\red255\green0\blue0;\red0\green0\blue255;}
407	END
408	}
409
410
411	sub doc_info {
412	my $self = $_[0];
413
414	my $class = ref($self) \|\| $self;
415
416	my $tag = __PACKAGE__ . ' ' . $VERSION;
417
418	unless($class eq __PACKAGE__) {
419	$tag = " ($tag)";
420	$tag = " v" . $self->VERSION . $tag if defined $self->VERSION;
421	$tag = $class . $tag;
422	}
423
424	return sprintf <<'END',
425	{\info{\doccomm
426	%s
427	using %s v%s
428	under Perl v%s at %s GMT}
429	{\author [see doc]}{\company [see doc]}{\operator [see doc]}
430	}
431
432	END
433
434	# None of the following things should need escaping, I dare say!
435	$tag,
436	$ISA[0], $ISA[0]->VERSION(),
437	$], scalar(gmtime),
438	;
439	}
440
441	sub doc_start {
442	my $self = $_[0];
443	my $title = $self->get_short_title();
444	DEBUG and print "Short Title: <$title>\n";
445	$title .= ' ' if length $title;
446
447	$title =~ s/ *$/ /s;
448	$title =~ s/^ //s;
449	$title =~ s/ $/, /s;
450	# make sure it ends in a comma and a space, unless it's 0-length
451
452	my $is_obviously_module_name;
453	$is_obviously_module_name = 1
454	if $title =~ m/^\S+$/s and $title =~ m/::/s;
455	# catches the most common case, at least
456
457	DEBUG and print "Title0: <$title>\n";
458	$title = rtf_esc($title);
459	DEBUG and print "Title1: <$title>\n";
460	$title = '\lang1024\noproof ' . $title
461	if $is_obviously_module_name;
462
463	return sprintf <<'END',
464	\deflang%s\plain\lang%s\widowctrl
465	{\header\pard\qr\plain\f2\fs%s
466	%s
467	p.\chpgn\par}
468	\fs%s
469
470	END
471	($self->doc_lang) x 2,
472	$self->header_halfpoint_size,
473	$title,
474	$self->normal_halfpoint_size,
475	;
476	}
477
478	#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
479	#-------------------------------------------------------------------------
480
481	use integer;
482	sub rtf_esc {
483	my $x; # scratch
484	if(!defined wantarray) { # void context: alter in-place!
485	for(@_) {
486	s/([F\x00-\x1F\-\\\{\}\x7F-\xFF])/$Escape{$1}/g; # ESCAPER
487	s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
488	}
489	return;
490	} elsif(wantarray) { # return an array
491	return map {; ($x = $_) =~
492	s/([F\x00-\x1F\-\\\{\}\x7F-\xFF])/$Escape{$1}/g; # ESCAPER
493	$x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
494	$x;
495	} @_;
496	} else { # return a single scalar
497	($x = ((@_ == 1) ? $_[0] : join '', @_)
498	) =~ s/([F\x00-\x1F\-\\\{\}\x7F-\xFF])/$Escape{$1}/g; # ESCAPER
499	# Escape \, {, }, -, control chars, and 7f-ff.
500	$x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
501	return $x;
502	}
503	}
504
505	sub rtf_esc_codely {
506	# Doesn't change "-" to hard-hyphen, nor apply computerese style-smarts.
507	# We don't want to change the "-" to hard-hyphen, because we want to
508	# be able to paste this into a file and run it without there being
509	# dire screaming about the mysterious hard-hyphen character (which
510	# looks just like a normal dash character).
511
512	my $x; # scratch
513	if(!defined wantarray) { # void context: alter in-place!
514	for(@_) {
515	s/([F\x00-\x1F\\\{\}\x7F-\xFF])/$Escape{$1}/g; # ESCAPER
516	s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
517	}
518	return;
519	} elsif(wantarray) { # return an array
520	return map {; ($x = $_) =~
521	s/([F\x00-\x1F\\\{\}\x7F-\xFF])/$Escape{$1}/g; # ESCAPER
522	$x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
523	$x;
524	} @_;
525	} else { # return a single scalar
526	($x = ((@_ == 1) ? $_[0] : join '', @_)
527	) =~ s/([F\x00-\x1F\\\{\}\x7F-\xFF])/$Escape{$1}/g; # ESCAPER
528	# Escape \, {, }, -, control chars, and 7f-ff.
529	$x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
530	return $x;
531	}
532	}
533
534	%Escape = (
535	map( (chr($_),chr($_)), # things not apparently needing escaping
536	0x20 .. 0x7E ),
537	map( (chr($_),sprintf("\\'%02x", $_)), # apparently escapeworthy things
538	0x00 .. 0x1F, 0x5c, 0x7b, 0x7d, 0x7f .. 0xFF, 0x46),
539
540	# We get to escape out 'F' so that we can send RTF files thru the mail
541	# without the slightest worry that paragraphs beginning with "From"
542	# will get munged.
543
544	# And some refinements:
545	"\cm" => "\n",
546	"\cj" => "\n",
547	"\n" => "\n\\line ",
548
549	"\t" => "\\tab ", # Tabs (altho theoretically raw \t's are okay)
550	"\f" => "\n\\page\n", # Formfeed
551	"-" => "\\_", # Turn plaintext '-' into a non-breaking hyphen
552	"\xA0" => "\\~", # Latin-1 non-breaking space
553	"\xAD" => "\\-", # Latin-1 soft (optional) hyphen
554
555	# CRAZY HACKS:
556	"\n" => "\\line\n",
557	"\r" => "\n",
558	"\cb" => "{\n\\cs21\\lang1024\\noproof ", # \\cf1
559	"\cc" => "}",
560	);
561	1;
562
563	__END__
564
565	=head1 NAME
566
567	Pod::Simple::RTF -- format Pod as RTF
568
569	=head1 SYNOPSIS
570
571	perl -MPod::Simple::RTF -e \
572	"exit Pod::Simple::RTF->filter(shift)->any_errata_seen" \
573	thingy.pod > thingy.rtf
574
575	=head1 DESCRIPTION
576
577	This class is a formatter that takes Pod and renders it as RTF, good for
578	viewing/printing in MSWord, WordPad/write.exe, TextEdit, etc.
579
580	This is a subclass of L<Pod::Simple> and inherits all its methods.
581
582	=head1 FORMAT CONTROL ATTRIBUTES
583
584	You can set these attributes on the parser object before you
585	call C<parse_file> (or a similar method) on it:
586
587	=over
588
589	=item $parser->head1_halfpoint_size( I<halfpoint_integer> );
590
591	=item $parser->head2_halfpoint_size( I<halfpoint_integer> );
592
593	=item $parser->head3_halfpoint_size( I<halfpoint_integer> );
594
595	=item $parser->head4_halfpoint_size( I<halfpoint_integer> );
596
597	These methods set the size (in half-points, like 52 for 26-point)
598	that these heading levels will appear as.
599
600	=item $parser->codeblock_halfpoint_size( I<halfpoint_integer> );
601
602	This method sets the size (in half-points, like 21 for 10.5-point)
603	that codeblocks ("verbatim sections") will appear as.
604
605	=item $parser->header_halfpoint_size( I<halfpoint_integer> );
606
607	This method sets the size (in half-points, like 15 for 7.5-point)
608	that the header on each page will appear in. The header
609	is usually just "I<modulename> p. I<pagenumber>".
610
611	=item $parser->normal_halfpoint_size( I<halfpoint_integer> );
612
613	This method sets the size (in half-points, like 26 for 13-point)
614	that normal paragraphic text will appear in.
615
616	=item $parser->no_proofing_exemptions( I<true_or_false> );
617
618	Set this value to true if you don't want the formatter to try
619	putting a hidden code on all Perl symbols (as best as it can
620	notice them) that labels them as being not in English, and
621	so not worth spellchecking.
622
623	=item $parser->doc_lang( I<microsoft_decimal_language_code> )
624
625	This sets the language code to tag this document as being in. By
626	default, it is currently the value of the environment variable
627	C<RTFDEFLANG>, or if that's not set, then the value
628	1033 (for US English).
629
630	Setting this appropriately is useful if you want to use the RTF
631	to spellcheck, and/or if you want it to hyphenate right.
632
633	Here are some notable values:
634
635	1033 US English
636	2057 UK English
637	3081 Australia English
638	4105 Canada English
639	1034 Spain Spanish
640	2058 Mexico Spanish
641	1031 Germany German
642	1036 France French
643	3084 Canada French
644	1035 Finnish
645	1044 Norwegian (Bokmal)
646	2068 Norwegian (Nynorsk)
647
648	=back
649
650	If you are particularly interested in customizing this module's output
651	even more, see the source and/or write to me.
652
653	=head1 SEE ALSO
654
655	L<Pod::Simple>, L<RTF::Writer>, L<RTF::Cookbook>, L<RTF::Document>,
656	L<RTF::Generator>
657
658	=head1 COPYRIGHT AND DISCLAIMERS
659
660	Copyright (c) 2002 Sean M. Burke. All rights reserved.
661
662	This library is free software; you can redistribute it and/or modify it
663	under the same terms as Perl itself.
664
665	This program is distributed in the hope that it will be useful, but
666	without any warranty; without even the implied warranty of
667	merchantability or fitness for a particular purpose.
668
669	=head1 AUTHOR
670
671	Sean M. Burke C<sburke@cpan.org>
672
673	=cut
674