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

   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__