contrib/mdoc2man.pl

   1 #!/usr/bin/perl
   2 ###
   3 ### Quick usage:  mdoc2man.pl < mdoc_manpage.8 > doc_manpage.8
   4 ###
   5 ###
   6 ###  Copyright (c) 2001 University of Illinois Board of Trustees
   7 ###  Copyright (c) 2001 Mark D. Roth
   8 ###  All rights reserved.
   9 ###
  10 ###  Redistribution and use in source and binary forms, with or without
  11 ###  modification, are permitted provided that the following conditions
  12 ###  are met:
  13 ###  1. Redistributions of source code must retain the above copyright
  14 ###     notice, this list of conditions and the following disclaimer.
  15 ###  2. Redistributions in binary form must reproduce the above copyright
  16 ###     notice, this list of conditions and the following disclaimer in the
  17 ###     documentation and/or other materials provided with the distribution.
  18 ###  3. All advertising materials mentioning features or use of this software
  19 ###     must display the following acknowledgement:
  20 ###     This product includes software developed by the University of
  21 ###     Illinois at Urbana, and their contributors.
  22 ###  4. The University nor the names of their
  23 ###     contributors may be used to endorse or promote products derived from
  24 ###     this software without specific prior written permission.
  25 ###
  26 ###  THIS SOFTWARE IS PROVIDED BY THE TRUSTEES AND CONTRIBUTORS ``AS IS'' AND
  27 ###  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  28 ###  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  29 ###  ARE DISCLAIMED.  IN NO EVENT SHALL THE TRUSTEES OR CONTRIBUTORS BE LIABLE
  30 ###  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  31 ###  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  32 ###  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  33 ###  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  34 ###  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  35 ###  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  36 ###  SUCH DAMAGE.
  37 ###
  38
  39 use strict;
  40
  41 my ($name, $date, $id);
  42 my ($line);
  43 my ($optlist, $nospace, $enum, $synopsis);
  44
  45
  46 $optlist = 0;           ### 1 = bullet, 2 = enum, 3 = tag
  47 $nospace = 0;
  48 $synopsis = 0;
  49
  50 while ($line = <STDIN>)
  51 {
  52         if ($line !~ /^\./)
  53         {
  54                 print $line;
  55                 next;
  56         }
  57
  58         $line =~ s/^\.//;
  59
  60         next
  61                 if ($line =~ m/\\"/);
  62
  63         $line = ParseMacro($line);
  64         print($line)
  65                 if (defined $line);
  66 }
  67
  68
  69
  70 sub ParseMacro # ($line)
  71 {
  72         my ($line) = @_;
  73         my (@words, $retval, $option, $parens, $arg);
  74
  75         @words = split(/\s+/, $line);
  76         $retval = '';
  77         $option = 0;
  78         $parens = 0;
  79         $arg = 0;
  80
  81 #       print('@words = ', scalar(@words), ': ', join(' ', @words), "\n");
  82
  83         while ($_ = shift @words)
  84         {
  85 #               print "WORD: $_\n";
  86
  87                 next
  88                         if (/^(Li|Pf|X[oc])$/);
  89
  90                 if (/^Ns/)
  91                 {
  92                         $nospace = 1
  93                                 if (! $nospace);
  94                         $retval =~ s/ $//;
  95                         next;
  96                 }
  97
  98                 if (/^No/)
  99                 {
 100                         $retval =~ s/ $//;
 101                         $retval .= shift @words;
 102                         next;
 103                 }
 104
 105                 if (/^Dq$/) {
 106                         $retval .= '``' . (shift @words) . '\'\'';
 107                         $nospace = 1
 108                                 if (! $nospace && $words[0] =~ m/^[\.,]/);
 109                         next;
 110                 }
 111
 112                 if (/^(Sq|Ql)$/) {
 113                         $retval .= '`' . (shift @words) . '\'';
 114                         $nospace = 1
 115                                 if (! $nospace && $words[0] =~ m/^[\.,]/);
 116                         next;
 117                 }
 118
 119                 $retval .= ' '
 120                         if (! $nospace && $retval ne '' && $retval !~ m/[\n ]$/);
 121                 $nospace = 0
 122                         if ($nospace == 1);
 123
 124                 if (/^Dd$/) {
 125                         $date = join(' ', @words);
 126                         return undef;
 127                 }
 128
 129                 if (/^Dt$/) {
 130                         $id = join(' ', @words);
 131                         return undef;
 132                 }
 133
 134                 if (/^Os$/) {
 135                         $retval .= '.TH '
 136                                 . $id
 137                                 . " \"$date\" \""
 138                                 . join(' ', @words)
 139                                 . "\"";
 140                         last;
 141                 }
 142
 143                 if (/^Sh$/) {
 144                         $retval .= '.SH';
 145                         if ($words[0] eq 'SYNOPSIS')
 146                         {
 147                                 $synopsis = 1;
 148                         }
 149                         else
 150                         {
 151                                 $synopsis = 0;
 152                         }
 153                         next;
 154                 }
 155
 156                 if (/^Xr$/) {
 157                         $retval .= '\\fB' . (shift @words) .
 158                                 '\\fR(' . (shift @words) . ')'
 159                                 . (shift @words);
 160                         last;
 161                 }
 162
 163                 if (/^Nm$/) {
 164                         $name = shift @words
 165                                 if (@words > 0);
 166                         $retval .= ".br\n"
 167                                 if ($synopsis);
 168                         $retval .= "\\fB$name\\fR";
 169                         $nospace = 1
 170                                 if (! $nospace && $words[0] =~ m/^[\.,]/);
 171                         next;
 172                 }
 173
 174                 if (/^Nd$/) {
 175                         $retval .= '\\-';
 176                         next;
 177                 }
 178
 179                 if (/^Fl$/) {
 180                         $retval .= '\\fB\\-' . (shift @words) . '\\fR';
 181                         $nospace = 1
 182                                 if (! $nospace && $words[0] =~ m/^[\.,]/);
 183                         next;
 184                 }
 185
 186                 if (/^Ar$/) {
 187                         $retval .= '\\fI';
 188                         if (! defined $words[0])
 189                         {
 190                                 $retval .= 'file ...\\fR';
 191                         }
 192                         $arg = 1;
 193                         $nospace = 1
 194                                 if (! $nospace);
 195                         next;
 196                 }
 197
 198                 if (/^Cm$/) {
 199                         $retval .= '\\fB' . (shift @words) . '\\fR';
 200                         next;
 201                 }
 202
 203                 if (/^Op$/) {
 204                         $option = 1;
 205                         $nospace = 1
 206                                 if (! $nospace);
 207                         $retval .= '[';
 208                         next;
 209                 }
 210
 211                 if (/^Oo$/) {
 212                         $retval .= "[\\c\n";
 213                         next;
 214                 }
 215
 216                 if (/^Oc$/) {
 217                         $retval .= ']';
 218                         next;
 219                 }
 220
 221                 if (/^Pp$/) {
 222                         if ($optlist) {
 223                                 $retval .= "\n";
 224                         } else {
 225                                 $retval .= '.LP';
 226                         }
 227                         next;
 228                 }
 229
 230                 if (/^Ss$/) {
 231                         $retval .= '.SS';
 232                         next;
 233                 }
 234
 235                 if (/^Pa$/ && ! $option) {
 236                         $retval .= '\\fI';
 237                         $retval .= '\\&'
 238                                 if ($words[0] =~ m/^\./);
 239                         $retval .= (shift @words) . '\\fR';
 240                         $nospace = 1
 241                                 if (! $nospace && $words[0] =~ m/^[\.,]/);
 242                         next;
 243                 }
 244
 245                 if (/^Dv$/) {
 246                         $retval .= '.BR';
 247                         next;
 248                 }
 249
 250                 if (/^(Em|Ev)$/) {
 251                         $retval .= '.IR';
 252                         next;
 253                 }
 254
 255                 if (/^Pq$/) {
 256                         $retval .= '(';
 257                         $nospace = 1;
 258                         $parens = 1;
 259                         next;
 260                 }
 261
 262                 if (/^(S[xy])$/) {
 263                         $retval .= '.B ' . join(' ', @words);
 264                         last;
 265                 }
 266
 267                 if (/^Ic$/)
 268                 {
 269                         $retval .= '\\fB';
 270                         while (defined $words[0]
 271                                 && $words[0] !~ m/^[\.,]/)
 272                         {
 273                                 $retval .= shift @words;
 274                                 $retval .= ' '
 275                                         if (! $nospace);
 276                         }
 277                         $retval =~ s/ $//;
 278                         $retval .= '\\fR';
 279                         $retval .= shift @words
 280                                 if (defined $words[0]);
 281                         last;
 282                 }
 283
 284                 if (/^Bl$/) {
 285                         if ($words[0] eq '-bullet') {
 286                                 $optlist = 1;
 287                         } elsif ($words[0] eq '-enum') {
 288                                 $optlist = 2;
 289                                 $enum = 0;
 290                         } elsif ($words[0] eq '-tag') {
 291                                 $optlist = 3;
 292                         }
 293                         last;
 294                 }
 295
 296                 if (/^El$/) {
 297                         $optlist = 0;
 298                         next;
 299                 }
 300
 301                 if ($optlist && /^It$/) {
 302                         if ($optlist == 1) {
 303                                 # bullets
 304                                 $retval .= '.IP \\(bu';
 305                                 next;
 306                         }
 307
 308                         if ($optlist == 2) {
 309                                 # enum
 310                                 $retval .= '.IP ' . (++$enum) . '.';
 311                                 next;
 312                         }
 313
 314                         if ($optlist == 3) {
 315                                 # tags
 316                                 $retval .= ".TP\n";
 317                                 if ($words[0] =~ m/^(Pa|Ev)$/)
 318                                 {
 319                                         shift @words;
 320                                         $retval .= '.B';
 321                                 }
 322                                 next;
 323                         }
 324
 325                         next;
 326                 }
 327
 328                 if (/^Sm$/) {
 329                         if ($words[0] eq 'off') {
 330                                 $nospace = 2;
 331                         } elsif ($words[0] eq 'on') {
 332                                 $retval .= "\n";
 333                                 $nospace = 0;
 334                         }
 335                         shift @words;
 336                         next;
 337                 }
 338
 339                 $retval .= "$_";
 340         }
 341
 342         return undef
 343                 if ($retval eq '.');
 344
 345         $retval =~ s/^\.([^a-zA-Z])/$1/;
 346         $retval =~ s/ $//;
 347
 348         $retval .= ')'
 349                 if ($parens == 1);
 350
 351         $retval .= ']'
 352                 if ($option == 1);
 353
 354         $retval .= '\\fR'
 355                 if ($arg);
 356
 357         $retval .= '\\c'
 358                 if ($nospace && $retval ne '' && $retval !~ m/\n$/);
 359
 360         $retval .= "\n"
 361                 if ($retval ne '' && $retval !~ m/\n$/);
 362
 363         return $retval;
 364 }