eudora-mac/Editor/Source/Editor Source/makecomponent.pl

#!/usr/local/bin/perl
#
# this thing generates all sorts of component crap
#
# usage: makecomponent prefix outputfile.h outputfile.c inputfiles...
#    eg: makecomponent PETE :include:petecomp.h petecomp.c :{ext}:editor:pete.h
#
#		 Will also generate seconds header file for CFM macros named
#		 ouputfilecfm.h.
#
#		 I left in my comments that begin with #**. They can be deleted since I was
#		 using them to walk through the code and figure it out.
#


#** get arguments, shift removed first item so you can get the next in line
#** $prefix = $ARGV[0]; shift;
$prefix = 'PETE';
#** $hfile = $ARGV[0]; shift;
$hfile = ':Editor:Source:Application Headers:petecomponent.h';
$cfile = ':Editor:Source:Editor Source:petecomponent.c';
$mfile = ':Editor:Source:Application Headers:petecfm.h';


#** open output files
open(HFILE,">$hfile")||die;
open(MFILE,">$mfile")||die;
open(CFILE,">$cfile")||die;

#put top of outputfilecfm.h here
print MFILE <<BOILER;
/* gComponentDispatchUPP is a global initialized to GetToolTrapAddress(_ComponentDispatch) */
extern UniversalProcPtr gComponentDispatchUPP;

BOILER

# put top of outputfile.h stuff here
print HFILE <<BOILER;
#ifndef PETECOMPONENT_H
#define PETECOMPONENT_H

#ifndef PETE_H
#include "pete.h"
#endif

#define TWOBYTESIZE(x) (sizeof(x) == 1 ? 2 : sizeof(x))

BOILER

#** $_ default variable still has the last parameter ':{ext}:editor:pete.h'
#** read each line from file
while (<>)
{
	if (/^pascal/)
#** if "pascal" is at the beginning of the input line
#** only care about pascal type declarations in this file
	{
		chop;
#** chop CR

		#
		# make sure we can use whitespace for tokens
		s/\(/ \(/g;
#** search for "(" replace with " (", all occurances in line

		#
		# trim the pascal part
		s/pascal\s*//;
#** delete "pascal" and space (replace with nothing)

		#
		# nab the return type
		#** "[ \t]+" is one or more spaces or tabs
		#** "2" limits the result into two peices
		#** $returns = the return type
		#** $rest = the rest of the string
		($returns,$rest) = split("[ \t]+",$_,2);

		#
		# nab the function name
		#** do it again
		($func,$rest) = split("[ \t]+",$rest,2);

		#
		# and the parameters
		$rest =~ s/.*\(//;
	#** delete all chars before and including the "("
		$rest =~ s/\).*//;
	#** delete all chars after and including the ")"
		$params = $rest;
		#** $params is comman delim param list
		@params = split(',',$rest);		#** @params is array of the parameters, cool!

		#
		# record the function name
		$funcList[$#funcList+1] = $func;  #** add the func name to an array each loop

		#** got the info, now do something with it

		#
		# Declare the param structure
		#** plug in function name and concat the strings together, write out to file
		print MFILE "#define $func(";

		for ($i=0;$i<=$#params;$i++)
		{
			if ($i) {print MFILE ",";}
			print MFILE "p" . ($i+1);
		}
		print MFILE ") \\\n";
		
		print MFILE "\tCallUniversalProc(gComponentDispatchUPP, \\\n";
		print MFILE "\t\tkD0DispatchedPascalStackBased \\\n";

		if ($returns ne "void")
		{
			print MFILE "\t\t | RESULT_SIZE(SIZE_CODE(sizeof($returns))) \\\n";
		}
		
		print MFILE "\t\t | DISPATCHED_STACK_ROUTINE_SELECTOR_SIZE(kFourByteCode)";
		
		for ($i=0;$i<=$#params;$i++)
		{
			($type,$littleParam) = split("[ \t]+",$params[$i]);
			$littleParam =~ s/[ \t]+.*//;
					#** deletes everything after the space
			if ($littleParam =~ /^\*/)
						#** if this is a pointer parameter
			{
			  $type .= '*';

	#** add * to type
			}
			print MFILE " \\\n\t\t | DISPATCHED_STACK_ROUTINE_PARAMETER(" . ($i+1) . ", SIZE_CODE(sizeof($type)))";
		}
		print MFILE " \\\n\t\t | DISPATCHED_STACK_ROUTINE_PARAMETER(" . ($#params + 2) . ", kTwoByteCode)";
		print MFILE " \\\n\t\t | DISPATCHED_STACK_ROUTINE_PARAMETER(" . ($#params + 3) . ", kTwoByteCode)";

		print MFILE ", \\\n\t\t0L, \\\n\t\t";
		
		for ($i=0;$i<=$#params;$i++)
		{
			if ($i) {print MFILE ",";}
			print MFILE "(p" . ($i+1) . ")";
		}
		
		print MFILE ", \\\n\t\tk" . ($func) . "Rtn";
		print MFILE ", \\\n\t\tk" . ($func) . "ParamSize)\n\n";

		#
		# UPP enum and ParamSize
		$sizeof = "TW