psutils/fixmacps.pl

   1 @PERL@
   2 # fixmacps: swap to sanitised appledict
   3 #
   4 # Copyright (C) Angus J. C. Duggan 1991-1995
   5 # See file LICENSE for details.
   6
   7 $line = 0;                      # keep line count
   8 $dir = "@INCLUDE@";
   9 $prefix = "md";
  10 $default = "md71_0.ps";
  11
  12 while ($_ = shift(@ARGV)) {
  13    if (/^-d(ir)?$/)   { $dir = shift(@ARGV); }
  14    elsif (/^-n(ame)?$/)   { $prefix = shift(@ARGV); }
  15    else {
  16       unshift(@ARGV, $_);
  17       last;
  18    }
  19 }
  20
  21 %fonts = ();
  22 $nesting = 0;
  23
  24 while (<>) {
  25    if (/^%!/) {
  26       if (! $line) {
  27          print;
  28       }
  29    } elsif (/^%%(Begin|Include)ProcSet: "?\(AppleDict md\)"? ([0-9]+) ([0-9]+)$/) {
  30       local($inc, $mdv, $mdr) = ($1, $2, $3);
  31       if (open(SANE, "<$dir/$prefix${mdv}_$mdr.ps") ||
  32           open(SANE, "<$dir/$default")) {
  33          $sane = <SANE>;
  34          local($snv, $snr) =
  35             $sane =~ /^%%BeginProcSet: \(AppleDict md\) ([0-9]+) ([0-9]+)$/;
  36          if ($mdv == $snv && $mdr == $snr) {
  37              if ( $inc eq "Include" ) {
  38                  print STDERR "Inserting ProcSet \"(AppleDict md)\" $snv $snr\n";
  39                  print $sane;
  40                  while(<SANE>) {
  41                      print;
  42                  }
  43                  close(SANE);
  44              }
  45              else {
  46                  print STDERR "Substituting ProcSet \"(AppleDict md)\" $snv $snr\n";
  47                  $ignore = 1;
  48              }
  49          } else {
  50             print STDERR "Unrecognised AppleDict version $mdv $mdr\n";
  51             print "%!\n" if !$line;
  52             print;
  53          }
  54       } else {
  55          print STDERR "Can't find sanitised AppleDict\n";
  56          print "%!\n" if !$line;
  57          print;
  58       }
  59    } elsif (/^%%EndProcSet/) {
  60       if ($ignore) {
  61          $ignore = 0;
  62          print "%!\n" if !$line;
  63          print $sane;
  64          while(<SANE>) {
  65             print;
  66          }
  67          close(SANE);
  68       } else {
  69          print "%!\n" if !$line;
  70          print;
  71       }
  72    } elsif (/^%%Page:/ && $nesting == 0) {
  73       print $_;
  74       print values(%fonts);
  75    } elsif (/^%%BeginDocument/ || /^%%BeginBinary/ || /^%%BeginFile/) {
  76       print $_;
  77       $nesting++;
  78    } elsif (/^%%EndDocument/ || /^%%EndBinary/ || /^%%EndFile/) {
  79       print $_;
  80       $nesting--;
  81    } else {
  82       if (! $ignore) {
  83          if (/^\{\}mark .*rf$/) {
  84             $fonts{$_} = $_;
  85             print;
  86          } else {
  87             print "%!\n" if !$line;
  88             print;
  89          }
  90       }
  91    }
  92    $line++;
  93 }
  94 @END@