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