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