git.maemo.org Git - pkg-perl/blob - deb-src/libpod-simple-perl/libpod-simple-perl-3.07/lib/Pod/Simple/RTF.pm

   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