src/roff/grog/subs.pl

   1 #! /usr/bin/env perl
   2 # grog - guess options for groff command
   3 # Inspired by doctype script in Kernighan & Pike, Unix Programming
   4 # Environment, pp 306-8.
   5
   6 # Source file position: <groff-source>/src/roff/grog/subs.pl
   7 # Installed position: <prefix>/lib/grog/subs.pl
   8
   9 # Copyright (C) 1993-2014  Free Software Foundation, Inc.
  10 # This file was split from grog.pl and put under GPL2 by
  11 #               Bernd Warken <groff-bernd.warken-72@web.de>.
  12 # The macros for identifying the devices were taken from Ralph
  13 # Corderoy's `grog.sh' of 2006.
  14
  15 # This file is part of `grog', which is part of `groff'.
  16
  17 # `groff' is free software; you can redistribute it and/or modify it
  18 # under the terms of the GNU General Public License as published by
  19 # the Free Software Foundation, either version 2 of the License, or
  20 # (at your option) any later version.
  21
  22 # `groff' is distributed in the hope that it will be useful, but
  23 # WITHOUT ANY WARRANTY; without even the implied warranty of
  24 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  25 # General Public License for more details.
  26
  27 # You can get the license text for the GNU General Public License
  28 # version 2 in the internet at
  29 # <http://www.gnu.org/licenses/gpl-2.0.html>.
  30
  31 ########################################################################
  32
  33 require v5.6;
  34
  35 use warnings;
  36 use strict;
  37
  38 use File::Spec;
  39
  40 # printing of hashes: my %hash = ...; print Dumper(\%hash);
  41 use Data::Dumper;
  42
  43 $\ = "\n";
  44
  45 # my $Sp = "[\\s\\n]";
  46 # my $Sp = qr([\s\n]);
  47 # my $Sp = '' if $arg eq '-C';
  48 my $Sp = '';
  49
  50 # from `src/roff/groff/groff.cpp' near `getopt_long'
  51 my $groff_opts =
  52   'abcCd:D:eEf:F:gGhiI:jJkK:lL:m:M:n:No:pP:r:RsStT:UvVw:W:XzZ';
  53
  54 my @Command = ();               # stores the final output
  55 my @Mparams = ();               # stores the options `-m*'
  56 my @devices = ();
  57 my $do_run = 0;                 # run generated `groff' command
  58 my $pdf_with_ligatures = 0;     # `-P-y -PU' for `pdf' device
  59 my $with_warnings = 0;
  60
  61 my $Prog = $0;
  62 {
  63   my ($v, $d, $f) = File::Spec->splitpath($Prog);
  64   $Prog = $f;
  65 }
  66
  67
  68 my %macros;
  69 my %Groff =
  70   (
  71    # preprocessors
  72    'chem' => 0,
  73    'eqn' => 0,
  74    'gperl' => 0,
  75    'grap' => 0,
  76    'grn' => 0,
  77    'gideal' => 0,
  78    'gpinyin' => 0,
  79    'lilypond' => 0,
  80
  81    'pic' => 0,
  82    'PS' => 0,           # opening for pic
  83    'PF' => 0,           # alternative opening for pic
  84    'PE' => 0,           # closing for pic
  85
  86    'refer' => 0,
  87    'refer_open' => 0,
  88    'refer_close' => 0,
  89    'soelim' => 0,
  90    'tbl' => 0,
  91
  92    # tmacs
  93 #   'man' => 0,
  94 #   'mandoc' => 0,
  95 #   'mdoc' => 0,
  96 #   'mdoc_old' => 0,
  97 #   'me' => 0,
  98 #   'mm' => 0,
  99 #   'mom' => 0,
 100 #   'ms' => 0,
 101
 102    # requests
 103    'AB' => 0,           # ms
 104    'AE' => 0,           # ms
 105    'AI' => 0,           # ms
 106    'AU' => 0,           # ms
 107    'NH' => 0,           # ms
 108    'TL' => 0,           # ms
 109    'UL' => 0,           # ms
 110    'XP' => 0,           # ms
 111
 112    'IP' => 0,           # man and ms
 113    'LP' => 0,           # man and ms
 114    'P' => 0,            # man and ms
 115    'PP' => 0,           # man and ms
 116    'SH' => 0,           # man and ms
 117
 118    'OP' => 0,           # man
 119    'SS' => 0,           # man
 120    'SY' => 0,           # man
 121    'TH' => 0,           # man
 122    'TP' => 0,           # man
 123    'UR' => 0,           # man
 124    'YS' => 0,           # man
 125
 126    # for mdoc and mdoc-old
 127    # .Oo and .Oc for modern mdoc, only .Oo for mdoc-old
 128    'Oo' => 0,           # mdoc and mdoc-old
 129    'Oc' => 0,           # mdoc
 130    'Dd' => 0,           # mdoc
 131   ); # end of %Groff
 132
 133
 134 # for first line check
 135 my %preprocs_tmacs =
 136   (
 137    'chem' => 0,
 138    'eqn' => 0,
 139    'gideal' => 0,
 140    'gpinyin' => 0,
 141    'grap' => 0,
 142    'grn' => 0,
 143    'pic' => 0,
 144    'refer' => 0,
 145    'soelim' => 0,
 146    'tbl' => 0,
 147
 148    'geqn' => 0,
 149    'gpic' => 0,
 150    'neqn' => 0,
 151
 152    'man' => 0,
 153    'mandoc' => 0,
 154    'mdoc' => 0,
 155    'mdoc-old' => 0,
 156    'me' => 0,
 157    'mm' => 0,
 158    'mom' => 0,
 159    'ms' => 0,
 160   );
 161
 162 my @filespec;
 163
 164 my $tmac_ext = '';
 165
 166
 167 ########################################################################
 168 # handle_args()
 169 ########################################################################
 170
 171 sub handle_args {
 172   my $double_minus = 0;
 173   my $was_minus = 0;
 174   my $was_T = 0;
 175   my $optarg = 0;
 176   # globals: @filespec, @Command, @devices, @Mparams
 177
 178   foreach my $arg (@ARGV) {
 179
 180     if ( $optarg ) {
 181       push @Command, $arg;
 182       $optarg = 0;
 183       next;
 184     }
 185
 186     if ( $double_minus ) {
 187       if (-f $arg && -r $arg) {
 188         push @filespec, $arg;
 189       } else {
 190         print STDERR __FILE__ . ' ' .  __LINE__ . ': ' .
 191           "grog: $arg is not a readable file.";
 192       }
 193       next;
 194     }
 195
 196     if ( $was_T ) {
 197       push @devices, $arg;
 198       $was_T = 0;
 199       next;
 200     }
 201 ####### handle_args()
 202
 203     unless ( $arg =~ /^-/ ) { # file name, no opt, no optarg
 204       unless (-f $arg && -r $arg) {
 205         print 'unknown file name: ' . $arg;
 206       }
 207       push @filespec, $arg;
 208       next;
 209     }
 210
 211     # now $arg starts with `-'
 212
 213     if ($arg eq '-') {
 214       unless ($was_minus) {
 215         push @filespec, $arg;
 216         $was_minus = 1;
 217       }
 218       next;
 219     }
 220
 221     if ($arg eq '--') {
 222       $double_minus = 1;
 223       push(@filespec, $arg);
 224       next;
 225     }
 226
 227     &version() if $arg =~ /^--?v/;      # --version, with exit
 228     &help() if $arg  =~ /--?h/;         # --help, with exit
 229
 230     if ( $arg =~ /^--r/ ) {             #  --run, no exit
 231       $do_run = 1;
 232       next;
 233     }
 234
 235     if ( $arg =~ /^--wa/ ) {            #  --warnings, no exit
 236       $with_warnings = 1;
 237       next;
 238     }
 239 ####### handle_args()
 240
 241     if ( $arg =~ /^--(wi|l)/ ) { # --ligatures, no exit
 242       # the old --with_ligatures is only kept for compatibility
 243       $pdf_with_ligatures = 1;
 244       next;
 245     }
 246
 247     if ($arg =~ /^-m/) {
 248       push @Mparams, $arg;
 249       next;
 250     }
 251
 252     if ($arg =~ /^-T$/) {
 253       $was_T = 1;
 254       next;
 255     }
 256
 257     if ($arg =~ s/^-T(\w+)$/$1/) {
 258       push @devices, $1;
 259       next;
 260     }
 261
 262     if ($arg =~ /^-(\w)(\w*)$/) {       # maybe a groff option
 263       my $opt_char = $1;
 264       my $opt_char_with_arg = $opt_char . ':';
 265       my $others = $2;
 266       if ( $groff_opts =~ /$opt_char_with_arg/ ) {      # groff optarg
 267         if ( $others ) {        # optarg is here
 268           push @Command, '-' . $opt_char;
 269           push @Command, '-' . $others;
 270           next;
 271         }
 272         # next arg is optarg
 273         $optarg = 1;
 274         next;
 275 ####### handle_args()
 276       } elsif ( $groff_opts =~ /$opt_char/ ) {  # groff no optarg
 277         push @Command, '-' . $opt_char;
 278         if ( $others ) {        # $others is now an opt collection
 279           $arg = '-' . $others;
 280           redo;
 281         }
 282         # arg finished
 283         next;
 284       } else {          # not a groff opt
 285         print STDERR __FILE__ . ' '  . __LINE__ . ': ' .
 286           'unknown argument ' . $arg;
 287         push(@Command, $arg);
 288         next;
 289       }
 290     }
 291   }
 292   @filespec = ('-') unless (@filespec);
 293 } # handle_args()
 294
 295
 296
 297 ########################################################################
 298 # handle_file_ext()
 299 ########################################################################
 300
 301 sub handle_file_ext {
 302   # get tmac from file name extension
 303   # output number of found single tmac
 304
 305   # globals: @filespec, $tmac_ext;
 306
 307   foreach my $file ( @filespec ) {
 308     # test for each file name in the arguments
 309     unless ( open(FILE, $file eq "-" ? $file : "< $file") ) {
 310       print STDERR __FILE__ . ' ' .  __LINE__ . ': ' .
 311         "$Prog: can't open \`$file\': $!";
 312       next;
 313     }
 314
 315     next unless ( $file =~ /\./ ); # file name has no dot `.'
 316
 317 ##### handle_file_ext()
 318     # get extension
 319     my $ext = $file;
 320     $ext =~ s/^
 321               .*
 322               \.
 323               ([^.]*)
 324               $
 325              /$1/x;
 326     next unless ( $ext );
 327
 328 ##### handle_file_ext()
 329     # these extensions are correct, but not based on a tmac
 330     next if ( $ext =~ /^(
 331                          chem|
 332                          eqn|
 333                          pic|
 334                          tbl|
 335                          ref|
 336                          t|
 337                          tr|
 338                          g|
 339                          groff|
 340                          roff|
 341                          www|
 342                          hdtbl|
 343                          grap|
 344                          grn|
 345                          pdfroff|
 346                          pinyin
 347                        )$/x );
 348
 349 ##### handle_file_ext()
 350     # extensions for man tmac
 351     if ( $ext =~ /^(
 352                       [1-9lno]|
 353                       man|
 354                       n|
 355                       1b
 356                     )$/x ) {
 357       # `man|n' from `groff' source
 358       # `1b' from `heirloom'
 359       # `[1-9lno]' from man-pages
 360       if ( $tmac_ext && $tmac_ext ne 'man' ) {
 361         # found tmac is not 'man'
 362         print STDERR __FILE__ . ' ' .  __LINE__ . ': ' .
 363           '2 different file name extensions found ' .
 364             $tmac_ext . ' and ' . $ext;
 365         $tmac_ext = '';
 366         next;
 367       }
 368
 369 ##### handle_file_ext()
 370       $tmac_ext = 'man';
 371       next;
 372     }
 373
 374     if ( $ext =~ /^(
 375                     mandoc|
 376                     mdoc|
 377                     me|
 378                     mm|
 379                     mmse|
 380                     mom|
 381                     ms|
 382                     $)/x ) {
 383       if ( $tmac_ext && $tmac_ext ne $ext ) {
 384         # found tmac is not identical to former found tmac
 385 ##### handle_file_ext()
 386         print STDERR __FILE__ . ' ' .  __LINE__ . ': ' .
 387           '2 different file name extensions found ' .
 388             $tmac_ext . ' and ' . $ext;
 389         $tmac_ext = '';
 390         next;
 391       }
 392
 393       $tmac_ext = $ext;
 394       next;
 395     }
 396
 397     print STDERR __FILE__ . ' ' .  __LINE__ . ': ' .
 398       'Unknown file name extension '. $file . '.';
 399     next;
 400   } # end foreach file
 401
 402   1;
 403 } # handle_file_ext()
 404
 405
 406 ########################################################################
 407 # handle_whole_files()
 408 ########################################################################
 409
 410 sub handle_whole_files {
 411   # globals: @filespec
 412
 413   foreach my $file ( @filespec ) {
 414     unless ( open(FILE, $file eq "-" ? $file : "< $file") ) {
 415       print STDERR __FILE__ . ' ' .  __LINE__ . ': ' .
 416         "$Prog: can't open \`$file\': $!";
 417       next;
 418     }
 419     my $line = <FILE>; # get single line
 420
 421     unless ( defined($line) ) {
 422       # empty file, go to next filearg
 423       close (FILE);
 424       next;
 425     }
 426
 427     if ( $line ) {
 428       chomp $line;
 429       unless ( &do_first_line( $line, $file ) ) {
 430         # not an option line
 431         &do_line( $line, $file );
 432       }
 433     } else { # emptry line
 434       next;
 435     }
 436
 437     while (<FILE>) { # get lines by and by
 438       chomp;
 439       &do_line( $_, $file );
 440     }
 441     close(FILE);
 442   } # end foreach
 443 } # handle_whole_files()
 444
 445
 446 ########################################################################
 447 # do_first_line()
 448 ########################################################################
 449
 450 # As documented for the `man' program, the first line can be
 451 # used as a groff option line.  This is done by:
 452 # - start the line with '\" (apostrophe, backslash, double quote)
 453 # - add a space character
 454 # - a word using the following characters can be appended: `egGjJpRst'.
 455 #     Each of these characters means an option for the generated
 456 #     `groff' command line, e.g. `-t'.
 457
 458 sub do_first_line {
 459   my ( $line, $file ) = @_;
 460
 461   # globals: %preprocs_tmacs
 462
 463   # For a leading groff options line use only [egGjJpRst]
 464   if  ( $line =~ /^[.']\\"[\segGjJpRst]+&/ ) {
 465     # this is a groff options leading line
 466     if ( $line =~ /^\./ ) {
 467       # line is a groff options line with . instead of '
 468       print "First line in $file must start with an apostrophe \ " .
 469         "instead of a period . for groff options line!";
 470     }
 471
 472     if ( $line =~ /j/ ) {
 473       $Groff{'chem'}++;
 474     }
 475     if ( $line =~ /e/ ) {
 476       $Groff{'eqn'}++;
 477     }
 478     if ( $line =~ /g/ ) {
 479       $Groff{'grn'}++;
 480     }
 481     if ( $line =~ /G/ ) {
 482       $Groff{'grap'}++;
 483     }
 484     if ( $line =~ /i/ ) {
 485       $Groff{'gideal'}++;
 486     }
 487     if ( $line =~ /p/ ) {
 488       $Groff{'pic'}++;
 489     }
 490     if ( $line =~ /R/ ) {
 491       $Groff{'refer'}++;
 492     }
 493     if ( $line =~ /s/ ) {
 494       $Groff{'soelim'}++;
 495     }
 496 ####### do_first_line()
 497     if ( $line =~ /t/ ) {
 498       $Groff{'tbl'}++;
 499     }
 500     return 1;   # a leading groff options line, 1 means yes, 0 means no
 501   }
 502
 503   # not a leading short groff options line
 504
 505   return 0 if ( $line !~ /^[.']\\"\s*(.*)$/ );  # ignore non-comments
 506
 507   return 0 unless ( $1 );       # for empty comment
 508
 509   # all following array members are either preprocs or 1 tmac
 510   my @words = split '\s+', $1;
 511
 512   my @in = ();
 513   my $word;
 514   for $word ( @words ) {
 515     if ( $word eq 'ideal' ) {
 516       $word = 'gideal';
 517     } elsif ( $word eq 'gpic' ) {
 518       $word = 'pic';
 519     } elsif ( $word =~ /^(gn|)eqn$/ ) {
 520       $word = 'eqn';
 521     }
 522     if ( exists $preprocs_tmacs{$word} ) {
 523       push @in, $word;
 524     } else {
 525       # not word for preproc or tmac
 526       return 0;
 527     }
 528   }
 529
 530   for $word ( @in ) {
 531     $Groff{$word}++;
 532   }
 533 } # do_first_line()
 534
 535
 536 ########################################################################
 537 # do_line()
 538 ########################################################################
 539
 540 sub do_line {
 541   my ( $line, $file ) = @_;
 542
 543   return if ( $line =~ /^[.']\s*\\"/ ); # comment
 544
 545   return unless ( $line =~ /^[.']/ );   # ignore text lines
 546
 547   $line =~ s/^['.]\s*/./;       # let only a dot as leading character,
 548                                 # remove spaces after the leading dot
 549   $line =~ s/\s+$//;            # remove final spaces
 550
 551   return if ( $line =~ /^\.$/ );        # ignore .
 552   return if ( $line =~ /^\.\.$/ );      # ignore ..
 553
 554   # split command
 555   $line =~ /^(\.\w+)\s*(.*)$/;
 556   my $command = $1;
 557   $command = '' unless ( defined $command );
 558   my $args = $2;
 559   $args = '' unless ( defined $args );
 560
 561
 562   ######################################################################
 563   # soelim
 564   if ( $line =~ /^\.(do)?\s*(so|mso|PS\s*<|SO_START).*$/ ) {
 565     # `.so', `.mso', `.PS<...', `.SO_START'
 566     $Groff{'soelim'}++;
 567     return;
 568   }
 569   if ( $line =~ /^\.(do)?\s*(so|mso|PS\s*<|SO_START).*$/ ) {
 570     # `.do so', `.do mso', `.do PS<...', `.do SO_START'
 571     $Groff{'soelim'}++;
 572     return;
 573   }
 574 ####### do_line()
 575
 576   ######################################################################
 577   # macros
 578
 579   if ( $line =~ /^\.de1?\W?/ ) {
 580     # this line is a macro definition, add it to %macros
 581     my $macro = $line;
 582     $macro =~ s/^\.de1?\s+(\w+)\W*/.$1/;
 583     return if ( exists $macros{$macro} );
 584     $macros{$macro} = 1;
 585     return;
 586   }
 587
 588
 589   # if line command is a defined macro, just ignore this line
 590   return if ( exists $macros{$command} );
 591
 592
 593   ######################################################################
 594   # preprocessors
 595
 596   if ( $command =~ /^(\.cstart)|(begin\s+chem)$/ ) {
 597     $Groff{'chem'}++;           # for chem
 598     return;
 599   }
 600   if ( $command =~ /^\.EQ$/ ) {
 601     $Groff{'eqn'}++;            # for eqn
 602     return;
 603   }
 604   if ( $command =~ /^\.G1$/ ) {
 605     $Groff{'grap'}++;           # for grap
 606     return;
 607   }
 608   if ( $command =~ /^\.Perl/ ) {
 609     $Groff{'gperl'}++;          # for gperl
 610     return;
 611   }
 612   if ( $command =~ /^\.pinyin/ ) {
 613     $Groff{'gpinyin'}++;                # for gperl
 614     return;
 615   }
 616   if ( $command =~ /^\.GS$/ ) {
 617     $Groff{'grn'}++;            # for grn
 618     return;
 619   }
 620   if ( $command =~ /^\.IS$/ ) {
 621     $Groff{'gideal'}++;         # preproc gideal for ideal
 622     return;
 623   }
 624   if ( $command =~ /^\.lilypond$/ ) {
 625     $Groff{'lilypond'}++;       # for glilypond
 626     return;
 627   }
 628
 629 ####### do_line()
 630
 631   # pic can be opened by .PS or .PF and closed by .PE
 632   if ( $command =~ /^\.PS$/ ) {
 633     $Groff{'pic'}++;            # normal opening for pic
 634     return;
 635   }
 636   if ( $command =~ /^\.PF$/ ) {
 637     $Groff{'PF'}++;             # alternate opening for pic
 638     return;
 639   }
 640   if ( $command =~ /^\.PE$/ ) {
 641     $Groff{'PE'}++;             # closing for pic
 642     return;
 643   }
 644
 645   if ( $command =~ /^\.R1$/ ) {
 646     $Groff{'refer'}++;          # for refer
 647     return;
 648   }
 649   if ( $command =~ /^\.\[$/ ) {
 650     $Groff{'refer_open'}++;     # for refer open
 651     return;
 652   }
 653   if ( $command =~ /^\.\]$/ ) {
 654     $Groff{'refer_close'}++;    # for refer close
 655     return;
 656   }
 657   if ( $command =~ /^\.TS$/ ) {
 658     $Groff{'tbl'}++;            # for tbl
 659     return;
 660   }
 661
 662
 663   ######################################################################
 664   # macro package (tmac)
 665   ######################################################################
 666
 667   ##########
 668   # modern mdoc
 669
 670   if ( $command =~ /^\.(Dd)$/ ) {
 671     $Groff{'Dd'}++;             # for modern mdoc
 672     return;
 673   }
 674
 675 ####### do_line()
 676   # In the old version of -mdoc `Oo' is a toggle, in the new it's
 677   # closed by `Oc'.
 678   if ( $command =~ /^\.Oc$/ ) {
 679     $Groff{'Oc'}++;             # only for modern mdoc
 680     return;
 681   }
 682
 683
 684   ##########
 685   # old and modern mdoc
 686
 687   if ( $command =~ /^\.Oo$/ ) {
 688     $Groff{'Oo'}++;             # for mdoc and mdoc-old
 689     return;
 690   }
 691
 692
 693   ##########
 694   # old mdoc
 695   if ( $command =~ /^\.(Tp|Dp|De|Cx|Cl)$/ ) {
 696     $Groff{'mdoc_old'}++;       # true for old mdoc
 697     return;
 698   }
 699
 700
 701   ##########
 702   # for ms
 703
 704 ####### do_line()
 705   if ( $command =~ /^\.AB$/ ) {
 706     $Groff{'AB'}++;             # for ms
 707     return;
 708   }
 709   if ( $command =~ /^\.AE$/ ) {
 710     $Groff{'AE'}++;             # for ms
 711     return;
 712   }
 713   if ( $command =~ /^\.AI$/ ) {
 714     $Groff{'AI'}++;             # for ms
 715     return;
 716   }
 717   if ( $command =~ /^\.AU$/ ) {
 718     $Groff{'AU'}++;             # for ms
 719     return;
 720   }
 721   if ( $command =~ /^\.NH$/ ) {
 722     $Groff{'NH'}++;             # for ms
 723     return;
 724   }
 725   if ( $command =~ /^\.TL$/ ) {
 726     $Groff{'TL'}++;             # for ms
 727     return;
 728   }
 729   if ( $command =~ /^\.XP$/ ) {
 730     $Groff{'XP'}++;             # for ms
 731     return;
 732   }
 733
 734
 735   ##########
 736   # for man and ms
 737
 738   if ( $command =~ /^\.IP$/ ) {
 739     $Groff{'IP'}++;             # for man and ms
 740     return;
 741   }
 742   if ( $command =~ /^\.LP$/ ) {
 743     $Groff{'LP'}++;             # for man and ms
 744     return;
 745   }
 746 ####### do_line()
 747   if ( $command =~ /^\.P$/ ) {
 748     $Groff{'P'}++;              # for man and ms
 749     return;
 750   }
 751   if ( $command =~ /^\.PP$/ ) {
 752     $Groff{'PP'}++;             # for man and ms
 753     return;
 754   }
 755   if ( $command =~ /^\.SH$/ ) {
 756     $Groff{'SH'}++;             # for man and ms
 757     return;
 758   }
 759   if ( $command =~ /^\.UL$/ ) {
 760     $Groff{'UL'}++;             # for man and ms
 761     return;
 762   }
 763
 764
 765   ##########
 766   # for man only
 767
 768   if ( $command =~ /^\.OP$/ ) { # for man
 769     $Groff{'OP'}++;
 770     return;
 771   }
 772   if ( $command =~ /^\.SS$/ ) { # for man
 773     $Groff{'SS'}++;
 774     return;
 775   }
 776   if ( $command =~ /^\.SY$/ ) { # for man
 777     $Groff{'SY'}++;
 778     return;
 779   }
 780   if ( $command =~ /^\.TH$/ ) {
 781     $Groff{'TH'}++;             # for man
 782     return;
 783   }
 784   if ( $command =~ /^\.TP$/ ) { # for man
 785     $Groff{'TP'}++;
 786     return;
 787   }
 788   if ( $command =~ /^\.UR$/ ) {
 789     $Groff{'UR'}++;             # for man
 790     return;
 791   }
 792   if ( $command =~ /^\.YS$/ ) { # for man
 793    $Groff{'YS'}++;
 794     return;
 795   }
 796 ####### do_line()
 797
 798
 799   ##########
 800   # me
 801
 802   if ( $command =~ /^\.(
 803                       [ilnp]p|
 804                       sh
 805                     )$/x ) {
 806     $Groff{'me'}++;             # for me
 807     return;
 808   }
 809
 810
 811   #############
 812   # mm and mmse
 813
 814   if ( $command =~ /^\.(
 815                       H|
 816                       MULB|
 817                       LO|
 818                       LT|
 819                       NCOL|
 820                       P\$|
 821                       PH|
 822                       SA
 823                     )$/x ) {
 824     $Groff{'mm'}++;             # for mm and mmse
 825     if ( $command =~ /^\.LO$/ ) {
 826       if ( $args =~ /^(DNAMN|MDAT|BIL|KOMP|DBET|BET|SIDOR)/ ) {
 827         $Groff{'mmse'}++;       # for mmse
 828       }
 829     } elsif ( $command =~ /^\.LT$/ ) {
 830       if ( $args =~ /^(SVV|SVH)/ ) {
 831         $Groff{'mmse'}++;       # for mmse
 832       }
 833     }
 834     return;
 835   }
 836 ####### do_line()
 837
 838   ##########
 839   # mom
 840
 841   if ( $line =~ /^\.(
 842                    ALD|
 843                    DOCTYPE|
 844                    FAMILY|
 845                    FT|
 846                    FAM|
 847                    LL|
 848                    LS|
 849                    NEWPAGE|
 850                    PAGE|
 851                    PAPER|
 852                    PRINTSTYLE|
 853                    PT_SIZE|
 854                    T_MARGIN
 855                  )$/x ) {
 856     $Groff{'mom'}++;            # for mom
 857     return;
 858   }
 859
 860 } # do_line()
 861
 862
 863 ########################################################################
 864 # sub make_groff_device
 865 ########################################################################
 866
 867 my @m = ();
 868 my @preprograms = ();
 869 my $correct_tmac = '';
 870
 871 sub make_groff_device {
 872   # globals: @devices
 873
 874   # default device is empty, i.e. it is `ps' when without `-T'
 875   return '' unless ( @devices );
 876
 877   for ( @devices ) {
 878     print STDERR __FILE__ . ' ' .  __LINE__ . ': ' .
 879       $_ . ': not a suitable device'
 880       unless (
 881               /^(
 882                  dvi|
 883                  html|
 884                  xhtml|
 885                  lbp|
 886                  lj4|
 887                  ps|
 888                  pdf|
 889                  ascii|
 890                  cp1047|
 891                  latin1|
 892                  utf8
 893                )$/x );
 894   }
 895
 896 ###### make_groff_device()
 897   my $device = pop( @devices );
 898   if ( @devices ) {
 899     for ( @devices ) {
 900       next if ( $_ eq $device );
 901       print STDERR __FILE__ . ' ' .  __LINE__ . ': ' .
 902         'additional device: ' . $_;
 903     }
 904     print STDERR __FILE__ . ' ' .  __LINE__ . ': ' .
 905       'device ' . $device . ' taken instead';
 906   }
 907
 908   return '' unless ( $device );
 909   push @Command, '-T';
 910   push @Command, $device;
 911
 912 ###### make_groff_device()
 913   if ( $device eq 'pdf' ) {
 914     if ( $pdf_with_ligatures ) {        # with --ligature argument
 915       push( @Command, '-P-y' );
 916       push( @Command, '-PU' );
 917     } else {    # no --ligature argument
 918       if ( $with_warnings ) {
 919         print STDERR <<EOF;
 920 If you have trouble with ligatures like `fi' in the `groff' output, you
 921 can proceed as one of
 922 - add `grog' option `--with_ligatures' or
 923 - use the `grog' option combination `-P-y -PU' or
 924 - try to remove the font named similar to `fonts-texgyre' from your system.
 925 EOF
 926       } # end of warning
 927     }   # end of ligature
 928   }     # end of pdf device
 929 } # make_groff_device()
 930
 931
 932 ########################################################################
 933 # make_groff_preproc()
 934 ########################################################################
 935
 936 sub make_groff_preproc {
 937   # globals: %Groff, @preprograms, @Command
 938
 939   # preprocessors without `groff' option
 940   if ( $Groff{'lilypond'} ) {
 941     push @preprograms, 'glilypond';
 942   }
 943   if ( $Groff{'gperl'} ) {
 944     push @preprograms, 'gperl';
 945   }
 946   if ( $Groff{'gpinyin'} ) {
 947     push @preprograms, 'gpinyin';
 948   }
 949
 950   # preprocessors with `groff' option
 951   if ( ( $Groff{'PS'} ||  $Groff{'PF'} ) &&  $Groff{'PE'} ) {
 952     $Groff{'pic'} = 1;
 953   }
 954   if ( $Groff{'gideal'} ) {
 955     $Groff{'pic'} = 1;
 956   }
 957
 958 ###### make_groff_preproc()
 959   $Groff{'refer'} ||= $Groff{'refer_open'} && $Groff{'refer_close'};
 960
 961   if ( $Groff{'chem'} || $Groff{'eqn'} ||  $Groff{'gideal'} ||
 962        $Groff{'grap'} || $Groff{'grn'} || $Groff{'pic'} ||
 963        $Groff{'refer'} || $Groff{'tbl'} ) {
 964     push(@Command, '-s') if $Groff{'soelim'};
 965
 966     push(@Command, '-R') if $Groff{'refer'};
 967
 968     push(@Command, '-t') if $Groff{'tbl'};      # tbl before eqn
 969     push(@Command, '-e') if $Groff{'eqn'};
 970
 971     push(@Command, '-j') if $Groff{'chem'};     # chem produces pic code
 972     push(@Command, '-J') if $Groff{'gideal'};   # gideal produces pic
 973     push(@Command, '-G') if $Groff{'grap'};
 974     push(@Command, '-g') if $Groff{'grn'};      # gremlin files for -me
 975     push(@Command, '-p') if $Groff{'pic'};
 976
 977   }
 978 } # make_groff_preproc()
 979
 980
 981 ########################################################################
 982 # make_groff_tmac_man_ms()
 983 ########################################################################
 984
 985 sub make_groff_tmac_man_ms {
 986   # globals: @filespec, $tmac_ext, %Groff
 987
 988   # `man' requests, not from `ms'
 989   if ( $Groff{'SS'} || $Groff{'SY'} || $Groff{'OP'} ||
 990        $Groff{'TH'} || $Groff{'TP'} || $Groff{'UR'} ) {
 991     $Groff{'man'} = 1;
 992     push(@m, '-man');
 993
 994     $tmac_ext = 'man' unless ( $tmac_ext );
 995     &err('man requests found, but file name extension ' .
 996          'was: ' . $tmac_ext) unless ( $tmac_ext eq 'man' );
 997     $tmac_ext = 'man';
 998     return 1;   # true
 999   }
1000
1001 ###### make_groff_tmac_man_ms()
1002   # `ms' requests, not from `man'
1003   if (
1004       $Groff{'1C'} || $Groff{'2C'} ||
1005       $Groff{'AB'} || $Groff{'AE'} || $Groff{'AI'} || $Groff{'AU'} ||
1006       $Groff{'BX'} || $Groff{'CD'} || $Groff{'DA'} || $Groff{'DE'} ||
1007       $Groff{'DS'} || $Groff{'LD'} || $Groff{'ID'} || $Groff{'NH'} ||
1008       $Groff{'TL'} || $Groff{'UL'} || $Groff{'XP'}
1009      ) {
1010     $Groff{'ms'} = 1;
1011     push(@m, '-ms');
1012
1013     $tmac_ext = 'ms' unless ( $tmac_ext );
1014     &err('ms requests found, but file name extension ' .
1015          'was: ' . $tmac_ext) unless ( $tmac_ext eq 'ms' );
1016     $tmac_ext = 'ms';
1017     return 1;   # true
1018   }
1019
1020 ###### make_groff_tmac_man_ms()
1021
1022   # both `man' and `ms' requests
1023   if ( $Groff{'P'} || $Groff{'IP'}  ||
1024        $Groff{'LP'} || $Groff{'PP'} || $Groff{'SH'} ) {
1025     if ( $tmac_ext eq 'man' ) {
1026       $Groff{'man'} = 1;
1027       push(@m, '-man');
1028       return 1; # true
1029     } elsif ( $tmac_ext eq 'ms' ) {
1030       $Groff{'ms'} = 1;
1031       push(@m, '-ms');
1032       return 1; # true
1033     }
1034     return 0;
1035   }
1036 } # make_groff_tmac_man_ms()
1037
1038
1039
1040 ########################################################################
1041 # make_groff_tmac_others()
1042 ########################################################################
1043
1044 sub make_groff_tmac_others {
1045   # globals: @filespec, $tmac_ext, %Groff
1046
1047   # mdoc
1048   if ( ( $Groff{'Oo'} && $Groff{'Oc'} ) || $Groff{'Dd'} ) {
1049     $Groff{'Oc'} = 0;
1050     $Groff{'Oo'} = 0;
1051     push(@m, '-mdoc');
1052     return 1;   # true
1053   }
1054   if ( $Groff{'mdoc_old'} || $Groff{'Oo'} ) {
1055     push(@m, '-mdoc_old');
1056     return 1;   # true
1057   }
1058
1059   # me
1060   if ( $Groff{'me'} ) {
1061     push(@m, '-me');
1062     return 1;   # true
1063   }
1064
1065 ##### make_groff_tmac_others()
1066   # mm and mmse
1067   if ( $Groff{'mm'} ) {
1068     push(@m, '-mm');
1069     return 1;   # true
1070   }
1071   if ( $Groff{'mmse'} ) {       # Swedish mm
1072     push(@m, '-mmse');
1073     return 1;   # true
1074   }
1075
1076   # mom
1077   if ( $Groff{'mom'} ) {
1078     push(@m, '-mom');
1079     return 1;   # true
1080   }
1081 } # make_groff_tmac_others()
1082
1083
1084 ########################################################################
1085 # make_groff_line_rest()
1086 ########################################################################
1087
1088 sub make_groff_line_rest {
1089   my $file_args_included;       # file args now only at 1st preproc
1090   unshift @Command, 'groff';
1091   if ( @preprograms ) {
1092     my @progs;
1093     $progs[0] = shift @preprograms;
1094     push(@progs, @filespec);
1095     for ( @preprograms ) {
1096       push @progs, '|';
1097       push @progs, $_;
1098     }
1099     push @progs, '|';
1100     unshift @Command, @progs;
1101     $file_args_included = 1;
1102   } else {
1103     $file_args_included = 0;
1104   }
1105
1106   foreach (@Command) {
1107     next unless /\s/;
1108     # when one argument has several words, use accents
1109     $_ = "'" . $_ . "'";
1110   }
1111
1112
1113   ##########
1114   # -m arguments
1115   my $nr_m_guessed = scalar @m;
1116   if ( $nr_m_guessed > 1 ) {
1117     print STDERR __FILE__ . ' ' .  __LINE__ . ': ' .
1118       'argument for -m found: ' . @m;
1119   }
1120
1121 ###### make_groff_line()
1122
1123   my $nr_m_args = scalar @Mparams;      # m-arguments for grog
1124   my $last_m_arg = '';  # last provided -m option
1125   if ( $nr_m_args > 1 ) {
1126     # take the last given -m argument of grog call,
1127     # ignore other -m arguments and the found ones
1128     $last_m_arg = $Mparams[-1]; # take the last -m argument
1129     print STDERR __FILE__ . ' ' .  __LINE__ . ': ' .
1130       $Prog . ": more than 1 `-m' argument: @Mparams";
1131     print STDERR __FILE__ . ' ' .  __LINE__ . ': ' .
1132       'We take the last one: ' . $last_m_arg;
1133   } elsif ( $nr_m_args == 1 ) {
1134     $last_m_arg = $Mparams[0];
1135   }
1136
1137   my $final_m = '';
1138   if ( $last_m_arg ) {
1139     my $is_equal = 0;
1140     for ( @m ) {
1141       if ( $_ eq $last_m_arg ) {
1142         $is_equal = 1;
1143         last;
1144       }
1145       next;
1146     }   # end for @m
1147     if ( $is_equal ) {
1148       $final_m = $last_m_arg;
1149     } else {
1150       print STDERR __FILE__ . ' ' .  __LINE__ . ': ' .
1151         'Provided -m argument ' . $last_m_arg .
1152           ' differs from guessed -m args: ' . @m;
1153       print STDERR __FILE__ . ' ' .  __LINE__ . ': ' .
1154         'The argument is taken.';
1155       $final_m = $last_m_arg;
1156     }
1157 ###### make_groff_line()
1158   } else {      # no -m arg provided
1159     if ( $nr_m_guessed > 1 ) {
1160       print STDERR __FILE__ . ' ' .  __LINE__ . ': ' .
1161         'More than 1 -m arguments were guessed: ' . @m;
1162       print STDERR __FILE__ . ' ' .  __LINE__ . ': ' . 'Guessing stopped.';
1163       exit 1;
1164     } elsif ( $nr_m_guessed == 1 ) {
1165       $final_m = $m[0];
1166     } else {
1167       # no -m provided or guessed
1168     }
1169   }
1170   push @Command, $final_m if ( $final_m );
1171
1172   push(@Command, @filespec) unless ( $file_args_included );
1173
1174   #########
1175   # execute the `groff' command here with option `--run'
1176   if ( $do_run ) { # with --run
1177     print STDERR __FILE__ . ' ' .  __LINE__ . ': ' . "@Command";
1178     my $cmd = join ' ', @Command;
1179     system($cmd);
1180   } else {
1181     print "@Command";
1182   }
1183
1184   exit 0;
1185 } # make_groff_line()
1186
1187
1188 ########################################################################
1189 # sub help
1190 ########################################################################
1191
1192 sub help {
1193   print <<EOF;
1194 usage: grog [option]... [--] [filespec]...
1195
1196 "filespec" is either the name of an existing, readable file or "-" for
1197 standard input.  If no `filespec' is specified, standard input is
1198 assumed automatically.  All arguments after a `--' are regarded as file
1199 names, even if they start with a `-' character.
1200
1201 `option' is either a `groff' option or one of these:
1202
1203 -h|--help       print this uasge message and exit
1204 -v|--version    print version information and exit
1205
1206 -C              compatibility mode
1207 --ligatures     include options `-P-y -PU' for internal font, which
1208                 preserverses the ligatures like `fi'
1209 --run           run the checked-out groff command
1210 --warnings      display more warnings to standard error
1211
1212 All other options should be `groff' 1-character options.  These are then
1213 appended to the generated `groff' command line.  The `-m' options will
1214 be checked by `grog'.
1215
1216 EOF
1217   exit 0;
1218 } # help()
1219
1220
1221 ########################################################################
1222 # sub version
1223 ########################################################################
1224
1225 sub version {
1226   our %at_at;
1227   print "Perl version of GNU $Prog " .
1228     "in groff version " . $at_at{'GROFF_VERSION'};
1229   exit 0;
1230 } # version()
1231
1232
1233 1;
1234 ########################################################################
1235 ### Emacs settings
1236 # Local Variables:
1237 # mode: CPerl
1238 # End: