Re: Pages Man

トップ ページ

このメッセージに返信
著者: Raphael Manfredi
日付:  
To: guilde
CC: lforet
題目: Re: Pages Man
Quoting Laurent =?iso-8859-1?Q?For t?=:
:
:J'aurais voulu savoir comment créer une page de manuelle, existe t'il des
:outils ou simplement une syntaxe ?
:
:D'autre part est-ce qu'il existe des outils qui permettent de transformer
:une page man sous le format html.

Voila ce que j'utilise:

Usage: roff2html [-adht] [-m mac] files
-a : all text is included, even the one preceding the first troff command
-d : debug mode
-h : print this help message and exit
-m : specify macro package (-man assumed by default)
-t : transparent mode: let unrecognized troff commands pass through
-T : build table of contents

Raphael

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then feed it
# into a shell via "sh file" or similar.  To overwrite existing files,
# type "sh file -c".
# The tool that generated this appeared in the comp.sources.unix newsgroup;
# send mail to comp-sources-unix@??? if you want that tool.
# Contents:  roff2html
# Wrapped by ram@lyon on Thu Mar 18 13:18:05 1999
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
echo If this archive is complete, you will see the following message:
echo '          "shar: End of archive."'
if test -f 'roff2html' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'roff2html'\"
else
  echo shar: Extracting \"'roff2html'\" \(29516 characters\)
  sed "s/^X//" >'roff2html' <<'END_OF_FILE'
X: # feed this into perl
X    eval 'exec perl -S $0 ${1+"$@"}'
X        if $running_under_some_shell;
X
X# Copyright (c) 1996, Raphael Manfredi
X#
X# You may redistribute only under the terms of the Artistic License
X# as found in the Perl distribution.
X#
X# Converts nroff -man from stdin/file into HTML on stdout
X# Assummes linear source code (pre-processed by soelim).
X#
X# By default, all non-understood troff commands are ignored, as is
X# all the text preceding the first valid command found.
X
X($me = $0) =~ s|.*/(.*)|$1|;
X
Xrequire 'getopts.pl';
X&Getopts('adhm:tT');
X&usage if $opt_h;
X
Xsub usage {
X    print STDERR <<EOM;
XUsage: $me [-adht] [-m mac] files
X  -a : all text is included, even the one preceding the first troff command
X  -d : debug mode
X  -h : print this help message and exit
X  -m : specify macro package (-man assumed by default)
X  -t : transparent mode: let unrecognized troff commands pass through
X  -T : build table of contents
XEOM
X    exit 1;
X}
X
X$opt_m = 'an' unless $opt_m;        # Assume -man by default
X
Xhtml::init($opt_m);
X$concat = '';
Xwhile (defined ($_ = nextline())) {
X    if (s/\\$//) {                    # Concatenate lines ending with \
X        $concat .= $_;
X        next;
X    }
X    roff::input($concat . $_);
X    $concat = '';
X}
Xhtml::cleanup();
X
Xhtml::preamble();
Xhtml::toc();
Xhtml::flush();
Xhtml::postamble();
X
Xexit 0;
X
X# Get next line, from @Lines first, from <> otherwise
Xsub nextline {
X    return shift(@Lines) if @Lines;
X    my $line = <>;
X    chomp($line);
X    return $line;
X}
X
Xpackage html;
X
X# Initialize global state
Xsub init {
X    my ($macro) = @_;        # Macro package
X    $Macro = $macro;        # Save, for leading comment
X    $Font = FONT->make;        # Current font
X    $Lastfont = FONT->make;    # Where last font settings are saved
X    $Title = $ARGV[0];
X    $Header = 0;            # Header level
X    $Indent = 0;            # Indenting level
X    $Deferred_indent = 0;    # Deferred indenting level
X    $Deflist = 0;            # Definition lists
X    $Small = 0;
X    $HToc = "HDR0001";        # String for table of contents refs
X    $HTOCMIN = 2;            # Minumum header level for TOC inclusion
X    $HTlevel = $HTOCMIN;    # Header level in TOC (no <H1> in text)
X    $Intoc = 0;                # In toc flag (dups text to toc_print)
X    @toc = ();                # Where TOC is stored
X    @body = ();                # Where body is stored
X    roff::init($macro);
X}
X
X# Print HTML preamble
Xsub preamble {
X    print <<EOT;
X<HTML>
X<HEAD>
X    <!-- This file was created with roff2html -m$Macro. -->
X    <TITLE>$Title</TITLE>
X</HEAD>
X<BODY>
X<H2 ALIGN=CENTER>$Title</H2>
XEOT
X}
X
X# Final cleanup before postamble
Xsub cleanup {
X    roff::cleanup();
X    reset_font();
X    outdent();
X    end_deflist() while $Deflist > 0;
X}
X
X# Print HTML postamble
Xsub postamble {
X    my $time = scalar localtime;
X    print <<EOT
X<HR>
X<P><SMALL><EM>Converted from a troff man page on $time by</EM>
Xroff2html -m$Macro
X<EM>, a filter created and maintained by
X    <A HREF="mailto:Raphael_Manfredi\@grenoble.hp.com">
X    Raphael_Manfredi\@grenoble.hp.com</A>.
X<BR>
XCopyright &#169; 1996,
X    <A HREF="http://lyon.grenoble.hp.com/~ram/">
X    Rapha&euml;l Manfredi</A>.
X</EM></SMALL>
X<HR>
X</BODY>
X</HTML>
XEOT
X}
X
X# Record HTML title
Xsub title {
X    my ($title) = @_;
X    $Title = $title;
X}
X
X# Print table of contents
Xsub toc {
X    return unless $::opt_T;
X    toc_descend($HTlevel - $HTOCMIN);        # Restore initial indent
X    print "<H3>Table of Contents</H3>\n";
X    foreach (@toc) {
X        print $_;
X    }
X    print "<HR>\n";
X    print "<H2 ALIGN=CENTER>$Title</H2>\n";
X}
X
X# Ascend in TOC (indent)
Xsub toc_ascend {
X    my ($indent) = @_;
X    my $i;
X    toc_print("<UL>") while $indent-- > 0;
X}
X
X# Descend in TOC (outdent)
Xsub toc_descend {
X    my ($indent) = @_;
X    toc_print("</UL>") while $indent-- > 0;
X}
X
X# Open header HTML ref target
Xsub open_href {
X    my ($level) = @_;
X    my $str = $HToc++;
X    my $d = $level - $HTlevel;
X    if ($d > 0) {
X        toc_ascend($d)
X    } elsif ($d < 0) {
X        toc_descend(-$d)
X    } else {
X        toc_print("<BR>")
X    }
X    $HTlevel = $level;
X    html::print("<A NAME=\"$str\">");
X    html::toc_print("<A HREF=\"#$str\">");
X    $Intoc = 1;        # All text prints will now be duped to TOC
X}
X
X# Close header HTML ref
Xsub close_href {
X    $Intoc = 0;
X    html::print("</A>");
X    html::toc_print("</A>\n");
X}
X
X# Deferred HTML indentations (up to next paragraph)
Xsub defer_indent {
X    my ($indent) = @_;
X    $Deferred_indent += ($indent > 0 ? 1 : -1);
X}
X
X# Perform deferred indent
Xsub apply_defer_indent {
X    my ($indent_now) = @_;
X    return unless $Deferred_indent;
X    outdent() if $indent_now;
X    if ($Deferred_indent) {
X        $Indent += $Deferred_indent;
X        $Deferred_indent = 0;
X    }
X    indent() if $indent_now;
X}
X
X# Successive HTML indentations
Xsub change_indent {
X    my ($indent) = @_;
X    apply_defer_indent(0);
X    if ($indent > 0) {
X        $Indent++;
X        html::print("<UL>");
X    } else {
X        html::print("</UL>");
X        $Indent--;
X    }
X    warn "$'me: outdenting off by one at line $.?\n" if $Indent < 0;
X}
X
X# Emit indents
Xsub indent {
X    my $i;
X    for ($i = 0; $i < $Indent - $Deflist; $i++) {
X        html::print("<UL>");
X    }
X}
X
X# Emit outdents
Xsub outdent {
X    my $i;
X    for ($i = 0; $i < $Indent - $Deflist; $i++) {
X        html::print("</UL>");
X    }
X}
X
X# Print HTML text in TOC buffer
Xsub toc_print {
X    my ($line) = @_;
X    push(@toc, $line);
X    warn "$line\n" if $'opt_d;
X}
X
X# Print HTML text in local buffer
Xsub print {
X    my ($line) = @_;
X    push(@body, $line);
X    warn "$line\n" if $'opt_d;
X}
X
X# Escape HTML-sensitive characters
Xsub escape {
X    my ($line) = @_;
X    $line =~ s/&/&amp;/g;
X    $line =~ s/</&lt;/g;
X    $line =~ s/>/&gt;/g;
X    return $line;
X}
X
X# Append HTML text
Xsub text {
X    my ($line) = @_;
X    apply_defer_indent(1);
X    html::print(escape($line));
X    html::toc_print($line) if $Intoc;
X}
X
X# Append a "\n" character at the end of last printed line
Xsub newline {
X    return unless @body;                # Nothing done if empty
X    my ($last) = \$body[$#body];        # Ref to last item
X    $$last .= "\n";
X}
X
X# HTML break
Xsub break {
X    html::print('<BR>');
X}
X
X# HTML space
Xsub space {
X    save_font();
X    reset_font();
X    mark_paragraph();
X    restore_font();
X}
X
X# HTML centering
Xsub center {
X    my ($on) = @_;
X    my $s = $on ? '' : '/';
X    save_font();
X    reset_font();
X    html::print("<${s}CENTER>");
X    restore_font();
X}
X
X# Flush HTML text to stdout, removing empty containers
Xsub flush {
X    my @last = ();                # Last containers seen
X    foreach (@body) {
X        if (m|^<(\w+)>$|) {
X            push(@last, $1);
X            next;
X        } elsif (@last && m|^</(\w+)>$|) {
X            if ($1 eq $last[$#last]) {
X                pop(@last);        # Strip empty container
X                next;
X            }
X        }
X        foreach $last (@last) {
X            print "<$last>";
X        }
X        @last = ();
X        print $_;
X    }
X}
X
X# Handle roff font directive (mutually exclusive)
Xsub roff_font {
X    my ($desc) = @_;
X    my %trans = (            # Troff to font typeset translation
X        'I'        => 'change_italic',
X        'B'        => 'change_bold',
X        'R'        => '',
X        'CW'    => 'change_const',
X        'P'        => '',
X    );
X    unless (defined $trans{$desc}) {
X        warn "$'me: unknown roff font type '$desc' at line $.\n";
X        return;
X    }
X    if ($desc eq 'P') {
X        $Font->change($Lastfont);
X    } else {
X        $Font->copy($Lastfont);        # Save current font for \fP
X        my $fn = $trans{$desc};
X        $Font->change_italic(undef);
X        $Font->change_bold(undef);
X        $Font->change_const(undef);
X        $Font->$fn('true') if $fn;    # Sole attribute set here
X    }
X    $Font->apply;
X}
X
X# Save HTML font settting
Xsub save_font {
X    my $twin = $Font->twin;
X    push(@Font, $twin);
X}
X
X# Restore HTML font setting
Xsub restore_font {
X    my $font = pop(@Font);
X    die "$'me: font stack underflow\n" unless defined $font;
X    $Font->change($font);
X    $Font->apply;
X}
X
X# Reset HTML font
Xsub reset_font {
X    unsmall() while $Small;
X    $Font->reset;
X}
X
X# Begin HTML <DL> list
Xsub begin_deflist {
X    apply_defer_indent(1);
X    html::print("<DL COMPACT>");
X    $Deflist++;
X}
X
X# End HTML <DL> list
Xsub end_deflist {
X    html::print("</DL>\n");
X    die "$'me: definition list underflow\n" if --$Deflist < 0;
X}
X
X# Introduce HTML <DL> term
Xsub deflist_term {
X    html::print("<DT>\n");
X}
X
X# Introduce HTML <DL> value (definition)
Xsub deflist_value {
X    html::print("<DD>\n");
X}
X
X# Open header
Xsub header {
X    my ($level) = @_;
X    $Header = $level;
X    outdent();
X    html::print("<H$Header>");
X    html::open_href($level);
X}
X
X# Close last opened header
Xsub close_header {
X    die "$'me: nested header?\n" unless $Header;
X    html::close_href();
X    html::print("</H$Header>");
X    $Header = 0;
X    indent();
X}
X
X# Mark paragraph,
Xsub mark_paragraph {
X    html::print('<P>');
X}
X
X# New <LI> paragraph
Xsub list {
X    reset_font();
X    html::print('<LI>');
X    apply_defer_indent(1);
X}
X
X# New paragraph
Xsub paragraph {
X    reset_font();
X    mark_paragraph();
X    apply_defer_indent(1);
X}
X
X# Set font attribute -- called from FONT
Xsub font_set {
X    my ($attr) = @_;
X    font_change($attr, '');
X}
X
X# Clear font attribute -- called from FONT
Xsub font_clear {
X    my ($attr) = @_;
X    font_change($attr, '/');
X}
X
X# Change font setting -- private
Xsub font_change {
X    my ($attr, $e) = @_;    # Font characteristic, end-tag
X    my %trans = (            # Attribute => HTML tag translation
X        'italic'    => 'I',
X        'bold'        => 'B',
X        'const'        => 'TT',
X    );
X    my $tag = $trans{$attr};
X    warn "$'me: unknown font tag '$attr' at line $.\n" unless $tag;
X    html::print("<$e$tag>");
X}
X
X# Smaller fonts
Xsub small    { html::print("<SMALL>\n"); $Small++; }
Xsub unsmall    {
X    html::print("</SMALL>\n");
X    die "$'me: small font underflow\n" if --$Small < 0;
X}
X
Xpackage FONT;
X
Xsub italic    { $_[0]->{italic} }
Xsub bold    { $_[0]->{bold} }
Xsub const    { $_[0]->{const} }
X
Xsub change_italic    { $_[0]->{new_italic} = $_[1] }
Xsub change_bold        { $_[0]->{new_bold} = $_[1] }
Xsub change_const    { $_[0]->{new_const} = $_[1] }
X
X# Return "empty" roman font
Xsub make {
X    return bless {}, shift;
X}
X
X# Return a twin copy of current font
Xsub twin {
X    my $self = shift;
X    my $twin = FONT->make;
X    %{$twin} = %{$self};
X    return $twin;
X}
X
X# Copy font into target
Xsub copy {
X    my $self = shift;
X    my ($target) = @_;
X    %{$target} = %{$self};
X}
X
X# Change font (new_ attributes) to match the supplied one.
Xsub change {
X    my $self = shift;
X    my ($font) = @_;
X    my @attr = qw(italic bold const);
X    foreach $attr (@attr) {
X        $self->{"new_$attr"} = $font->{$attr};
X    }
X}
X
X# Reset font
Xsub reset {
X    my $self = shift;
X    $self->change(FONT->make);
X    $self->apply;
X}
X
X# Change font setting to new font, only changing what is necessary
X# compared to the current font attributes. Resetting of font attributes
X# is always done in reverse setting order to prevent nesting...
Xsub apply {
X    my $self = shift;
X    my @attr = qw(italic bold const);
X    my @change;
X    foreach $attr (@attr) {
X        push(@change, $attr) if $self->{$attr} ne $self->{"new_$attr"};
X    }
X    foreach $attr (reverse @change) {
X        html::font_clear($attr) unless $self->{"new_$attr"};
X    }
X    foreach $attr (@change) {
X        html::font_set($attr) if $self->{"new_$attr"};
X    }
X    foreach $attr (@attr) {
X        $self->{$attr} = $self->{"new_$attr"};
X        delete $self->{"new_$attr"};
X    }
X}
X
Xpackage roff;
Xuse Safe;
X
X# Initialize state
Xsub init {
X    my ($macro) = @_;                # Macro package name
X    $Center = 0;                    # Amount of lines to center
X    $Pspace = 1;                    # Paragraph space
X    $Inbullet = 0;                    # Not in bullet list
X    $Ignore = '';                    # Not ignoring text
X    $Div = 0;                        # Not in diversion
X    %Esc = (                        # Troff escape translatations
X        '-'        => '-',                # En-dash
X        '.'        => '.',                # Dot
X        '&'        => '',                # Null string
X        '|'        => '',                # Narrow space -> nothing in HTML
X        '^'        => '',                # Idem
X        '%'        => '',                # Optional hyphen character
X        ' '        => ' ',                # Constant width space
X        '{'        => '',                # Line grouping
X        '}'        => '',                # Line grouping
X        'e'        => '\\',            # Escape character
X        't'        => "\t",            # Tab, for what it's worth
X        'f'        => '\f',            # Font setting
X        '*(Tm'    => '&#174;',        # Registered Trademark
X        '(bu'    => '&#183;',        # Bullet (approx. is middle dot)
X        '(em'    => '--',            # Em-dash
X        '*R'    => '&#174;',        # Registered Trademark
X        '*S'    => '',                # Ignore
X    );
X    %Reg = ();                        # User-defined number registers
X    @Arg = ();                        # Macro arguments
X    @IE = ();                        # Handles truth value of nested .ie/.el
X    @SL = ();                        # Handles current slurping flag for .ie/.el
X    %Macro = (                        # Known -man directives
X        'AT'    => 'nop',
X        'B'        => 'bold',
X        'BC'    => 'bc',
X        'BI'    => 'bi',
X        'BR'    => 'br',
X        'C'        => 'const',
X        'CB'    => 'cb',
X        'CI'    => 'ci',
X        'CR'    => 'cr',
X        'CW'    => 'const',
X        'HP'    => 'paragraph',
X        'I'        => 'italic',
X        'IB'    => 'ib',
X        'IC'    => 'ic',
X        'IP'    => 'iparagraph',
X        'IR'    => 'ir',
X        'IX'    => 'nop',            # No indexing, for now
X        'P'        => 'paragraph',
X        'PD'    => 'para_sp',
X        'PM'    => 'nop',
X        'PP'    => 'paragraph',
X        'R'        => 'roman',
X        'RB'    => 'rb',
X        'RC'    => 'rc',
X        'RE'    => 're',
X        'RI'    => 'ri',
X        'RS'    => 'rs',
X        'SH'    => 'section',
X        'SM'    => 'small',
X        'SS'    => 'subsection',
X        'TH'    => 'title',
X        'TP'    => 'begin_deflist',
X        'UC'    => 'nop',
X    ) if $macro eq 'an';
X    %Ignore = (                        # Ignored troff directives if $dot is '
X        'br'    => 1,                # 'br does not need to do anything!
X    );
X    %Known = (                        # Known troff directives
X        'am'    => 'macro',            # Append macro
X        'as'    => 'append_string',
X        'bd'    => 'nop',            # No artifical embold
X        'br'    => 'break',
X        'ce'    => 'center',
X        'de'    => 'macro',            # Define macro
X        'di'    => 'divert',        # Divert text to macro
X        'ds'    => 'def_string',
X        'el'    => 'el',
X        'fi'    => 'fill',
X        'ft'    => 'font',
X        'hy'    => 'nop',            # No hyphenation -- ignored
X        'ie'    => 'ie',
X        'if'    => 'if',
X        'ig'    => 'ignore',        # Ignore text...
X        'in'    => 'indent',
X        'na'    => 'nop',            # No adjust -- ignored
X        'ne'    => 'nop',            # Need space on page
X        'nf'    => 'nofill',
X        'nr'    => 'set_register',
X        'rm'    => 'remove',        # Remove macro/string/command definition
X        'rn'    => 'rename',
X        'rr'    => 'rm_register',
X        'so'    => 'no_soelim',        # They are told to preprocess by soelim
X        'sp'    => 'space',
X        'ti'    => 'nop',            # No temporary indent
X        'tm'    => 'tty',            # Send message to user's terminal
X        'tr'    => 'nop',            # .tr abcd translates a->b, c->d XXX
X    );
X    $Safe = new Safe;
X    $Valid = 0;                        # True as when one valid command was found
X    die "$'me: unsupported macro package '$macro'.\n" unless defined %Macro;
X}
X
X# Handle roff input, slurping and .ie/.el code skips
Xsub input {
X    local ($_) = @_;
X
X    return if /^'''/;            # Skip ''' comments
X    return if /^[.']\s*\\"/;    # Skip .\" comments or '\"
X    s/\\".*//;                    # End-of-line comments
X
X    # Ignore text if necessary
X    $Ignore = $1 if /^[.']\s*ig\s*(.\S?)/;
X    if ($Ignore) {
X        $Ignore = '' if /^[.']\s*(.\S?)/ && $Ignore eq $1;
X        return;
X    }
X
X    # Process macros if already within a definition
X    if ($macro::in) {
X        if ($Div && /^[.']\s*di\s*$/) { $Div = 0; macro::end(); }
X        elsif (/^\.\./) { macro::end(); }
X        else { macro::append($_); }
X        return;
X    }
X
X    # If we're within an .ie/.el section, check whether the topmost condition
X    # is true. If it is, everything we see is for us anyway. Simply pop from
X    # @SL when we encounter a closing bracket.
X    # Possible values in @IE are:
X    #      0: .ie condition false, skip text
X    #      1: .ie condition true
X    #      2: .el condition false, skip text
X    #      3: .el condition true
X    # so that it is true modulo 2, and we know when to pop from @IE at the
X    # end of a slurp (end of .el section).
X
X    if (@IE) {
X        my $forus = $IE[$#IE];            # Is text for us?
X        my $endslurp = 0;                # Shall we end slurping?
X        $endslurp++ if s/\\\}//;
X        if ($forus >= 2) {                # Within a .el section
X            my $slurping = $SL[$#SL];    # Are we slurping in .el?
X            # Not part of condition (.el on 1 line) if not slurping already!
X            unless ($slurping) {
X                $endslurp++;            # Force cleanup if @SL and @IE
X                $forus = 1;                # We force processing on that line!
X            }
X            warn "$'me: invalid {} .el block nesting at line $.?\n"
X                if $endslurp && !@SL;
X            pop(@SL) if $endslurp;
X            pop(@IE) if $endslurp;
X        }
X        $forus = 1 if /^[.']\s*el/;        # Allow .el to pass through anyway!
X        return if !($forus % 2);        # Ignore text if necessary
X        # Continuing means we're processing the conditional text
X    }
X
X    # A blank line breaks current and outputs a blank line...
X    return if /^[.']\s*$/;                # Skip . or ' blank lines
X    $_ = '.sp' if /^\s*$/;                # Fake a .sp
X
X    # Retrofit macro text back into the input stream or process command
X    if (/^(\.|')\s*(.\S?)\s*(.*)/) {
X        if (macro::is($2)) {
X            macro::expand($2, $3);
X        } else {
X            roff::cmd($2, $3, $1);        # Deal with roff command
X        }
X    } else {
X        roff::text($_) if $Valid || $'opt_a;    # Handle text
X    }
X    html::newline();        # Ensure text is separated with whatever follows...
X}
X
X# Handle roff command
Xsub cmd {
X    my ($cmd, $remain, $dot) = @_;
X    my $fn = ($dot ne '.' && $Ignore{$cmd}) ? 'nop' : $Known{$cmd};
X    $fn = $Macro{$cmd} unless defined $fn;
X
X    unless (defined $fn) {
X        warn "$'me: unknown roff directive '.$cmd' at line $.\n";
X        return unless $'opt_t;
X        # Handle whole unknown line as plain text then, just make it
X        # stand out a little by inserting breaks around the faulty line.
X        html::break();
X        text('.' . $cmd . ' ' . $remain);
X        html::break();
X        return;
X    }
X    $Valid++;                        # Mark valid command
X
X    # Two callbacks are allowed. The first one is taken from the %known
X    # table and is the name of a function to call with the remaining of
X    # the command line. That routine may return the name of a cleanup
X    # callback that will be called once the remaining text has been printed,
X    # or undef if no further output is allowed (cmd swallowed its arguments)
X
X    my $cleanup = &$fn(\$remain);    # Handle command, get cleanup callback
X    text($remain) if $cleanup;        # Print remaining if callback allows it
X    &$cleanup($cmd) if $cleanup;    # Final cleanup (close tag, reset font...)
X}
X
Xsub nop            { undef }
Xsub paragraph    { clear_state(); html::paragraph(); undef }
Xsub iparagraph    { clear_state(); ipgf_handle(${$_[0]}); undef }
Xsub macro        { macro::begin(${$_[0]}); undef }
Xsub divert        { $Div = 1; macro::begin(${$_[0]}); undef }
X
Xsub section        { stripquote($_[0]); header(3); 'close_header' }
Xsub subsection    { stripquote($_[0]); header(4); 'close_header' }
Xsub stripquote    { ${$_[0]} =~ s/^\s*"(.*)"\s*$/$1/; }
X
Xsub font    { my ($fr) = @_; html::roff_font(ref($fr) ? $$fr : $fr); undef }
Xsub italic    { font('I'); 'roman' }
Xsub bold    { font('B'); 'roman' }
Xsub roman    { font('R'); 'roman' }
Xsub const    { font('CW'); 'roman' }
Xsub small    { html::small; 'unsmall'; }
Xsub unsmall    { html::unsmall; undef }
X
Xsub ri    { alternate('R', 'I', $_[0]) }
Xsub ir    { alternate('I', 'R', $_[0]) }
Xsub rb    { alternate('R', 'B', $_[0]) }
Xsub br    { alternate('B', 'R', $_[0]) }
Xsub ib    { alternate('I', 'B', $_[0]) }
Xsub bi    { alternate('B', 'I', $_[0]) }
Xsub ci    { alternate('CW', 'I', $_[0]) }
Xsub ic    { alternate('I', 'CW', $_[0]) }
Xsub cb    { alternate('CW', 'B', $_[0]) }
Xsub bc    { alternate('B', 'CW', $_[0]) }
Xsub cr    { alternate('CW', 'R', $_[0]) }
Xsub rc    { alternate('R', 'CW', $_[0]) }
X
Xsub rs        { change_indent(1); undef }
Xsub re        { change_indent(-1); undef }
Xsub indent    { change_indent(int(${$_[0]})); undef }
Xsub break    { html::break(); undef }
Xsub space    { html::space(); undef }
Xsub para_sp    { my $pd = ${$_[0]}; $Pspace = $pd eq '' ? 1 : $pd; undef; }
X
X# Renaming and deleting
Xsub rename { my ($old, $new) = split(' ',${$_[0]}); alter($old, $new); undef; }
Xsub remove { foreach $n (split(' ',${$_[0]})) { alter($n, undef) } undef; }
X
X# Turn filling off/on by forcing breaks after each printed line
Xsub nofill    { $Break = 1; undef }
Xsub fill    { $Break = 0; undef }
X
X# Ignore text until macro is seen. If not specified, use '..'.
Xsub ignore {
X    my ($iref) = @_;
X    ($Ignore = $$iref) =~ s/^\s*(.\S?).*//;
X    undef;
X}
X
X# Title of page
Xsub title {
X    my ($lref) = @_;
X    my ($title, $section) = split_args($$lref);
X    html::title("$title($section)");
X    undef;
X}
X
X# Definition lists
Xsub begin_deflist    {
X    space() if $Pspace;
X    html::begin_deflist() unless $Deflist++; $DT++; $DD++; undef;
X}
X# Non-generic callbacks (not called from main cmd engine)
Xsub end_deflist        { html::end_deflist(); $Deflist = 0; }
Xsub deflist_term    { html::deflist_term(); $DT = 0; }
Xsub deflist_value    { html::deflist_value() if $DD; $DD = 0; }
X# Handle .TP "body" lines
Xsub deflist    { &{$DT ? 'deflist_term':'deflist_value'} }
X
X# Alternate fonts between arguments, up to 6 arguments.
X# Remaining args printed with the last font setting.
Xsub alternate {
X    my ($f1, $f2, $lref) = @_;
X    html::save_font();
X    escape($lref);
X    my @words = split_args($$lref);
X    my ($i, $x, $y);
X    for ($i = 0; $i < 3; $i++) {
X        $x = shift(@words);
X        $y = shift(@words);
X        last unless defined $x;
X        unless (defined $y) {
X            warn "$'me: missing arguments for $f1/$f2 font switch at line $.\n";
X            font($f1); html::text($x);
X            last;
X        }
X        font($f1); html::text($x); font($f2); html::text($y);
X    }
X    if (@words) {
X        warn "$'me: extra arguments for $f1/$f2 font switch at line $.\n";
X        html::text(' ') if "$last\0$words[0]" =~ /(\w\0\W)|(\W\0\w)/;
X        font($f2);
X        html::text(join(' ', @words));
X    }
X    html::restore_font();
X    undef;
X}
X
X# Indented paragraphs
Xsub ipgf_handle {
X    my ($cmd) = @_;
X    my ($mark, $indent) = split_args($cmd);
X    if ($mark eq '\\(bu') {
X        html::change_indent(1);
X        html::list();
X        $Inbullet++;
X    } else {
X        begin_deflist();
X        deflist_term();
X        escape(\$mark);
X        html::text($mark);
X    }
X}
X
X# Center next input line(s) or disable centering
Xsub center {
X    my ($lref) = @_;
X    $Center = int($$lref);
X    $Center = 1 if $$lref =~ /^\s*$/;
X    undef;
X}
X
X# Handle headers (sub paragraphs are indented)
Xmy $header_seen = 0;
Xsub header {
X    my ($level) = @_;
X    clear_state();
X    html::change_indent(-1) if $header_seen++;
X    html::header($level);
X}
Xsub close_header {
X    html::close_header();
X    html::defer_indent(1);
X}
X
X# Handle roff indents (which causes a break).
X# Amount is positive if we're indenting and negative when outdenting.
Xsub change_indent {
X    my ($amount) = @_;
X    html::save_font();
X    html::reset_font();        # Don't nest font settings
X    html::change_indent($amount);
X    html::restore_font();
X}
X
X# Handle roff text line
Xsub text {
X    my ($line) = @_;
X    deflist() if $Deflist;            # Handle definition lists
X    escape(\$line);                    # Handle troff escapes
X    html::center(1) if $Center;        # Handle centering
X    # Handle embeded font changes
X    while ($line =~ s/^(.*?)\\f(\w|\(\w\w)//) {
X        my ($text, $font) = ($1, $2);
X        $font =~ s/^\(//;            # Strip leading ( for double char name
X        html::text($text);
X        html::roff_font($font);
X    }
X    html::text($line) if $line ne '';    # Print remaining, if any
X    if ($Center) {                        # Turn off centering
X        html::center(0);
X        $Center--;
X    }
X    if ($Break) {                        # No-fill mode
X        html::break();
X        html::newline();
X    }
X}
X
X# Escape all troff characters inplace
Xsub escape {
X    my ($lref) = @_;
X    $$lref =~ s/\\\\/\0/g;                    # \\ -> ^@
X    $$lref =~ s/\\\$(\d)/arg($1)/eg;        # \$n (macro argument)
X    $$lref =~ s/\\(\*\(..)/esc($1)/eg;        # \*(Tm
X    $$lref =~ s/\\(\*.)/esc($1)/eg;            # \*R
X    $$lref =~ s/\\(\(\w\w)/esc($1)/eg;        # \(bu
X    $$lref =~ s/\\n(\(..)/reg($1)/eg;        # \n(xx
X    $$lref =~ s/\\n(\..)/reg($1)/eg;        # \n.x
X    $$lref =~ s/\\n(.)/reg($1)/eg;            # \nx
X    $$lref =~ s/\\(.)/esc($1)/eg;            # \x
X    $$lref =~ s/\0/\\/g;                    # ^@ -> \
X}
X
X# Define string -- .ds xx whatever
X# This works by recording the *(xx or *x macro set to whatever
Xsub def_string {
X    my ($lref) = @_;
X    my ($var, $value) = split(' ', $$lref, 2);
X    return set_string($var, $value, 0, '.ds');
X}
X
X# Append string -- .as xx whatever
Xsub append_string {
X    my ($lref) = @_;
X    my ($var, $value) = split(' ', $$lref, 2);
X    return set_string($var, $value, 1, '.as');
X}
X
X# Set string for given command, by overriding or by appending to the
X# right string macro. (handles .ds and .as)
Xsub set_string {
X    my ($var, $value, $append, $cmd) = @_;
X    if (length($var) > 2) {
X        warn "$'me: invalid $cmd setting for '$var' at line $.\n";
X        return;
X    }
X    if ($append) {
X        $Esc{"*($var"} .= $value if length($var) == 2;    # \*(xx
X        $Esc{"*$var"} .= $value if length($var) == 1;    # \*x
X    } else {
X        $Esc{"*($var"} = $value if length($var) == 2;    # \*(xx
X        $Esc{"*$var"} = $value if length($var) == 1;    # \*x
X    }
X    undef;        # Don't print remaining
X}
X
X# Return translated escaped character, same if not found
Xsub esc {
X    my ($char) = @_;
X    return $Esc{$char} if defined $Esc{$char};
X    warn "$'me: unknown roff escape sequence \\$char at line $.\n";
X    return '';                    # Remove unknown escape anyway
X}
X
X# Return value of number register or macro argument
Xsub arg { $Arg[$_[0]-1] }
Xsub reg {
X    my ($name) = @_;
X    my %trans = (                # Translated registers (as-is)
X        '%'        =>    '1',        # Page number is always 1
X    );
X    my %etrans = (                        # Translated registers (evaluated expr)
X        '.$'    =>    'scalar(@Arg)',        # Amount of macro arguments
X    );
X    return $Reg{$name} if defined $Reg{$name};    # user-defined register
X    return $trans{$name} if defined $trans{$name};
X    return eval $etrans{$name} if defined $etrans{$name};
X    warn "$'me: ignoring register '$name' at line $.\n";
X    return '0';
X}
X
X# Set register value
Xsub set_register {
X    my ($vref) = @_;
X    my ($name, $add, $value, $ai) =
X        $$vref =~ /^\s*(\S+)\s+((?:[+-]\s+)?)(\d+)\s*(.*)/;
X    unless (defined $name) {
X        warn "$'me: bad .nr format at line $.\n";
X        return;
X    }
X    warn "$'me: autoincrement for register $name ignored at line $.\n"
X        if $ai ne '';
X    $Reg{$name} = $value unless $add;
X    $Reg{$name} += $value if $add;
X    undef;
X}
X
X# Remove register
Xsub rm_register {
X    my ($rref) = @_;
X    my ($name) = $$rref;
X    delete $Reg{$name};            # Only remove from the user-defined set?
X    undef;
X}
X
X# Clear pending state
Xsub clear_state {
X    end_deflist() if $Deflist;
X    $Deflist = 0;
X    html::change_indent(-1) if $Inbullet;
X    $Inbullet = 0;
X}
X
X# Split arguments, handling "quoted value" and ""quoted"" as appropriate
X# Returns an array of those values
Xsub split_args {
X    my ($line) = @_;
X    $line =~ s|(""?.*?"?")|quote_space($1)|ge;
X    my @arg = split(' ', $line);
X    return map { s/^"(.*)"$/$1/; unquote_space($_) } @arg;
X}
X
X# Quote or unquote all spaces within string into ^@ (null)
Xsub quote_space   { my ($str) = @_; $str =~ s/ /\0/g; return $str; }
Xsub unquote_space { my ($str) = @_; $str =~ s/\0/ /g; return $str; }
X
X# Conditionals:
X#  .if c remain
X#  .if !c remain
X# If condition is true, feed remain as input. Otherwise ignore it.
Xsub if {
X    my ($lref) = @_;
X    my $not = 0;
X    $not = 1 if $$lref =~ s/^\s*!\s*//;
X    my ($condition, $remain) = split(' ', $$lref, 2);
X    my $val = evalcond($condition, $not);
X    my $slurp = $remain =~ s/\\\{//;    # Need to perform slurping?
X    if ($slurp) {                        # Yes, simulate a .el setting
X        push(@IE, ($val>0)?3:2);        # See &el
X        push(@SL, $slurp);                # Slurping that one!
X    }
X    roff:input($remain) if $val > 0;
X    undef;
X}
X
X# Conditionals:
X#  .ie [!]c remain_if
X#  .el remain_else
X# If condition is true, feed remain_if as input. Otherwise feed remain_else
Xsub ie {
X    my ($lref) = @_;
X    my $not = 0;
X    $not = 1 if $$lref =~ s/^\s*!\s*//;
X    my ($condition, $remain) = split(' ', $$lref, 2);
X    my $val = evalcond($condition, $not);
X    my $slurp = $remain =~ s/\\\{//;    # Slurping done until .el anyway
X    push(@IE, $val>0?1:0);    # Conditions may be nested
X    push(@SL, $slurp);        # Slurping that one?
X    roff::input($remain) if $val && $remain !~ /^\s*$/;
X    undef;
X}
X
X# Else conditional reached
Xsub el {
X    my ($lref) = @_;
X    my $remain = $$lref;
X    my $val = pop(@IE);                    # Logical value of matching .if
X    pop(@SL);                            # Slurping status for .if
X    warn "$'me: unexpected .el at line $.\n" unless defined $val;
X    $val = 1 unless defined $val;        # Will cause this .el to be ignored!
X    my $slurp = $remain =~ s/\\\{//;    # Slurping for .el
X    push(@IE, (!$val)?3:2);    # Conditions may be nested
X    push(@SL, $slurp);        # Slurping that one?
X    roff::input($remain) if !$val && $remain !~ /^\s*$/;
X    undef;
X}
X
X# Evaluate .if conditional and return its logical value
Xsub evalcond {
X    my ($condition, $not) = @_;
X    my $val;
X    if ($condition =~ /^[ntv]$/) {
X        # Handle special common tests for roff right now (we're nroff!)
X        $val = $condition eq 'n';
X    } else {
X        # All other things evaluated in the Safe compartment after a few fixes
X        $condition =~ s/([^<>])=/$1==/g;
X        escape(\$condition);
X        my $val = $Safe->reval($condition);
X        return undef if $@;                    # Always false when error
X    }
X    $val = !$val if $not;        # Inverse if needed
X    return $val;
X}
X
X# Rename/delete macro, string or command (in that order)
Xsub alter {
X    my ($old, $new) = @_;        # Deletes if $new is undef
X    # Macro?
X    if (macro::is($old)) {
X        macro::rename($old, $new);
X        return;
X    }
X    # String?
X    if (length($old) == 1 && defined $Esc{"*$old"}) {
X        set_string($new, $Esc{"*$old"}, 0, '.rn') if defined $new;
X        delete $Esc{"*$old"};
X        return;
X    }
X    # Must be a command then... rename from both all command arrays
X    if (defined $Macro{$old}) {
X        $Macro{$new} = $Macro{$old} if defined $new;
X        delete $Macro{$old};
X    }
X    if (defined $Known{$old}) {
X        $Known{$new} = $Known{$old} if defined $new;
X        delete $Known{$old};
X    }
X    if (defined $Ignore{$old}) {
X        $Ignore{$new} = $Ignore{$new} if defined $new;
X        delete $Ignore{$old};
X    }
X}
X
X# Send message to user's terminal via stderr
Xsub tty {
X    my ($mref) = @_;
X    print STDERR $$mref, "\n";
X    undef;
X}
X
X# Remind them to pre-process their source with soelim!
X# XXX Do it ourselves, that shouldn't be too hard.
Xsub no_soelim {
X    warn "$'me: you haven't run soelim, inclusions are ignored!\n";    # XXX
X    undef;
X}
X
X# Final cleanup
Xsub cleanup {
X    clear_state();
X    warn "$'me: unclosed {} block\n" if @SL;
X    warn "$'me: pending .ie/.el condition\n" if @IE;
X}
X
Xpackage macro;
X
X$in = 0;            # In macro state
X$current = '';        # Current macro name
X
X# Begin macro definition
Xsub begin {
X    my ($name) = @_;
X    $name =~ s/\s*$//;
X    die "$'me: nested macro definition ($name) within macro $current!\n"
X        if $in++ >= 1;
X    $current = $name;
X}
X
X# Record current macro definition
Xsub append {
X    my ($line) = @_;
X    roff::escape(\$line);                # Interpolate what needs to be
X    $Macro{$current} .= $line . "\n";
X}
X
X# End macro definition
Xsub end {
X    $in--;
X}
X
X# Checks whether a name is a macro
Xsub is {
X    my ($name) = @_;
X    return defined $Macro{$name};
X}
X
X# Rename macro
Xsub rename {
X    my ($old, $new) = @_;
X    return unless is($old);
X    $Macro{$new} = $Macro{$old} if defined $new;
X    delete $Macro{$old};
X}
X
X# Expand macro into forthcoming input
Xsub expand {
X    my ($name, $args) = @_;
X    @roff::Arg = roff::split_args($args);    # Allow \$1 expansion
X    foreach $line (split(/\n/, $Macro{$name})) {
X        roff::escape(\$line);
X        push(@main::Lines, $line)
X    }
X    @roff::Arg = ();        # Reset arguments outside of macro expansion
X}
X
Xpackage main;
X
END_OF_FILE
  if test 29516 -ne `wc -c <'roff2html'`; then
    echo shar: \"'roff2html'\" unpacked with wrong size!
  fi
  chmod +x 'roff2html'
  # end of 'roff2html'
fi
echo shar: End of archive.
exit 0