mdoc2man revision 290001 
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