contrib/ntp/sntp/ag-tpl/0-old/mdoc2texi

   1 #! /usr/bin/perl
   2
   3 ### To Do:
   4
   5 # the Bl -column command needs work:
   6 # - support for "-offset"
   7 # - support for the header widths
   8
   9 #
  10
  11 ###
  12
  13 package mdoc2texi;
  14 use strict;
  15 use warnings;
  16 use File::Basename qw(dirname);
  17 use lib dirname(__FILE__);
  18 use Mdoc qw(ns pp hs mapwords gen_encloser nl);
  19
  20 # Ignore commments
  21 Mdoc::def_macro( '.\"',  sub { () } );
  22
  23 # Enclosers
  24 Mdoc::def_macro( '.An',  sub { @_, ns, '@*' } );
  25 Mdoc::def_macro( '.Aq',  gen_encloser(qw(< >)),   greedy => 1);
  26 Mdoc::def_macro( '.Bq',  gen_encloser(qw([ ])),   greedy => 1);
  27 Mdoc::def_macro( '.Brq', gen_encloser(qw(@{ @})), greedy => 1);
  28 Mdoc::def_macro( '.Pq',  gen_encloser(qw/( )/),   greedy => 1);
  29 Mdoc::def_macro( '.Qq',  gen_encloser(qw(" ")),   greedy => 1);
  30 Mdoc::def_macro( '.Op',  gen_encloser(qw(@code{[ ]})), greedy => 1);
  31 Mdoc::def_macro( '.Ql',  gen_encloser(qw(@quoteleft{} @quoteright{})),
  32     greedy => 1);
  33 Mdoc::def_macro( '.Sq',  gen_encloser(qw(@quoteleft{} @quoteright{})),
  34     greedy => 1);
  35 Mdoc::def_macro( '.Dq',  gen_encloser(qw(@quotedblleft{} @quotedblright{})),
  36     greedy => 1);
  37 Mdoc::def_macro( '.Eq', sub {
  38         my ($o, $c) = (shift, pop);
  39         gen_encloser($o, $c)->(@_)
  40 },  greedy => 1);
  41 Mdoc::def_macro( '.D1', sub { "\@example\n", ns, @_, ns, "\n\@end example" },
  42     greedy => 1);
  43 Mdoc::def_macro( '.Dl', sub { "\@example\n", ns, @_, ns, "\n\@end example" },
  44     greedy => 1);
  45
  46 Mdoc::def_macro( '.Oo',  gen_encloser(qw(@code{[ ]})), concat_until => '.Oc');
  47 Mdoc::def_macro( 'Oo',   sub { '@code{[', ns, @_ } );
  48 Mdoc::def_macro( 'Oc',   sub { @_, ns, pp(']}') } );
  49
  50 Mdoc::def_macro( '.Bro', gen_encloser(qw(@code{@{ @}})), concat_until => '.Brc');
  51 Mdoc::def_macro( 'Bro',  sub { '@code{@{', ns, @_ } );
  52 Mdoc::def_macro( 'Brc',  sub { @_, ns, pp('@}}') } );
  53
  54 Mdoc::def_macro( '.Po',  gen_encloser(qw/( )/), concat_until => '.Pc');
  55 Mdoc::def_macro( 'Po',   sub { '(', @_     } );
  56 Mdoc::def_macro( 'Pc',   sub { @_, ')' } );
  57
  58 Mdoc::def_macro( '.Ar', sub { mapwords {"\@kbd{$_}"} @_ } );
  59 Mdoc::def_macro( '.Fl', sub { mapwords {"\@code{-$_}"} @_ } );
  60 Mdoc::def_macro( '.Cm', sub { mapwords {"\@code{-$_}"} @_ } );
  61 Mdoc::def_macro( '.Ic', sub { mapwords {"\@code{$_}"} @_ } );
  62 Mdoc::def_macro( '.Cm', sub { mapwords {"\@code{$_}"} @_ } );
  63 Mdoc::def_macro( '.Li', sub { mapwords {"\@code{$_}"} @_ } );
  64 Mdoc::def_macro( '.Va', sub { mapwords {"\@code{$_}"} @_ } );
  65 Mdoc::def_macro( '.Em', sub { mapwords {"\@emph{$_}"} @_ } );
  66 Mdoc::def_macro( '.Fn', sub { '@code{'.(shift).'()}' } );
  67 Mdoc::def_macro( '.Ss', sub { "\@subsubsection", hs, @_ });
  68 Mdoc::def_macro( '.Sh', sub {
  69         my $name = "@_";
  70         "\@node", hs, "$name\n", ns, "\@subsection", hs, $name
  71     });
  72 Mdoc::def_macro( '.Ss', sub { "\@subsubsection", hs, @_ });
  73 Mdoc::def_macro( '.Xr', sub { '@code{'.(shift).'('.(shift).')}', @_ } );
  74 Mdoc::def_macro( '.Sx', gen_encloser(qw(@ref{ })) );
  75 Mdoc::def_macro( '.Ux', sub { '@sc{unix}', @_ } );
  76 Mdoc::def_macro( '.Fx', sub { '@sc{freebsd}', @_ } );
  77 {
  78     my $name;
  79     Mdoc::def_macro('.Nm', sub {
  80         $name = shift || $ENV{AG_DEF_PROG_NAME} || 'XXX' if (!$name);
  81         "\@code{$name}"
  82     } );
  83 }
  84 Mdoc::def_macro( '.Pa', sub { mapwords {"\@file{$_}"} @_ } );
  85 Mdoc::def_macro( '.Pp', sub { '' } );
  86
  87 # Setup references
  88
  89 Mdoc::def_macro( '.Rs', sub { "\@*\n", @_ } );
  90 Mdoc::set_Re_callback(sub {
  91         my ($reference) = @_;
  92         "@*\n", ns, $reference->{authors}, ',', "\@emph{$reference->{title}}",
  93         ',', $reference->{optional}
  94     });
  95
  96 # Set up Bd/Ed
  97
  98 my %displays = (
  99     literal => [ '@verbatim', '@end verbatim' ],
 100 );
 101
 102 Mdoc::def_macro( '.Bd', sub {
 103         (my $type = shift) =~ s/^-//;
 104         die "Not supported display type <$type>"
 105             if not exists $displays{ $type };
 106
 107         my $orig_ed = Mdoc::get_macro('.Ed');
 108         Mdoc::def_macro('.Ed', sub {
 109                 Mdoc::def_macro('.Ed', delete $orig_ed->{run}, %$orig_ed);
 110                 $displays{ $type }[1];
 111             });
 112         $displays{ $type }[0]
 113     });
 114 Mdoc::def_macro('.Ed', sub { die '.Ed used but .Bd was not seen' });
 115
 116 # Set up Bl/El
 117
 118 my %lists = (
 119     bullet => [ '@itemize @bullet', '@end itemize' ],
 120     tag    => [ '@table @asis', '@end table' ],
 121     column => [ '@table @asis', '@end table' ],
 122 );
 123
 124 Mdoc::set_Bl_callback(sub {
 125         my $type = shift;
 126         die "Specify a list type"             if not defined $type;
 127         $type =~ s/^-//;
 128         die "Not supported list type <$type>" if not exists $lists{ $type };
 129         Mdoc::set_El_callback(sub { $lists{ $type }[1] });
 130         $lists{ $type }[0]
 131     });
 132 Mdoc::def_macro('.It', sub { '@item', hs, @_ });
 133
 134 for (qw(Aq Bq Brq Pq Qq Ql Sq Dq Eq Ar Fl Ic Pa Op Cm Li Fx Ux Va)) {
 135     my $m = Mdoc::get_macro(".$_");
 136     Mdoc::def_macro($_, delete $m->{run}, %$m);
 137 }
 138
 139 sub print_line {
 140     my $s = shift;
 141     $s =~ s/\\&//g;
 142     print "$s\n";
 143 }
 144
 145 sub preprocess_args {
 146     $_ =~ s/([{}])/\@$1/g for @_;
 147 }
 148
 149 sub run {
 150     while (my ($macro, @args) = Mdoc::parse_line(\*STDIN, \&print_line,
 151             \&preprocess_args)
 152     ) {
 153         my @ret = Mdoc::call_macro($macro, @args);
 154         if (@ret) {
 155             my $s = Mdoc::to_string(@ret);
 156             print_line($s);
 157         }
 158     }
 159     return 0;
 160 }
 161
 162 exit run(@ARGV) unless caller;