1#!/usr/bin/perl -w
2
3#############################################################################
4#
5
6#
7# Controls
8#
9# @filesection
10# Expected to contain @nam1rule and perhaps @nam2rule
11# which overwrite all later name rules
12#
13# @datasection
14# subdivides for multiple types in one file e.g. ajstr.c
15# expected to have @nam2rule
16# which overwrites all later name rules
17#
18# @fdata [Datatype]
19# should automatically pick up rules from an @datasection block
20#
21# @nam*rule Name Descriptive text
22# describes a name element and its level
23# if attached always to a lower level name, include both e.g. NewRes
24# (or they could be simply nested if the name can appear anywhere)
25#
26# @suffix Name
27# single letter suffix appended to any function name
28# defined globally in @filesection or @datasection
29# or just for a single section
30#
31# @argrule Name Argname [Argtype] Descriptive text
32# attached to a name from @namrule or @suffix
33# the argument name must appear in the order specified in the rules
34# Name can (should) be * to apply to all functions in a section.
35#
36# @valrule Name [Valtype] Descriptive text
37# The return value for a named set of functions.
38# Name can (should) be * to apply to all functions in a section.
39#############################################################################
40
41use English;
42
43sub nametowords($) {
44    my ($name) = @_;
45    my $fname = $name;
46    $name =~ s/([A-Z])/ $1/go;
47    my @nameparts = split(' ', $name);
48#    print LOG "sub function $fname parts $#nameparts\n";
49    return @nameparts;
50}
51
52sub nametorules($@) {
53    my ($name,$rules) = @_;
54    my $fname = $name;
55    my $ok = 1;
56    if (!($name =~ s/^M//)) {return 0}
57
58    print LOG "nametorules $fname\n";
59    my $ilevel = 0;
60    my $irule = 0;
61    my $urule = "";
62    my $nname = $name;
63    my @nametorules = ();
64
65    foreach $rulelevel (@$rules) {
66	$ok = 1;
67	$ilevel++;
68	print LOG "nametorules level $ilevel\n";
69	$irule = 0;
70	$nname = $name;
71	foreach $currule (@$rulelevel) {
72	    $irule++;
73	    print LOG "nametorules level $ilevel rule $irule\n";
74	    $currule =~ s/([A-Z])/ $1/gos;
75	    @ruleparts = split(' ', $currule);
76	    $rule = pop(@ruleparts);
77	    $urule = uc($rule);
78	    print LOG "nametorules rule '$rule'\n";
79	    if($nname =~ s/^$urule//) {
80		print LOG "nametorules matched name: '...$nname'\n";
81		$ok = 1;
82		push(@nametorules, $rule);
83		if($nname eq "") {last}
84		next;
85	    }
86	    else {
87		print LOG "nametorules no match\n";
88		$ok = 0;
89	    }
90	}
91	if($ok) {
92	    if ($nname eq "") {
93		print LOG "nametorules success\n";
94		return @nametorules;
95	    }
96	    else {
97		print LOG "nametorules matched up to: '...$nname'\n";
98		$name = $nname;
99	    }
100	}
101	else {
102	    print LOG "nametorules not found '...$nname'\n";
103	}
104    }
105
106    print LOG "nametorules failed $fname ok:$ok name: '$nname'\n";
107
108    return 0;
109}
110
111sub testorder($$@) {
112    my ($lastname, $type, @newparts) = @_;
113    print LOG "testorder '$lastname' '$name'\n";
114    if($lastname eq "") {return 1}
115    $lastname =~ s/([A-Z])/ $1/go;
116    my @oldparts = split(' ', $lastname);
117    my $o;
118    foreach $o (@oldparts) {
119	if($#newparts < 0) {return 0}
120	$n = shift(@newparts);
121	if($o =~ /^[A-Z]$/) {	# last name within suffix list
122	    print LOG "testorder suffix '$n' '$o'\n";
123	    if($n =~ /^[A-Z]$/) {
124		if($n lt $o) {return 0}
125		if($n gt $o) {return 1}
126	    }
127	    else {return 1}	# new name level
128	}
129	else {
130	    print LOG "testorder name '$n' '$o'\n";
131	    if($n lt $o) {return 0}
132	    if($n gt $o) {return 1}
133	}
134    }
135    if($#newparts >= 0) {return 1}
136    # oops - names seem to be the same
137    print LOG "testorder fail: identity\n";
138    if($type eq "macro") {return 1} # macro can follow function of same name
139    return 0;
140}
141
142sub issuffix($@) {
143    my ($name,@suffixes) = @_;
144    my $s;
145    if($#suffixes < 0) {return 0}
146
147    foreach $s (@suffixes) {
148#	print LOG "issuffix '$name' '$s'\n";
149	if ($name eq $s) {return 1}
150    }
151
152#    print LOG "issuffix failed\n";
153    return 0;
154}
155
156sub isnamrule($\@@) {
157    my ($i, $rules, @nameparts) = @_;
158    my $j = $i-1;
159#    print LOG "isnamrule ++ i: $i rules $#{$rules} names $#nameparts '$nameparts[$i]'\n";
160    if($i > $#nameparts) {
161#	print LOG "isnamrule i: $i names $#nameparts\n";
162	return 0;
163    }
164    my $rule;
165    my $r;
166    my @ruleparts;
167    my $ok;
168    foreach $currule (@$rules) {
169#	print LOG "isnamrule: rule '$currule'\n";
170	$rule = $currule;
171	$rule =~ s/([A-Z])/ $1/gos;
172	@ruleparts = split(' ', $rule);
173	$j = $i - $#ruleparts;
174	if($j < 0) {next}
175	$ok = 1;
176	foreach $r (@ruleparts) {
177#	    print LOG "isnamrule $j name: '$nameparts[$j]' rule '$r'\n";
178	    if($nameparts[$j] ne $r) {$ok=0;last}
179	    $j++;
180	}
181	if(!$ok) {next}
182#	print LOG "isnamrule OK\n";
183	return 1;
184    }
185#    print LOG "isnamrule all rules failed\n";
186    return 0;
187}
188
189sub matchargname($$@) {
190    my ($aname, $anum, @nameparts) = @_;
191    my $j = $#nameparts;
192    my $argname = $aname;
193    $argname =~ s/^[*]//go;
194    $argname =~ s/([A-Z])/ $1/go;
195    my @argparts = split(' ', $argname);
196    my $k = $#argparts;
197    if($j < $k) {return 0} 	# argname longer than function name!
198    my $curarg;
199    my $ok;
200    my $imax = $j - $k;
201    my $i;
202    my $ii;
203    my $kk;
204    my $n = "";
205    my $sufcnt = 0;
206    print LOG "matchargname '$aname' <$anum> '$fname' imax:$imax\n";
207    print LOG "matchargname parts: \n";
208    foreach $n (@nameparts) { print LOG " '$n'"}
209    print LOG "\n";
210    for ($i=0;$i<=$imax; $i++) {
211	$ok = 1;
212	$aname = "";
213	$sufcnt = 0;
214	for ($ii=0; $ii < $i; $ii++) {
215	    if($nameparts[$ii] =~ /^[A-Z]$/) {
216		print LOG "i:$i suffix '$nameparts[$ii]'\n";
217		$sufcnt++;
218	    }
219	}
220	print LOG "i:$i sufcnt: $sufcnt\n";
221	for ($kk=0;$kk<=$k;$kk++) {
222	    $ii = $i+$kk;
223	    print LOG "matchargname test $nameparts[$ii] $argparts[$kk]\n";
224	    if($nameparts[$ii] =~ /^[A-Z]$/) {$sufcnt++}
225	    if($nameparts[$ii] ne $argparts[$kk]) {
226		print LOG "matchargname reject $nameparts[$ii] $argparts[$kk]\n";
227		$ok = 0;
228		last;
229	    }
230	    $aname .= $nameparts[$ii];
231	    print LOG "matchargname OK so far: $aname\n";
232	}
233	if($ok) {
234	    print LOG "matchargname: matched i:$i '$aname' $sufcnt/$anum\n";
235	    if($anum && ($sufcnt != $anum)) {next}
236	    return 1;
237	}
238    }
239    print LOG "matchargname failed\n";
240    return 0;
241}
242
243sub srsref {
244    return "<a href=\"http://srs.ebi.ac.uk/srs7bin/cgi-bin/wgetz?-e+[EFUNC-ID:$_[0]]\">$_[0]</a>";
245}
246sub srsdref {
247    return "<a href=\"http://srs.ebi.ac.uk/srs7bin/cgi-bin/wgetz?-e+[EDATA-ID:$_[0]]\">$_[0]</a>";
248}
249
250sub secttest($$) {
251    my ($sect, $ctype) = @_;
252    my $stype = "";
253    if ($sect =~ /Constructors$/i) {$stype = "new"}
254    elsif ($sect =~ /Destructors$/i) {$stype = "delete"}
255    elsif ($sect =~ /Assignments$/i) {$stype = "assign"}
256    elsif ($sect =~ /Iterators$/i) {$stype = "iterate"}
257    elsif ($sect =~ /Modifiers$/i) {$stype = "modify"}
258    elsif ($sect =~ /Casts$/i) {$stype = "cast"}
259    elsif ($sect =~ /Input$/i) {$stype = "input"}
260    elsif ($sect =~ /Output$/i) {$stype = "output"}
261    elsif ($sect =~ /Miscellaneous$/i) {$stype = "misc"}
262    if ($stype eq "") {return $stype}
263    if ($stype ne $ctype) {
264	print "bad category '$ctype' (expected '$stype') in section '$sect'\n";
265    }
266    return $stype;
267}
268
269sub testvar($) {
270    my ($tvar) = @_;
271    if (defined($cppreserved{$tvar})) {
272	print "bad variable '$tvar' - reserved word in C++, use '$cppreserved{$tvar}'\n";
273    }
274}
275
276sub testnew($$) {
277    my ($tdata, $ttype) = @_;
278    if ($tdata ne $ttype) {
279	print "bad category new - return type '$ttype' datatype '$tdata'\n";
280    }
281}
282
283sub testdelete($$\@\@) {
284    my ($tdata, $ttype, $tcast, $tcode) = @_;
285    if ($ttype ne "void") {
286	print "bad category delete - return type '$ttype' non-void\n";
287    }
288    if ($#{$tcast} < 0) {
289	print "bad category delete - parameter missing\n";
290	return 0;
291    }
292    $tx = ${$tcode}[0];
293    if ($#{$tcast} > 0) {
294	print "bad category delete - only one parameter allowed\n";
295	return 0;
296    }
297    if (${$tcast}[0] !~ /$tdata\*+/) {
298	$tc = ${$tcast}[0];
299	print "bad category delete - only parameter '$tc' must be '$tdata\*'\n";
300    }
301    if ($tx !~ /[d]/) {
302	print "bad category delete - code1 '$tx' not 'd'\n";
303    }
304}
305
306sub testassign($$\@\@) {
307    my ($tdata, $ttype, $tcast, $tcode) = @_;
308    if ($#{$tcast} < 0) {
309	print "bad category assign - no parameters\n";
310    }
311    $tc = ${$tcast}[0];
312    $tx = ${$tcode}[0];
313    if ($tc ne "$tdata\*") {
314	print "bad category assign - parameter1 '$tc' not '$tdata\*'\n";
315    }
316    if ($tx !~ /[w]/) {
317	print "bad category assign - code1 '$tx' not 'w'\n";
318    }
319#    if ($tx !~ /[D]/) {
320#	print "bad category assign - code1 '$tx' not 'D'\n";
321#    }
322}
323
324sub testmodify($$\@\@) {
325    my ($tdata, $ttype, $tcast, $tcode) = @_;
326    if ($#{$tcast} < 0) {
327	print "bad category modify - no parameters\n";
328    }
329    $tc = ${$tcast}[0];
330    $tx = ${$tcode}[0];
331    if(!defined($tc)) {
332    print "testmodify tc undefined for $fname $pubout\n";
333    }
334    if ($tc ne "$tdata" && $tc ne "$tdata\*") {
335	print "bad category modify - parameter1 '$tc' not '$tdata' or '$tdata\*'\n";
336    }
337    if ($tx !~ /[wu]/) {
338	print "bad category modify - code1 '$tx' not 'w' or 'u'\n";
339    }
340}
341
342sub testcast($$\@\@) {
343    my ($tdata, $ttype, $tcast, $tcode) = @_;
344    if ($#{$tcast} < 0) {
345	print "bad category cast - no parameters\n";
346	return 0;
347    }
348    if ($#{$tcast} == 0 && $ttype eq "void") {
349	print "bad category cast - one parameter and returns void\n";
350    }
351    $tc = ${$tcast}[0];
352    $tx = ${$tcode}[0];
353    if ($tc ne "const $tdata") {
354	print "bad category cast - parameter1 '$tc' not 'const $tdata'\n";
355    }
356    if ($tx !~ /[r]/) {
357	print "bad category cast - code1 '$tx' not 'r'\n";
358    }
359}
360
361sub testderive($$\@\@) {
362    my ($tdata, $ttype, $tcast, $tcode) = @_;
363    if ($#{$tcast} < 0) {
364	print "bad category derive - no parameters\n";
365	return 0;
366    }
367    if ($#{$tcast} == 0 && $ttype eq "void") {
368	print "bad category derive - one parameter and returns void\n";
369    }
370    $tc = ${$tcast}[0];
371    $tx = ${$tcode}[0];
372    if ($tc ne "const $tdata") {
373	print "bad category derive - parameter1 '$tc' not 'const $tdata'\n";
374    }
375    if ($tx !~ /[r]/) {
376	print "bad category derive - code1 '$tx' not 'r'\n";
377    }
378}
379
380sub testuse($\@\@) {
381    my ($tdata, $tcast, $tcode) = @_;
382    if ($#{$tcast} < 0) {
383	print "bad category use - no parameters\n";
384	return 0;
385    }
386    $qpat = qr/^const $tdata[*]*$/;
387    $qpat2 = qr/^$tdata[*]* const[ *]*$/;
388    $tc = ${$tcast}[0];
389    $tx = ${$tcode}[0];
390    $tc =~ s/^CONST /const /go;
391    if ($tc !~ $qpat && $tc !~ $qpat2 && $tc ne "const void*") {
392	print "bad category use - parameter1 '$tc' not 'const $tdata'\n";
393    }
394    if ($tx !~ /[r]/) {
395	print "bad category use - code1 '$tx' not 'r'\n";
396    }
397}
398
399sub testiterate($$$\@) {
400    my ($tdata, $ttype, $tdesc, $tcast, $tcode) = @_;
401    my ($itertype) = ($tdesc =~ /(^\S+)\s+iterator/);
402    if (!$itertype) {
403	print "bad category iterator - no type in description\n";
404    }
405    else {
406	$tc = ${$tcast}[0];
407	if ($ttype ne $itertype &&
408	    $tc ne "$itertype" &&
409	    $tc ne "$itertype\*") {
410	    print "bad category iterate - type '$itertype' not referenced\n";
411	}
412    }
413}
414
415sub testinput($\@\@) {
416    my ($tdata, $tcast, $tcode) = @_;
417    my $ok = 0;
418    my $i = 0;
419    if ($#{$tcast} < 0) {
420	print "bad category input - no parameters\n";
421	return 0;
422    }
423
424    for ($i=0; $i <= $#{$tcast}; $i++) {
425	$tc = ${$tcast}[$i];
426	$tx = ${$tcode}[$i];
427	if (($tc eq "$tdata" || $tc eq "$tdata*")&& ($tx =~ /[wu]/)) {
428	    $ok = 1;
429	}
430    }
431    if (!$ok) {
432	print "bad category input - no parameter '$tdata' with code 'w' or 'u'\n";
433    }
434}
435
436sub testoutput($\@\@) {
437    my ($tdata, $tcast, $tcode) = @_;
438    my $ok = 0;
439    my $i = 0;
440    if ($#{$tcast} < 0) {
441	print "bad category output - no parameters\n";
442	return 0;
443    }
444    for ($i=0; $i <= $#{$tcast}; $i++) {
445	$tc = ${$tcast}[$i];
446	$tx = ${$tcode}[$i];
447	if ($tc eq "$tdata" || $tc eq "const $tdata") {
448	    if  ($tx =~ /[ru]/) {
449		$ok = 1;
450	    }
451	}
452    }
453    if (!$ok) {
454	print "bad category output - no parameter (const) '$tdata' and code 'r' or 'u'\n";
455    }
456}
457
458sub testmisc($\@\@) {
459    my ($tdata, $tcast, $tcode) = @_;
460    my $ok = 0;
461    my $i = 0;
462#    if ($#{$tcast} < 0) {
463#	print "bad category misc - no parameters\n";
464#	return 0;
465#    }
466#    for ($i=0; $i <= $#{$tcast}; $i++) {
467#	$tc = ${$tcast}[$i];
468#	$tx = ${$tcode}[$i];
469#	if ($tc eq "$tdata" || $tc eq "const $tdata") {
470#	    if  ($tx =~ /[ru]/) {
471#		$ok = 1;
472#	    }
473#	}
474#    }
475#    if (!$ok) {
476#	print "bad category misc - no parameter (const) '$tdata' and code 'r' or 'u'\n";
477#    }
478}
479
480sub testinternals($\@\@) {
481    my ($tdata, $tcast, $tcode) = @_;
482    my $ok = 0;
483    my $i = 0;
484#    if ($#{$tcast} < 0) {
485#	print "bad category misc - no parameters\n";
486#	return 0;
487#    }
488#    for ($i=0; $i <= $#{$tcast}; $i++) {
489#	$tc = ${$tcast}[$i];
490#	$tx = ${$tcode}[$i];
491#	if ($tc eq "$tdata" || $tc eq "const $tdata") {
492#	    if  ($tx =~ /[ru]/) {
493#		$ok = 1;
494#	    }
495#	}
496#    }
497#    if (!$ok) {
498#	print "bad category internals - no parameter (const) '$tdata' and code 'r' or 'u'\n";
499#    }
500}
501
502sub printsect($$) {
503    my ($mysect,$mysrest) = @_;
504    if ($mysect ne $lastfsect) {
505	if(defined($dataname)) {
506	    printdata($dataname,$datadesc);
507	}
508	if(${$ostr} =~ /\.\.\.\.lastsect\.\.\.\./) {
509	    if(!$dosecttest) {$sectstr = ""}
510	    elsif($sectstr !~ /[^ ]$/) {$sectstr = ""}
511	    else {$sectstr .= "</table>\n"}
512	    ${$ostr} =~ s/[.]+lastsect[.]+/$sectstr\n/;
513	}
514	my $mysname = $mysect;
515	$mysname =~ s/\s+/_/;
516	${$ostr} .= "<hr><h3><a name=\"sec_$mysname\">\n";
517
518	my $dname = "none";
519	if(defined($dataname)) {$dname = $dataname}
520	if($dname eq "none") {$dname = "Section"}
521	${$ostr} .= "$dname: $mysect</a></h3>\n";
522
523	${$ostr} .= "$mysrest\n";
524	${$ostr} .= "....lastsect....";
525	$lastfsect = $mysect;
526	my $catdesc = "";
527	if($fctype ne "") {$catdesc = "Category: '$fctype'"}
528	if(defined($categs{$fctype})) {$catdesc = $categs{$fctype}}
529	$datastr .= "<tr><td> <a href=#sec_$mysname>$mysect</a></td><td>$catdesc</td></tr>\n";
530    }
531}
532
533sub printsectstatic($$) {
534    my ($mysect, $mysrest) = @_;
535    if ($mysect ne $laststatfsect) {
536	if(defined($dataname)) {
537	    printdatastatic($dataname,$datadesc);
538	}
539	if(${$ostr} =~ /\.\.\.\.lastsect\.\.\.\./) {
540	    if(!$dosecttest) {$sectstrstatic = ""}
541	    elsif($sectstrstatic !~ /[^ ]$/) {$sectstrstatic = ""}
542	    else {$sectstrstatic .= "</table>\n"}
543	    ${$ostr} =~ s/[.]+lastsect[.]+/$sectstrstatic\n/;
544	}
545	my $mysname = $mysect;
546	$mysname =~ s/\s+/_/;
547	${$ostr} .= "<hr><h3><a name=\"sec_$mysname\">\n";
548	${$ostr} .= "Section: $mysect</a></h3>\n";
549	${$ostr} .= "$mysrest\n";
550	${$ostr} .= "....lastsect....";
551	$laststatfsect = $mysect;
552
553	my $catdesc = "";
554	if(defined($fctype)) {$catdesc = "Category: '$fctype'"}
555	if(defined($categs{$fctype})) {$catdesc = $categs{$fctype}}
556	$datastrstatic .= "<tr><td> <a href=#sec_$mysname>$mysect</a></td><td>$catdesc</td></tr>\n";
557    }
558}
559
560sub printdata($$) {
561    my ($mydata,$mydrest) = @_;
562    if ($mydata ne $lastdsect) {
563	if(${$ostr} =~ /\.\.\.\.lastdata\.\.\.\./) {
564	    if(!$dosecttest) {$datastr = ""}
565	    elsif($datastr !~ /[^ ]$/) {$datastr = ""}
566	    else {$datastr .= "</table>\n"}
567	    ${$ostr} =~ s/[.]+lastdata[.]+/$datastr\n/;
568	}
569	my $mydname = $mydata;
570	$mydname =~ s/\s+/_/;
571	${$ostr} .= "<hr><h2><a name=\"data_$mydname\">\n";
572	${$ostr} .= "Datatype: $mydata</a></h2>\n";
573	${$ostr} .= "$mydrest\n";
574	${$ostr} .= "....lastdata....";
575	$lastdsect = $mydata;
576
577	$filestr .= "<tr><td> <a href=#data_$mydname>$mydata</a> </td><td>$datashortdesc</td></tr>\n";
578    }
579}
580
581sub printdatastatic($$) {
582    my ($mydata, $mydrest) = @_;
583    if ($mydata ne $laststatdsect) {
584	if(${$ostr} =~ /\.\.\.\.lastdata\.\.\.\./) {
585	    if(!$dosecttest) {$datastrstatic = ""}
586	    elsif($datastrstatic !~ /[^ ]$/) {$datastrstatic = ""}
587	    else {$datastrstatic .= "</table>\n"}
588	    ${$ostr} =~ s/[.]+lastdata[.]+/$datastrstatic\n/;
589	}
590	my $mydname = $mydata;
591	$mydname =~ s/\s+/_/;
592	${$ostr} .= "<hr><h2><a name=\"data_$mydname\">\n";
593	    ${$ostr} .= "Datatype: $mydata</a></h2>\n";
594	${$ostr} .= "Datatype: $mydata</a></h2>\n";
595	${$ostr} .= "$mydrest\n";
596	${$ostr} .= "....lastdata....";
597	$laststatdsect = $mydata;
598
599	$filestrstatic .= "<tr><td> <a href=#data_$mydname>$mydata</a> </td><td>$datashortdesc</td></tr>\n";
600    }
601}
602
603$pubout = "public";
604$local = "local";
605$infile = "";
606$lib = "unknown";
607$countglobal=0;
608$countstatic=0;
609$countsection = 0;
610
611@namrules = ();
612@sufname = ();
613@datalist = ();
614$namrulesfilecount=$#namrules;
615$namrulesdatacount=$#namrules;
616$suffixfilecount=$#sufname;
617$suffixdatacount=$#sufname;
618
619$dosecttest = 0;
620$datatype="undefined";
621$unused = "";
622$inline = "";
623$flastname = 0;
624
625$filestr = "<p><b>Datatypes:</b>\n<table> ";
626$filestrstatic = "<p><b>Datatypes:</b>\n<table> ";
627
628$ftable = "";
629
630$lastfname = "";
631
632### cppreserved is a list of C++ reserved words not to be used as param names.
633### test is whether to test the return etc.
634### body is whether to print the body code
635
636%cppreserved = ("this" => "thys", "bool" => "boule", "string" => "strng");
637%test = ("func" => 1, "funcstatic" => 1, "funclist" => 0, "prog" => 0);
638%body = ("func" => 1, "funcstatic" => 1, "funclist" => 1, "prog" => 1);
639
640%categs = ("new" => "Constructors",
641	   "delete" => "Destructors",
642	   "assign" => "Assignments",
643	   "modify" => "Modifiers",
644	   "cast" => "Casts",
645	   "derive" => "Derievd values",
646	   "use" => "General use",
647	   "iterate" => "Iterators",
648	   "input" => "Input",
649	   "output" => "Output",
650	   "misc" => "Miscellaneous",
651	   "internals" => "Internals");
652%ctot = ();
653if ($ARGV[0]) {$infile = $ARGV[0];}
654if ($ARGV[1]) {$lib = $ARGV[1];}
655
656foreach $x ("short", "int", "long", "float", "double", "char",
657	    "size_t", "time_t",
658	    "unsigned", "unsigned char",
659	    "unsigned short", "unsigned int",
660	    "unsigned long", "unsigned long int") {
661    $simpletype{$x} = 1;
662}
663
664foreach $x ("ajshort", "ajushort", "ajint", "ajuint", "ajlong", "ajulong",
665	    "jobject", "jstring", "jboolean", "jclass", "jint", "jbyteArray",
666	    "AjBool", "AjStatus", "BOOL", "AjEnum", "PLFLT", "PLINT",
667	    "VALIST", "AjEQryLink") {
668    $simpletype{$x} = 1;
669}
670
671foreach $x ("CallFunc", "AjMessVoidRoutine", "AjMessOutRoutine") {
672    $functype{$x} = 1;
673}
674
675foreach $x ("datastatic", "conststatic", "const", "alias", "attr") {
676    $datatoken{$x} = 1;
677}
678
679foreach $x("plus") {
680    $ignore{$x} = 1;
681}
682
683$source = "";
684
685if ($infile) {
686    (undef, $dir, $pubout) = ($infile =~ /^(([^\/.]*)\/)*([^\/.]+)(\.\S+)?$/);
687##    ($dummy, $dir, $pubout) = ($infile =~ /(([^\/.]+)\/)?([^\/.]+)(\.\S+)?$/);
688    $local = $pubout;
689    if ($dir) {$lib = $dir}
690    print "set pubout '$pubout' lib '$lib'\n";
691    open (INFILE, "$infile") || die "Cannot open $infile";
692    $linenum=0;
693    while (<INFILE>) {
694	$linenum++;
695	if(length($_) > 81) {
696	    printf "%s %d: length %d\n",
697	    $infile, $linenum, length($_);
698	}
699	$source .= $_
700    }
701}
702else {
703    while (<>) {$source .= $_}
704}
705
706open (BOOK, ">$pubout.book");
707open (OBS, ">>deprecated.new");
708print OBS "#$pubout\n";
709open (HTML, ">$pubout.html");
710open (HTMLB, ">$local\_static.html");
711open (SRS, ">$pubout.srs");
712open (LOG, ">$local.log");
713
714$file = "$pubout\.c";
715$title = "$file";
716$out="";
717$outstatic="";
718$out .=  "<html><head><title>$title</title></head>\n";
719$out .=  "<body bgcolor=\"#ffffff\">\n";
720$outstatic .= "<html><head><title>$title</title></head>\n";
721$outstatic .= "<body bgcolor=\"#ffffff\">\n";
722
723$out .=  "<h1>$file</h1>\n...lastfile...";
724$outstatic .= "<h1>$file</h1>\n...lastfile...";
725
726$sect = $lastfsect = $laststatfsect = "";
727$datasect = $lastdsect = $laststatdsect = "";
728$mainprog = 0;
729$functot = 0;
730$datanum=0;
731$secnum=0;
732$bookstr = "$pubout\.c\n";
733$datastr = " ";
734$datastrstatic = " ";
735$sectstr = " ";
736$sectstrstatic = " ";
737$fnum=0;
738$ostr = \$out;
739$datatitle = "";
740$fctype = "";
741$indep=0;
742$indepbook=0;
743
744##############################################################
745## $source is the entire source file as a string with newlines
746## step through each comment
747## looking for extended JavaDoc style formatting
748## $ccfull is the comment
749## $rest is the rest of the file
750##############################################################
751
752# Process an entire block
753# We process each part below
754
755$fdata = "";
756
757while ($source =~ m"((\s+)([#]if[^\n]+\n)?)([/][*][^*]*[*]+([^/*][^*]*[*]+)*[/])"gos) {
758    $partnum=0;
759    $mastertoken="undefined";
760    $prespace = $2;
761    $ifdef = $3;
762    $ccfull = $4;
763    $rest = $POSTMATCH;
764    $pref = $PREMATCH;
765
766    if($indepbook && $ccfull =~ /@/ && $pref =~ /#endif\s*\Z/om) {
767	$indepbook=0;
768#	print "unset indepbook\n";
769    }
770    if($indep && $ccfull =~ /@/ && $pref =~ /#endif\s*\Z/om) {
771        $indep=0;
772	print "unset indep pref '$ccfull'\n";
773    }
774
775    if(defined($ifdef)){
776#	print "ifdef '$ifdef'\n";
777	if(!$indepbook && $ifdef =~ /AJ_COMPILE_DEPRECATED_BOOK/g) {
778	    $indepbook=1;
779#	    print "set indepbook\n";
780	}
781	if(!$indep && $ifdef =~ /AJ_COMPILE_DEPRECATED\n/g) {
782	    $indep=1;
783#	    print "set indep\n";
784	}
785    }
786
787    ($cc) = ($ccfull =~ /^..\s*(.*\S)*\s*..$/gos);
788    if (defined($cc)) {
789	$cc =~ s/[* ]*\n[* ]*/\n/gos;
790	$cc = " ".$cc;
791    }
792    else {
793	$cc = "";
794    }
795    $type = "";
796    $acnt = 0;
797    $rtype = "";
798    $ismacro = 0;
799    $isprog = 0;
800    $islist = 0;
801    @largs = ();
802    @savecode = ();
803    @savevar = ();
804    @savecast = ();
805    @savedesc = ();
806    $inputargs = "";
807    $outputargs = "";
808    $modifyargs = "";
809    $returnargs = "";
810    $longdesc = "";
811    $shortdesc = "";
812    $usetext = "See source code";
813    $exampletext = "In preparation";
814    $errtext = "See source code";
815    $dependtext = "See source code";
816    $othertext = "See other functions in this section";
817    $availtext = "In release 6.5.0";
818    $ctype = "";
819
820    while ($cc =~ m/\s@((\S+)\s+([^@]*[^@\s]))/gos) {
821	$data = $1;
822	$token = $2;
823	#print "<$token>\n";
824	#print "$data\n";
825
826	if(!$partnum) {$mastertoken = $token}
827	$partnum++;
828
829	if ($token eq "section")  {
830	    $secnum++;
831	    if($out =~ /\.\.\.\.lastsect\.\.\.\./) {
832		if($sectstr !~ /[^ ]$/) {$sectstr = ""}
833		else {$sectstr .= "</table>\n"}
834		$out =~ s/\.\.\.\.lastsect\.\.\.\./$sectstr\n/;
835	    }
836	    if($outstatic =~ /\.\.\.\.lastsect\.\.\.\./) {
837		if($sectstrstatic !~ /[^ ]$/) {$sectstrstatic = ""}
838		else {$sectstrstatic .= "</table>\n"}
839		$outstatic =~ s/\.\.\.\.lastsect\.\.\.\./$sectstrstatic\n/;
840	    }
841	    $sectstr = "<p><b>Functions:</b>\n<table> ";
842	    $sectstrstatic = "<p><b>Functions:</b>\n<table> ";
843
844	    $ostr = \$out;
845	    $countglobal++;
846	    if($dosecttest && $sect ne "") {
847		if($countsection == 0 && $countstatic == 0) {
848		    print "bad section: '$sect' has no public or static functions\n";
849		}
850	    }
851	    $countsection = 0;
852	    ($sect, $srest) = ($data =~ /\S+\s+([^*\n]+)\s*(.*)/gos);
853	    if(!defined($sect)) {
854		print "bad section: cannot parse '$data'\n";
855	    }
856	    $sect =~ s/\s+/ /gos;
857	    $sect =~ s/^ //gos;
858	    $sect =~ s/ $//gos;
859	    $srest =~ s/>/\&gt;/gos;
860	    $srest =~ s/</\&lt;/gos;
861	    $srest =~ s/\n\n/\n<p>\n/gos;
862	    $srest =~ s/{([^\}]+)}/<a href="#$1">$1<\/a>/gos;
863	    print "\nSection $sect\n";
864	    print "-----------------------------\n";
865
866	    if($prespace !~ /^\n\n\n\n\n$/) {
867		if($prespace =~ /^[\n]+$/) {
868		    $whitelen = length($&) - 1;
869		    print "bad whitespace $whitelen lines at start\n";
870		}
871		elsif ($prespace =~ / /) {
872		    print "bad whitespace has space(s) at start\n";
873		}
874		elsif ($prespace =~ /\t/) {
875		    print "bad whitespace has tab(s) at start\n";
876		}
877		else {
878		    print "bad whitespace at start\n";
879		}
880	    }
881
882	    $bookstr .= "\n  section: $sect\n";
883
884	    push (@{$datasect{$datatitle}}, $sect);
885	    $datasub = "$datatitle - $sect";
886	    @{$datafunc{$datasub}} = ();
887
888	    if($dosecttest) {
889		@argnumb = ();
890		@argpref = ();
891		@argname = ();
892		@argtype = ();
893		@argdesc = ();
894		@valname = ();
895		@valtype = ();
896		$lastfname = "";
897		$fdata = "";
898		$ctype = "";
899		$fctype = "";
900		splice(@namrules, 1+$namrulesdatacount);
901		splice(@namdescs, 1+$namrulesdatacount);
902		splice(@sufname, 1+$suffixdatacount);
903		splice(@sufdesc, 1+$suffixdatacount);
904	    }
905	}
906
907	elsif ($token eq "fdata")  {
908	    $dosecttest = 1;
909	    if($mastertoken ne "section") {
910		print "bad syntax \@$token must be in \@section\n";
911	    }
912	    ($fdata) =
913		($data =~ /^\S+\s+[\[]([^\]]+)[\]]\s*(.*)/gos);
914	    if(!defined($fdata)) {
915		print "bad fdata: $data\n";
916	    }
917	    elsif($fdata ne $datatype) {
918		print "bad fdata <$fdata> <$datatype>\n";
919	    }
920	}
921
922	elsif ($token eq "datasection")  {
923	    $datanum++;
924	    if($out =~ /\.\.\.\.lastdata\.\.\.\./) {
925		if($datastr !~ /[^ ]$/) {$datastr = ""}
926		else {$datastr .= "</table>\n"}
927		$out =~ s/\.\.\.\.lastdata\.\.\.\./$datastr\n/;
928	    }
929	    if($outstatic =~ /\.\.\.\.lastdata\.\.\.\./) {
930		if($datastrstatic !~ /[^ ]$/) {$datastrstatic = ""}
931		else {$datastrstatic .= "</table>\n"}
932		$outstatic =~ s/\.\.\.\.lastdata\.\.\.\./$datastrstatic\n/;
933	    }
934	    $datastr = "<p><b>Sections:</b>\n<table> ";
935	    $datastrstatic = "<p><b>Sections:</b>\n<table> ";
936
937	    $secnum=0;
938	    $fnum=0;
939	    $dosecttest = 1;
940	    if($partnum != 1) {
941		print "bad syntax \@$token must be at start\n";
942	    }
943	    $flastname = "";
944	    ($datatype, $datashortdesc, $datadesc) =
945		($data =~ /\S+\s+[\[]([^\]]+)[\]]\s*([^*\n]+)[*\n]*(.*)/gos);
946	    if(!defined($datadesc)) {
947		print "bad datasection: $data\n";
948		next;
949	    }
950	    $dataname = $datatype;
951	    $dataname =~ s/\s+/ /gos;
952	    $dataname =~ s/^ //gos;
953	    $dataname =~ s/ $//gos;
954	    $datadesc =~ s/\s+/ /gos;
955	    $datadesc =~ s/^ //gos;
956	    $datadesc =~ s/ $//gos;
957
958	    $datatitle = "$dataname: $datashortdesc";
959	    push (@datalist, "$datatitle");
960
961	    @{ $datasect{$datatitle} } = ();
962	    $datastr = "<p><b>Sections:</b>\n<table> ";
963	    $datastrstatic = "<p><b>Sections:</b>\n<table> ";
964
965	    if($prespace !~ /^\n\n\n\n\n$/) {
966		print "Datasection '$datatype' '$datadesc'\n";
967		if($prespace =~ /^[\n]+$/) {
968		    $whitelen = length($&) - 1;
969		    print "bad whitespace $whitelen lines at start\n";
970		}
971		elsif ($prespace =~ / /) {
972		    print "bad whitespace has space(s) at start\n";
973		}
974		elsif ($prespace =~ /\t/) {
975		    print "bad whitespace has tab(s) at start\n";
976		}
977		else {
978		    print "bad whitespace at start\n";
979		}
980	    }
981
982	    $bookstr .= "  $dataname\n $datadesc\n";
983	    splice(@namrules, 1+$namrulesfilecount);
984	    splice(@namdescs, 1+$namrulesfilecount);
985	    splice(@sufname, 1+$suffixfilecount);
986	    splice(@sufdesc, 1+$suffixfilecount);
987	}
988
989	elsif ($token eq "filesection")  {
990	    $dosecttest = 1;
991	    if($partnum != 1) {
992		print "bad syntax \@$token must be at start\n";
993	    }
994	    ($sname, $norest) =
995		($data =~ /\S+\s+(\S+)\s*(.*)/gos);
996	    $flastname = "";
997	    splice (@namrules, 0);
998
999	    if($prespace !~ /^\n\n\n\n\n$/) {
1000		print "Filesection $sname\n";
1001		if($prespace =~ /^[\n]+$/) {
1002		    $whitelen = length($&) - 1;
1003		    print "bad whitespace $whitelen lines at start\n";
1004		}
1005		elsif ($prespace =~ / /) {
1006		    print "bad whitespace has space(s) at start\n";
1007		}
1008		elsif ($prespace =~ /\t/) {
1009		    print "bad whitespace has tab(s) at start\n";
1010		}
1011		else {
1012		    print "bad whitespace at start\n";
1013		}
1014	    }
1015
1016	}
1017
1018	elsif ($token eq "fnote")  {
1019	    if($mastertoken ne "section") {
1020		print "bad syntax \@$token must be in \@section\n";
1021	    }
1022	}
1023
1024	elsif ($token eq "suffix")  {
1025	    # can be on its own or in a block?
1026	    ($sufname,$sufdesc) =
1027		($data =~ /\S+\s+(\S+)\s+(.*)/gos);
1028	    push(@sufname, $sufname);
1029	    push(@sufdesc, $sufdesc);
1030	}
1031
1032	elsif ($token =~ /^nam([1-9])rule$/)  {
1033	    if($mastertoken ne "section" &&
1034	       $mastertoken ne "filesection" &&
1035	       $mastertoken ne "datasection") {
1036		print "bad syntax \@$token must be in \@filesection, \@datasection or \@section\n";
1037	    }
1038	    $i = $1 - 1;
1039	    ($namrule, $namdesc) = ($data =~ /\S+\s+(\S+)\s*(.*)/gos);
1040	    if(!defined($namdesc)) {
1041		print "bad namrule: $data\n";
1042		next;
1043	    }
1044	    print LOG "defined nam$i"."rule '$namrule'\n";
1045	    $namdesc =~ s/\n//;
1046	    $namdesc =~ s/[.]$//;
1047	    push(@{$namrules[$i]},$namrule);
1048	    push(@{$namdescs[$i]},$namdesc);
1049	}
1050
1051	elsif ($token eq "valrule")  {
1052	    if($mastertoken ne "section") {
1053		print "bad syntax \@$token must be in \@section\n";
1054	    }
1055	    ($valname,$valtype,$valdesc) =
1056		($data =~ /\S+\s+(\S+)\s+[\[]([^\]]+)[\]]\s*(.*)/gos);
1057	    if(!defined($valdesc)) {
1058		print "bad valrule: $data\n";
1059		next;
1060	    }
1061	    $valdesc =~ s/\n//;
1062	    $valdesc =~ s/[.]$//;
1063	    push (@valname, $valname);
1064	    push (@valtype, $valtype);
1065	    push (@valdesc, $valdesc);
1066	}
1067
1068	elsif ($token =~ /^arg(\d?)rule$/)  {
1069	    if($mastertoken ne "section") {
1070		print "bad syntax \@$token must be in \@section\n";
1071	    }
1072	    $argnumb = $1;
1073	    if ($argnumb ne "") {
1074		print LOG "$token argnumb: $argnumb\n";
1075	    }
1076	    ($argpref, $argname, $argtype, $argdesc) =
1077		($data =~ /\S+\s+(\S+)\s+(\S+)\s+[\[]([^\]]+[\]]?)[\]]\s*(.*)/gos);
1078	    if(!defined($argdesc)) {
1079		print "bad argrule: $data\n";
1080		next;
1081	    }
1082	    $argdesc =~ s/\n//;
1083	    $argdesc =~ s/[.]$//;
1084	    push (@argnumb, $argnumb);
1085	    push (@argpref, $argpref);
1086	    push (@argname, $argname);
1087	    push (@argtype, $argtype);
1088	    push (@argdesc, $argdesc);
1089	}
1090
1091	elsif (!$dosecttest && $token eq "section")  {
1092	    if($partnum != 1) {
1093		print "bad syntax \@$token must be at start\n";
1094	    }
1095	    $out = \$out;
1096	    $countglobal++;
1097	    ($sect, $srest) = ($data =~ /\S+\s+([^*\n]+)\s*(.*)/gos);
1098	    $sect =~ s/\s+/ /gos;
1099	    $sect =~ s/^ //gos;
1100	    $sect =~ s/ $//gos;
1101	    $srest =~ s/>/\&gt;/gos;
1102	    $srest =~ s/</\&lt;/gos;
1103	    $srest =~ s/\n\n/\n<p>\n/gos;
1104	    $srest =~ s/{([^\}]+)}/<a href="#$1">$1<\/a>/gos;
1105	    print "Section $sect\n";
1106	}
1107
1108	elsif ($token eq "func" || $token eq "prog")  {
1109	    if($partnum != 1) {
1110		print "bad syntax \@$token must be at start\n";
1111	    }
1112	    $ismacro = 0;
1113	    $isprog = 0;
1114	    $fnum++;
1115	    if ($token eq "prog") {
1116		$isprog = 1;
1117		$mainprog=1;
1118		if($functot) {
1119		    print "bad ordering - main program should come first\n";
1120		}
1121	    }
1122	    if($mainprog && !$isprog) {
1123		print "bad function prototype: not static after main program\n";
1124	    }
1125	    $ostr = \$out;
1126	    $countglobal++;
1127	    $functot++;
1128	    if($sect ne "") {$countsection++;}
1129
1130	    printsect($sect,$srest);
1131
1132	    $testrest = $rest;
1133	    $testrest =~ s/[\(]assert[\)]/assert/;
1134	    $type = $token;
1135	    ($name, $frest) = ($data =~ /\S+\s+(\S+)\s*(.*)/gos);
1136	    ($ftype,$fname, $fargs) =
1137		$testrest =~ /^\s*([^\(\)]+[^\(\)\s])\s+([^\(\)]+[^\(\)\s]+)\s*[\(]\s*([^{]*)[)]\s*[\{]/os;
1138	    if(!defined($ftype)){
1139		print "bad \@$type header\n";
1140	    }
1141	    $ftype =~ s/^inline\s+//;
1142	    $ftype =~ s/^__noreturn\s+//;
1143	    if($isprog) {$progname = $name}
1144	    elsif(defined($datasub)) {
1145		push(@{$datafunc{$datasub}}, "$name");
1146	    }
1147	    print "Function $name\n";
1148	    ${$ostr} .= "<hr><h4><a name=\"$name\">\n";
1149	    ${$ostr} .= "Function</a> ".srsref($name)."</h4>\n";
1150
1151	    if($prespace !~ /^\n\n\n\n\n$/) {
1152		if($prespace =~ /^[\n]+$/) {
1153		    $whitelen = length($&) - 1;
1154		    print "bad whitespace $whitelen lines at start\n";
1155		}
1156		elsif ($prespace =~ / /) {
1157		    print "bad whitespace has space(s) at start\n";
1158		}
1159		elsif ($prespace =~ /\t/) {
1160		    print "bad whitespace has tab(s) at start\n";
1161		}
1162		else {
1163		    print "bad whitespace at start\n";
1164		}
1165	    }
1166
1167	    if(!defined($fargs)) {
1168		print "bad function prototype: not parsed\n";
1169		$ftype = "unknown";
1170		$fname = "unknown";
1171		next;
1172	    }
1173	    if ($isprog && $fname eq "main") {$fname = $pubout}
1174	    $trest = $frest;
1175	    #if($frest =~ /<(.*)>/) {print "bad HTML tag <$1>\n"}
1176	    $frest =~ s/>/\&gt;/gos;
1177	    $frest =~ s/</\&lt;/gos;
1178	    $frest =~ s/\n\n/\n<p>\n/gos;
1179	    #${$ostr} .= "$frest\n";
1180	    $longdesc = $frest;
1181	    $shortdesc = $frest;
1182	    $shortdesc =~ s/\n<p>.*//gos;
1183
1184	    $sectstr .= "<tr><td> <a href=#$name>$name</a></td><td>$shortdesc</td></td></tr>\n";
1185	    print SRS "ID $name\n";
1186	    print SRS "TY public\n";
1187	    print SRS "MO $pubout\n";
1188	    print SRS "LB $lib\n";
1189	    print SRS "XX\n";
1190
1191	    $ftype =~ s/\s+/ /gos;
1192	    $ftype =~ s/ \*/\*/gos;
1193	    $fname =~ s/^[\(]//gos;
1194	    $fname =~ s/[\)]$//gos;
1195	    if ($fname =~ /^Java_org.*Ajax_([^_]+)$/) {
1196		$fname = "Ajax.".$1;
1197		if ($ftype =~ /JNIEXPORT+\s+(\S+)\s+JNICALL/) {
1198		    $ftype = $1;
1199		}
1200	    }
1201	    if ($isprog && $ftype ne "int") {print "bad main type (not int)\n"}
1202	    if (!$ftype) {print "bad function definition\n"}
1203	    if ($fname ne $name) {print "bad function name <$name> <$fname>\n"}
1204	    if (!$frest) {print "bad function '$name', no description\n"}
1205
1206	    $trest =~ s/\n\n+$/\n/gos;
1207	    $trest =~ s/\n\n\n+/\n\n/gos;
1208	    $trest =~ s/\n([^\n])/\nDE $1/gos;
1209	    $trest =~ s/\n\n/\nDE\n/gos;
1210	    $trest =~ s/>/\&gt;/gos;
1211	    $trest =~ s/</\&lt;/gos;
1212	    chomp $trest;
1213	    print SRS "DE $trest\n";
1214	    print SRS "XX\n";
1215
1216	    $fargs =~ s/\s+/ /gos;    # all whitespace is one space
1217	    $fargs =~ s/ ,/,/gos;   # no space before comma
1218	    $fargs =~ s/, /,/gos;   # no space after comma
1219	    $fargs =~ s/ *(\w+) *((\[[^\]]*\])+)/$2 $1/gos;   # [] before name
1220	    $fargs =~ s/(\*+)(\S)/$1 $2/g;  # put space after run of *
1221	    $fargs =~ s/ \*/\*/gos;         # no space before run of *
1222	    $fargs =~ s/ [\(]\* (\w+)[\)]/ $1/gos;  # remove fn arguments
1223	    $fargs =~ s/(\w+)\s?[\(][^\)]+[\)],/function $1,/gos; # ditto
1224	    $fargs =~ s/(\w+)\s?[\(][^\)]+[\)]$/function $1/gos;  # ditto
1225	    $fargs =~ s/\s*\(\*(\w+)[^\)]*\)/\* $1/gs;
1226#           print "**functype <$ftype> fname <$fname> fargs <$fargs>\n";
1227	    @largs = split(/,/, $fargs);
1228#           foreach $x (@largs) {
1229#	        print "<$x> ";
1230#           }
1231#           print "\n";
1232#           print "-----------------------------\n";
1233	    $bookstr .= sprintf "%-15s %s (", $ftype, $fname;
1234	    $ia = 0;
1235	    foreach $f (split(/,/,$fargs)) {
1236		if($ia++) {$bookstr .= ", "}
1237		$bookstr .= $f;
1238	    }
1239	    $bookstr .= ");\n";
1240	}
1241
1242	elsif ($token eq "funcstatic")  {
1243	    if($partnum != 1) {
1244		print "bad syntax \@$token must be at start\n";
1245	    }
1246	    $ismacro = 0;
1247	    $isprog = 0;
1248	    $fnum++;
1249	    $ostr = \$outstatic;
1250	    $countstatic++;
1251
1252	    printsectstatic($sect, $srest);
1253
1254	    $type = $token;
1255	    ($name, $frest) = ($data =~ /\S+\s+(\S+)\s*(.*)/gos);
1256	    ($unused,$inline,$ftype,$fname,$fargs) =
1257		$rest =~ /^\s*(__noreturn\s*)?static\s+(inline\s+)?([^\(\)]+[^\(\)\s])\s+([^\(\)]+[^\(\)\s]+)\s*[\(]\s*([^{]*)[)]\s*[\{]/os;
1258	    $ftype =~ s/^inline\s+//;
1259	    if(!defined($fname)){
1260		print "bad \@$type header\n";
1261	    }
1262	    print "Static function $name\n";
1263
1264	    if($prespace !~ /^\n\n\n\n\n$/) {
1265		if($prespace =~ /^[\n]+$/) {
1266		    $whitelen = length($&) - 1;
1267		    print "bad whitespace $whitelen lines at start\n";
1268		}
1269		 else {
1270		     print "bad whitespace at start\n";
1271		 }
1272	    }
1273
1274	    ${$ostr} .= "<hr><h4><a name=\"$name\">\n";
1275	    ${$ostr} .= "Static function</a> ".srsref($name)."</h4>\n";
1276	    if(!defined($ftype)){
1277		print "bad static function prototype: not parsed\n";
1278		next;
1279	    }
1280	    if($mainprog) {
1281		if($name !~ /^$progname[_A-Z]/) {
1282		    print "bad name expected prefix '$progname\_'\n";
1283		}
1284	    }
1285	    $trest = $frest;
1286	    #if($frest =~ /<(.*)>/) {print "bad HTML tag <$1>\n"}
1287	    $frest =~ s/>/\&gt;/gos;
1288	    $frest =~ s/</\&lt;/gos;
1289	    $frest =~ s/\n\n/\n<p>\n/gos;
1290	    #${$ostr} .= "$frest\n";
1291	    $longdesc = $frest;
1292	    $shortdesc = $frest;
1293	    $shortdesc =~ s/\n<p>.*//gos;
1294	    $sectstrstatic .= "<tr><td> <a href=#$name>$name</a></td><td>$shortdesc</td></td></tr>\n";
1295
1296	    print SRS "ID $name\n";
1297	    print SRS "TY static\n";
1298	    print SRS "MO $pubout\n";
1299	    print SRS "LB $lib\n";
1300	    print SRS "XX\n";
1301
1302	    if ($fname ne $name) {print "bad function name <$name> <$fname>\n"}
1303	    if (!$frest) {print "bad function '$name', no description\n"}
1304
1305	    $ftype =~ s/\s+/ /gos;
1306	    $ftype =~ s/ \*/\*/gos;
1307
1308	    $trest =~ s/\n\n+$/\n/gos;
1309	    $trest =~ s/\n\n\n+/\n\n/gos;
1310	    $trest =~ s/\n([^\n])/\nDE $1/gos;
1311	    $trest =~ s/\n\n/\nDE\n/gos;
1312	    $trest =~ s/>/\&gt;/gos;
1313	    $trest =~ s/</\&lt;/gos;
1314	    chomp $trest;
1315	    print SRS "DE $trest\n";
1316	    print SRS "XX\n";
1317
1318
1319	    $fargs =~ s/\s+/ /gos;    # all whitespace is one space
1320	    $fargs =~ s/ ,/,/gos;   # no space before comma
1321	    $fargs =~ s/, /,/gos;   # no space after comma
1322	    $fargs =~ s/ *(\w+) *((\[[^\]]*\])+)/$2 $1/gos;   # [] before name
1323	    $fargs =~ s/(\*+)(\S)/$1 $2/g;  # put space after run of *
1324	    $fargs =~ s/ \*/\*/gos;         # no space before run of *
1325	    $fargs =~ s/ [\(]\* (\w+)[\)]/ $1/gos;  # remove fn arguments
1326	    $fargs =~ s/(\w+)\s?[\(][^\)]+[\)],/function $1,/gos;  # ditto
1327	    $fargs =~ s/(\w+)\s?[\(][^\)]+[\)]$/function $1/gos;  # ditto
1328	    $fargs =~ s/\s*\(\*(\w+)[^\)]*\)/\* $1/gs;
1329	    @largs = split(/,/, $fargs);
1330	}
1331
1332	elsif ($token eq "macro")  {
1333	    if($partnum != 1) {
1334		print "bad syntax \@$token must be at start\n";
1335	    }
1336	    $fnum++;
1337	    $ismacro = 1;
1338	    $ostr = \$out;
1339	    $countglobal++;
1340	    if($sect ne "") {$countsection++;}
1341
1342	    printsect($sect,$srest);
1343
1344	    $type = $token;
1345	    ($name, $mrest) = ($data =~ /\S+\s+(\S+)\s*(.*)/gos);
1346	    $fname = $name;
1347	    print "Macro $name\n";
1348
1349	    if($prespace !~ /^\n\n\n\n\n$/) {
1350		if($prespace =~ /^[\n]+$/) {
1351		    $whitelen = length($&) - 1;
1352		    print "bad whitespace $whitelen lines at start\n";
1353		}
1354		 else {
1355		     print "bad whitespace at start\n";
1356		 }
1357	    }
1358
1359	    $sectstr .= "<tr><td> <a href=#$name>$name</a></td></tr>\n";
1360	    ### print "args '$margs'\n";
1361	    ${$ostr} .= "<hr><h4><a name=\"$name\">\n";
1362	    ${$ostr} .= "Macro</a> ".srsref($name)."</h4>\n";
1363	    $trest = $mrest;
1364	    #if($mrest =~ /<(.*)>/) {print "bad HTML tag <$1>\n"}
1365	    $mrest =~ s/>/\&gt;/gos;
1366	    $mrest =~ s/</\&lt;/gos;
1367	    $mrest =~ s/\n\n/\n<p>\n/gos;
1368	    #${$ostr} .= "$mrest\n";
1369	    $longdesc = $mrest;
1370	    $shortdesc = $mrest;
1371	    $shortdesc =~ s/\n<p>.*\n//gos;
1372
1373	    $bookmacro = $fname;
1374	    @bookmacroparams = ();
1375	    print SRS "ID $name\n";
1376	    print SRS "TY macro\n";
1377	    print SRS "MO $pubout\n";
1378	    print SRS "LB $lib\n";
1379	    print SRS "XX\n";
1380
1381#           $ftype =~ s/\s+/ /gos;
1382#           $ftype =~ s/ \*/\*/gos;
1383#           if (!$ftype) {print "bad macro definition\n"}
1384#           if ($fname ne $name) {print "bad macro name <$name> <$fname>\n"}
1385#           if (!$frest) {print "bad macro '$name', no description\n"}
1386
1387	    $trest =~ s/\n\n+$/\n/gos;
1388	    $trest =~ s/\n\n\n+/\n\n/gos;
1389	    $trest =~ s/\n([^\n])/\nDE $1/gos;
1390	    $trest =~ s/\n\n/\nDE\n/gos;
1391	    $trest =~ s/>/\&gt;/gos;
1392	    $trest =~ s/</\&lt;/gos;
1393	    chomp $trest;
1394	    print SRS "DE $trest\n";
1395	    print SRS "XX\n";
1396	}
1397
1398	elsif ($token eq "funclist")  {
1399	    if($partnum != 1) {
1400		print "bad syntax \@$token must be at start\n";
1401	    }
1402	    $fnum++;
1403	    $ismacro = 0;
1404	    $isprog = 0;
1405	    $islist = 1;
1406	    $ostr = \$outstatic;
1407	    $countstatic++;
1408
1409	    printsectstatic($sect, $srest);
1410
1411	    $type = $token;
1412	    ($name, $mrest) = ($data =~ /\S+\s+(\S+)\s*(.*)/gos);
1413	    print "Function list $name\n";
1414
1415	    if($prespace !~ /^\n\n\n\n\n$/) {
1416		if($prespace =~ /^[\n]+$/) {
1417		    $whitelen = length($&) - 1;
1418		    print "bad whitespace $whitelen lines at start\n";
1419		}
1420		 else {
1421		     print "bad whitespace at start\n";
1422		 }
1423	    }
1424
1425	    $sectstrstatic .= "<tr><td> <a href=#$name>$name</a></td></tr>\n";
1426	    ${$ostr} .= "<hr><h4><a name=\"$name\">\n";
1427	    ${$ostr} .= "Function list</a> ".srsref($name)."</h4>\n";
1428	    $trest = $mrest;
1429	    #if($mrest =~ /<(.*)>/) {print "bad HTML tag <$1>\n"}
1430	    $mrest =~ s/>/\&gt;/gos;
1431	    $mrest =~ s/</\&lt;/gos;
1432	    $mrest =~ s/\n\n/\n<p>\n/gos;
1433	    #${$ostr} .= "$mrest\n";
1434	    $longdesc = $mrest;
1435	    $shortdesc = $mrest;
1436	    $shortdesc =~ s/\n<p>.*\n//gos;
1437
1438	    print SRS "ID $name\n";
1439	    print SRS "TY list\n";
1440	    print SRS "MO $pubout\n";
1441	    print SRS "LB $lib\n";
1442	    print SRS "XX\n";
1443
1444	    $trest =~ s/\n\n+$/\n/gos;
1445	    $trest =~ s/\n\n\n+/\n\n/gos;
1446	    $trest =~ s/\n([^\n])/\nDE $1/gos;
1447	    $trest =~ s/\n\n/\nDE\n/gos;
1448	    $trest =~ s/>/\&gt;/gos;
1449	    $trest =~ s/</\&lt;/gos;
1450	    chomp $trest;
1451	    print SRS "DE $trest\n";
1452	    print SRS "XX\n";
1453	}
1454
1455	elsif ($token eq "param")  {
1456	    if($mastertoken ne "func" &&
1457	       $mastertoken ne "funcstatic" &&
1458	       $mastertoken ne "macro" &&
1459	       $mastertoken ne "funclist") {
1460		print "bad syntax \@$token must be in \@func, funcstatic, funclist or macro\n";
1461	    }
1462	    if (!$intable) {
1463		$ftable = "<p><table border=1>\n";
1464		$ftable .= "<tr><th>Type</th><th>Name</th><th>Read/Write</th><th>Description</th></tr>\n";
1465		$intable = 1;
1466	    }
1467	    ($code,$var,$cast, $prest) = ($data =~ m/[\[]([^\]]+)[\]]\s*(\S*)\s*[\[]([^\]]+[\]]?)[\]]\s*(.*)/gos);
1468	    if (!defined($code)) {
1469		print "bad paramsyntax:\n$data";
1470		next;
1471	    }
1472
1473	    if($prest =~ /([^\{]+)[\{]([^\}]+)[\}]/) {
1474		if($usetext eq "See source code") {$usetext = ""}
1475		else {$usetext .= "<p>\n"}
1476		$usetext .= "<b>$var:</b> $2\n";
1477		$prest = $1;
1478	    }
1479
1480#           print "code: <$code> var: <$var> cast: <$cast>\n";
1481#           print "-----------------------------\n";
1482	    $cast =~ s/ \*/\*/gos;         # no space before run of *
1483	    $cast =~ s/\{/\[/gos;	# brackets fixed
1484	    $cast =~ s/\}/\]/gos;	# brackets fixed
1485
1486	    if ($code !~ /^[rwufdvo?][CENP]*$/) { # deleted OSU (all unused)
1487		print "bad code <$code> var: <$var>\n";
1488	    }
1489	    elsif ($code =~ /^.([CENP]+)$/){
1490		{$countcode{$1}++}
1491	    }
1492
1493	    if($code =~ /^[rfv]/) {
1494		if($code =~ /^r/) {$codename = "Input"}
1495		elsif($code =~ /^f/) {$codename = "Function"}
1496		elsif($code =~ /^v/) {$codename = "Vararg"}
1497		$inputargs .= "<tr><td><b>$var:</b></td><td>($codename)</td><td>$prest</td></tr>";
1498	    }
1499	    elsif($code =~ /[wd]/) {
1500		if($code =~ /^w/) {$codename = "Output"}
1501		elsif($code =~ /^d/) {$codename = "Delete"}
1502		$outputargs .= "<tr><td><b>$var:</b></td><td>($codename)</td><td>$prest</td></tr>";
1503	    }
1504	    elsif($code =~ /[u]/) {
1505		if($code =~ /^u/) {$codename = "Modify"}
1506		$modifyargs .= "<tr><td><b>$var:</b></td><td>($codename)</td><td>$prest</td></tr>";
1507	    }
1508	    else {$codename = "Unknown"}
1509
1510	    testvar($var);
1511	    if ($ismacro) {               # No code to test for macros
1512		push (@bookmacroparams, "$cast $var");
1513	    }
1514	    else {
1515		$curarg = $largs[$acnt];
1516		if (!defined($curarg)) {
1517		    print "bad argument \#$acnt not found in prototype for <$var>\n";
1518		}
1519		else {
1520		    ($tcast,$tname) = ($curarg =~ /(\S.*\S)\s+(\S+)/);
1521		    if (!defined($tname)) {
1522			$tcast = $curarg;
1523			if (!$var) {
1524			    if($curarg eq "...") {
1525				$var = $tname = "vararg";
1526			    }
1527			    else {
1528				print "bad argument \#$acnt parsing failed for '$curarg'\n";
1529				$var = "unknown";
1530				$tname = "undefined";
1531			    }
1532			}
1533			else {
1534				print "bad argument \#$acnt parsing failed for '$curarg'\n";
1535				$tname = "undefined";
1536			}
1537		    }
1538		    $castfix = $cast;
1539		    $castfix =~ s/^CONST +//go;
1540		    if (!$isprog && ($castfix ne $tcast)) {
1541			print "bad cast for $tname <$cast> <$tcast>\n";
1542		    }
1543		    if (!$isprog && ($var ne $tname)) {
1544			print "bad var <$var> <$tname>\n";
1545		    }
1546		}
1547	    }
1548	    $acnt++;
1549
1550	    push @savecode, $code;
1551	    push @savevar,  $var;
1552	    push @savecast, $cast;
1553	    push @savedesc, $prest;
1554	    $drest = $prest;
1555	    $drest =~ s/\n\n+$/\n/gos;
1556	    $drest =~ s/\n\n\n+/\n\n/gos;
1557	    $drest =~ s/\n([^\n])/\nPD $1/gos;
1558	    $drest =~ s/\n\n/\nPD\n/gos;
1559	    $drest =~ s/>/\&gt;/gos;
1560	    $drest =~ s/</\&lt;/gos;
1561	    chomp $drest;
1562	    print SRS "PN [$acnt]\n";
1563	    print SRS "PA $code $var $cast\n";
1564	    print SRS "PD $drest\n";
1565	    print SRS "PX\n";
1566
1567	    if (!$prest) {print "bad paramdescription '$var', no description\n"}
1568	    $ftable .= "<tr><td><tt>$cast</tt></td><td><tt>$var</tt></td><td>$codename</td><td>$prest</td></tr>\n";
1569
1570	    if ($simpletype{$cast}) {
1571# Simple C types (not structs)
1572# and EMBOSS types that resolve to simple types
1573		if ($code !~ /r/) {
1574		    print "bad paramcode '$var' pass by value, code '$code'\n";
1575		}
1576	    }
1577	    elsif ($functype{$cast}) {
1578# Known function types - C and EMBOSS-specific
1579		if ($code !~ /f/) {
1580		    print "bad paramcode '$var' function type '$cast', code '$code'\n";
1581		}
1582	    }
1583	    elsif ($cast =~ / function$/) {
1584# other function types
1585		if ($code !~ /f/) {
1586		    print "bad paramcode '$var' function type '$cast', code '$code'\n";
1587		}
1588	    }
1589	    elsif ($cast =~ /^const .*[*][*]/) {
1590# Tricky - we can be read-only
1591# or we can set to any const char* string (for example)
1592# e.g. pcre error pointers
1593# but can be d (e.g. in ajTableMapDel functions)
1594		if ($code !~ /[rwud]/) {
1595		    print "bad paramcode '$var' const ** but code '$code'\n";
1596		}
1597	    }
1598	    elsif ($cast =~ /^const /) {
1599#If it starts const - except const type ** (see above) - it is const
1600# One exception: pcre has a "const int*" array that is set
1601		if ($cast =~ /const[^a-z].*[*]/)
1602		{
1603		    if ($code !~ /[rwud]/) {
1604			print "bad paramcode '$var' const($cast) but code '$code'\n";
1605		    }
1606		}
1607		elsif ($code !~ /r/) {
1608		    print "bad paramcode '$var' const but code '$code'\n";
1609		}
1610	    }
1611	    elsif ($cast =~ /^struct /) {
1612		if ($code !~ /u/) {
1613		    print "bad paramcode '$var' struct but code '$code'\n";
1614		}
1615	    }
1616	    elsif ($cast =~ / const[^a-z]/) {
1617# also if it has an internal const
1618# For example char* const argv[] is "char* const[]"
1619# One exception: pcre has a "register const uschar*" array that is set
1620		if ($cast =~ / const[^a-z].*[*]/)
1621		{
1622		    if ($code !~ /[rwud]/) {
1623			print "bad paramcode '$var' const($cast) but code '$code'\n";
1624		    }
1625		}
1626		elsif ($cast =~ /^[\S+ const[*]/)
1627		{
1628		    if ($code !~ /[rwud]/) {
1629			print "bad paramcode '$var' const($cast) but code '$code'\n";
1630		    }
1631		}
1632		elsif ($code !~ /r/) {
1633			print "bad paramcode '$var' const($cast) but code '$code'\n";
1634		}
1635	    }
1636	    elsif ($cast =~ / const$/) {
1637# For char* const (so far no examples)
1638# There could be exceptions - but not yet!
1639		if ($code !~ /r/) {
1640		    print "bad paramcode '$var' const($cast) but code '$code'\n";
1641		}
1642	    }
1643	    elsif ($cast =~ /^[.][.][.]$/) {
1644# varargs can be ...
1645		if ($code !~ /v/) {
1646		    print "bad paramcode '$var' type '...' but code '$code'\n";
1647		}
1648	    }
1649	    elsif ($cast =~ /^va_list$/) {
1650# varargs can also be va_list down the list
1651# we did use 'a' for this instead of 'v' but it is too confusing
1652		if ($code !~ /v/) {
1653		    print "bad paramcode '$var' type '$cast' but code '$code'\n";
1654		}
1655	    }
1656	    elsif ($cast =~ /^void[*]$/) {
1657# hard to check - can be read, write, update or delete
1658		if ($code =~ /[?]/) {
1659		    print "bad paramcode '$var' code '$code'\n";
1660		}
1661	    }
1662	    elsif ($cast =~ /^void[*]+$/) {
1663# hard to check - can be read, write, update or delete
1664# Note: maybe we can put a placeholder in the @param cast
1665		if ($code =~ /[?]/) {
1666		    print "bad paramcode '$var' code '$code'\n";
1667		}
1668	    }
1669	    elsif ($cast =~ /[\]]$/) {
1670# hard to check - can be read, write, update or delete
1671# because we can't use const for these
1672# Note: maybe we can put a placeholder in the @param cast
1673		if ($code =~ /[?]/) {
1674		    print "bad paramcode '$var' code '$code'\n";
1675		}
1676		if ($code =~ /r/) {
1677		    if ($cast =~ /^CONST +/) {
1678			$cast =~ s/^CONST +//o;
1679		    }
1680		    else
1681		    {
1682			print "bad paramcode '$var' code '$code' but '$cast'\n";
1683		    }
1684		}
1685	    }
1686	    elsif ($cast =~ /[*]+$/) {
1687# hard to check - can be read, write, update or delete
1688# because we can't use const for these
1689# Note: maybe we can put a placeholder in the @param cast
1690		if ($code =~ /[?]/) {
1691		    print "bad paramcode '$var' code '$code'\n";
1692		}
1693		if ($code =~ /r/) {
1694		    if ($cast =~ /^CONST +/) {
1695			$cast =~ s/^CONST +//o;
1696		    }
1697		    else
1698		    {
1699			print "bad paramcode '$var' code '$code' but '$cast'\n";
1700		    }
1701		}
1702	    }
1703	    else {
1704# Standard checks for anything else
1705		if ($code =~ /r/) {
1706		    print "bad paramcode '$var' code '$code' but not const\n";
1707		}
1708		if ($code =~ /[?]/) {
1709		    print "bad paramcode '$var' code '$code'\n";
1710		}
1711	    }
1712	}
1713
1714	elsif ($token eq "return")  {
1715	    if($mastertoken ne "func" &&
1716	       $mastertoken ne "funcstatic" &&
1717	       $mastertoken ne "macro" &&
1718	       $mastertoken ne "funclist") {
1719		print "bad syntax \@$token must be in \@func, funcstatic, funclist or macro\n";
1720	    }
1721	    if (!$intable) {
1722		$ftable = "<p><table border=1>\n";
1723		$ftable .= "<tr><th>Type</th><th>Name</th><th>Read/Write</th><th>Description</th></tr>\n";
1724		$intable = 1;
1725	    }
1726	    ($rtype, $rrest) = ($data =~ /\S+\s+\[([^\]]+)\]\s*(.*)/gos);
1727	    if(!defined($rtype)) {
1728		print "bad return definition: not parsed\n";
1729		next;
1730	    }
1731	    if(!defined($ftype)) {$ftype = "unknown";}
1732	    if (!$ismacro && !$isprog && $rtype ne $ftype) {
1733		print "bad return type <$rtype> <$ftype>\n";
1734	    }
1735	    if (!$rrest && $rtype ne "void") {
1736		print "bad return description [$rtype], no description\n";
1737	    }
1738
1739	    if($rtype eq "void") {
1740		$returnargs = "<tr><td><b>$rtype:</b></td><td>No return value</td></tr>";
1741	    }
1742	    else {
1743		$returnargs = "<tr><td><b>$rtype:</b></td><td>$rrest</td></tr>";
1744	    }
1745	    if($ismacro) {
1746		$bookstr .= sprintf "%-15s %s (", $rtype, $bookmacro;
1747		$ia = 0;
1748		foreach $f (@bookmacroparams) {
1749		    if($ia++) {$bookstr .= ", "}
1750		    $bookstr .= $f;
1751		}
1752		$bookstr .= ");\n";
1753	    }
1754
1755	    $rrest =~ s/>/\&gt;/gos;
1756	    $rrest =~ s/</\&lt;/gos;
1757	    $ftable .= "<tr><td><tt>$rtype</tt></td><td>\&nbsp;</td><td>RETURN</td><td>$rrest</td></tr>\n";
1758	    $ftable .= "</table><p>\n";
1759	    $intable = 0;
1760
1761	    $drest = $rrest;
1762	    $drest =~ s/^$/\n/gos;  # make sure we have something
1763	    $drest =~ s/\n\n+$/\n/gos;
1764	    $drest =~ s/\n\n\n+/\n\n/gos;
1765	    $drest =~ s/\n([^\n])/\nRD $1/gos;
1766	    $drest =~ s/\n\n/\nRD\n/gos;
1767	    $drest =~ s/>/\&gt;/gos;
1768	    $drest =~ s/</\&lt;/gos;
1769	    chomp $drest;
1770	    print SRS "RT $rtype\n";
1771	    print SRS "RD $drest\n";
1772	    print SRS "RX\n";
1773	}
1774
1775	elsif ($token eq "fcategory")  {
1776	    if($mastertoken ne "section") {
1777		print "bad syntax \@fcategory must be in \@section\n";
1778	    }
1779	    ($ctype, $crest) = ($data =~ /\S+\s+(\S+)\s*(.*)/gos);
1780	    if ($crest) {
1781		print "bad \@$token [$ctype], extra text\n";
1782	    }
1783
1784	    $fctype = $ctype;
1785	    $ctot{$ctype}++;
1786	    secttest($sect,$ctype);
1787	    if (!defined($categs{$ctype})) {
1788		print "bad \@fcategory $ctype - unknown category type\n";
1789	    }
1790	}
1791
1792	elsif ($token eq "category")  {
1793	    if($mastertoken ne "func" &&
1794		   $mastertoken ne "funcstatic" &&
1795	       $mastertoken ne "macro") {
1796		print "bad syntax \@category must be in \@func, funcstatic, or macro\n";
1797	    }
1798	    ($ctype, $cdata, $crest) = ($data =~ /\S+\s+(\S+)\s+\[([^\]]+)\]\s*(.*)/gos);
1799	    if (!$crest) {
1800		print "bad \@$token [$ctype], no description\n";
1801	    }
1802
1803	    $crest =~ s/\s+/ /gos;
1804	    $crest =~ s/^ //gos;
1805	    $crest =~ s/ $//gos;
1806	    $crest =~ s/>/\&gt;/gos;
1807	    $crest =~ s/</\&lt;/gos;
1808
1809	    $drest = $crest;
1810	    $drest =~ s/^$/\n/gos;  # make sure we have something
1811	    $drest =~ s/\n\n+$/\n/gos;
1812	    $drest =~ s/\n\n\n+/\n\n/gos;
1813	    $drest =~ s/\n([^\n])/\nCD $1/gos;
1814	    $drest =~ s/\n\n/\nCD\n/gos;
1815	    $drest =~ s/>/\&gt;/gos;
1816	    $drest =~ s/</\&lt;/gos;
1817	    chomp $drest;
1818	    print SRS "CA $ctype\n";
1819	    print SRS "CT $cdata\n";
1820	    print SRS "CD $drest\n";
1821	    print SRS "CX\n";
1822
1823###	    print "category $ctype [$cdata] $fname $pubout $lib : $crest\n";
1824	    $ctot{$ctype}++;
1825	    secttest($sect,$ctype);
1826
1827	    if ($dosecttest && $fdata ne "") {
1828		$cdata = $fdata;
1829	    }
1830	    if (!defined($categs{$ctype})) {
1831		print "bad \@$type [$ctype], unknown type\n";
1832	    }
1833	    elsif ($ctype eq "new") {
1834		testnew($cdata,$rtype);
1835	    }
1836	    elsif  ($ctype eq "delete") {
1837		testdelete($cdata, $rtype,@savecast,@savecode);
1838	    }
1839	    elsif  ($ctype eq "assign") {
1840		testassign($cdata,$rtype,@savecast,@savecode);
1841	    }
1842	    elsif  ($ctype eq "modify") {
1843		testmodify($cdata,$rtype,@savecast,@savecode);
1844	    }
1845	    elsif  ($ctype eq "cast") {
1846		testcast($cdata,$rtype,@savecast,@savecode);
1847	    }
1848	    elsif  ($ctype eq "derive") {
1849		testderive($cdata,$rtype,@savecast,@savecode);
1850	    }
1851	    elsif  ($ctype eq "use") {
1852		testuse($cdata,@savecast,@savecode);
1853	    }
1854	    elsif  ($ctype eq "iterate") {
1855		testiterate($cdata,$rtype,$crest,@savecast);
1856	    }
1857	    elsif  ($ctype eq "input") {
1858		testinput($cdata,@savecast,@savecode);
1859	    }
1860	    elsif  ($ctype eq "output") {
1861		testoutput($cdata,@savecast,@savecode);
1862	    }
1863	    elsif  ($ctype eq "misc") {
1864		testmisc($cdata,@savecast,@savecode);
1865	    }
1866	    elsif  ($ctype eq "internals") {
1867		testinternals($cdata,@savecast,@savecode);
1868	    }
1869	    else {
1870		print "bad category type '$ctype' - no validation\n";
1871	    }
1872	}
1873
1874	elsif ($token eq "header")  {
1875	    if($partnum != 1) {
1876		print "bad syntax \@$token must be at start\n";
1877	    }
1878	    next;
1879	}
1880
1881	elsif ($token eq "short")  {
1882	    if($mastertoken ne "func" &&
1883	       $mastertoken ne "funcstatic" &&
1884	       $mastertoken ne "macro") {
1885		print "bad syntax \@$token must be in \@func, funcstatic, or macro\n";
1886	    }
1887	    ($shortdesc) = ($data =~ /\S+\s+(.*)/);
1888	    $shortdesc =~ s/>/\&gt;/gos;
1889	    $shortdesc =~ s/</\&lt;/gos;
1890	    $shortdesc =~ s/\n\n/\n<p>\n/gos;
1891	}
1892
1893	elsif ($token eq "release")  {
1894	    if($mastertoken ne "func" &&
1895	       $mastertoken ne "funcstatic" &&
1896	       $mastertoken ne "macro") {
1897		print "bad syntax \@$token must be in \@func, funcstatic, or macro\n";
1898	    }
1899	    ($availtext) = ($data =~ /\S+\s+(.*)/);
1900	    $availtext =~ s/\s+$//gos;
1901	    if($availtext =~ /^(\d+[.][.\d]+)$/) {
1902		$availtext = "From EMBOSS $1";
1903	    }
1904	    $availtext =~ s/>/\&gt;/gos;
1905	    $availtext =~ s/</\&lt;/gos;
1906	    $availtext =~ s/\n\n/\n<p>\n/gos;
1907	}
1908
1909	elsif ($token eq "cc")  {
1910	    if($mastertoken ne "func" &&
1911	       $mastertoken ne "funcstatic" &&
1912	       $mastertoken ne "macro" &&
1913	       $mastertoken ne "section" &&
1914	       $mastertoken ne "filesection" &&
1915	       $mastertoken ne "datasection") {
1916		print "bad syntax \@$token must be in \@func, funcstatic, or macro or a section\n";
1917	    }
1918	    next;
1919	}
1920
1921	elsif ($token eq "obsolete")  {
1922	    ($oname, $norest) =
1923		($data =~ /\S+\s+(\S+)\s*(.*)/gos);
1924	    if($partnum != 1) {
1925		print "bad syntax \@$token $oname must be at start\n";
1926	    }
1927	    if(!$indep && !$indepbook) {
1928		print "bad syntax \@$token $oname must be in AJ_COMPILE_DEPRECATED\n";
1929	    }
1930	    if($prespace !~ /^\n\n\n\n\n$/) {
1931		print "Obsolete $oname\n";
1932		if($prespace =~ /^[\n]+$/) {
1933		    $whitelen = length($&) - 1;
1934		    print "bad whitespace $whitelen lines at start\n";
1935		}
1936		elsif ($prespace =~ / /) {
1937		    print "bad whitespace has space(s) at start\n";
1938		}
1939		elsif ($prespace =~ /\t/) {
1940		    print "bad whitespace has tab(s) at start\n";
1941		}
1942		else {
1943		    print "bad whitespace at start\n";
1944		}
1945	    }
1946
1947	    if($norest) {
1948		print "bad obsolete $oname - extra text\n"
1949	    }
1950	    $replaces = "";
1951	    if ($rest =~ /^\s*__deprecated\s+([^\(\)]*\S)\s+(\S+)\s*[\(]\s*([^{]*)[)]\s*[\{]/os) {
1952		$ofname = $2;
1953		$ofname =~ s/^[*]+//;
1954		if ($oname ne $ofname) {
1955		    print "bad obsolete function name <$ofname> <$oname>\n";
1956		}
1957	    }
1958	    else {
1959		print "bad obsolete function $oname - not __deprecated\n";
1960	    }
1961	    next;
1962	}
1963
1964	elsif ($token eq "rename")  {
1965	    if($mastertoken ne "obsolete") {
1966		print "bad syntax \@$token must be in \@obsolete\n";
1967	    }
1968	    if($partnum == 1) {
1969		print "bad syntax \@$token cannot be the start\n";
1970	    }
1971	    ($rename, $norest) =
1972		($data =~ /\S+\s+(\S+)\s*(.*)/gos);
1973	    if($norest) {
1974		print "bad rename $oname $rename - extra text\n";
1975		next;
1976	    }
1977	    print OBS "$oname $rename\n";
1978	    next;
1979	}
1980
1981	elsif ($token eq "replace")  {
1982	    if($mastertoken ne "obsolete") {
1983		print "bad syntax \@$token must be in \@obsolete\n";
1984	    }
1985	    if($partnum == 1) {
1986		print "bad syntax \@$token cannot be the start\n";
1987	    }
1988	    ($replace, $repargs, $norest) =
1989		($data =~ /\S+\s+(\S+)\s+[\(]([^\)]+)[\)]\s*(.*)/gos);
1990	    if(!defined($repargs)){
1991		print "bad replace $oname value: failed to parse\n";
1992		next;
1993	    }
1994	    if($repargs ne "") {
1995		($repold, $repnew) = split('/', $repargs);
1996		@repold = split(',', $repold);
1997		@repnew = split(',', $repnew);
1998		print OBS "$oname =$replace $repold $repnew\n";
1999	    }
2000	    else {
2001		print "bad replace $oname $replace - no arguments\n";
2002		next;
2003	    }
2004	    if($norest) {
2005		print "bad replace $oname $replace - extra text\n";
2006		next;
2007	    }
2008
2009	    if($replaces ne "") {
2010		$replaces .= "_or_\@$replace";
2011	    }
2012	    else {
2013		$replaces = "\@$replace";
2014	    }
2015	    next;
2016	}
2017
2018	elsif ($token eq "remove")  {
2019	    if($mastertoken ne "obsolete") {
2020		print "bad syntax \@$token must be in \@obsolete\n";
2021	    }
2022	    if($partnum == 1) {
2023		print "bad syntax \@$token cannot be the start\n";
2024	    }
2025	    ($delrest) =
2026		($data =~ /\S+\s*(.*)/gos);
2027	    if(!$delrest) {
2028		print "bad remove $oname - no explanation\n";
2029		next;
2030	    }
2031	    print OBS "$oname -\n";
2032	    next;
2033	}
2034
2035	elsif ($token eq "source")  {
2036	    if($partnum != 1) {
2037		print "bad syntax \@$token must be at start\n";
2038	    }
2039	    next;
2040	}
2041
2042	elsif ($token eq "author")  {
2043	    if($mastertoken ne "source") {
2044		print "bad syntax \@$token must be in \@source\n";
2045	    }
2046	    next;
2047	}
2048
2049	elsif ($token eq "version")  {
2050	    if($mastertoken ne "source") {
2051		print "bad syntax \@$token must be in \@source\n";
2052	    }
2053	    next;
2054	}
2055
2056	elsif ($token eq "modified")  {
2057	    if($mastertoken ne "source") {
2058		print "bad syntax \@$token must be in \@source\n";
2059	    }
2060	    next;
2061	}
2062
2063	elsif ($token eq "error")  {
2064	    if($mastertoken ne "func" &&
2065	       $mastertoken ne "funcstatic" &&
2066	       $mastertoken ne "macro") {
2067		print "bad syntax \@$token must be in \@func, funcstatic, or macro\n";
2068	    }
2069	    next;
2070	}
2071
2072	elsif ($token eq "cre")  {
2073	    if($mastertoken ne "func" &&
2074	       $mastertoken ne "funcstatic" &&
2075	       $mastertoken ne "macro") {
2076		print "bad syntax \@$token must be in \@func, funcstatic, or macro\n";
2077	    }
2078	    next;
2079	}
2080
2081	elsif ($token eq "see")  {
2082	    if($mastertoken ne "func" &&
2083	       $mastertoken ne "funcstatic" &&
2084	       $mastertoken ne "macro") {
2085		print "bad syntax \@$token must be in \@func, funcstatic, or macro\n";
2086	    }
2087	    next;
2088	}
2089
2090	elsif ($token eq "ure")  {
2091	    if($mastertoken ne "func" &&
2092	       $mastertoken ne "funcstatic" &&
2093	       $mastertoken ne "macro") {
2094		print "bad syntax \@$token must be in \@func, funcstatic, or macro\n";
2095	    }
2096	    next;
2097	}
2098
2099	elsif ($datatoken{$token}) {
2100	}
2101	elsif (defined($categs{$token})) {
2102	}
2103	elsif ($ignore{$token}) {
2104	}
2105	elsif ($token eq "@")  {
2106	    if($partnum == 1) {
2107		print "bad syntax \@$token cannot be the start\n";
2108	    }
2109	    last;
2110	}
2111	else {
2112	    print "Unknown tag '\@$token\n";
2113	}
2114    }
2115
2116# Whole block read.
2117# Post-processing
2118
2119    if($dosecttest) {
2120	if($mastertoken eq "obsolete") {
2121	    if($replaces ne "") {
2122		print OBS "$oname $replaces\n";
2123	    }
2124	}
2125
2126	if($mastertoken eq "filesection") {
2127	    $namrulesfilecount=$#namrules;
2128	    $suffixfilecount=$#sufname;
2129	}
2130	if($mastertoken eq "datasection") {
2131	    $namrulesdatacount=$#namrules;
2132	    $suffixdatacount=$#sufname;
2133	}
2134
2135	if($mastertoken eq "section") {
2136	    if($fdata eq "") {
2137		print "bad section: '$sect' no fdata $datatype assumed\n";
2138	    }
2139	    if($ctype eq "") {
2140		print "bad section: '$sect' no fcategory\n";
2141	    }
2142	}
2143    }
2144
2145    if ($type) {
2146#       print "acnt: $acnt largs: $#largs\n";
2147#       print "type $type test $test{$type}\n";
2148
2149	if ($dosecttest && $type eq "func") { # not funcstatic or funclist
2150	    if($type eq "macro") {
2151		@nameparts = nametorules($fname, @namrules);
2152	    }
2153	    else {
2154		@nameparts = nametowords($fname);
2155	    }
2156	    if(!testorder($lastfname, $type, @nameparts)) {
2157		print "bad order: Function $fname follows $lastfname\n";
2158	    }
2159	    if($type eq "macro") {
2160		$lastfname = "";
2161		foreach $n(@nameparts) {
2162		    $lastfname .= $n;
2163		}
2164		print LOG "Macro lastfname '$lastfname'\n";
2165	    }
2166	    else {
2167		$lastfname = $fname;
2168	    }
2169	    print LOG "function $fname ...\n";
2170
2171# Function name compared to naming rules
2172
2173	    $i=0;
2174	    foreach $f (@nameparts) {
2175		$j = $i+1;
2176#		print LOG "name $j '$f'\n";
2177		if(defined($namrules[$i]) && ($f eq $namrules[$i])) {
2178#		    print LOG "namecheck OK\n";
2179		}
2180		elsif(issuffix($f,@sufname)) {
2181#		    print LOG "namecheck OK suffix\n";
2182		}
2183		else {
2184		    if(defined($namrules[$i])) {
2185#			print LOG "calling isnamrule i: $i rules $#{$namrules[$i]} names $#nameparts\n";
2186			if(!isnamrule($i, @{$namrules[$i]}, @nameparts)) {
2187			    print "bad namerule $fname: '$f' not found\n";
2188			    print "** \@nam$j";
2189			    if($j == $#nameparts) {
2190				print "rule $f $frest\n";
2191                            }
2192                            else{
2193                                print "rule $f Undocumented\n";
2194			    }
2195			    last;
2196			}
2197		    }
2198		    else {
2199			print "bad namerule $fname: '$f' beyond last rule\n";
2200			last;
2201		    }
2202		}
2203		$i++;
2204	    }
2205
2206# parameters compared to argument rules
2207
2208# First we use the name to generate a list of arguments
2209
2210	    @genargname=();
2211	    @genargtype=();
2212	    @genvalname=();
2213	    @genvaltype=();
2214	    $i=0;
2215	    foreach $a (@argpref) {
2216		print LOG "argrule '$a' $argnumb[$i] testing $fname\n";
2217		$j = $i+1;
2218#		print LOG "argrule $j '$a' [$argtype[$i]] '$argdesc[$i]'\n";
2219		if(($a eq "*") || matchargname($a, $argnumb[$i], @nameparts)) {
2220#		    print LOG "argrule used: '$a' $argname[$i] [$argtype[$i]]\n";
2221		    push (@genargname, $argname[$i]);
2222		    push (@genargtype, $argtype[$i]);
2223		}
2224		$i++;
2225	    }
2226
2227### return value = "*" for default, may also have a specific value
2228
2229	    $valtypeall = "";
2230	    $i=0;
2231	    foreach $v (@valname) {
2232		$vv = $v;
2233#		print LOG "valrule '$v' testing $fname\n";
2234		$j = $i+1;
2235#		print LOG "valrule $j '$v' [$valtype[$i]]'\n";
2236		if(matchargname($v, 0, @nameparts)) {
2237#		    print LOG "valrule used: '$vv' [$valtype[$i]]\n";
2238		    if($vv =~ /^[*](.+)/) {
2239			$vv = $1;
2240			@genvalname = ();
2241			@genvaltype = ();
2242		    }
2243		    push (@genvaltype, $valtype[$i]);
2244		    push (@genvalname, $vv);
2245		}
2246		if($vv eq "*") {
2247		    $valtypeall = $valtype[$i];
2248		}
2249		$i++;
2250	    }
2251	    if($valtypeall ne "") {
2252		print LOG "valrule * [$valtypeall]\n";
2253		if(!defined($genvaltype[0])) {
2254#		    print LOG " valrule * [$valtypeall] used\n";
2255		    push (@genvaltype, $valtypeall);
2256		}
2257	    }
2258	    $i=0;
2259	    foreach $x (@genargname) {
2260		if(!defined($savevar[$i])) {
2261		    print LOG "++ arg '$x' [$genargtype[$i]] ... <undefined>\n";
2262		}
2263		else {
2264		    print LOG "++ arg '$x' [$genargtype[$i]] ... $savevar[$i] [$savecast[$i]]\n";
2265		    if($x ne $savevar[$i]) {
2266			print "bad param name <$savevar[$i]> rule <$x> \n";
2267		    }
2268		    if($genargtype[$i] ne $savecast[$i]) {
2269			print "bad param type <$savevar[$i]> [$savecast[$i]] rule <$x> [$genargtype[$i]]\n";
2270		    }
2271		}
2272		$i++;
2273	    }
2274#
2275	    $isave = $#savevar + 1;
2276	    $igen=$#genargname + 1;
2277	    if($igen < $isave) {
2278		print "bad argrule: $igen/$isave params defined\n";
2279		for($i=$igen;$i <$isave;$i++) {
2280		    print "** \@argrule $fname $savevar[$i] \[$savecast[$i]\] $savedesc[$i]\n";
2281		}
2282	    }
2283	    elsif($igen > $isave) {
2284		print "bad argrule: expected $isave params, found $igen\n";
2285	    }
2286
2287	    if($#genvaltype <0) {
2288		print "bad valrule: no matching rule\n"
2289	    }
2290	    elsif($#genvaltype >0) {
2291		$igenvaltype = $#genvaltype+1;
2292		print "bad valrule: $igenvaltype matching rules:";
2293		foreach $g(@genvalname) {
2294		    print "<$g>";
2295		}
2296		print "\n";
2297	    }
2298	    else {
2299		print LOG "++ val [$genvaltype[0]] ... [$rtype]\n";
2300		if($rtype ne $genvaltype[0]) {
2301		    print "bad return: <$rtype> rule <$genvaltype[0]>\n";
2302		}
2303	    }
2304	    if($dosecttest && $fdata ne "") {
2305		$cdata = $fdata;
2306	    }
2307	    if ($ctype eq "") {
2308		# already an error above
2309	    }
2310	    elsif ($ctype eq "new") {
2311		testnew($fdata,$rtype);
2312	    }
2313	    elsif  ($ctype eq "delete") {
2314		testdelete($fdata, $rtype,@savecast,@savecode);
2315	    }
2316	    elsif  ($ctype eq "assign") {
2317		testassign($fdata,$rtype,@savecast,@savecode);
2318	    }
2319	    elsif  ($ctype eq "modify") {
2320		testmodify($fdata,$rtype,@savecast,@savecode);
2321	    }
2322	    elsif  ($ctype eq "cast") {
2323		testcast($fdata,$rtype,@savecast,@savecode);
2324	    }
2325	    elsif  ($ctype eq "derive") {
2326		testderive($fdata,$rtype,@savecast,@savecode);
2327	    }
2328	    elsif  ($ctype eq "use") {
2329		testuse($fdata,@savecast,@savecode);
2330	    }
2331	    elsif  ($ctype eq "iterate") {
2332		testiterate($fdata,$rtype,$crest,@savecast);
2333	    }
2334	    elsif  ($ctype eq "input") {
2335		testinput($fdata,@savecast,@savecode);
2336	    }
2337	    elsif  ($ctype eq "output") {
2338		testoutput($fdata,@savecast,@savecode);
2339	    }
2340	    elsif  ($ctype eq "misc") {
2341		testmisc($fdata,@savecast,@savecode);
2342	    }
2343	    else {
2344		print "bad category type '$ctype' - no validation\n";
2345	    }
2346	}
2347
2348	if ($test{$type}) {
2349	    if ($acnt == $#largs) {
2350		if ($largs[$#largs] ne "void") {
2351		    print "bad last argument: $largs[$#largs]\n";
2352		    if(!$acnt) {
2353			for ($ii=0;$ii<=$#largs;$ii++) {
2354			    ($itcast,$itname) = ($largs[$ii] =~ /(\S.*\S)\s+(\S+)/);
2355			    if($itcast =~ /[*]/)
2356			    {
2357				print "** \@param [u] $itname [$itcast] Undocumented\n";
2358			    }
2359			    else
2360			    {
2361				print "** \@param [r] $itname [$itcast] Undocumented\n";
2362			    }
2363			}
2364		    }
2365		}
2366	    }
2367	    if ($acnt < $#largs) {   # allow one remaining
2368		$w=$#largs+1;
2369		print "bad \@param list $acnt found $w wanted\n";
2370		if(!$acnt) {
2371		    for ($ii=0;$ii<=$#largs;$ii++) {
2372			($itcast,$itname) = ($largs[$ii] =~ /(\S.*\S)\s+(\S+)/);
2373			if($itcast =~ /[*]/)
2374			{
2375			    print "** \@param [u] $itname [$itcast] Undocumented\n";
2376			}
2377			else
2378			{
2379			    print "** \@param [r] $itname [$itcast] Undocumented\n";
2380			}
2381		    }
2382		}
2383	    }
2384	    if(!defined($ftype)) {$ftype = "unknown"}
2385	    if (!$rtype && $ftype ne "void") {print "bad missing \@return\n"}
2386	    print "=============================\n";
2387	}
2388	print SRS "//\n";
2389
2390
2391	if($shortdesc) {
2392	    ${$ostr} .= "$shortdesc\n";
2393	}
2394
2395##############################################################
2396## do we want to save what follows the comment?
2397## Yes, for functions (and static functions) and main programs
2398## $rest is what follows the comment
2399##############################################################
2400
2401	if (defined($body{$type}) && $body{$type} == 1) {
2402
2403# body is the code up to a '}' at the start of a line
2404
2405	    ($body) = ($rest =~ /(.*?\n\}[^\n]*\n)/os);
2406	    if(!defined($body)) {
2407		print "bad code body, closing brace not found\n";
2408		$body = "\n";
2409	    }
2410	    print SRS $body;
2411
2412	    if(defined($fname)) {
2413		${$ostr} .= "<h4>Prototype</h4><pre>";
2414		${$ostr} .= "\n$ftype $fname (";
2415		$firstarg = 1;
2416		foreach $a (@largs) {
2417		    if($firstarg) {
2418			${$ostr} .= "\n      $a";
2419		    }
2420		    else {
2421			${$ostr} .= ",\n      $a";
2422		    }
2423		    $firstarg = 0;
2424		}
2425		if($firstarg) {
2426		    ${$ostr} .= "void);\n</pre>\n";
2427		}
2428		else {
2429		    ${$ostr} .= "\n);\n</pre>\n";
2430		}
2431		if($ftable ne "") {
2432		    ${$ostr} .= $ftable;
2433		    $ftable = "";
2434		}
2435	    }
2436	}
2437
2438	if (defined($test{$type}) && $test{$type} == 2) {
2439
2440# body is the code up to a line that doesn't end with '\'
2441
2442	    ($body) = ($rest =~ /\s*(\n\#define\s+[^(\n]+\s*[(][^)\n]*[)].*?[^\\])$/os);
2443	    print SRS "==FUNCLIST\n$body\n==ENDLIST\n";
2444	    print SRS "==REST\n$rest\n==ENDREST\n";
2445	}
2446
2447# skip these - they duplicate what is in the table
2448
2449#	if($inputargs) {
2450#	    ${$ostr} .= "<h4>Input</h4>\n";
2451#	    ${$ostr} .= "<table>$inputargs</table>\n";
2452#	}
2453#	if($outputargs) {
2454#	    ${$ostr} .= "<h4>Output</h4>\n";
2455#	    ${$ostr} .= "<table>$outputargs</table>\n";
2456#	}
2457#	if($modifyargs) {
2458#	    ${$ostr} .= "<h4>Input \&amp; Output</h4>\n";
2459#	    ${$ostr} .= "<table>$modifyargs</table>\n";
2460#	}
2461#	if($returnargs) {
2462#	    ${$ostr} .= "<h4>Returns</h4>\n";
2463#	    ${$ostr} .= "<table>$returnargs</table>\n";
2464#	}
2465
2466# report if not the default string
2467	if($usetext ne "See source code") {
2468	    ${$ostr} .= "<h4>Usage</h4>\n";
2469	    ${$ostr} .= "$usetext\n";
2470	}
2471	if($exampletext ne "In preparation") {
2472	    ${$ostr} .= "<h4>Example</h4>\n";
2473	    ${$ostr} .= "$exampletext\n";
2474	}
2475	if($errtext ne "See source code") {
2476	    ${$ostr} .= "<h4>Errors</h4>\n";
2477	    ${$ostr} .= "$errtext\n";
2478	}
2479	if($dependtext ne "See source code") {
2480	    ${$ostr} .= "<h4>Dependencies</h4>\n";
2481	    ${$ostr} .= "$dependtext\n";
2482	}
2483	if($othertext ne "See other functions in this section") {
2484	    ${$ostr} .= "<h4>See Also</h4>\n";
2485	    ${$ostr} .= "$othertext\n";
2486	}
2487
2488# release tag
2489	if($availtext) {
2490#	    ${$ostr} .= "<h4>Availability</h4>\n";
2491	    ${$ostr} .= "$availtext\n";
2492	}
2493    }
2494}
2495
2496if($dosecttest && $sect ne "") {
2497    if($countsection == 0) {
2498	print "bad section: '$sect' has no public functions\n";
2499    }
2500}
2501
2502if (!$countglobal) {
2503    open (EMPTY, ">$pubout.empty") || die "Cannot open  $pubout.empty";
2504    close EMPTY;
2505    $out .= "<p>No public functions in source file $infile</p>"
2506}
2507if (!$countstatic) {
2508    open (EMPTY, ">$local\_static.empty") || die "Cannot open $local\_static.empty";
2509    close EMPTY;
2510    $outstatic .= "<p>No static functions in source file $infile</p>"
2511}
2512
2513if($sectstr !~ /[^ ]$/) {$sectstr = ""}
2514else {$sectstr .= "</table>\n"}
2515$out =~ s/[.]+lastsect[.]+/$sectstr\n/;
2516
2517if($sectstrstatic !~ /[^ ]$/) {$sectstrstatic = ""}
2518else {$sectstrstatic .= "</table>\n"}
2519$outstatic =~ s/[.]+lastsect[.]+/$sectstrstatic\n/;
2520
2521if($datastr !~ /[^ ]$/) {$datastr = ""}
2522else {$datastr .= "</table>\n"}
2523$out =~ s/[.]+lastdata[.]+/$datastr\n/;
2524
2525if($datastrstatic !~ /[^ ]$/) {$datastrstatic = ""}
2526else {$datastrstatic .= "</table>\n"}
2527$outstatic =~ s/[.]+lastdata[.]+/$datastrstatic\n/;
2528
2529if($filestr !~ /[^ ]$/) {$filestr = ""}
2530else{$filestr .= "</table>\n"}
2531$out =~ s/[.]+lastfile[.]+/$filestr\n/;
2532
2533if($filestrstatic !~ /[^ ]$/) {$filestrstatic = ""}
2534else{$filestrstatic .= "</table>\n"}
2535$outstatic =~ s/[.]+lastfile[.]+/$filestrstatic\n/;
2536
2537$out .= "</body></html>\n";
2538$outstatic .= "</body></html>\n";
2539
2540print HTML "$out";
2541print HTMLB "$outstatic";
2542close HTML;
2543close HTMLB;
2544
2545print BOOK "$bookstr\n";
2546close BOOK;
2547
2548open (TESTLOG, ">>../embossdoc.log") || die "Cannot open embossdoc.log";
2549
2550$i=0;
2551foreach $ccc (sort(keys(%countcode))) {
2552    if(!$i++) {print TESTLOG "$pubout parameter codes:\n"}
2553    print TESTLOG "  $ccc: $countcode{$ccc}\n";
2554}
2555
2556close TESTLOG;
2557
2558exit ();
2559
2560foreach $x (@datalist) {
2561    print STDERR "$x\n";
2562
2563    foreach $y (@{$datasect{$x}}) {
2564	print STDERR "    $y\n";
2565	$d = "$x - $y";
2566	foreach $f (@{$datafunc{$d}}) {
2567	    print STDERR "        $f\n";
2568	}
2569	print STDERR "\n";
2570    }
2571    print STDERR "\n";
2572}
2573
2574