Home | History | Annotate | Line # | Download | only in 0-old 
      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;
    163