#!/usr/local/perl/bin/perl eval 'exec /usr/local/perl/bin/perl -S $0 ${1+"$@"}' if $running_under_some_shell; $DEF_PM_SECTION = '3' || '3'; =head1 NOM pod2manfr - convertit les directives pod vers le format des pages de manuel =head1 SYNOPSIS B [ B<--section=>I ] [ B<--release=>I ] [ B<--center=>I ] [ B<--date=>I ] [ B<--fixed=>I ] [ B<--official> ] [ B<--lax> ] I =head1 AVERTISSEMENT Cet utilitaire est l'adaptation française du programme B. Il en récupère donc toutes les qualités mais aussi tous les défauts... =head1 DESCRIPTION B convertit les directives Pod (voir L) contenues dans le fichier d'entrée en un source nroff compréhensible par nroff(1) ou troff(1) en utilisant l'ensemble de macros commandes man(7). En sus des conversions pod imposées, B tient aussi compte de func(), func(n) et des références à des variables simples comme $foo ou @bar. Il n'est donc pas nécessaire d'utiliser de directives pod pour cela. Par contre, les expressions compliquées comme C<$fred{'stuff'}> en ont toujours besoin. B fait aussi attention à pleins d'autres petites choses comme convertir correctement le tiret court dans foo-bar, convertir un double tirets--comme ceux-ci-- en un vrai tiret long, combiner "les parenthèse", ajouter un peu d'espace après des parenthèses comme dans func(), afficher correctement C++ et PI, rendre les mots EN CAPITALES un petit peu plus petit dans troff(1) et ajouter le caractère d'échapemment devant les backslashes (C<\>). =head1 OPTIONS =over 8 =item center Spécifie la chaîne utilisée dans l'en-tête. La valeur par défaut est "Documentation Perl des Contributions Utilisateurs " sauf si l'option C<--official> est active. Dans ce cas la valeur par défaut est "Guide de Références des Programmeurs Perl". =item date Spécifie la chaîne apparaîssant dans la partie gauche du pied-de-page. Par défaut, c'est la date de modification du fichier d'entrée qui est utilisée. =item fixed La police de taille fixe a utiliser pour le code. Par défaut CW. =item official Change l'en-tête par défaut pour indiquer que cette page fait partie de la distribution Perl standard (si l'option C<--center> n'est pas utilisée). =item release Spécifie la chaîne utilisée au centre du pied-de-page. Par défaut, c'est le numéro de la version courante de Perl. =item section Spécifie la section pour la macro C<.TH>. La convention standard est 1 pour les commandes utilisateurs, 2 pour les appels systèmes, 3 pour les fonctions, 4 pour les devices, 5 pour les formats de fichiers, 6 pour les jeux, 7 pour les informations diverses et 8 pour les commandes d'administration. Ça marche mieux si vous classez les pages de manuel Perl dans une arborescence séparée comme F. Par défaut, la section 1 est utilisée à moins que le nom du fichier se termine par F<.pm> auquel cas c'est la section 3 qui est utilisée. =item lax Ne rien dire si les sections obligatoires ne sont pas là. =back =head1 Anatomie d'une page de manuel correcte Voici un exemple du squelette d'une page de manuel correcte. Les titres principaux sont spécifiés par la directive C<=head1> et, pour des raisons historiques, sont écrits en CAPITALES bien que ce ne soit pas absolument nécessaire. Les titres secondaires utilisent la directive C<=head2> et sont habituellement ecrits en mélangeant majuscules et minuscules. =over 10 =item NOM Section obligatoire. Devrait être la liste de noms de programmes ou fonctions documentés dans cette page Pod. Le séparateur est la virgule. Exemple : foo, bar - programmes pour faire quelque chose Afin d'accepter les pages de manuels en anglais, B accepte aussi NAME. =item SYNOPSIS Un court résumé de l'utilisation de ces programmes ou fonctions (cette section pourrait devenir obligatoire). =item DESCRIPTION Un long discours concernant le programme. C'est une bonne idée de le diviser en plusieurs sous-sections en utilisant la directive C<=head2>. Par exemple : =head2 Un exemple de sous-section =head2 Encore un autre exemple de sous-section =item OPTIONS Certains les séparent de la description. =item VALEUR RETOURNÉE Ce que le programme ou les fonctions renvoient normalement comme résultats. =item ERREURS Les exceptions, les codes de retour, les status de sortie et les valeurs de errno. =item EXEMPLES Quelques exemples d'utilisation du programme. =item ENVIRONNEMENT Les variables d'environnement utilisées part ce programme. =item FICHIERS Tous les fichiers utilisés par le programme. Vous aurez certainement besoin de la directive FEE. =item VOIR AUSSI Autres pages du manuel à consulter comme man(1), man(7), makewhatis(8) ou catman(8). =item NOTES Commentaires divers. =item AVERTISSEMENT Différentes choses nécessitant une attention particulière. =item DIAGNOSTICS Tous les messages que le programme est susceptible d'afficher--et leur signification. =item BUGS (ou BOGUES) Ce qui ne marche pas ou pas très bien. =item RESTRICTIONS Les bogues que vous ne comptez pas corriger :-) =item AUTEUR Qui a rédigé le document (ou AUTEURS quand ils sont plusieurs). =item HISTORIQUE Les programmes dérivés d'autres sources ont parfois cette section. Vous pouvez aussi y inclure la liste des modifications. =back =head1 EXEMPLES pod2man program > program.1 pod2man some_module.pm > /usr/perl/man/man3/some_module.3 pod2man --section=7 note.pod > note.7 =head1 DIAGNOSTICS Les diagnostics suivants sont produits par B. Les items marqués "(W)" ne sont pas fatals alors que les erreurs notées "(F)" arrêteront B immédiatement avec un statut d'exécution non-nul. =over 4 =item mauvaise option dans le paragraphe %d de %s: ``%s'' devrait être [%s]E%sE (W) Si vous commencez une nouvelle option, vous devriez ne plus être en gras, en italique ou dans du code. =item impossible d'ouvrir %s: %s (F) Le fichier d'entrée n'est pas lisible. Le message d'erreur (du système) en indiquant la raison est affiché. =item Page de manuel incorrecte - pas de tiret dans le titre NOM du paragraphe %d de %s. (W) Le titre NOM ne contient pas de tiret isolé. C'est important. =item Page de manuel incorrecte - pas de titre NOM dans %s (F) Vous n'avez pas mis de titre NOM (ou NAME). C'est essentiel. =item la police roff doit contenir 1 ou 2 caractères, pas `%s' (F) La police spécifiée par l'option C<--fixed> n'est pas une police roff valide. =item %s ne contient pas la section obligatoire %s (W) Les sections obligatoires sont NOM et DESCRIPTION plus SYNOPSIS si vous spécifiez un numéro de section commençant par 3. Pour l'instant seul l'absence de NOM (ou NAME) est fatale. =item Séquence inconnue dans %s: ``%s'' (W) Recontre d'une entité HTML inconnue (probablement pour des caractères 8-bit) via la dire4ctive CE>. En plus de amp, lt, gt et quot, les entités reconnues sont Aacute, aacute, Acirc, acirc, AElig, aelig, Agrave, agrave, Aring, aring, Atilde, atilde, Auml, auml, Ccedil, ccedil, Eacute, eacute, Ecirc, ecirc, Egrave, egrave, ETH, eth, Euml, euml, Iacute, iacute, Icirc, icirc, Igrave, igrave, Iuml, iuml, Ntilde, ntilde, Oacute, oacute, Ocirc, ocirc, Ograve, ograve, Oslash, oslash, Otilde, otilde, Ouml, ouml, szlig, THORN, thorn, Uacute, uacute, Ucirc, ucirc, Ugrave, ugrave, Uuml, uuml, Yacute, yacute, et yuml. =item =back inconsistant (W) Vous avez un C<=back> sans le C<=over> correspondant. =item Directive pod inconnue : %s (W) Vous avez spécifié une directive pod qui ne fait pas partie de la liste des directives connues: C<=head1>, C<=head2>, C<=item>, C<=over>, C<=back>, ou C<=cut>. =back =head1 NOTES Si vous voulez imprimer plusieurs pages du manuel de manière continue, vous voudrez probablement utiliser les registres C et D pour obtenir une numérotation continue et une mise en pages paire/impaire sur certaines versions de man(7). En utilisant le registre F vous obtiendrez aussi une indexation expérimentale supplémentaire: troff -man -rC1 -rD1 -rF1 perl.1 perldata.1 perlsyn.1 ... L'indexation sortira sûrement des messages via C<.tm> pour chaque page, section, sous-section, item et toutes les directives CE>. =head1 RESTRICTIONS Aucune pour l'instant. =head1 BUGS Les directives =over et =back ne marchent pas très bien. Elles utilisent des positions absolues au lieu de décalages relatifs et ne s'imbriquent donc pas très bien. =head1 AUTHORS Prototype original écrit par Larry Wall mais tellement remanié par Tom Christiansen que Larry ne le reconnaîtrait sûrement plus. =head1 TRADUCTION Traduction en adaptation française par P.Gaborit (Paul.Gaborit@enstimac.fr). =cut $/ = ""; $cutting = 1; @Indices = (); # We try first to get the version number from a local binary, in case we're # running an installed version of Perl to produce documentation from an # uninstalled newer version's pod files. if ($^O ne 'plan9' and $^O ne 'dos' and $^O ne 'os2' and $^O ne 'MSWin32') { ($version,$patch) = `\PATH=.:..:\$PATH; perl -v` =~ /version (\d\.\d{3})(?:_(\d{2}))?/; } # No luck; we'll just go with the running Perl's version ($version,$patch) = $] =~ /^(.{5})(\d{2})?/ unless $version; $DEF_RELEASE = "perl $version"; $DEF_RELEASE .= ", patch $patch" if $patch; sub makedate { my $secs = shift; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($secs); my $mname = (qw{Jan Fév Mar Avr Mai Juin Juil Août Sept Oct Nov Déc})[$mon]; return "$mday/$mname/$year"; } use Getopt::Long; $DEF_SECTION = 1; # $DEF_CENTER = "User Contributed Perl Documentation"; # $STD_CENTER = "Perl Programmers Reference Guide"; $DEF_CENTER = "Documentation Perl des Contributions Utilisateurs"; $STD_CENTER = "Guide de Références des Programmeurs Perl"; $DEF_FIXED = 'CW'; $DEF_LAX = 0; sub usage { warn "$0: @_\n" if @_; die <"; $Filename = $name; if ($section =~ /^1/) { require File::Basename; $name = uc File::Basename::basename($name); } $name =~ s/\.(pod|p[lm])$//i; # Lose everything up to the first of # */lib/*perl* standard or site_perl module # */*perl*/lib from -D prefix=/opt/perl # */*perl*/ random module hierarchy # which works. $name =~ s-//+-/-g; if ($name =~ s-^.*?/lib/[^/]*perl[^/]*/--i or $name =~ s-^.*?/[^/]*perl[^/]*/lib/--i or $name =~ s-^.*?/[^/]*perl[^/]*/--i) { # Lose ^site(_perl)?/. $name =~ s-^site(_perl)?/--; # Lose ^arch/. (XXX should we use Config? Just for archname?) $name =~ s~^(.*-$^O|$^O-.*)/~~o; # Lose ^version/. $name =~ s-^\d+\.\d+/--; } # Translate Getopt/Long to Getopt::Long, etc. $name =~ s(/)(::)g; if ($name ne 'something') { FCHECK: { open(F, "< $ARGV[0]") || die "impossible d'ouvrir $ARGV[0]: $!"; while () { next unless /^=\b/; if (/^=head1\s+(NAME|NOM)\s*$/) { # an /m would forgive mistakes $_ = ; unless (/\s*-+\s+/) { $oops++; warn "$0: Page de manuel incorrecte - pas de tiret dans la titre NOM du paragraphe $. de $ARGV[0]\n" } else { my @n = split /\s+-+\s+/; if (@n != 2) { $oops++; warn "$0: Improper man page - malformed NOM header in paragraph $. of $ARGV[0]\n" } else { %namedesc = @n; } } last FCHECK; } next if /^=cut\b/; # DB_File and Net::Ping have =cut before NAME next if /^=pod\b/; # It is OK to have =pod before NAME die "$0: Page de manuel invalide - 1re ligne pod n'est pas NOM (ou NAME) dans $ARGV[0]\n" unless $lax; } die "$0: Page de manuel invalide - pas de documentation dans $ARGV[0]\n" unless $lax; } close F; } print <<"END"; .rn '' }` ''' \$RCSfile\$\$Revision\$\$Date\$ ''' ''' \$Log\$ ''' .de Sh .br .if t .Sp .ne 5 .PP \\fB\\\\\$1\\fR .PP .. .de Sp .if t .sp .5v .if n .sp .. .de Ip .br .ie \\\\n(.\$>=3 .ne \\\\\$3 .el .ne 3 .IP "\\\\\$1" \\\\\$2 .. .de Vb .ft $CFont .nf .ne \\\\\$1 .. .de Ve .ft R .fi .. ''' ''' ''' Set up \\*(-- to give an unbreakable dash; ''' string Tr holds user defined translation string. ''' Bell System Logo is used as a dummy character. ''' .tr \\(*W-|\\(bv\\*(Tr .ie n \\{\\ .ds -- \\(*W- .ds PI pi .if (\\n(.H=4u)&(1m=24u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-12u'-\\" diablo 10 pitch .if (\\n(.H=4u)&(1m=20u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-8u'-\\" diablo 12 pitch .ds L" "" .ds R" "" ''' \\*(M", \\*(S", \\*(N" and \\*(T" are the equivalent of ''' \\*(L" and \\*(R", except that they are used on ".xx" lines, ''' such as .IP and .SH, which do another additional levels of ''' double-quote interpretation .ds M" """ .ds S" """ .ds N" """"" .ds T" """"" .ds L' ' .ds R' ' .ds M' ' .ds S' ' .ds N' ' .ds T' ' 'br\\} .el\\{\\ .ds -- \\(em\\| .tr \\*(Tr .ds L" `` .ds R" '' .ds M" `` .ds S" '' .ds N" `` .ds T" '' .ds L' ` .ds R' ' .ds M' ` .ds S' ' .ds N' ` .ds T' ' .ds PI \\(*p 'br\\} END print <<'END'; .\" If the F register is turned on, we'll generate .\" index entries out stderr for the following things: .\" TH Title .\" SH Header .\" Sh Subsection .\" Ip Item .\" X<> Xref (embedded .\" Of course, you have to process the output yourself .\" in some meaninful fashion. .if \nF \{ .de IX .tm Index:\\$1\t\\n%\t"\\$2" .. .nr % 0 .rr F .\} END print <<"END"; .TH $name $section "$RP" "$date" "$center" .UC END push(@Indices, qq{.IX Title "$name $section"}); while (($name, $desc) = each %namedesc) { for ($name, $desc) { s/^\s+//; s/\s+$//; } push(@Indices, qq(.IX Nom "$name - $desc"\n)); } print <<'END'; .if n .hy 0 .if n .na .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' .de CQ \" put $1 in typewriter font END print ".ft $CFont\n"; print <<'END'; 'if n "\c 'if t \\&\\$1\c 'if n \\&\\$1\c 'if n \&" \\&\\$2 \\$3 \\$4 \\$5 \\$6 \\$7 '.ft R .. .\" @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2 . \" AM - accent mark definitions .bd B 3 . \" fudge factors for nroff and troff .if n \{\ . ds #H 0 . ds #V .8m . ds #F .3m . ds #[ \f1 . ds #] \fP .\} .if t \{\ . ds #H ((1u-(\\\\n(.fu%2u))*.13m) . ds #V .6m . ds #F 0 . ds #[ \& . ds #] \& .\} . \" simple accents for nroff and troff .if n \{\ . ds ' \& . ds ` \& . ds ^ \& . ds , \& . ds ~ ~ . ds ? ? . ds ! ! . ds / . ds q .\} .if t \{\ . ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" . ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' . ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' . ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' . ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' . ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10' . ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m' . ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' . ds q o\h'-\w'o'u*8/10'\s-4\v'.4m'\z\(*i\v'-.4m'\s+4\h'\w'o'u*8/10' .\} . \" troff and (daisy-wheel) nroff accents .ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' .ds 8 \h'\*(#H'\(*b\h'-\*(#H' .ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#] .ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u' .ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u' .ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#] .ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] .ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' .ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' .ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] .ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] .ds ae a\h'-(\w'a'u*4/10)'e .ds Ae A\h'-(\w'A'u*4/10)'E .ds oe o\h'-(\w'o'u*4/10)'e .ds Oe O\h'-(\w'O'u*4/10)'E . \" corrections for vroff .if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' .if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' . \" for low resolution devices (crt and lpr) .if \n(.H>23 .if \n(.V>19 \ \{\ . ds : e . ds 8 ss . ds v \h'-1'\o'\(aa\(ga' . ds _ \h'-1'^ . ds . \h'-1'. . ds 3 3 . ds o a . ds d- d\h'-1'\(ga . ds D- D\h'-1'\(hy . ds th \o'bp' . ds Th \o'LP' . ds ae ae . ds Ae AE . ds oe oe . ds Oe OE .\} .rm #[ #] #H #V #F C END $indent = 0; $begun = ""; # Unrolling [^A-Z>]|[A-Z](?!<) gives: // MRE pp 165. my $nonest = '(?:[^A-Z>]*(?:[A-Z](?!<)[^A-Z>]*)*)'; while (<>) { if ($cutting) { next unless /^=/; $cutting = 0; } if ($begun) { if (/^=end\s+$begun/) { $begun = ""; } elsif ($begun =~ /^(roff|man)$/) { print STDOUT $_; } next; } chomp; # Translate verbatim paragraph if (/^\s/) { @lines = split(/\n/); for (@lines) { 1 while s {^( [^\t]* ) \t ( \t* ) } { $1 . ' ' x (8 - (length($1)%8) + 8 * (length($2))) }ex; s/\\/\\e/g; s/\A/\\&/s; } $lines = @lines; makespace() unless $verbatim++; print ".Vb $lines\n"; print join("\n", @lines), "\n"; print ".Ve\n"; $needspace = 0; next; } $verbatim = 0; if (/^=for\s+(\S+)\s*/s) { if ($1 eq "man" or $1 eq "roff") { print STDOUT $',"\n\n"; } else { # ignore unknown for } next; } elsif (/^=begin\s+(\S+)\s*/s) { $begun = $1; if ($1 eq "man" or $1 eq "roff") { print STDOUT $'."\n\n"; } next; } # check for things that'll hosed our noremap scheme; affects $_ init_noremap(); if (!/^=item/) { # trofficate backslashes; must do it before what happens below s/\\/noremap('\\e')/ge; # protect leading periods and quotes against *roff # mistaking them for directives s/^(?:[A-Z]<)?[.']/\\&$&/gm; # first hide the escapes in case we need to # intuit something and get it wrong due to fmting 1 while s/([A-Z]<$nonest>)/noremap($1)/ge; # func() is a reference to a perl function s{ \b ( [:\w]+ \(\) ) } {I<$1>}gx; # func(n) is a reference to a perl function or a man page s{ ([:\w]+) ( \( [^\051]+ \) ) } {I<$1>\\|$2}gx; # convert simple variable references s/(\s+)([\$\@%][\w:]+)(?!\()/${1}C<$2>/g; if (m{ ( [\-\w]+ \( [^\051]*? [\@\$,] [^\051]*? \) ) }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/) { warn "$0: mauvaise option dans le paragraphe $. de $ARGV: ``$1'' devrait être [LCI]<$1>\n"; $oops++; } while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) { warn "$0: mauvaise option dans le paragraphe $. de $ARGV: ``$1'' devrait être [CB]<$1>\n"; warn $_; $oops++; } # put it back so we get the <> processed again; clear_noremap(0); # 0 means leave the E's } else { # trofficate backslashes s/\\/noremap('\\e')/ge; } # need to hide E<> first; they're processed in clear_noremap s/(E<[^<>]+>)/noremap($1)/ge; $maxnest = 10; while ($maxnest-- && /[A-Z]/font($1) . $2 . font('R')/eg; # files and filelike refs in italics s/F<($nonest)>/I<$1>/g; # no break -- usually we want C<> for this s/S<($nonest)>/nobreak($1)/eg; # LREF: a la HREF L s:L<([^|>]+)\|[^>]+>:$1:g; # LREF: a manpage(3f) s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:la page de manuel I<$1>$2:g; # LREF: an =item on another manpage s{ L< ([^/]+) / ( [:\w]+ (\(\))? ) > } {le point C<$2> dans la page de manuel I<$1>}gx; # LREF: an =item on this manpage s{ ((?: L< / ( [:\w]+ (\(\))? ) > (,?\s+(and\s+)?)? )+) } { internal_lrefs($1) }gex; # LREF: a =head2 (head1?), maybe on a manpage, maybe right here # the "func" can disambiguate s{ L< (?: ([a-zA-Z]\S+?) / )? "?(.*?)"? > }{ do { $1 # if no $1, assume it means on this page. ? "la section concernant I<$2> dans la page de manuel I<$1>" : "la section concernant I<$2>" } }gesx; # s in case it goes over multiple lines, so . matches \n s/Z<>/\\&/g; # comes last because not subject to reprocessing s/C<($nonest)>/noremap("${CFont_embed}${1}\\fR")/eg; } if (s/^=//) { $needspace = 0; # Assume this. s/\n/ /g; ($Cmd, $_) = split(' ', $_, 2); $dotlevel = 1; if ($Cmd eq 'head1') { $dotlevel = 1; } elsif ($Cmd eq 'head2') { $dotlevel = 1; } elsif ($Cmd eq 'item') { $dotlevel = 2; } if (defined $_) { &escapes($dotlevel); s/"/""/g; } clear_noremap(1); if ($Cmd eq 'cut') { $cutting = 1; } elsif ($Cmd eq 'head1') { s/\s+$//; delete $wanna_see{$_} if exists $wanna_see{$_}; print qq{.SH "$_"\n}; push(@Indices, qq{.IX Header "$_"\n}); } elsif ($Cmd eq 'head2') { print qq{.Sh "$_"\n}; push(@Indices, qq{.IX Subsection "$_"\n}); } elsif ($Cmd eq 'over') { push(@indent,$indent); $indent += ($_ + 0) || 5; } elsif ($Cmd eq 'back') { $indent = pop(@indent); warn "$0: =back inconsistant dans le paragraphe $. de $ARGV\n" unless defined $indent; $needspace = 1; } elsif ($Cmd eq 'item') { s/^\*( |$)/\\(bu$1/g; # if you know how to get ":s please do s/\\\*\(L"([^"]+?)\\\*\(R"/'$1'/g; s/\\\*\(L"([^"]+?)""/'$1'/g; s/[^"]""([^"]+?)""[^"]/'$1'/g; # here do something about the $" in perlvar? print STDOUT qq{.Ip "$_" $indent\n}; push(@Indices, qq{.IX Item "$_"\n}); } elsif ($Cmd eq 'pod') { # this is just a comment } else { warn "$0: Directive pod inconnue dans le paragraphe $. de $ARGV: $Cmd\n"; } } else { if ($needspace) { &makespace; } &escapes(0); clear_noremap(1); print $_, "\n"; $needspace = 1; } } print <<"END"; .rn }` '' END if (defined $wanna_see{"NOM"} && ! defined $wanna_see{"NAME"}) { delete $wanna_see{"NOM"}; } if (! defined $wanna_see{"NOM"} && defined $wanna_see{"NAME"}) { delete $wanna_see{"NAME"}; } if (%wanna_see && !$lax) { @missing = keys %wanna_see; warn "$0: $Filename ne contient pas la section obligatoire" . (@missing > 1 && "s") . ": @missing\n"; $oops++; } foreach (@Indices) { print "$_\n"; } exit; #exit ($oops != 0); ######################################################################### sub nobreak { my $string = shift; $string =~ s/ /\\ /g; $string; } sub escapes { my $indot = shift; s/X<(.*?)>/mkindex($1)/ge; # translate the minus in foo-bar into foo\-bar for roff s/([^0-9a-z-])-([^-])/$1\\-$2/g; # make -- into the string version \*(-- (defined above) s/\b--\b/\\*(--/g; s/"--([^"])/"\\*(--$1/g; # should be a better way s/([^"])--"/$1\\*(--"/g; # fix up quotes; this is somewhat tricky my $dotmacroL = 'L'; my $dotmacroR = 'R'; if ( $indot == 1 ) { $dotmacroL = 'M'; $dotmacroR = 'S'; } elsif ( $indot >= 2 ) { $dotmacroL = 'N'; $dotmacroR = 'T'; } if (!/""/) { s/(^|\s)(['"])/noremap("$1\\*($dotmacroL$2")/ge; s/(['"])($|[\-\s,;\\!?.])/noremap("\\*($dotmacroR$1$2")/ge; } #s/(?!")(?:.)--(?!")(?:.)/\\*(--/g; #s/(?:(?!")(?:.)--(?:"))|(?:(?:")--(?!")(?:.))/\\*(--/g; # make sure that func() keeps a bit a space tween the parens ### s/\b\(\)/\\|()/g; ### s/\b\(\)/(\\|)/g; # make C++ into \*C+, which is a squinched version (defined above) s/\bC\+\+/\\*(C+/g; # make double underbars have a little tiny space between them s/__/_\\|_/g; # PI goes to \*(PI (defined above) s/\bPI\b/noremap('\\*(PI')/ge; # make all caps a teeny bit smaller, but don't muck with embedded code literals my $hidCFont = font('C'); if ($Cmd !~ /^head1/) { # SH already makes smaller # /g isn't enough; 1 while or we'll be off # 1 while s{ # (?!$hidCFont)(..|^.|^) # \b # ( # [A-Z][\/A-Z+:\-\d_$.]+ # ) # (s?) # \b # } {$1\\s-1$2\\s0}gmox; 1 while s{ (?!$hidCFont)(..|^.|^) ( \b[A-Z]{2,}[\/A-Z+:\-\d_\$]*\b ) } { $1 . noremap( '\\s-1' . $2 . '\\s0' ) }egmox; } } # make troff just be normal, but make small nroff get quoted # decided to just put the quotes in the text; sigh; sub ccvt { local($_,$prev) = @_; noremap(qq{.CQ "$_" \n\\&}); } sub makespace { if ($indent) { print ".Sp\n"; } else { print ".PP\n"; } } sub mkindex { my ($entry) = @_; my @entries = split m:\s*/\s*:, $entry; push @Indices, ".IX Xref " . join ' ', map {qq("$_")} @entries; return ''; } sub font { local($font) = shift; return '\\f' . noremap($font); } sub noremap { local($thing_to_hide) = shift; $thing_to_hide =~ tr/\000-\177/\200-\377/; return $thing_to_hide; } sub init_noremap { # escape high bit characters in input stream s/([\200-\377])/"E<".ord($1).">"/ge; } sub clear_noremap { my $ready_to_print = $_[0]; tr/\200-\377/\000-\177/; # trofficate backslashes # s/(?!\\e)(?:..|^.|^)\\/\\e/g; # now for the E<>s, which have been hidden until now # otherwise the interative \w<> processing would have # been hosed by the E s { E< ( ( \d + ) | ( [A-Za-z]+ ) ) > } { do { defined $2 ? chr($2) : exists $HTML_Escapes{$3} ? do { $HTML_Escapes{$3} } : do { warn "$0: Séquence inconnue dans $ARGV: ``$&''\n"; "E<$1>"; } } }egx if $ready_to_print; } sub internal_lrefs { local($_) = shift; local $trailing_and = s/and\s+$// ? "and " : ""; s{L]+)>}{$1}g; my(@items) = split( /(?:,?\s+(?:and\s+)?)/ ); my $retstr = "the "; my $i; for ($i = 0; $i <= $#items; $i++) { $retstr .= "C<$items[$i]>"; $retstr .= ", " if @items > 2 && $i != $#items; $retstr .= " and " if $i+2 == @items; } $retstr .= " entr" . ( @items > 1 ? "ies" : "y" ) . " elsewhere in this document"; # terminal space to avoid words running together (pattern used # strips terminal spaces) $retstr .= " " if length $trailing_and; $retstr .= $trailing_and; return $retstr; } BEGIN { %HTML_Escapes = ( 'amp' => '&', # ampersand 'lt' => '<', # left chevron, less-than 'gt' => '>', # right chevron, greater-than 'quot' => '"', # double quote "Aacute" => "A\\*'", # capital A, acute accent "aacute" => "a\\*'", # small a, acute accent "Acirc" => "A\\*^", # capital A, circumflex accent "acirc" => "a\\*^", # small a, circumflex accent "AElig" => '\*(AE', # capital AE diphthong (ligature) "aelig" => '\*(ae', # small ae diphthong (ligature) "Agrave" => "A\\*`", # capital A, grave accent "agrave" => "A\\*`", # small a, grave accent "Aring" => 'A\\*o', # capital A, ring "aring" => 'a\\*o', # small a, ring "Atilde" => 'A\\*~', # capital A, tilde "atilde" => 'a\\*~', # small a, tilde "Auml" => 'A\\*:', # capital A, dieresis or umlaut mark "auml" => 'a\\*:', # small a, dieresis or umlaut mark "Ccedil" => 'C\\*,', # capital C, cedilla "ccedil" => 'c\\*,', # small c, cedilla "Eacute" => "E\\*'", # capital E, acute accent "eacute" => "e\\*'", # small e, acute accent "Ecirc" => "E\\*^", # capital E, circumflex accent "ecirc" => "e\\*^", # small e, circumflex accent "Egrave" => "E\\*`", # capital E, grave accent "egrave" => "e\\*`", # small e, grave accent "ETH" => '\\*(D-', # capital Eth, Icelandic "eth" => '\\*(d-', # small eth, Icelandic "Euml" => "E\\*:", # capital E, dieresis or umlaut mark "euml" => "e\\*:", # small e, dieresis or umlaut mark "Iacute" => "I\\*'", # capital I, acute accent "iacute" => "i\\*'", # small i, acute accent "Icirc" => "I\\*^", # capital I, circumflex accent "icirc" => "i\\*^", # small i, circumflex accent "Igrave" => "I\\*`", # capital I, grave accent "igrave" => "i\\*`", # small i, grave accent "Iuml" => "I\\*:", # capital I, dieresis or umlaut mark "iuml" => "i\\*:", # small i, dieresis or umlaut mark "Ntilde" => 'N\*~', # capital N, tilde "ntilde" => 'n\*~', # small n, tilde "Oacute" => "O\\*'", # capital O, acute accent "oacute" => "o\\*'", # small o, acute accent "Ocirc" => "O\\*^", # capital O, circumflex accent "ocirc" => "o\\*^", # small o, circumflex accent "Ograve" => "O\\*`", # capital O, grave accent "ograve" => "o\\*`", # small o, grave accent "Oslash" => "O\\*/", # capital O, slash "oslash" => "o\\*/", # small o, slash "Otilde" => "O\\*~", # capital O, tilde "otilde" => "o\\*~", # small o, tilde "Ouml" => "O\\*:", # capital O, dieresis or umlaut mark "ouml" => "o\\*:", # small o, dieresis or umlaut mark "szlig" => '\*8', # small sharp s, German (sz ligature) "THORN" => '\\*(Th', # capital THORN, Icelandic "thorn" => '\\*(th',, # small thorn, Icelandic "Uacute" => "U\\*'", # capital U, acute accent "uacute" => "u\\*'", # small u, acute accent "Ucirc" => "U\\*^", # capital U, circumflex accent "ucirc" => "u\\*^", # small u, circumflex accent "Ugrave" => "U\\*`", # capital U, grave accent "ugrave" => "u\\*`", # small u, grave accent "Uuml" => "U\\*:", # capital U, dieresis or umlaut mark "uuml" => "u\\*:", # small u, dieresis or umlaut mark "Yacute" => "Y\\*'", # capital Y, acute accent "yacute" => "y\\*'", # small y, acute accent "yuml" => "y\\*:", # small y, dieresis or umlaut mark ); }