home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / PERL4036.ZIP / usub / man2mus < prev    next >
Text File  |  1993-02-08  |  1KB  |  67 lines
  1. #!/usr/bin/perl
  2. while (<>) {
  3.     if (/^\.SH SYNOPSIS/) {
  4.     $spec = '';
  5.     for ($_ = <>; $_ && !/^\.SH/; $_ = <>) {
  6.         s/^\.[IRB][IRB]\s*//;
  7.         s/^\.[IRB]\s+//;
  8.         next if /^\./;
  9.         s/\\f\w//g;
  10.         s/\\&//g;
  11.         s/^\s+//;
  12.         next if /^$/;
  13.         next if /^#/;
  14.         $spec .= $_;
  15.     }
  16.     $_ = $spec;
  17.     0 while s/\(([^),;]*)\s*,\s*([^);]*)\)/($1|$2)/g;
  18.     s/\(\*([^,;]*)\)\(\)/(*)()$1/g;
  19.     s/(\w+)\[\]/*$1/g;
  20.  
  21.     s/\n/ /g;
  22.     s/\s+/ /g;
  23.     s/(\w+) \(([^*])/$1($2/g;
  24.     s/^ //;
  25.     s/ ?; ?/\n/g;
  26.     s/\) /)\n/g;
  27.     s/ \* / \*/g;
  28.     s/\* / \*/g;
  29.  
  30.     $* = 1;
  31.     0 while s/^((struct )?\w+ )([^\n,]*), ?(.*)/$1$3\n$1$4/g;
  32.     $* = 0;
  33.     s/\|/,/g;
  34.  
  35.     @cases = ();
  36.     for (reverse split(/\n/,$_)) {
  37.         if (/\)$/) {
  38.         ($type,$name,$args) = split(/(\w+)\(/);
  39.         $type =~ s/ $//;
  40.         if ($type =~ /^(\w+) =/) {
  41.             $type = $type{$1} if $type{$1};
  42.         }
  43.         $type = 'int' if $type eq '';
  44.         @args = grep(/./, split(/[,)]/,$args));
  45.         $case = "CASE $type $name\n";
  46.         foreach $arg (@args) {
  47.             $type = $type{$arg} || "int";
  48.             $type =~ s/ //g;
  49.             $type .= "\t" if length($type) < 8;
  50.             if ($type =~ /\*/) {
  51.             $case .= "IO    $type    $arg\n";
  52.             }
  53.             else {
  54.             $case .= "I    $type    $arg\n";
  55.             }
  56.         }
  57.         $case .= "END\n\n";
  58.         unshift(@cases, $case);
  59.         }
  60.         else {
  61.         $type{$name} = $type if ($type,$name) = /(.*\W)(\w+)$/;
  62.         }
  63.     }
  64.     print @cases;
  65.     }
  66. }
  67.