Home | History | Annotate | Line # | Download | only in 0-old 
      1 #!/usr/bin/perl
      2 
      3 ### ToDo
      4 # Properly implement -columns in the "my %lists" definition...
      5 #
      6 # .Xr requires at least 1 arg, the code here expects at least 2
      7 ###
      8 
      9 package mdoc2man;
     10 use strict;
     11 use warnings;
     12 use File::Basename;
     13 use lib dirname(__FILE__);
     14 use Mdoc qw(hs ns pp mapwords son soff stoggle gen_encloser);
     15 
     16 ########
     17 ## Basic
     18 ########
     19 
     20 Mdoc::def_macro( '.Sh', sub { '.SH', hs, @_ }, raw => 1);
     21 Mdoc::def_macro( '.Ss', sub { '.SS', hs, @_ }, raw => 1);
     22 Mdoc::def_macro( '.Pp', sub { ".sp \\n(Ppu\n.ne 2\n" } );
     23 Mdoc::def_macro( '.Nd', sub { "\\- @_" } );
     24 
     25 # Macros that enclose things
     26 Mdoc::def_macro( '.Brq', gen_encloser(qw({ }))          , greedy => 1 );
     27 Mdoc::def_macro( '.Op' , gen_encloser(qw([ ]))          , greedy => 1 );
     28 Mdoc::def_macro( '.Qq' , gen_encloser(qw(" "))          , greedy => 1 );
     29 Mdoc::def_macro( '.Dq' , gen_encloser(qw(\*[Lq] \*[Rq])), greedy => 1 );
     30 Mdoc::def_macro( '.Ql' , gen_encloser(qw(\[oq] \[cq]))  , greedy => 1 );
     31 Mdoc::def_macro( '.Sq' , gen_encloser(qw(\[oq] \[cq]))  , greedy => 1 );
     32 Mdoc::def_macro( '.Pq' , gen_encloser(qw/( )/)          , greedy => 1 );
     33 Mdoc::def_macro( '.D1' , sub { ".in +4\n", ns, @_ , ns , "\n.in -4" } , greedy => 1);
     34 
     35 Mdoc::def_macro( 'Oo',  sub { '[', @_ } );
     36 Mdoc::def_macro( 'Oc',  sub { ']', @_ } );
     37 
     38 Mdoc::def_macro( 'Po',  sub { '(', @_} );
     39 Mdoc::def_macro( 'Pc',  sub { ')', @_ } );
     40 
     41 Mdoc::def_macro( 'Bro', sub { '{', ns, @_ } );
     42 Mdoc::def_macro( 'Brc', sub { '}', @_ } );
     43 
     44 Mdoc::def_macro( '.Oo',  gen_encloser(qw([ ])), concat_until => '.Oc' );
     45 Mdoc::def_macro( '.Bro', gen_encloser(qw({ })), concat_until => '.Brc' );
     46 Mdoc::def_macro( '.Po',  gen_encloser(qw/( )/), concat_until => '.Pc' );
     47 
     48 Mdoc::def_macro( '.Ev', sub { @_ } );
     49 Mdoc::def_macro( '.An', sub { ".NOP ", @_, "\n.br" }, raw => 1 );
     50 Mdoc::def_macro( '.Li', sub { mapwords {"\\f[C]$_\\f[]"} @_ } );
     51 Mdoc::def_macro( '.Cm', sub { mapwords {"\\f\\*[B-Font]$_\\f[]"} @_ } );
     52 Mdoc::def_macro( '.Ic', sub { mapwords {"\\f\\*[B-Font]$_\\f[]"} @_ } );
     53 Mdoc::def_macro( '.Fl', sub { mapwords {"\\f\\*[B-Font]\\-$_\\f[]"} @_ } );
     54 Mdoc::def_macro( '.Ar', sub { mapwords {"\\f\\*[I-Font]$_\\f[]"} @_ } );
     55 Mdoc::def_macro( '.Em', sub { mapwords {"\\fI$_\\f[]"} @_ } );
     56 Mdoc::def_macro( '.Va', sub { mapwords {"\\fI$_\\f[]"} @_ } );
     57 Mdoc::def_macro( '.Sx', sub { mapwords {"\\fI$_\\f[]"} @_ } );
     58 Mdoc::def_macro( '.Xr', sub { "\\fC".(shift)."\\fR(".(shift).")\\f[]", @_ } );
     59 Mdoc::def_macro( '.Fn', sub { "\\f\\*[B-Font]".(shift)."\\fR()\\f[]" } );
     60 Mdoc::def_macro( '.Fn', sub { "\\fB".(shift)."\\fR()\\f[]" } );
     61 Mdoc::def_macro( '.Fx', sub { "FreeBSD", @_ } );
     62 Mdoc::def_macro( '.Ux', sub { "UNIX", @_ } );
     63 
     64 Mdoc::def_macro( '.No', sub { ".NOP", map { ($_, ns) } @_ } );
     65 Mdoc::def_macro( '.Pa', sub { mapwords {"\\fI$_\\f[]"} @_; } );
     66 {
     67     my $name;
     68     Mdoc::def_macro('.Nm', sub {
     69         $name = shift if (!$name);
     70         "\\f\\*[B-Font]$name\\fP", @_
     71     } );
     72 }
     73 
     74 ########
     75 ## lists
     76 ########
     77 
     78 my %lists = (
     79     bullet => sub {
     80         Mdoc::def_macro('.It', sub { '.IP \fB\(bu\fP 2' });
     81     },
     82 
     83     column => sub {
     84         Mdoc::def_macro('.It', sub { '.IP \fB\(bu\fP 2' });
     85     },
     86 
     87     tag    => sub {
     88         my (%opts) = @_;
     89 
     90         my $width = '';
     91 
     92         if (exists $opts{width}) {
     93             $width = ' '.((length $opts{width})+1);
     94         }
     95 
     96         if (exists $opts{compact}) {
     97             my $dobrns = 0;
     98             Mdoc::def_macro('.It', sub {
     99                     my @ret = (".TP$width\n.NOP", hs);
    100                     if ($dobrns) {
    101                         ".br\n.ns\n", ns, @ret, @_;
    102                     }
    103                     else {
    104                         $dobrns = 1;
    105                         @ret, @_;
    106                     }
    107                 }, raw => 1);
    108         }
    109         else {
    110             Mdoc::def_macro('.It', sub {
    111                     ".TP$width\n.NOP", hs, @_
    112                 }, raw => 1);
    113         }
    114     },
    115 );
    116 
    117 Mdoc::set_Bl_callback(do { my $nested = 0; sub {
    118     my $type = shift;
    119     my %opts = Mdoc::parse_opts(@_);
    120     if (defined $type && $type =~ /-(\w+)/ && exists $lists{$1}) {
    121 
    122         # Wrap nested lists with .RS and .RE
    123         Mdoc::set_El_callback(sub { 
    124                 return '.RE' if $nested-- > 1;
    125                 return '.PP';
    126             });
    127 
    128         $lists{$1}->(%opts);
    129 
    130         if ($nested++) {
    131             return ".RS";
    132         }
    133         else {
    134             return ();
    135         }
    136     }
    137     else {
    138         die "Invalid list type <$type>";
    139     }
    140 }}, raw => 1);
    141 
    142 # don't bother with arguments for now and do what mdoc2man'.sh' did
    143 
    144 Mdoc::def_macro('.Bd', sub { ".br\n.in +4\n.nf" } );
    145 Mdoc::def_macro('.Ed', sub { ".in -4\n.fi" } );
    146 
    147 Mdoc::set_Re_callback(sub { 
    148         my ($reference) = @_;
    149         <<"REF";
    150 $reference->{authors},
    151 \\fI$reference->{title}\\fR,
    152 $reference->{optional}\n.PP
    153 REF
    154 });
    155 
    156 # Define all macros which have the same sub for inline and standalone macro
    157 for (qw(Xr Em Ar Fl Ic Cm Qq Op Nm Pa Sq Li Va Brq Pq Fx Ux)) {
    158     my $m = Mdoc::get_macro(".$_");
    159     Mdoc::def_macro($_, delete $m->{run}, %$m);
    160 }
    161 
    162 sub print_line {
    163     print shift;
    164     print "\n";
    165 }
    166 
    167 sub run {
    168     print <<'DEFS';
    169 .de1 NOP
    170 .  it 1 an-trap
    171 .  if \\n[.$] \,\\$*\/
    172 ..
    173 .ie t \
    174 .ds B-Font [CB]
    175 .ds I-Font [CI]
    176 .ds R-Font [CR]
    177 .el \
    178 .ds B-Font B
    179 .ds I-Font I
    180 .ds R-Font R
    181 DEFS
    182 
    183     while (my ($macro, @args) = Mdoc::parse_line(\*STDIN, \&print_line)) {
    184         my @ret = Mdoc::call_macro($macro, @args);
    185         print_line(Mdoc::to_string(@ret)) if @ret;
    186     }
    187     return 0;
    188 }
    189 
    190 exit run(@ARGV) unless caller;
    191 
    192 1;
    193 __END__
    194