mdoc2texi revision 290001 
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
13package mdoc2texi;
14use strict;
15use warnings;
16use File::Basename qw(dirname);
17use lib dirname(__FILE__);
18use Mdoc qw(ns pp hs mapwords gen_encloser nl);
19
20# Ignore commments
21Mdoc::def_macro( '.\"',  sub { () } );
22
23# Enclosers
24Mdoc::def_macro( '.An',  sub { @_, ns, '@*' } );
25Mdoc::def_macro( '.Aq',  gen_encloser(qw(< >)),   greedy => 1);
26Mdoc::def_macro( '.Bq',  gen_encloser(qw([ ])),   greedy => 1);
27Mdoc::def_macro( '.Brq', gen_encloser(qw(@{ @})), greedy => 1);
28Mdoc::def_macro( '.Pq',  gen_encloser(qw/( )/),   greedy => 1);
29Mdoc::def_macro( '.Qq',  gen_encloser(qw(" ")),   greedy => 1);
30Mdoc::def_macro( '.Op',  gen_encloser(qw(@code{[ ]})), greedy => 1);
31Mdoc::def_macro( '.Ql',  gen_encloser(qw(@quoteleft{} @quoteright{})),
32    greedy => 1);
33Mdoc::def_macro( '.Sq',  gen_encloser(qw(@quoteleft{} @quoteright{})),
34    greedy => 1);
35Mdoc::def_macro( '.Dq',  gen_encloser(qw(@quotedblleft{} @quotedblright{})), 
36    greedy => 1);
37Mdoc::def_macro( '.Eq', sub { 
38        my ($o, $c) = (shift, pop); 
39        gen_encloser($o, $c)->(@_) 
40},  greedy => 1);
41Mdoc::def_macro( '.D1', sub { "\@example\n", ns, @_, ns, "\n\@end example" },
42    greedy => 1);
43Mdoc::def_macro( '.Dl', sub { "\@example\n", ns, @_, ns, "\n\@end example" },
44    greedy => 1);
45
46Mdoc::def_macro( '.Oo',  gen_encloser(qw(@code{[ ]})), concat_until => '.Oc');
47Mdoc::def_macro( 'Oo',   sub { '@code{[', ns, @_ } );
48Mdoc::def_macro( 'Oc',   sub { @_, ns, pp(']}') } );
49
50Mdoc::def_macro( '.Bro', gen_encloser(qw(@code{@{ @}})), concat_until => '.Brc');
51Mdoc::def_macro( 'Bro',  sub { '@code{@{', ns, @_ } );
52Mdoc::def_macro( 'Brc',  sub { @_, ns, pp('@}}') } );
53
54Mdoc::def_macro( '.Po',  gen_encloser(qw/( )/), concat_until => '.Pc');
55Mdoc::def_macro( 'Po',   sub { '(', @_     } );
56Mdoc::def_macro( 'Pc',   sub { @_, ')' } );
57
58Mdoc::def_macro( '.Ar', sub { mapwords {"\@kbd{$_}"} @_ } );
59Mdoc::def_macro( '.Fl', sub { mapwords {"\@code{-$_}"} @_ } );
60Mdoc::def_macro( '.Cm', sub { mapwords {"\@code{-$_}"} @_ } );
61Mdoc::def_macro( '.Ic', sub { mapwords {"\@code{$_}"} @_ } );
62Mdoc::def_macro( '.Cm', sub { mapwords {"\@code{$_}"} @_ } );
63Mdoc::def_macro( '.Li', sub { mapwords {"\@code{$_}"} @_ } );
64Mdoc::def_macro( '.Va', sub { mapwords {"\@code{$_}"} @_ } );
65Mdoc::def_macro( '.Em', sub { mapwords {"\@emph{$_}"} @_ } );
66Mdoc::def_macro( '.Fn', sub { '@code{'.(shift).'()}' } );
67Mdoc::def_macro( '.Ss', sub { "\@subsubsection", hs, @_ });
68Mdoc::def_macro( '.Sh', sub { 
69        my $name = "@_"; 
70        "\@node", hs, "$name\n", ns, "\@subsection", hs, $name
71    });
72Mdoc::def_macro( '.Ss', sub { "\@subsubsection", hs, @_ });
73Mdoc::def_macro( '.Xr', sub { '@code{'.(shift).'('.(shift).')}', @_ } );
74Mdoc::def_macro( '.Sx', gen_encloser(qw(@ref{ })) );
75Mdoc::def_macro( '.Ux', sub { '@sc{unix}', @_ } );
76Mdoc::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}
84Mdoc::def_macro( '.Pa', sub { mapwords {"\@file{$_}"} @_ } );
85Mdoc::def_macro( '.Pp', sub { '' } );
86
87# Setup references
88
89Mdoc::def_macro( '.Rs', sub { "\@*\n", @_ } );
90Mdoc::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
98my %displays = (
99    literal => [ '@verbatim', '@end verbatim' ],
100);
101
102Mdoc::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    });
114Mdoc::def_macro('.Ed', sub { die '.Ed used but .Bd was not seen' });
115
116# Set up Bl/El
117
118my %lists = (
119    bullet => [ '@itemize @bullet', '@end itemize' ],
120    tag    => [ '@table @asis', '@end table' ],
121    column => [ '@table @asis', '@end table' ],
122);
123
124Mdoc::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    });
132Mdoc::def_macro('.It', sub { '@item', hs, @_ });
133
134for (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
139sub print_line {
140    my $s = shift;
141    $s =~ s/\\&//g;
142    print "$s\n";
143}
144
145sub preprocess_args {
146    $_ =~ s/([{}])/\@$1/g for @_;
147}
148
149sub 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
162exit run(@ARGV) unless caller;
163