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