#!/usr/bin/perl -w # # pod2help # $Id: pod2help,v 1.9 2004/06/07 00:57:30 johnh Exp $ # # Copyright (C) 1999 by John Heidemann # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License, # version 2, as published by the Free Software Foundation. # # 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. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. # sub usage { print STDERR <= 0 && $ARGV[0] eq '-?'); my(%opts); &GetOptions(\%opts, qw(k m=s)); &usage if ($#ARGV < 0); my($mode) = $opts{'m'}; $mode = 'tcl' if (!defined($mode)); die "$0: unknown mode $mode.\n" if (!($mode eq 'tcl' || $mode eq 'gtk')); my($section) = $ARGV[0]; my($over) = 0; my($item) = ''; $/ = "\n\n"; # paragraph slurping my(%HTML_Escapes) = ( 'amp' => '&', # ampersand 'lt' => '<', # left chevron, less-than 'gt' => '>', # right chevron, greater-than 'quot' => '"', # double quote "Aacute" => "\xC1", # capital A, acute accent "aacute" => "\xE1", # small a, acute accent "Acirc" => "\xC2", # capital A, circumflex accent "acirc" => "\xE2", # small a, circumflex accent "AElig" => "\xC6", # capital AE diphthong (ligature) "aelig" => "\xE6", # small ae diphthong (ligature) "Agrave" => "\xC0", # capital A, grave accent "agrave" => "\xE0", # small a, grave accent "Aring" => "\xC5", # capital A, ring "aring" => "\xE5", # small a, ring "Atilde" => "\xC3", # capital A, tilde "atilde" => "\xE3", # small a, tilde "Auml" => "\xC4", # capital A, dieresis or umlaut mark "auml" => "\xE4", # small a, dieresis or umlaut mark "Ccedil" => "\xC7", # capital C, cedilla "ccedil" => "\xE7", # small c, cedilla "Eacute" => "\xC9", # capital E, acute accent "eacute" => "\xE9", # small e, acute accent "Ecirc" => "\xCA", # capital E, circumflex accent "ecirc" => "\xEA", # small e, circumflex accent "Egrave" => "\xC8", # capital E, grave accent "egrave" => "\xE8", # small e, grave accent "ETH" => "\xD0", # capital Eth, Icelandic "eth" => "\xF0", # small eth, Icelandic "Euml" => "\xCB", # capital E, dieresis or umlaut mark "euml" => "\xEB", # small e, dieresis or umlaut mark "Iacute" => "\xCD", # capital I, acute accent "iacute" => "\xED", # small i, acute accent "Icirc" => "\xCE", # capital I, circumflex accent "icirc" => "\xEE", # small i, circumflex accent "Igrave" => "\xCD", # capital I, grave accent "igrave" => "\xED", # small i, grave accent "Iuml" => "\xCF", # capital I, dieresis or umlaut mark "iuml" => "\xEF", # small i, dieresis or umlaut mark "Ntilde" => "\xD1", # capital N, tilde "ntilde" => "\xF1", # small n, tilde "Oacute" => "\xD3", # capital O, acute accent "oacute" => "\xF3", # small o, acute accent "Ocirc" => "\xD4", # capital O, circumflex accent "ocirc" => "\xF4", # small o, circumflex accent "Ograve" => "\xD2", # capital O, grave accent "ograve" => "\xF2", # small o, grave accent "Oslash" => "\xD8", # capital O, slash "oslash" => "\xF8", # small o, slash "Otilde" => "\xD5", # capital O, tilde "otilde" => "\xF5", # small o, tilde "Ouml" => "\xD6", # capital O, dieresis or umlaut mark "ouml" => "\xF6", # small o, dieresis or umlaut mark "szlig" => "\xDF", # small sharp s, German (sz ligature) "THORN" => "\xDE", # capital THORN, Icelandic "thorn" => "\xFE", # small thorn, Icelandic "Uacute" => "\xDA", # capital U, acute accent "uacute" => "\xFA", # small u, acute accent "Ucirc" => "\xDB", # capital U, circumflex accent "ucirc" => "\xFB", # small u, circumflex accent "Ugrave" => "\xD9", # capital U, grave accent "ugrave" => "\xF9", # small u, grave accent "Uuml" => "\xDC", # capital U, dieresis or umlaut mark "uuml" => "\xFC", # small u, dieresis or umlaut mark "Yacute" => "\xDD", # capital Y, acute accent "yacute" => "\xFD", # small y, acute accent "yuml" => "\xFF", # small y, dieresis or umlaut mark "lchevron" => "\xAB", # left chevron (double less than) "rchevron" => "\xBB", # right chevron (double greater than)); ); &main; exit 0; sub tag { my($name, $value) = @_; if ($name eq 'C' || $name eq 'F') { return "$value" if ($mode eq 'tcl'); return "$value" if ($mode eq 'gtk'); die; } elsif ($name eq 'Z') { return ''; } elsif ($name eq 'L') { return "$value" if ($mode eq 'gtk'); return $value; } elsif ($name eq 'I') { return "$value" if ($mode eq 'tcl'); return "$value" if ($mode eq 'gtk'); } elsif ($name eq 'B') { return "$value" if ($mode eq 'tcl'); return "$value" if ($mode eq 'gtk'); } else { die "unknown tag $name<$value>\n"; }; } sub output { local($_) = @_; s/(\w)<([^>]+)>/tag($1,$2)/ge; s/\n/ /g; s/"/\\"/g if ($mode eq 'gtk'); print "$_\n\n" if ($mode eq 'tcl'); print "\t\"$_\\n\\n\"\n" if ($mode eq 'gtk'); } sub main { print "\tset help($section) {" if ($mode eq 'tcl'); print "static gtk_lava_help_text glht_$section(O_(\"$section\"),\n\tN_(\n" if ($mode eq 'gtk'); my($first_title) = undef; while () { chomp; s/^\n//g; if (!/^=/) { output($_); next; }; s/^=(\S+)\s*(.*)$//m; my($cmd, $args) = ($1, $2); my($rest) = $_; # directives if ($cmd eq 'head1') { my($title, $w) = ''; foreach $w (split(/ /, $args)) { $title .= ucfirst(lc($w)) . " "; }; $title =~ s/ $//; print "\n$title\n\n" if ($mode eq 'tcl'); print "\t\"\\n$title\\n\\n\"\n" if ($mode eq 'gtk'); $first_title = $title if (!defined($first_title)); } elsif ($cmd eq 'over') { $over = $args; } elsif ($cmd eq 'back') { $over = 0; } elsif ($cmd eq 'item') { $item = $args; output("$item\n$rest"); } else { die "unknown cmd ``$cmd''.\n"; }; }; die "$0: unknown title.\n" if (!defined($first_title) && $mode eq 'gtk'); print "\t), N_(\"$first_title\"));\n\n" if ($mode eq 'gtk'); print "}\n" if ($mode eq 'tcl'); }