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