mdoc2man.pl

   1 #!/usr/bin/perl
   2 ###
   3 ### Quick usage:  mdoc2man.pl < mdoc_manpage.8 > man_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, $oldoptlist, $nospace, $enum, $synopsis);
  44 my ($reference, $block, $ext, $extopt, $literal);
  45 my (@refauthors, $reftitle, $refissue, $refdate, $refopt);
  46
  47
  48 $optlist = 0;           ### 1 = bullet, 2 = enum, 3 = tag, 4 = item
  49 $oldoptlist = 0;
  50 $nospace = 0;
  51 $synopsis = 0;
  52 $reference = 0;
  53 $block = 0;
  54 $ext = 0;
  55 $extopt = 0;
  56 $literal = 0;
  57
  58 while ($line = <STDIN>)
  59 {
  60         if ($line !~ /^\./)
  61         {
  62                 print $line;
  63                 print ".br\n"
  64                         if ($literal);
  65                 next;
  66         }
  67
  68         $line =~ s/^\.//;
  69
  70         next
  71                 if ($line =~ m/\\"/);
  72
  73         $line = ParseMacro($line);
  74         print($line)
  75                 if (defined $line);
  76 }
  77
  78
  79
  80 sub ParseMacro # ($line)
  81 {
  82         my ($line) = @_;
  83         my (@words, $retval, $option, $parens);
  84
  85         @words = split(/\s+/, $line);
  86         $retval = '';
  87         $option = 0;
  88         $parens = 0;
  89
  90 #       print('@words = ', scalar(@words), ': ', join(' ', @words), "\n");
  91
  92         while ($_ = shift @words)
  93         {
  94 #               print "WORD: $_\n";
  95
  96                 next
  97                         if (/^(Li|Pf)$/);
  98
  99                 if (/^Xo$/)
 100                 {
 101                         $ext = 1;
 102                         $retval .= ' '
 103                                 if ($retval ne '' && $retval !~ m/[\n ]$/);
 104                         next;
 105                 }
 106
 107                 if (/^Xc$/)
 108                 {
 109                         $ext = 0;
 110                         $retval .= "\n"
 111                                 if (! $extopt);
 112                         last;
 113                 }
 114
 115                 if (/^Bd$/)
 116                 {
 117                         $literal = 1
 118                                 if ($words[0] eq '-literal');
 119                         $retval .= "\n";
 120                         last;
 121                 }
 122
 123                 if (/^Ed$/)
 124                 {
 125                         $literal = 0;
 126                         last;
 127                 }
 128
 129                 if (/^Ns$/)
 130                 {
 131                         $nospace = 1
 132                                 if (! $nospace);
 133                         $retval =~ s/ $//;
 134                         next;
 135                 }
 136
 137                 if (/^No$/)
 138                 {
 139                         $retval =~ s/ $//;
 140                         $retval .= shift @words;
 141                         next;
 142                 }
 143
 144                 if (/^Dq$/)
 145                 {
 146                         $retval .= '``';
 147                         do
 148                         {
 149                                 $retval .= (shift @words) . ' ';
 150                         }
 151                         while (@words > 0 && $words[0] !~ m/^[\.,]/);
 152                         $retval =~ s/ $//;
 153                         $retval .= '\'\'';
 154                         $nospace = 1
 155                                 if (! $nospace && $words[0] =~ m/^[\.,]/);
 156                         next;
 157                 }
 158
 159                 if (/^(Sq|Ql)$/)
 160                 {
 161                         $retval .= '`' . (shift @words) . '\'';
 162                         $nospace = 1
 163                                 if (! $nospace && $words[0] =~ m/^[\.,]/);
 164                         next;
 165                 }
 166
 167 #               if (/^Ic$/)
 168 #               {
 169 #                       $retval .= '\\fB' . shift(@words) . '\\fP';
 170 #                       next;
 171 #               }
 172
 173                 if (/^Oo$/)
 174                 {
 175 #                       $retval .= "[\\c\n";
 176                         $extopt = 1;
 177                         $nospace = 1
 178                                 if (! $nospace);
 179                         $retval .= '[';
 180                         next;
 181                 }
 182
 183                 if (/^Oc$/)
 184                 {
 185                         $extopt = 0;
 186                         $retval .= ']';
 187                         next;
 188                 }
 189
 190                 $retval .= ' '
 191                         if (! $nospace && $retval ne '' && $retval !~ m/[\n ]$/);
 192                 $nospace = 0
 193                         if ($nospace == 1);
 194
 195                 if (/^Dd$/)
 196                 {
 197                         $date = join(' ', @words);
 198                         return undef;
 199                 }
 200
 201                 if (/^Dt$/)
 202                 {
 203                         $id = join(' ', @words);
 204                         return undef;
 205                 }
 206
 207                 if (/^Os$/)
 208                 {
 209                         $retval .= '.TH '
 210                                 . $id
 211                                 . " \"$date\" \""
 212                                 . join(' ', @words)
 213                                 . "\"";
 214                         last;
 215                 }
 216
 217                 if (/^Sh$/)
 218                 {
 219                         $retval .= '.SH';
 220                         if ($words[0] eq 'SYNOPSIS')
 221                         {
 222                                 $synopsis = 1;
 223                         }
 224                         else
 225                         {
 226                                 $synopsis = 0;
 227                         }
 228                         next;
 229                 }
 230
 231                 if (/^Xr$/)
 232                 {
 233                         $retval .= '\\fB' . (shift @words) .
 234                                 '\\fP(' . (shift @words) . ')'
 235                                 . (shift @words);
 236                         last;
 237                 }
 238
 239                 if (/^Rs/)
 240                 {
 241                         @refauthors = ();
 242                         $reftitle = '';
 243                         $refissue = '';
 244                         $refdate = '';
 245                         $refopt = '';
 246                         $reference = 1;
 247                         last;
 248                 }
 249
 250                 if (/^Re/)
 251                 {
 252                         $retval .= "\n";
 253
 254                         # authors
 255                         while (scalar(@refauthors) > 1)
 256                         {
 257                                 $retval .= shift(@refauthors) . ', ';
 258                         }
 259                         $retval .= 'and '
 260                                 if ($retval ne '');
 261                         $retval .= shift(@refauthors);
 262
 263                         # title
 264                         $retval .= ', \\fI' . $reftitle . '\\fP';
 265
 266                         # issue
 267                         $retval .= ', ' . $refissue
 268                                 if ($refissue ne '');
 269
 270                         # date
 271                         $retval .= ', ' . $refdate
 272                                 if ($refdate ne '');
 273
 274                         # optional info
 275                         $retval .= ', ' . $refopt
 276                                 if ($refopt ne '');
 277
 278                         $retval .= ".\n";
 279
 280                         $reference = 0;
 281                         last;
 282                 }
 283
 284                 if ($reference)
 285                 {
 286                         if (/^%A$/)
 287                         {
 288                                 unshift(@refauthors, join(' ', @words));
 289                                 last;
 290                         }
 291
 292                         if (/^%T$/)
 293                         {
 294                                 $reftitle = join(' ', @words);
 295                                 $reftitle =~ s/^"//;
 296                                 $reftitle =~ s/"$//;
 297                                 last;
 298                         }
 299
 300                         if (/^%N$/)
 301                         {
 302                                 $refissue = join(' ', @words);
 303                                 last;
 304                         }
 305
 306                         if (/^%D$/)
 307                         {
 308                                 $refdate = join(' ', @words);
 309                                 last;
 310                         }
 311
 312                         if (/^%O$/)
 313                         {
 314                                 $refopt = join(' ', @words);
 315                                 last;
 316                         }
 317                 }
 318
 319                 if (/^Nm$/)
 320                 {
 321                         $name = shift @words
 322                                 if (@words > 0);
 323                         $retval .= ".br\n"
 324                                 if ($synopsis);
 325                         $retval .= "\\fB$name\\fP";
 326                         $nospace = 1
 327                                 if (! $nospace && $words[0] =~ m/^[\.,]/);
 328                         next;
 329                 }
 330
 331                 if (/^Nd$/)
 332                 {
 333                         $retval .= '\\-';
 334                         next;
 335                 }
 336
 337                 if (/^Fl$/)
 338                 {
 339                         $retval .= '\\fB\\-' . (shift @words) . '\\fP';
 340                         $nospace = 1
 341                                 if (! $nospace && $words[0] =~ m/^[\.,]/);
 342                         next;
 343                 }
 344
 345                 if (/^Ar$/)
 346                 {
 347                         $retval .= '\\fI';
 348                         if (! defined $words[0])
 349                         {
 350                                 $retval .= 'file ...\\fP';
 351                         }
 352                         else
 353                         {
 354                                 $retval .= shift(@words) . '\\fP';
 355                                 while ($words[0] eq '|')
 356                                 {
 357                                         $retval .= ' ' . shift(@words);
 358                                         $retval .= ' \\fI' . shift(@words);
 359                                         $retval .= '\\fP';
 360                                 }
 361                         }
 362                         $nospace = 1
 363                                 if (! $nospace && $words[0] =~ m/^[\.,]/);
 364                         next;
 365                 }
 366
 367                 if (/^Cm$/)
 368                 {
 369                         $retval .= '\\fB' . (shift @words) . '\\fP';
 370                         while ($words[0] =~ m/^[\.,:)]$/)
 371                         {
 372                                 $retval .= shift(@words);
 373                         }
 374                         next;
 375                 }
 376
 377                 if (/^Op$/)
 378                 {
 379                         $option = 1;
 380                         $nospace = 1
 381                                 if (! $nospace);
 382                         $retval .= '[';
 383 #                       my $tmp = pop(@words);
 384 #                       $tmp .= ']';
 385 #                       push(@words, $tmp);
 386                         next;
 387                 }
 388
 389                 if (/^Pp$/)
 390                 {
 391                         $retval .= "\n";
 392                         next;
 393                 }
 394
 395                 if (/^Ss$/)
 396                 {
 397                         $retval .= '.SS';
 398                         next;
 399                 }
 400
 401                 if (/^Pa$/ && ! $option)
 402                 {
 403                         $retval .= '\\fI';
 404                         $retval .= '\\&'
 405                                 if ($words[0] =~ m/^\./);
 406                         $retval .= (shift @words) . '\\fP';
 407                         while ($words[0] =~ m/^[\.,:;)]$/)
 408                         {
 409                                 $retval .= shift(@words);
 410                         }
 411 #                       $nospace = 1
 412 #                               if (! $nospace && $words[0] =~ m/^[\.,:)]/);
 413                         next;
 414                 }
 415
 416                 if (/^Dv$/)
 417                 {
 418                         $retval .= '.BR';
 419                         next;
 420                 }
 421
 422                 if (/^(Em|Ev)$/)
 423                 {
 424                         $retval .= '.IR';
 425                         next;
 426                 }
 427
 428                 if (/^Pq$/)
 429                 {
 430                         $retval .= '(';
 431                         $nospace = 1;
 432                         $parens = 1;
 433                         next;
 434                 }
 435
 436                 if (/^(S[xy])$/)
 437                 {
 438                         $retval .= '.B ' . join(' ', @words);
 439                         last;
 440                 }
 441
 442                 if (/^Ic$/)
 443                 {
 444                         $retval .= '\\fB';
 445                         while (defined $words[0]
 446                                 && $words[0] !~ m/^[\.,]/)
 447                         {
 448                                 if ($words[0] eq 'Op')
 449                                 {
 450                                         shift(@words);
 451                                         $retval .= '[';
 452                                         my $tmp = pop(@words);
 453                                         $tmp .= ']';
 454                                         push(@words, $tmp);
 455                                         next;
 456                                 }
 457                                 if ($words[0] eq 'Ar')
 458                                 {
 459                                         shift @words;
 460                                         $retval .= '\\fI';
 461                                         $retval .= shift @words;
 462                                         $retval .= '\\fP';
 463                                 }
 464                                 else
 465                                 {
 466                                         $retval .= shift @words;
 467                                 }
 468                                 $retval .= ' '
 469                                         if (! $nospace);
 470                         }
 471                         $retval =~ s/ $//;
 472                         $retval .= '\\fP';
 473                         $retval .= shift @words
 474                                 if (defined $words[0]);
 475                         last;
 476                 }
 477
 478                 if (/^Bl$/)
 479                 {
 480                         $oldoptlist = $optlist;
 481                         if ($words[0] eq '-bullet')
 482                         {
 483                                 $optlist = 1;
 484                         }
 485                         elsif ($words[0] eq '-enum')
 486                         {
 487                                 $optlist = 2;
 488                                 $enum = 0;
 489                         }
 490                         elsif ($words[0] eq '-tag')
 491                         {
 492                                 $optlist = 3;
 493                         }
 494                         elsif ($words[0] eq '-item')
 495                         {
 496                                 $optlist = 4;
 497                         }
 498                         last;
 499                 }
 500
 501                 if (/^El$/)
 502                 {
 503                         $optlist = $oldoptlist;
 504                         next;
 505                 }
 506
 507                 if ($optlist && /^It$/)
 508                 {
 509                         if ($optlist == 1)
 510                         {
 511                                 # bullets
 512                                 $retval .= '.IP \\(bu';
 513                                 next;
 514                         }
 515
 516                         if ($optlist == 2)
 517                         {
 518                                 # enum
 519                                 $retval .= '.IP ' . (++$enum) . '.';
 520                                 next;
 521                         }
 522
 523                         if ($optlist == 3)
 524                         {
 525                                 # tags
 526                                 $retval .= ".TP\n";
 527                                 if ($words[0] =~ m/^(Pa|Ev)$/)
 528                                 {
 529                                         shift @words;
 530                                         $retval .= '.B';
 531                                 }
 532                                 next;
 533                         }
 534
 535                         if ($optlist == 4)
 536                         {
 537                                 # item
 538                                 $retval .= ".IP\n";
 539                                 next;
 540                         }
 541
 542                         next;
 543                 }
 544
 545                 if (/^Sm$/)
 546                 {
 547                         if ($words[0] eq 'off')
 548                         {
 549                                 $nospace = 2;
 550                         }
 551                         elsif ($words[0] eq 'on')
 552                         {
 553 #                               $retval .= "\n";
 554                                 $nospace = 0;
 555                         }
 556                         shift @words;
 557                         next;
 558                 }
 559
 560                 $retval .= "$_";
 561         }
 562
 563         return undef
 564                 if ($retval eq '.');
 565
 566         $retval =~ s/^\.([^a-zA-Z])/$1/;
 567 #       $retval =~ s/ $//;
 568
 569         $retval .= ')'
 570                 if ($parens == 1);
 571
 572         $retval .= ']'
 573                 if ($option == 1);
 574
 575 #       $retval .= ' '
 576 #               if ($nospace && $retval ne '' && $retval !~ m/\n$/);
 577
 578 #       $retval .= ' '
 579 #               if ($extended && $retval !~ m/ $/);
 580
 581         $retval .= ' '
 582                 if ($ext && ! $extopt && $retval !~ m/ $/);
 583
 584         $retval .= "\n"
 585                 if (! $ext && ! $extopt && $retval ne '' && $retval !~ m/\n$/);
 586
 587         return $retval;
 588 }
 589
 590