home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / MacPerl 5.0.3 / MacPerl Source ƒ / MacPerl5 / BuildHelpIndex next >
Encoding:
Text File  |  1995-10-18  |  2.6 KB  |  117 lines  |  [TEXT/MPS ]
  1. Perl -Sx "{0}" {"Parameters"}
  2. Exit 0
  3.  
  4. #!perl -s
  5.  
  6. ($index = shift @ARGV) || die "No help index specified";
  7.  
  8. dbmopen(%INDEX, $index, 0666) || die "Couldn't open index file \"$index\"";
  9.  
  10. for (keys %INDEX) {
  11.     delete $INDEX{$_};
  12. }
  13.  
  14. while (<>) {
  15.     if (/\@menu/) {
  16.         &DoMenu();
  17.     } elsif (/\@index\s+(\S+)/) {
  18.         &DoIndex($1, $');
  19.     } elsif (/\S+/) {
  20.         die "Don't understand \"$&\"";
  21.     }
  22. }
  23.  
  24. if ($v) {
  25.     print "-----\n";
  26.     print $MENU;
  27.     print "-----\n";
  28.  
  29.     for (sort keys %INDEX) {
  30.         printf("%-20s %s\n", $_, $INDEX{$_});
  31.     }
  32. }
  33.  
  34. $INDEX{" MENU"} = $MENU;
  35. MacPerl::SetFileInfo('McPL', 'HELP', $index);
  36.  
  37. dbmclose %INDEX;
  38.  
  39. sub DoMenu {
  40.     $submenu = 0;
  41.     while (<>) {
  42.         if (/\@sep/) {
  43.             $MENU .= "-(\t\n";
  44.         } elsif (/\@sub\s+(\S.*\S)/) {
  45.             $MENU .= "$1\t!\n";
  46.             ++$submenu;
  47.         } elsif (/\@end/) {
  48.             $MENU .= "\n";
  49.             if (!$submenu--) {
  50.                 return;
  51.             }
  52.         } elsif (/(\S+)\s+(\S.*\S)/) {
  53.             $MENU .= "$2\t$1\n";
  54.         } elsif (/\S+/) {
  55.             die "Don't understand \"$&\"";
  56.         }
  57.     }
  58.     die "End of file while processing \@menu";
  59. }
  60.  
  61. sub DoIndex {
  62.     local($file, $var) = @_;
  63.     local(%rename, %alias);
  64.     
  65.     $url = $file;
  66.     if ($url =~ /^:/) {
  67.         $url = $';
  68.         $url =~ s|:|/|g;
  69.         $url = "file:$url";
  70.     } else {
  71.         $url =~ s|:|/|g;        
  72.         $url = "file://$url";
  73.     }
  74.     open(INDEX, $file) || die "Can't open index file \"$file\"";
  75.     $var = ($var =~ /\@var/);
  76.     while (<>) {
  77.         if (/\@end/) {
  78.             goto startindex;
  79.         } elsif (/\@index/) {
  80.             die "Forgot \@end";
  81.         } elsif (/\@rename\s+(\S+)\s+(\S+)/) {
  82.             warn "\"$2\" renamed both to \"$rename{$2}\" and \"$1\"" if $rename{$2};
  83.             $rename{$2} = $1;
  84.         } elsif (/\@alias\s+(\S+)\s+(\S+)/) {
  85.             warn "\"$1\" already aliased to \"$alias{$1}\"" if $alias{$1};
  86.             $alias{$1} = $2;
  87.         } elsif (/\@delete\s+(\S+)/) {
  88.             warn "\"$1\" both renamed to \"$rename{$1}\" and deleted" if $rename{$1};
  89.             $rename{$1} = "";
  90.         }
  91.     }
  92.     die "End of file while processing \@index";
  93. startindex:
  94.     while (<INDEX>) {
  95.         next unless /NAME\s*=\s*\"([^"]+)\"/;
  96.         ($name,$_) = ($1, $');
  97.         $key = $name;
  98.         $key =~ s/^perl[a-z]*_//;
  99.         if ($key =~ /_(\d+)/) {
  100.             redo unless !$1;    # Ignore all except _0
  101.             $key = $`;
  102.         }
  103.         $key = "\$\U$key\E" if $var;
  104.         $key = $rename{$key} if defined $rename{$key};
  105.         next unless $key;
  106.         warn "\"$key\" already defined as \"$INDEX{$key}\", redefined as \"$url#$name\""
  107.             if ($INDEX{$key} && $INDEX{$key} ne "$url#$name");
  108.         $INDEX{$key} = "$url#$name";
  109.     }
  110.     while (($key,$value) = each(%alias)) {
  111.         warn "\"$key\" already defined as \"$INDEX{$key}\", redefined as \"$INDEX{$value}\""
  112.             if ($INDEX{$key} && $INDEX{$key} ne $INDEX{$value});
  113.         warn "\"$value\" undefined" unless $INDEX{$value};
  114.         $INDEX{$key} = $INDEX{$value};
  115.     }
  116. }
  117.