", "

#!/usr/local/bin/perl # Perl script to convert nroff / sgml help files to HHW project # (c) 1997-2002 B. D. Ripley # Not unlike parts of nr2hlp and R's Sd2Rd (those parts written by BDR) # check index of last arg (should be at least 1 arg) die &usage unless $#ARGV >= 0; $topic = $ARGV[0]; if($#ARGV > 1) { shift; @helpfiles = @ARGV; } else { if($#ARGV == 1) { ## Try to map the usual OS wildcards $filespec = $ARGV[1]; $filespec =~ s/\./\\./; $filespec =~ s/\?/./; $filespec =~ s/\*/\.*/; } else { ## default spec is *.d $filespec='^.*\.d$'; # ' extra } opendir(LISDIR, ".") or die "Can't ls *.d this directory"; @helpfiles = grep(m!$filespec!, readdir(LISDIR)); closedir(LISDIR); } my @lines; %htmlfiles; %ahtmlfiles; %titles, %titles2fun; open CSSFILE, ">S+chm.css" or die "can't open S+chm.css"; print CSSFILE <; close(NRFILE); ## peek at the first line of the file, then dispatch to ## S3-style (nroff) or S4-style (SGML spec). if(@lines[0] =~ /^; close(NRFILE); ## peek at the first line of the file, then dispatch to ## S3-style (nroff) or S4-style (SGML spec). if(@lines[0] =~ /^

\n"; } sub alias { my $name=$_[0]; print OUTFILE "

\n"; } sub footer { JScript() if $nlink > 0; print OUTFILE "\n\n"; } sub doS3fun { foreach $_ (@lines) { chop; if (/^\.FN/) { my @word = split; $fun = $word[1]; $libfuns{$fun} = $fun; last; } } } sub doS4fun { foreach $_ (@lines) { chop; if (/(.*)<\/s-topic>/) { $fun = $1; $libfuns{$fun} = $fun; last; } } } sub doS3 { $braceLevel = 0; $inReferences = 0; $inVerbatim = 0; $inTitle = 0; $inSeeAlso = 0; $inCode = 0; $isDataSet = 0; $underlineNext = 0; $output = ""; $nlink = 0; @ends; my @alias; my $fun; my $hadArgs = 0; foreach $_ (@lines) { chop; $Title = $_ if $inTitle && !/^\./; &substitute unless /^\./; my @word = split; if (/^\s*$/) { &output("\n"); } if (/^[^.]/) { if ($underlineNext) { $_ = "" . $_ .""; $underlineNext = 0; } &output($_); } if (/^\.\\\"/o) { s/^\.\\\"/"); } if (/^\.BG D/) { $isDataSet = 1; } if (/^\.FN/) { if($fun) { push @alias, $word[1]; } else { $tfun = $fun = $word[1]; $funhtml = $fun . ".html"; $funhtml =~ s/ $funhtml" or die "Can't open file '$funhtml' for writing\n"; $htmlfiles{$word[1]} = "$funhtml"; } $ahtmlfiles{$word[1]} = "$funhtml"; } if (/^\.TL/) { &header($fun); foreach $f (@alias) { &alias($f); } §ion(0, "", ""); $inTitle = 1; $inVerbatim = 1; } if (/^\.RA/) { §ion(0, "

REQUIRED ARGUMENTS:

", ""); $hadArgs = 1; } if (/^\.OA/) { §ion(0, "

OPTIONAL ARGUMENTS:

", ""); $hadArgs = 1; } if (/^\.AG/) { $arg = $_; $arg =~ s/^\.AG\s//; if (!$hadArgs) { §ion(0, "

ARGUMENTS:

", ""); $hadArgs = 1; } §ion(1, "

$arg

", "

"); } if (/^\.CS/) { §ion(0, "

USAGE:

", "

"); $inVerbatim = 1; } if (/^\.DN/) { §ion(0, "

DESCRIPTION:

"); } if (/^\.DT/) { §ion(0, "

DETAILS:

"); } if (/^\.EX/) { §ion(0, "

EXAMPLES:

", "

"); $inVerbatim = 1; } if (/^\.(IP|PP)/) { &output("

\n"); } if (/^\.KW/) { §ion(0, ""); &output(""); } if (/^\.RC/) { §ion(1, "

" . join(" ", @word[1..$#word]) . "

", "

"); } if (/^\.RT/) { §ion(0, "

VALUE:

", ""); $output = ""; } if (/^\.SA/) { §ion(0, "

SIDE EFFECTS:

"); } if (/^\.SH/) { if ($word[1] =~ /REFERENCE/) { §ion(0, "

REFERENCES:

"); $inReferences = 1; } else { # This line may be of the form .SH "A B C" ($tmp = join(" ", @word[1..$#word])) =~ s/\"(.*)\"/$1/; §ion(0, "

$tmp:

"); } } if (/^\.sp/) { output("\n"); } if (/^\.WR/) { §ion(0, ""); &footer; $titles{$fun} = $Title; foreach $f (@alias) { $titles{$f} = $Title; } $titles2fun{$Title} = $fun; } if (/^\.AO/) { output("Arguments for function $word[1]() can also be"); output("supplied to this function."); } if (/^\.GE/) { output("This is a generic function."); output("Functions with names beginning in $fun. will be"); output("methods for this function."); output("Classes with methods for this function include:"); } if (/^\.GR/) { output("Graphical parameters (see par) may also"); output("be supplied as arguments to this function."); } if (/^\.ME/) { output("This function is a method for the generic function"); output("$word[1]() for class \"$word[2]\"."); output("It can be invoked by calling $word[1](x) for an"); output("object x of the appropriate class, or directly by"); output("calling $word[1].$word[2](x) regardless of the"); output("class of the object."); } if (/^\.NA/) { output("Missing values (NAs) are allowed."); } if (/^\.Tl/) { output("In addition, the high-level graphics control arguments"); output("described under par and the arguments to"); output("title may be supplied to this function."); } if (/^\.ul/) { $underlineNext = 1; } ## End } } sub substitute { s/&/&/go; if (!$inVerbatim) { s/\\\(aa/'/g; # extra ' for highlight matching s/\\\(em—//g; # em dash s/\\\(tm/ (TM) /g; # Trademark s/\\\(mu/ x /g; # multiply sign s/\\\(\*a/α/g; # greek s/\\\(\*b/β/g; s/\\\(\*e/ε/g; s/\\\(\*l/λ/g; s/\\\(\*m/μ/g; s/\\\(\*p/π/g; s/\\\(\*s/σ/g; } s//>/go; s/\\fI(.*?)\\fP/$1<\/em>/g; s/\\fI(.*?)\\fR/$1<\/em>/g; s/\\fB(.*?)\\fP/$1<\/b>/g; s/\\fB(.*?)\\fR/$1<\/b>/g; if($inCode && s/\'/<\/tt>/) { $inCode = 0; } if ($inSeeAlso) { while(s/\`([^\']*)\'/$1<\/tt><\/a>/) { if(defined $libfuns{$1}) { $replace = "href=\"" . $1 . ".html" . "\""; } else { $nlink++; $replace = mklink($1); } s/foobar/$replace/; } } elsif (!$inVerbatim) { if(s/\`([^\']*)$/$1/) { $inCode = 1; } s/\`([^\']*)\'$/$1<\/tt>/g; s/\`([^\']*)\'([^\'])/$1<\/tt>$2/g; } if ($inReferences) { s/([0-9])-([0-9])/$1–$2/g; } } sub section { my($level, $text, $end) = @_; while($braceLevel > $level) { my $end = pop @ends; print OUTFILE "$end\n" if length($end) > 0; print OUTFILE "\n"; $braceLevel--; } if($inTitle) { print OUTFILE "\n\n"; print OUTFILE "\n"; print OUTFILE "$tfun Library section $topic \n\n"; print OUTFILE "$Title\n\n"; $inTitle = 0; } print OUTFILE "$text\n" if $text; $braceLevel = $level + 1; $inReferences = 0; $inVerbatim = 0; $inSeeAlso = 0; push @ends, $end; } sub output { my($text) = @_; print OUTFILE "$text\n"; } ## ---------------------------- S4 section ------------------------- my $skipping = 0; my $nextskipping = 0; my $text = ""; my $fun; my $InArgs = 0; sub doS4 { $nlink = 0; $nalias = 0; undef @aliases; foreach $_ (@lines) { # skip header if (/^\s*$/s; } if($skipping && /^>/) { $nextskipping = 0;} # skip comments $skipping = $nextskipping = 1 if (/^\s*<\!-- /); if($skipping && /-->\s*$/) { $nextskipping = 0;} if(!$skipping) { $text = $text . $_; } $skipping = $nextskipping; } ($type, $text, $rest) = get_group($text); # s-function-doc or whatever if($type ne "function-doc" && $type ne "method-doc") { die "Document class `s-$type' is not supported"; } chomp $text; while(length($text) > 0) { ($type, $body, $text) = get_group($text); process_group($type, $body); } footer(); foreach $f (@aliases) { $titles{$f} = $title2; } } sub get_group { my $text = $_[0]; my $body; my $rest; die "not at beginning of a group in |$text|" unless $text =~ /^\s*/s; my $type = $1; my $tt = $type; $tt =~ s/([a-zA-Z-]+).*/$1/; if($text =~ /^\s*(.*?)<\/s-$tt>(.*)/s) { $body = $1; $rest = $2; } else { warn "no match for `s-$tt' in file `$nrfile'\n"; $text =~ /^\s*\s*(.*)/s; $body = $1; $rest = ""; } ($type, $body, $rest); } sub process_group { my $type = $_[0]; my $text = $_[1]; if($InArgs && ($type =~ /^args/) != 1) { print OUTFILE "\n\n"; $InArgs = 0; } $text =~ s/^\n*//; $text =~ s/\n*$//; if ($type eq "topics") { process_sub_groups($text, "topic"); } elsif ($type eq "title") { # conversion to .sgml adds a trailing space my $title = $text; $title =~ s/ +$//o; $title2 = $title; $title2 =~ s/<.*?>//go; $titles{$fun} = $title2; $titles2fun{$title2} = $fun; print OUTFILE "$title\n\n"; print OUTFILE "\n\n"; print OUTFILE "\n"; print OUTFILE "$fun Library section $topic \n\n"; print OUTFILE "$title\n\n"; } elsif ($type eq "description") { print OUTFILE "DESCRIPTION: \n\n", sub4($text), "\n\n"; } elsif ($type eq "usage") { ## new-style usage is not catered for here: no examples seen ## it will be passed through verbatim. if ($text =~ /^\s*\s*(.*?)\s*<\/s-old-style-usage>/s) { $text = $1; } print OUTFILE " USAGE: \n\n", verbsub($text), "\n\n\n"; } elsif ($type eq "args" || $type eq "args-optional" || $type eq "args-required" ) { print OUTFILE "\n\n" if $InArgs; print OUTFILE "ARGUMENTS: \n
\n" if $type eq "args"; print OUTFILE "
REQUIRED ARGUMENTS:
\n
\n" if $type eq "args-required"; print OUTFILE "
OPTIONAL ARGUMENTS:
\n
\n" if $type eq "args-optional"; $InArgs = 1; ## some files seem to have text before args my $pre = $text =~ /^\s* groups! $pre = $text; $text = ""; } print OUTFILE sub4($pre), "\n"; } process_sub_groups($text, "arg"); } elsif ($type eq "value") { print OUTFILE "
VALUE:
\n
\n"; my $t; my @groups = split /\s*(.*)<\/s-return-component>/s) { my $name=$1; $t = $2; print OUTFILE "
$1
\n", sub4($t), "
\n"; } else { print OUTFILE sub4($t), "\n"; } } print OUTFILE "
\n"; } elsif ($type eq "details") { print OUTFILE "
DETAILS:
\n
\n", sub4($text), "\n\n"; } elsif ($type eq "see") { print OUTFILE "
SEE ALSO
\n", makelinks($text), "\n\n"; } elsif ($type eq "examples") { print OUTFILE "
EXAMPLES:
\n
"; process_sub_groups($text, "example"); print OUTFILE "
\n"; } elsif ($type eq "note" || $type eq "notes") { print OUTFILE "
uc($type):\n", sub4($text), "\n\n"; } elsif ($type eq "bugs") { print OUTFILE "
BUGS:
\n", sub4($text), "\n\n"; } elsif ($type eq "references") { print OUTFILE "
REFERENCES:
\n", inref(sub4($text)), "\n\n"; } elsif ($type =~ /^section\s+name\s*=\s*(.*)/) { my $name = $1; $name =~ s/\s*\"(.*?)\"/$1/o; $name =~ s/^\s*//o; if ($name =~ /^reference$/io) { print OUTFILE "
REFERENCES:
\n", inref(sub4($text)), "\n\n"; } elsif ($name =~ /^source$/io) { print OUTFILE "
SOURCE:
\n", inref(sub4($text)), "\n\n"; } else { $name = uc($name); $name =~ s/^([a-z])/\U$1/; print OUTFILE "
$name:
\n", sub4($text), "\n\n"; } } elsif ($type eq "docclass") { print OUTFILE "\n"; } elsif ($type eq "warnings") { process_sub_groups($text, "warning"); } elsif ($type eq "warning") { print OUTFILE "
WARNING:
\n", sub4($text), "\n\n"; } elsif ($type eq "background") { print OUTFILE "
BACKGROUND:
\n", sub4($text), "\n\n"; } elsif ($type eq "side-effects") { print OUTFILE "
SIDE EFFECTS:
\n", sub4($text), "\n\n"; } elsif ($type eq "author") { print OUTFILE "
AUTHOR:
\n", sub4($text), "\n\n"; } elsif ($type eq "keywords") { process_sub_groups($text, "keyword"); } else { warn "unknown SGML entity `$type' in file `$nrfile'\n"; print OUTFILE "%type:\n%$text\n"; } } sub process_sub_groups{ my $text = $_[0]; my $topic = $_[1]; while(length($text) > 0) { ($type, $body, $text) = get_group($text); die "invalid subgroup" unless $type =~ /^$topic/; process_sub_group($type, $body); } } sub process_sub_group { my $topic = $_[0]; my $text = $_[1]; my $example = 0; $text =~ s/^\n*//; $text =~ s/\n*$//; if ($type eq "topic") { $text =~ s/^\s*//; $text =~ s/\s*$//; if($nalias == 0) { $nalias = 1; $fun = $text; $funhtml = $fun . ".html"; $funhtml =~ s/ $funhtml" or die "Can't open file '$funhtml' for writing\n"; $htmlfiles{$fun} = "$funhtml"; header($fun); print OUTFILE "\n"; $ahtmlfiles{$fun} = "$funhtml"; } else { push @aliases, $text; &alias($text); $ahtmlfiles{$text} = "$funhtml"; } } elsif ($type eq "warning") { print OUTFILE "
WARNING:
\n", sub4($text), "\n\n"; } elsif ($type eq "keyword") { print OUTFILE "\n"; } elsif ($type =~ /^example/) { if ($nexample++ > 0) { print OUTFILE "\n"; } print OUTFILE verbsub($text), "\n"; } elsif ($type =~ /^arg/) { $type =~ /^arg\s+name\s*=\s*(.*)/; my $name = $1; $name =~ s/\s*\"(.*?)\"/$1/o; $name =~ s/\s*(\w*)\s*/$1/o; # $name =~ s/\.\.\./\\dots/; print OUTFILE "
$name
\n", sub4($text), "\n
\n"; } else { warn "unknown SGML entity `$type' in file `$nrfile'\n"; print OUTFILE "%type:\n%$text\n"; } } sub inref { my $text = $_[0]; $text =~ s/([0-9])-([0-9])/$1–$2/go; $text; } sub verbsub { my $text = $_[0]; $text =~ s/&/&/go; $text =~ s//>/go; $text; } sub sub4 { my $text = $_[0]; ## These tags can have id's $text =~ s+(.*?)+$2+go; $text =~ s+(.*?)+$2+go; $text =~ s+(.*?)+$2+go; $text =~ s+(.*?)+$2+go; $text =~ s+(.*?)+$2+go; $text =~ s+(.*?)+$2+go; ## I have never seen these used $text =~ s+(.*?)+$2+go; $text =~ s+(.*?)+$2+go; $text =~ s+(.*?)+$2+go; $text =~ s+(.*?)+$2+go; $text =~ s+(.*?)+$2+go; $text =~ s+(.*?)+$2+go; $text =~ s+(.*?)+$2+go; $text =~ s+(.*?)+$1+go; $text =~ s+(.*?)+$1+go; $text =~ s+(.*?)+$1+go; # not clear what to do with $text =~ s+(.*?)+$1+go; $text =~ s+(.*?)+$1+go; # $text =~ s+(.*?)+$1+go; $text =~ s/&/&/go; $text =~ s/]/]/go; $text =~ s/[/[/go; $text =~ s//$1<\/tt><\/a>/gso; # process $text =~ s+++go; $text =~ s+++go; $text =~ s+(.*?)+$1+go; $text =~ s+$1\n$2\n\n+gso; $text; } sub makelinks { my $text = $_[0]; # $text =~ s+(.*?)+$2+g; while($text =~ s+(.*?)+$2+) { if(defined $libfuns{$2}) { $replace = "href=\"" . $2 . ".html" . "\""; } else { $nlink++; $replace = mklink($2); } $text =~ s/foobar/$replace/; } $text; } ## ---------------------------- hhp section ------------------------- sub make_hhp { my $topic = $_[0]; print "making HHW project file\n"; open hhpfile, ">$topic.hhp" or die "Couldn't open the chm project file\n"; print hhpfile "[OPTIONS]\n", "Contents file=$topic.hhc\n", "Compiled file=$topic.chm\n", "Display compile progress=No\n", "Index file=$topic.hhk\n", "Binary Index=YES\n", "Full-text search=Yes\n", "\n\n[FILES]\n"; foreach $f (sort values %htmlfiles) { print hhpfile "$f\n"; } close hhpfile; } sub make_hhk { my $topic = $_[0]; open hhkfile, ">$topic.hhk" or die "Couldn't open the chm hhk file"; print hhkfile < END foreach $fun (sort keys %ahtmlfiles) { print hhkfile "\n"; } print hhkfile "\n\n"; close hhkfile; } sub foldorder {uc($a) cmp uc($b) or $a cmp $b;} sub make_toc { my $topic = $_[0]; open tocfile, "> $topic.hhc" or die "Couldn't open the chm toc file"; print tocfile "\n\n"; print tocfile " \n"; print tocfile "\n"; # contents of a book foreach $title (sort foldorder keys %titles2fun) { print tocfile " \n"; } print tocfile "\n"; # end of a book print tocfile "\n\n"; close tocfile; } sub mklink { "onclick=\"findlink('" . $_[0] . "')\" " . "style=\"text-decoration: underline; color: blue; cursor: hand\""; } sub JScript { print OUTFILE < function findlink(fn) { var Y, link; Y = location.href.lastIndexOf("\\\\") + 1; link = location.href.substring(0, Y); link = link + "..\\\\..\\\\cmd\\\\Splus.chm::/" + fn + ".html"; location.href = link; } END } ### Local Variables: *** ### mode: perl *** ### perl-indent-level: 4 *** ### End: ***

REQUIRED ARGUMENTS:

OPTIONAL ARGUMENTS:

ARGUMENTS:

USAGE:

DESCRIPTION:

DETAILS:

EXAMPLES:

VALUE:

SEE ALSO:

SIDE EFFECTS:

REFERENCES:

$tmp:

$Title

$title

DESCRIPTION:

USAGE:

ARGUMENTS:

REQUIRED ARGUMENTS:

OPTIONAL ARGUMENTS:

VALUE:

DETAILS:

SEE ALSO

EXAMPLES:

uc($type):\n", sub4($text), "\n\n"; } elsif ($type eq "bugs") { print OUTFILE "

BUGS:

REFERENCES:

REFERENCES:

SOURCE:

$name:

WARNING:

BACKGROUND:

SIDE EFFECTS:

AUTHOR:

WARNING: