File: fixmacps.pl

package info (click to toggle)
psutils 1.17-15
  • links: PTS
  • area: main
  • in suites: woody
  • size: 420 kB
  • ctags: 189
  • sloc: ansic: 1,867; sh: 766; perl: 509; makefile: 218; lisp: 74
file content (94 lines) | stat: -rw-r--r-- 2,076 bytes parent folder | download | duplicates (8)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
@PERL@
# fixmacps: swap to sanitised appledict
#
# Copyright (C) Angus J. C. Duggan 1991-1995
# See file LICENSE for details.

$line = 0;			# keep line count
$dir = "@INCLUDE@";
$prefix = "md";
$default = "md71_0.ps";

while ($_ = shift(@ARGV)) {
   if (/^-d(ir)?$/)   { $dir = shift(@ARGV); }
   elsif (/^-n(ame)?$/)   { $prefix = shift(@ARGV); }
   else {
      unshift(@ARGV, $_);
      last;
   }
}

%fonts = ();
$nesting = 0;

while (<>) {
   if (/^%!/) {
      if (! $line) {
	 print;
      }
   } elsif (/^%%(Begin|Include)ProcSet: "?\(AppleDict md\)"? ([0-9]+) ([0-9]+)$/) {
      local($inc, $mdv, $mdr) = ($1, $2, $3);
      if (open(SANE, "<$dir/$prefix${mdv}_$mdr.ps") ||
	  open(SANE, "<$dir/$default")) {
	 $sane = <SANE>;
	 local($snv, $snr) =
	    $sane =~ /^%%BeginProcSet: \(AppleDict md\) ([0-9]+) ([0-9]+)$/;
	 if ($mdv == $snv && $mdr == $snr) {
	     if ( $inc eq "Include" ) {
		 print STDERR "Inserting ProcSet \"(AppleDict md)\" $snv $snr\n";
		 print $sane;
		 while(<SANE>) {
		     print;
		 }
		 close(SANE);
	     }
	     else {
		 print STDERR "Substituting ProcSet \"(AppleDict md)\" $snv $snr\n";
		 $ignore = 1;
	     }
	 } else {
	    print STDERR "Unrecognised AppleDict version $mdv $mdr\n";
	    print "%!\n" if !$line;
	    print;
	 }
      } else {
	 print STDERR "Can't find sanitised AppleDict\n";
	 print "%!\n" if !$line;
	 print;
      }
   } elsif (/^%%EndProcSet/) {
      if ($ignore) {
	 $ignore = 0;
	 print "%!\n" if !$line;
	 print $sane;
	 while(<SANE>) {
	    print;
	 }
	 close(SANE);
      } else {
	 print "%!\n" if !$line;
	 print;
      }
   } elsif (/^%%Page:/ && $nesting == 0) {
      print $_;
      print values(%fonts);
   } elsif (/^%%BeginDocument/ || /^%%BeginBinary/ || /^%%BeginFile/) {
      print $_;
      $nesting++;
   } elsif (/^%%EndDocument/ || /^%%EndBinary/ || /^%%EndFile/) {
      print $_;
      $nesting--;
   } else {
      if (! $ignore) {
	 if (/^\{\}mark .*rf$/) {
	    $fonts{$_} = $_;
	    print;
	 } else {
	    print "%!\n" if !$line;
	    print;
	 }
      }
   }
   $line++;
}
@END@