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 9package mdoc2man; 10use strict; 11use warnings; 12use File::Basename; 13use lib dirname(__FILE__); 14use Mdoc qw(hs ns pp mapwords son soff stoggle gen_encloser); 15 16######## 17## Basic 18######## 19 20Mdoc::def_macro( '.Sh', sub { '.SH', hs, @_ }, raw => 1); 21Mdoc::def_macro( '.Ss', sub { '.SS', hs, @_ }, raw => 1); 22Mdoc::def_macro( '.Pp', sub { ".sp \\n(Ppu\n.ne 2\n" } ); 23Mdoc::def_macro( '.Nd', sub { "\\- @_" } ); 24 25# Macros that enclose things 26Mdoc::def_macro( '.Brq', gen_encloser(qw({ })) , greedy => 1 ); 27Mdoc::def_macro( '.Op' , gen_encloser(qw([ ])) , greedy => 1 ); 28Mdoc::def_macro( '.Qq' , gen_encloser(qw(" ")) , greedy => 1 ); 29Mdoc::def_macro( '.Dq' , gen_encloser(qw(\*[Lq] \*[Rq])), greedy => 1 ); 30Mdoc::def_macro( '.Ql' , gen_encloser(qw(\[oq] \[cq])) , greedy => 1 ); 31Mdoc::def_macro( '.Sq' , gen_encloser(qw(\[oq] \[cq])) , greedy => 1 ); 32Mdoc::def_macro( '.Pq' , gen_encloser(qw/( )/) , greedy => 1 ); 33Mdoc::def_macro( '.D1' , sub { ".in +4\n", ns, @_ , ns , "\n.in -4" } , greedy => 1); 34 35Mdoc::def_macro( 'Oo', sub { '[', @_ } ); 36Mdoc::def_macro( 'Oc', sub { ']', @_ } ); 37 38Mdoc::def_macro( 'Po', sub { '(', @_} ); 39Mdoc::def_macro( 'Pc', sub { ')', @_ } ); 40 41Mdoc::def_macro( 'Bro', sub { '{', ns, @_ } ); 42Mdoc::def_macro( 'Brc', sub { '}', @_ } ); 43 44Mdoc::def_macro( '.Oo', gen_encloser(qw([ ])), concat_until => '.Oc' ); 45Mdoc::def_macro( '.Bro', gen_encloser(qw({ })), concat_until => '.Brc' ); 46Mdoc::def_macro( '.Po', gen_encloser(qw/( )/), concat_until => '.Pc' ); 47 48Mdoc::def_macro( '.Ev', sub { @_ } ); 49Mdoc::def_macro( '.An', sub { ".NOP ", @_, "\n.br" }, raw => 1 ); 50Mdoc::def_macro( '.Li', sub { mapwords {"\\f[C]$_\\f[]"} @_ } ); 51Mdoc::def_macro( '.Cm', sub { mapwords {"\\f\\*[B-Font]$_\\f[]"} @_ } ); 52Mdoc::def_macro( '.Ic', sub { mapwords {"\\f\\*[B-Font]$_\\f[]"} @_ } ); 53Mdoc::def_macro( '.Fl', sub { mapwords {"\\f\\*[B-Font]\\-$_\\f[]"} @_ } ); 54Mdoc::def_macro( '.Ar', sub { mapwords {"\\f\\*[I-Font]$_\\f[]"} @_ } ); 55Mdoc::def_macro( '.Em', sub { mapwords {"\\fI$_\\f[]"} @_ } ); 56Mdoc::def_macro( '.Va', sub { mapwords {"\\fI$_\\f[]"} @_ } ); 57Mdoc::def_macro( '.Sx', sub { mapwords {"\\fI$_\\f[]"} @_ } ); 58Mdoc::def_macro( '.Xr', sub { "\\fC".(shift)."\\fR(".(shift).")\\f[]", @_ } ); 59Mdoc::def_macro( '.Fn', sub { "\\f\\*[B-Font]".(shift)."\\fR()\\f[]" } ); 60Mdoc::def_macro( '.Fn', sub { "\\fB".(shift)."\\fR()\\f[]" } ); 61Mdoc::def_macro( '.Fx', sub { "FreeBSD", @_ } ); 62Mdoc::def_macro( '.Ux', sub { "UNIX", @_ } ); 63 64Mdoc::def_macro( '.No', sub { ".NOP", map { ($_, ns) } @_ } ); 65Mdoc::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 78my %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 117Mdoc::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 144Mdoc::def_macro('.Bd', sub { ".br\n.in +4\n.nf" } ); 145Mdoc::def_macro('.Ed', sub { ".in -4\n.fi" } ); 146 147Mdoc::set_Re_callback(sub { 148 my ($reference) = @_; 149 <<"REF"; 150$reference->{authors}, 151\\fI$reference->{title}\\fR, 152$reference->{optional}\n.PP 153REF 154}); 155 156# Define all macros which have the same sub for inline and standalone macro 157for (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 162sub print_line { 163 print shift; 164 print "\n"; 165} 166 167sub 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 181DEFS 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 190exit run(@ARGV) unless caller; 191 1921; 193__END__ 194