rtf.pm

source of perl for linux application,

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<[e-mail]>

=cut