#! /usr/local/bin/perl -P
##########################################################
#
# Preprocess Common Lisp file for translation into Scheme.
#
##########################################################

# Get the name of a Common Lisp file to preprocess.
sub getfile {
  print STDOUT "\nFile name: ";
  <STDIN> =~ /(\w*)/;
  $file = $1;
}

sub filterfile {

  # Open the file for reading.
  open(INPUT, "<".$file.".lisp") || die "Could not open input file.\n";

  # Open the result file for writing.
  open(OUTPUT, ">".$file.".temp") || die "Could not open output file.\n";

  # Check for the Copyright-notice-at-the-end preamble.
  $_ = <INPUT>; 
  if (/;; Copyright/) {
    $_ = <INPUT>;
    if (/;; See end/) {
      # Print the Copyright preamble.
      &preamble;
    } else { die "No Copyright notice!\n"; };
  } else { die "No Copyright notice!\n"; };

  while (<INPUT>) {
    if (/;; Copyright/) { while (<INPUT>) {}; }
       else { s/(\#')//g ;
              s/(\.lisp)/\.scm/g ;
              print OUTPUT $_;
            };
     };

  # Print the Copyright postscript. 
  &postscript; 

  # Close the open files.
  close(INPUT);
  close(OUTPUT);
}

sub preamble {
 print OUTPUT 
  ";; Copyright 1994, Brown University, Providence, RI\n",
  ";; See end of file for full copyright information\n\n";
}

sub postscript {
 print OUTPUT 
";; Copyright 1994, Brown University, Providence, RI\n",
";; Permission to use and modify this software and its documentation\n",
";; for any purpose other than its incorporation into a commercial\n",
";; product is hereby granted without fee.  Permission to copy and\n",
";; distribute this software and its documentation only for\n",
";; non-commercial use is also granted without fee, provided, however\n",
";; that the above copyright notice appear in all copies, that both\n",
";; that copyright notice and this permission notice appear in\n",
";; supporting documentation, that the name of Brown University not\n",
";; be used in advertising or publicity pertaining to distribution\n",
";; of the software without specific, written prior permission, and\n",
";; that the person doing the distribution notify Brown University\n",
";; of such distributions outside of his or her organization. Brown\n",
";; University makes no representations about the suitability of this\n",
";; software for any purpose. It is provided \"as is\" without express\n",
";; or implied warranty.  Brown University requests notification of\n",
";; any modifications to this software or its documentation.\n",
";;\n",
";; Send the following redistribution information\n",
";;\n",
";; 	Name:\n",
";; 	Organization:\n",
";; 	Address (postal and/or electronic):\n",
";;\n",
";; To:\n",
";; 	Software Librarian\n",
";; 	Computer Science Department, Box 1910\n",
";; 	Brown University\n",
";; 	Providence, RI 02912\n",
";;\n",
";; 		or\n",
";;\n",
";; 	brusd@cs.brown.edu\n",
";;\n",
";; We will acknowledge all electronic notifications.\n\n";
}

# Main program.
&getfile;
while ("quit" ne $file) {
   &filterfile;
   &getfile;
};

die "Done!\n";

