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 © 1996,
X <A HREF="http://lyon.grenoble.hp.com/~ram/">
X Raphaë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/&/&/g;
X $line =~ s/</</g;
X $line =~ s/>/>/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' => '®', # Registered Trademark
X '(bu' => '·', # Bullet (approx. is middle dot)
X '(em' => '--', # Em-dash
X '*R' => '®', # 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
