1#! /usr/bin/env perl
2
3#-----------------------------------------------------------------------------
4#-                                                                          --
5#-                         GNAT COMPILER COMPONENTS                         --
6#-                                                                          --
7#-                             G N A T H T M L                              --
8#-                                                                          --
9#-          Copyright (C) 1998-2009, Free Software Foundation, Inc.         --
10#-                                                                          --
11#- GNAT is free software;  you can  redistribute it  and/or modify it under --
12#- terms of the  GNU General Public License as published  by the Free Soft- --
13#- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14#- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15#- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16#- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
17#- for  more details.  You should have  received  a copy of the GNU General --
18#- Public License  distributed  with GNAT;  see file  COPYING3.  If not see --
19#- <http://www.gnu.org/licenses/>.                                          --
20#-                                                                          --
21#- GNAT was originally developed  by the GNAT team at  New York University. --
22#- Extensive contributions were provided by Ada Core Technologies Inc.      --
23#-                                                                          --
24#-----------------------------------------------------------------------------
25
26## This script converts an Ada file (and its dependency files) to Html.
27## Keywords, comments and strings are color-hilighted. If the cross-referencing
28## information provided by Gnat (when not using the -gnatx switch) is found,
29## the html files will also have some cross-referencing features, i.e. if you
30## click on a type, its declaration will be displayed.
31##
32## To find more about the switches provided by this script, please use the
33## following command :
34##     perl gnathtml.pl -h
35## You may also change the first line of this script to indicates where Perl is
36## installed on your machine, so that you can just type
37##     gnathtml.pl -h
38##
39## Unless you supply another directory with the -odir switch, the html files
40## will be saved saved in a html subdirectory
41
42use Cwd 'abs_path';
43use File::Basename;
44
45### Print help if necessary
46sub print_usage
47{
48  print "Usage is:\n";
49  print "  $0 [switches] main_file[.adb] main_file2[.adb] ...\n";
50  print "     -83       : Use Ada83 keywords only (default is Ada95)\n";
51  print "     -cc color : Choose the color for comments\n";
52  print "     -d        : Convert also the files which main_file depends on\n";
53  print "     -D        : same as -d, also looks for files in the standard library\n";
54  print "     -f        : Include cross-references for local entities too\n";
55  print "     -absolute : Display absolute filenames in the headers\n";
56  print "     -h        : Print this help page\n";
57  print "     -lnb      : Display line numbers every nb lines\n";
58  print "     -Idir     : Specify library/object files search path\n";
59  print "     -odir     : Name of the directory where the html files will be\n";
60  print "                 saved. Default is 'html/'\n";
61  print "     -pfile    : Use file as a project file (.adp file)\n";
62  print "     -sc color : Choose the color for symbol definitions\n";
63  print "     -Tfile    : Read the name of the files from file rather than the\n";
64  print "                 command line\n";
65  print "     -ext ext  : Choose the generated file names extension (default\n";
66  print "                 is htm)\n";
67  print "This program attempts to generate an html file from an Ada file\n";
68  exit;
69}
70
71### Parse the command line
72local ($ada83_mode)    = 0;
73local ($prjfile)       = "";
74local (@list_files)    = ();
75local ($line_numbers)  = 0;
76local ($dependencies)  = 0;
77local ($standard_library) = 0;
78local ($output_dir)    = "html";
79local ($xref_variable) = 0;
80local (@search_dir)    = ('.');
81local ($tab_size)      = 8;
82local ($comment_color) = "green";
83local ($symbol_color)  = "red";
84local ($absolute)      = 0;
85local ($fileext)       = "htm";
86
87while ($_ = shift @ARGV)
88{
89  /^-83$/  &&   do { $ada83_mode = 1; };
90  /^-d$/   &&   do { $dependencies = 1; };
91  /^-D$/   &&   do { $dependencies = 1;
92		     $standard_library = 1; };
93  /^-f$/   &&   do { $xref_variable = 1; };
94  /^-absolute$/ && do {$absolute = 1; };
95  /^-h$/   &&   do { &print_usage; };
96  /^[^-]/  &&   do { $_ .= ".adb" if (! /\.ad[bs]$/);
97		     push (@list_files, $_); };
98
99  if (/^-o\s*(.*)$/)
100  {
101    $output_dir = ($1 eq "") ? shift @ARGV : $1;
102    chop $output_dir if ($output_dir =~ /\/$/);
103    &print_usage if ($output_dir =~ /^-/ || $output_dir eq "");
104  }
105
106  if (/^-T\s*(.*)$/)
107  {
108      my ($source_file) = ($1 eq "") ? shift @ARGV : $1;
109      local (*SOURCE);
110      open (SOURCE, "$source_file") || die "file not found: $source_file";
111      while (<SOURCE>) {
112	  @files = split;
113	  foreach (@files) {
114	      $_ .= ".adb" if (! /\.ad[bs]$/);
115	      push (@list_files, $_);
116	  }
117      }
118  }
119
120  if (/^-cc\s*(.*)$/)
121  {
122      $comment_color = ($1 eq "") ? shift @ARGV : $1;
123      &print_usage if ($comment_color =~ /^-/ || $comment_color eq "");
124  }
125
126  if (/^-sc\s*(.*)$/)
127  {
128      $symbol_color = ($1 eq "") ? shift @ARGV : $1;
129      &print_usage if ($symbol_color =~ /^-/ || $symbol_color eq "");
130  }
131
132  if (/^-I\s*(.*)$/)
133  {
134    push (@search_dir, ($1 eq "") ? scalar (shift @ARGV) : $1);
135  }
136
137  if (/^-p\s*(.*)$/)
138  {
139    $prjfile = ($1 eq "") ? shift @ARGV : $1;
140    &print_usage if ($prjfile =~ /^-/ || $prjfile eq "");
141  }
142
143  if (/^-l\s*(.*)$/)
144  {
145    $line_numbers = ($1 eq "") ? shift @ARGV : $1;
146    &print_usage if ($line_numbers =~ /^-/ || $line_numbers eq "");
147  }
148
149  if (/^-ext\s*(.*)$/)
150  {
151    $fileext = ($1 eq "") ? shift @ARGV : $1;
152    &print_usage if ($fileext =~ /^-/ || $fileext eq "");
153  }
154}
155
156&print_usage if ($#list_files == -1);
157local (@original_list) = @list_files;
158
159## This regexp should match all the files from the standard library (and only them)
160## Note that at this stage the '.' in the file names has been replaced with __
161$standard_file_regexp="^([agis]-|ada__|gnat__|system__|interface__).*\$";
162
163local (@src_dir) = ();
164local (@obj_dir) = ();
165
166if ($standard_library) {
167    open (PIPE, "gnatls -v | ");
168    local ($mode) = "";
169    while (defined ($_ = <PIPE>)) {
170	chop;
171	s/^\s+//;
172	$_ = './' if (/<Current_Directory>/);
173	next if (/^$/);
174
175	if (/Source Search Path:/) {
176	    $mode = 's';
177	}
178	elsif (/Object Search Path:/) {
179	    $mode = 'o';
180	}
181	elsif ($mode eq 's') {
182	    push (@src_dir, $_);
183	}
184	elsif ($mode eq 'o') {
185	    push (@obj_dir, $_);
186	}
187    }
188    close (PIPE);
189}
190else
191{
192    push (@src_dir, "./");
193    push (@obj_dir, "./");
194}
195
196foreach (@list_files) {
197  local ($dir) = $_;
198  $dir =~ s/\/([^\/]+)$//;
199  push (@src_dir, $dir. '/');
200  push (@obj_dir, $dir. '/');
201}
202
203### Defines and compiles the Ada key words :
204local (@Ada_keywords) = ('abort', 'abs', 'accept', 'access', 'all', 'and',
205			 'array', 'at', 'begin', 'body', 'case', 'constant',
206			 'declare', 'delay', 'delta', 'digits', 'do', 'else',
207			 'elsif', 'end', 'entry', 'exception', 'exit', 'for',
208			 'function', 'generic', 'goto', 'if', 'in', 'is',
209			 'limited', 'loop', 'mod', 'new', 'not', 'null', 'of',
210			 'or', 'others', 'out', 'package', 'pragma', 'private',
211			 'procedure', 'raise', 'range', 'record', 'rem',
212			 'renames', 'return', 'reverse', 'select', 'separate',
213			 'subtype', 'task', 'terminate', 'then', 'type',
214			 'until', 'use', 'when', 'while', 'with', 'xor');
215local (@Ada95_keywords) = ('abstract', 'aliased', 'protected', 'requeue',
216			'tagged');
217
218local (%keywords) = ();
219grep (++ $keywords{$_}, @Ada_keywords);
220grep (++ $keywords{$_}, @Ada95_keywords) unless ($ada83_mode);
221
222### Symbols declarations for the current file
223### format is   (line_column => 1, ...)
224local (%symbols);
225
226### Symbols usage for the current file
227### format is  ($adafile#$line_$column => $htmlfile#$linedecl_$columndecl, ...)
228local (%symbols_used);
229
230### the global index of all symbols
231### format is  ($name => [[file, line, column], [file, line, column], ...])
232local (%global_index);
233
234#########
235##  This function create the header of every html file.
236##  These header is returned as a string
237##  Params:  - Name of the Ada file associated with this html file
238#########
239sub create_header
240{
241  local ($adafile) = shift;
242  local ($string) = "<HEAD><TITLE>$adafile</TITLE></HEAD>
243<BODY>\n";
244
245  if ($adafile ne "")
246  {
247    $string .= "<HR><DIV ALIGN=\"center\"><H1> File : $adafile "
248	. "</H1></DIV><HR>\n<PRE>";
249  }
250  return $string;
251}
252
253#########
254##  Protect a string (or character) from the Html parser
255##  Params: - the string to protect
256##  Out:    - the protected string
257#########
258sub protect_string
259{
260    local ($string) = shift;
261    $string =~ s/&/&amp;/g;
262    $string =~ s/</&lt;/g;
263    $string =~ s/>/&gt;/g;
264    return $string;
265}
266
267#########
268##  This function creates the footer of the html file
269##  The footer is returned as a string
270##  Params :  - Name of the Ada file associated with this html file
271#########
272sub create_footer
273{
274  local ($adafile) = shift;
275  local ($string) = "";
276  $string = "</PRE>" if ($adafile ne "");
277  return $string . "</BODY></HTML>\n";
278}
279
280#########
281##  This function creates the string to use for comment output
282##  Params :  - the comment itself
283#########
284sub output_comment
285{
286  local ($comment) = &protect_string (shift);
287  return "<FONT COLOR=$comment_color><EM>--$comment</EM></FONT>";
288}
289
290########
291##  This function creates the string to use for symbols output
292##  Params :  - the symbol to output
293##            - the current line
294##            - the current column
295########
296sub output_symbol
297{
298  local ($symbol) = &protect_string (shift);
299  local ($lineno) = shift;
300  local ($column) = shift;
301  return "<FONT COLOR=$symbol_color><A NAME=\"$lineno\_$column\">$symbol</A></FONT>";
302}
303
304########
305##  This function creates the string to use for keyword output
306##  Params :  - the keyword to output
307########
308sub output_keyword
309{
310  local ($keyw) = shift;
311  return "<b>$keyw</b>";
312}
313
314########
315##  This function outputs a line number
316##  Params :  - the line number to generate
317########
318sub output_line_number
319{
320  local ($no) = shift;
321  if ($no != -1)
322  {
323    return "<EM><FONT SIZE=-1>" . sprintf ("%4d ", $no) . "</FONT></EM>";
324  }
325  else
326  {
327    return "<FONT SIZE=-1>     </FONT>";
328  }
329}
330
331########
332##  Converts a character into the corresponding Ada type
333##  This is based on the ali format (see lib-xref.adb) in the GNAT sources
334##  Note: 'f' or 'K' should be returned in case a link from the body to the
335##        spec needs to be generated.
336##  Params : - the character to convert
337########
338sub to_type
339{
340  local ($char) = shift;
341  $char =~ tr/a-z/A-Z/;
342
343  return 'array'                              if ($char eq 'A');
344  return 'boolean'                            if ($char eq 'B');
345  return 'class'                              if ($char eq 'C');
346  return 'decimal'                            if ($char eq 'D');
347  return 'enumeration'                        if ($char eq 'E');
348  return 'floating point'                     if ($char eq 'F');
349  return 'signed integer'                     if ($char eq 'I');
350  # return 'generic package'                    if ($char eq 'K');
351  return 'block'                              if ($char eq 'L');
352  return 'modular integer'                    if ($char eq 'M');
353  return 'enumeration literal'                if ($char eq 'N');
354  return 'ordinary fixed point'               if ($char eq 'O');
355  return 'access'                             if ($char eq 'P');
356  return 'label'                              if ($char eq 'Q');
357  return 'record'                             if ($char eq 'R');
358  return 'string'                             if ($char eq 'S');
359  return 'task'                               if ($char eq 'T');
360  return 'f'                                  if ($char eq 'U');
361  return 'f'                                  if ($char eq 'V');
362  return 'exception'                          if ($char eq 'X');
363  return 'entry'                              if ($char eq 'Y');
364  return "$char";
365}
366
367########
368##  Changes a file name to be http compatible
369########
370sub http_string
371{
372  local ($str) = shift;
373  $str =~ s/\//__/g;
374  $str =~ s/\\/__/g;
375  $str =~ s/:/__/g;
376  $str =~ s/\./__/g;
377  return $str;
378}
379
380########
381##  Creates the complete file-name, with directory
382##  use the variables read in the .prj file
383##  Params : - file name
384##  RETURNS : the relative path_name to the file
385########
386sub get_real_file_name
387{
388  local ($filename) = shift;
389  local ($path) = $filename;
390
391  foreach (@src_dir)
392  {
393      if ( -r "$_$filename")
394      {
395	  $path = "$_$filename";
396	  last;
397      }
398  }
399
400  $path =~ s/^\.\///;
401  return $path if (substr ($path, 0, 1) ne '/');
402
403  ## We want to return relative paths only, so that the name of the HTML files
404  ## can easily be generated
405  local ($pwd) = `pwd`;
406  chop ($pwd);
407  local (@pwd) = split (/\//, $pwd);
408  local (@path) = split (/\//, $path);
409
410  while (@pwd)
411  {
412    if ($pwd [0] ne $path [0])
413    {
414      return '../' x ($#pwd + 1) . join ("/", @path);
415    }
416    shift @pwd;
417    shift @path;
418  }
419  return join ('/', @path);
420}
421
422########
423##  Reads and parses .adp files
424##  Params : - adp file name
425########
426sub parse_prj_file
427{
428  local ($filename) = shift;
429  local (@src) = ();
430  local (@obj) = ();
431
432  print "Parsing project file : $filename\n";
433
434  open (PRJ, $filename) || do { print " ... sorry, file not found\n";
435				return;
436			      };
437  while (<PRJ>)
438  {
439    chop;
440    s/\/$//;
441    push (@src, $1 . "/") if (/^src_dir=(.*)/);
442    push (@obj, $1 . "/") if (/^obj_dir=(.*)/);
443  }
444  unshift (@src_dir, @src);
445  unshift (@obj_dir, @obj);
446  close (PRJ);
447}
448
449########
450##  Finds a file in the search path
451##  Params  : - the name of the file
452##  RETURNS : - the directory/file_name
453########
454sub find_file
455{
456  local ($filename) = shift;
457
458  foreach (@search_dir) {
459    if (-f "$_/$filename") {
460      return "$_/$filename";
461    }
462  }
463  return $filename;
464}
465
466########
467##  Inserts a new reference in the list of references
468##  Params: - Ref as it appears in the .ali file ($line$type$column)
469##          - Current file for the reference
470##          - Current offset to be added from the line (handling of
471##            pragma Source_Reference)
472##          - Current entity reference
473##  Modifies: - %symbols_used
474########
475sub create_new_reference
476{
477    local ($ref) = shift;
478    local ($lastfile) = shift;
479    local ($offset) = shift;
480    local ($currentref) = shift;
481    local ($refline, $type, $refcol);
482
483    ## Do not generate references to the standard library files if we
484    ## do not generate the corresponding html files
485    return if (! $standard_library && $lastfile =~ /$standard_file_regexp/);
486
487    ($refline, $type, $extern, $refcol) = /(\d+)(.)(<[^>]+>)?(\d+)/;
488    $refline += $offset;
489
490    ## If we have a body, then we only generate the cross-reference from
491    ## the spec to the body if we have a subprogram (or a package)
492
493
494    if ($type eq "b")
495#	&& ($symbols {$currentref} eq 'f' || $symbols {$currentref} eq 'K'))
496    {
497	local ($cref_file, $cref) = ($currentref =~ /([^\#]+).$fileext\#(.+)/);
498
499	$symbols_used {"$cref_file#$cref"} = "$lastfile.$fileext#$refline\_$refcol";
500	$symbols_used {"$lastfile#$refline\_$refcol"} = $currentref;
501	$symbols {"$lastfile.$fileext#$refline\_$refcol"} = "body";
502    }
503
504    ## Do not generate cross-references for "e" and "t", since these point to the
505    ## semicolon that terminates the block -- irrelevant for gnathtml
506    ## "p" is also removed, since it is used for primitive subprograms
507    ## "d" is also removed, since it is used for discriminants
508    ## "i" is removed since it is used for implicit references
509    ## "z" is used for generic formals
510    ## "k" is for references to parent package
511    ## "=", "<", ">", "^" is for subprogram parameters
512
513    elsif ($type !~ /[eztpid=<>^k]/)
514    {
515	$symbols_used {"$lastfile#$refline\_$refcol"} = $currentref;
516    }
517}
518
519########
520##  Parses the ali file associated with the current Ada file
521##  Params :  - the complete ali file name
522########
523sub parse_ali
524{
525  local ($filename) = shift;
526  local ($currentfile);
527  local ($currentref);
528  local ($lastfile);
529
530  # A    file | line type column      reference
531  local ($reference) = "(?:(?:\\d+\\|)?\\d+.\\d+|\\w+)";
532
533  # The following variable is used to represent the possible xref information
534  # output by GNAT when -gnatdM is used. It includes renaming references, and
535  # references to the parent type, as well as references to the generic parent
536
537  local ($typeref) = "(?:=$reference|<$reference>|\\{$reference\\}|\\($reference\\)|\\[$reference\\])?";
538
539  # The beginning of an entity declaration line in the ALI file
540  local ($decl_line) = "^(\\d+)(.)(\\d+)[ *]([\\w\\d.-]+|\"..?\")$typeref\\s+(\\S.*)?\$";
541
542  # Contains entries of the form  [ filename source_reference_offset]
543  # Offset needs to be added to the lines read in the cross-references, and are
544  # used when the source comes from a gnatchop-ed file. See lib-write.ads, lines
545  # with ^D in the ALI file.
546  local (@reffiles) = ();
547
548  open (ALI, &find_file ($filename)) || do {
549    print "no ", &find_file ($filename), " file...\n";
550    return;
551  };
552  local (@ali) = <ALI>;
553  close (ALI);
554
555  undef %symbols;
556  undef %symbols_used;
557
558  foreach (@ali)
559  {
560    ## The format of D lines is
561    ## D source-name time-stamp checksum [subunit-name] line:file-name
562
563    if (/^D\s+([\w\d.-]+)\s+\S+ \S+(\s+\D[^: ]+)?( (\d+):(.*))?/)
564    {
565	# The offset will be added to each cross-reference line. If it is
566	# greater than 1, this means that we have a pragma Source_Reference,
567	# and this must not be counted in the xref information.
568	my ($file, $offset) = ($1, (defined $4) ? 2 - $4 : 0);
569
570	if ($dependencies)
571	{
572	    push (@list_files, $1) unless (grep (/$file/, @list_files));
573	}
574	push (@reffiles, [&http_string (&get_real_file_name ($file)), $offset]);
575    }
576
577    elsif (/^X\s+(\d+)/)
578    {
579	$currentfile = $lastfile = $1 - 1;
580    }
581
582    elsif (defined $currentfile && /$decl_line/)
583    {
584      my ($line) = $1 + $reffiles[$currentfile][1];
585      next if (! $standard_library
586	       && $reffiles[$currentfile][0] =~ /$standard_file_regexp/);
587      if ($xref_variable || $2 eq &uppercases ($2))
588      {
589	$currentref = $reffiles[$currentfile][0] . ".$fileext#$line\_$3";
590	$symbols {$currentref} = &to_type ($2);
591	$lastfile = $currentfile;
592
593	local ($endofline) = $5;
594
595	foreach (split (" ", $endofline))
596	{
597	    (s/^(\d+)\|//) && do { $lastfile = $1 - 1; };
598	    &create_new_reference
599		($_, $reffiles[$lastfile][0],
600		 $reffiles[$lastfile][1], $currentref);
601	}
602      }
603      else
604      {
605	$currentref = "";
606      }
607    }
608    elsif (/^\.\s(.*)/ && $reffiles[$currentfile][0] ne "" && $currentref ne "")
609    {
610      next if (! $standard_library
611	       && $reffiles[$currentfile][0] =~ /$standard_file_regexp/);
612      foreach (split (" ", $1))
613      {
614	  (s/^(\d+)\|//) && do { $lastfile = $1 - 1; };
615	  &create_new_reference
616	      ($_, $reffiles[$lastfile][0], $reffiles[$lastfile][1],
617	       $currentref);
618      }
619    }
620  }
621}
622
623#########
624##  Return the name of the ALI file to use for a given source
625##  Params:  - Name of the source file
626##  return:  Name and location of the ALI file
627#########
628
629sub ali_file_name {
630    local ($source) = shift;
631    local ($alifilename, $unitname);
632    local ($in_separate) = 0;
633
634    $source =~ s/\.ad[sb]$//;
635    $alifilename = $source;
636    $unitname = $alifilename;
637    $unitname =~ s/-/./g;
638
639    ## There are two reasons why we might not find the ALI file: either the
640    ## user did not generate them at all, or we are working on a separate unit.
641    ## Thus, we search in the parent's ALI file.
642
643    while ($alifilename ne "") {
644
645      ## Search in the object path
646      foreach (@obj_dir) {
647
648	## Check if the ALI file does apply to the source file
649	## We check the ^D lines, which have the following format:
650	## D source-name time-stamp checksum [subunit-name] line:file-name
651
652	if (-r "$_$alifilename.ali") {
653	  if ($in_separate) {
654	    open (FILE, "$_$alifilename.ali");
655
656	    if (grep (/^D \S+\s+\S+\s+\S+ $unitname/, <FILE>)) {
657	      close FILE;
658	      return "$_$alifilename.ali";
659
660	    } else {
661	      ## If the ALI file doesn't apply to the source file, we can
662	      ## return now, since there won't be a parent ALI file above
663	      ## anyway
664	      close FILE;
665	      return "$source.ali";
666	    }
667	  } else {
668	    return "$_$alifilename.ali";
669	  }
670	}
671      }
672
673      ## Get the parent's ALI file name
674
675      if (! ($alifilename =~ s/-[^-]+$//)) {
676	$alifilename = "";
677      }
678      $in_separate = 1;
679    }
680
681    return "$source.ali";
682}
683
684#########
685## Convert a path to an absolute path
686#########
687
688sub to_absolute
689{
690  local ($path) = shift;
691  local ($name, $suffix, $separator);
692  ($name,$path,$suffix) = fileparse ($path, ());
693  $path = &abs_path ($path);
694  $separator = substr ($path, 0, 1);
695  return $path . $separator . $name;
696}
697
698#########
699##  This function outputs the html version of the file FILE
700##  The output is send to FILE.htm.
701##  Params :  - Name of the file to convert (ends with .ads or .adb)
702#########
703sub output_file
704{
705  local ($filename_param) = shift;
706  local ($lineno)   = 1;
707  local ($column);
708  local ($found);
709
710  local ($alifilename) = &ali_file_name ($filename_param);
711
712  $filename = &get_real_file_name ($filename_param);
713  $found = &find_file ($filename);
714
715  ## Read the whole file
716  open (FILE, $found) || do {
717    print $found, " not found ... skipping.\n";
718    return 0;
719  };
720  local (@file) = <FILE>;
721  close (FILE);
722
723  ## Parse the .ali file to find the cross-references
724  print "converting ", $filename, "\n";
725  &parse_ali ($alifilename);
726
727  ## Create and initialize the html file
728  open (OUTPUT, ">$output_dir/" . &http_string ($filename) . ".$fileext")
729      || die "Couldn't write $output_dir/" . &http_string ($filename)
730	  . ".$fileext\n";
731
732  if ($absolute) {
733     print OUTPUT &create_header (&to_absolute ($found)), "\n";
734  } else {
735     print OUTPUT &create_header ($filename_param), "\n";
736  }
737
738  ## Print the file
739  $filename = &http_string ($filename);
740  foreach (@file)
741  {
742      local ($index);
743      local ($line) = $_;
744      local ($comment);
745
746      $column = 1;
747      chop ($line);
748
749      ## Print either the line number or a space if required
750      if ($line_numbers)
751      {
752	  if ($lineno % $line_numbers == 0)
753	  {
754	      print OUTPUT &output_line_number ($lineno);
755	  }
756	  else
757	  {
758	      print OUTPUT &output_line_number (-1);
759	  }
760      }
761
762      ## First, isolate any comment on the line
763      undef $comment;
764      $index = index ($line, '--');
765      if ($index != -1) {
766	  $comment = substr ($line, $index + 2);
767	  if ($index > 1)
768	  {
769	      $line = substr ($line, 0, $index);
770	  }
771	  else
772	  {
773	      undef $line;
774	  }
775      }
776
777      ## Then print the line
778      if (defined $line)
779      {
780	  $index = 0;
781	  while ($index < length ($line))
782	  {
783	      local ($substring) = substr ($line, $index);
784
785	      if ($substring =~ /^\t/)
786	      {
787		  print OUTPUT ' ' x ($tab_size - (($column - 1) % $tab_size));
788		  $column += $tab_size - (($column - 1) % $tab_size);
789		  $index ++;
790	      }
791	      elsif ($substring =~ /^(\w+)/
792		     || $substring =~ /^("[^\"]*")/
793		     || $substring =~ /^(\W)/)
794	      {
795		  local ($word) = $1;
796		  $index += length ($word);
797
798		  local ($lowercase) = $word;
799		  $lowercase =~ tr/A-Z/a-z/;
800
801		  if ($keywords{$lowercase})
802		  {
803		      print OUTPUT &output_keyword ($word);
804		  }
805		  elsif ($symbols {"$filename.$fileext#$lineno\_$column"})
806		  {
807		      ##  A symbol can both have a link and be a reference for
808		      ##  another link, as is the case for bodies and
809		      ##  declarations
810
811		      if ($symbols_used{"$filename#$lineno\_$column"})
812		      {
813			  print OUTPUT "<A HREF=\"",
814			  $symbols_used{"$filename#$lineno\_$column"},
815			  "\">", &protect_string ($word), "</A>";
816			  print OUTPUT &output_symbol ('', $lineno, $column);
817		      }
818		      else
819		      {
820			  print OUTPUT &output_symbol ($word, $lineno, $column);
821		      }
822
823		      ## insert only functions into the global index
824
825		      if ($symbols {"$filename.$fileext#$lineno\_$column"} eq 'f')
826		      {
827			  push (@{$global_index {$word}},
828				[$filename_param, $filename, $lineno, $column]);
829		      }
830		  }
831		  elsif ($symbols_used{"$filename#$lineno\_$column"})
832		  {
833		      print OUTPUT "<A HREF=\"",
834		      $symbols_used{"$filename#$lineno\_$column"},
835		      "\">", &protect_string ($word), "</A>";
836		  }
837		  else
838		  {
839		      print OUTPUT &protect_string ($word);
840		  }
841		  $column += length ($word);
842	      }
843	      else
844	      {
845		  $index ++;
846		  $column ++;
847		  print OUTPUT &protect_string (substr ($substring, 0, 1));
848	      }
849	  }
850      }
851
852      ## Then output the comment
853      print OUTPUT &output_comment ($comment) if (defined $comment);
854      print OUTPUT "\n";
855
856      $lineno ++;
857  }
858
859  print OUTPUT &create_footer ($filename);
860  close (OUTPUT);
861  return 1;
862}
863
864#########
865##  This function generates the global index
866#########
867sub create_index_file
868{
869  open (INDEX, ">$output_dir/index.$fileext") || die "couldn't write $output_dir/index.$fileext";
870
871  print INDEX <<"EOF";
872<HTML>
873<HEAD><TITLE>Source Browser</TITLE></HEAD>
874<FRAMESET COLS='250,*'>
875<NOFRAME>
876EOF
877  ;
878
879  local (@files) = &create_file_index;
880  print INDEX join ("\n", @files), "\n";
881
882  print INDEX "<HR>\n";
883  local (@functions) = &create_function_index;
884  print INDEX join ("\n", @functions), "\n";
885
886  print INDEX <<"EOF";
887</NOFRAME>
888<FRAMESET ROWS='50%,50%'>
889<FRAME NAME=files SRC=files.$fileext>
890<FRAME NAME=funcs SRC=funcs.$fileext>
891</FRAMESET>
892<FRAME NAME=main SRC=main.$fileext>
893</FRAMESET>
894</HTML>
895EOF
896  ;
897  close (INDEX);
898
899  open (MAIN, ">$output_dir/main.$fileext") || die "couldn't write $output_dir/main.$fileext";
900  print MAIN &create_header (""),
901  "<P ALIGN=right>",
902  "<A HREF=main.$fileext TARGET=_top>[No frame version is here]</A>",
903  "<P>",
904  join ("\n", @files), "\n<HR>",
905  join ("\n", @functions), "\n";
906
907  if ($dependencies) {
908      print MAIN "<HR>\n";
909      print MAIN "You should start your browsing with one of these files:\n";
910      print MAIN "<UL>\n";
911      foreach (@original_list) {
912	  print MAIN "<LI><A HREF=", &http_string (&get_real_file_name ($_)),
913	     ".$fileext>$_</A>\n";
914      }
915  }
916  print MAIN &create_footer ("");
917  close (MAIN);
918}
919
920#######
921##  Convert to upper cases (did not exist in Perl 4)
922#######
923
924sub uppercases {
925  local ($tmp) = shift;
926  $tmp =~ tr/a-z/A-Z/;
927  return $tmp;
928}
929
930#######
931##  This function generates the file_index
932##  RETURN : - table with the html lines to be printed
933#######
934sub create_file_index
935{
936  local (@output) = ("<H2 ALIGN=CENTER>Files</H2>");
937
938
939  open (FILES, ">$output_dir/files.$fileext") || die "couldn't write $output_dir/files.$fileext";
940  print FILES &create_header (""), join ("\n", @output), "\n";
941
942
943  if ($#list_files > 20)
944  {
945    local ($last_letter) = '';
946    foreach (sort {&uppercases ($a) cmp &uppercases ($b)} @list_files)
947    {
948      next if ($_ eq "");
949      if (&uppercases (substr ($_, 0, 1)) ne $last_letter)
950      {
951	if ($last_letter ne '')
952	{
953	  print INDEX_FILE "</UL></BODY></HTML>\n";
954	  close (INDEX_FILE);
955	}
956	$last_letter = &uppercases (substr ($_, 0, 1));
957	open (INDEX_FILE, ">$output_dir/files/$last_letter.$fileext")
958	|| die "couldn't write $output_dir/files/$last_letter.$fileext";
959	print INDEX_FILE <<"EOF";
960<HTML><HEAD><TITLE>$last_letter</TITLE></HEAD>
961<BODY>
962<H2>Files - $last_letter</H2>
963<A HREF=../files.$fileext TARGET=_self>[index]</A>
964<UL COMPACT TYPE=DISC>
965EOF
966	;
967	local ($str) = "<A HREF=files/$last_letter.$fileext>[$last_letter]</A>";
968	push (@output, $str);
969	print FILES "$str\n";
970      }
971      print INDEX_FILE "<LI><A HREF=../",
972      &http_string (&get_real_file_name ($_)),
973      ".$fileext TARGET=main>$_</A>\n";   ## Problem with TARGET when in no_frame mode!
974    }
975
976    print INDEX_FILE "</UL></BODY></HTML>\n";
977    close INDEX_FILE;
978  }
979  else
980  {
981    push (@output, "<UL COMPACT TYPE=DISC>");
982    print FILES "<UL COMPACT TYPE=DISC>";
983    foreach (sort {&uppercases ($a) cmp &uppercases ($b)} @list_files)
984    {
985      next if ($_ eq "");
986      local ($ref) = &http_string (&get_real_file_name ($_));
987      push (@output, "<LI><A HREF=$ref.$fileext>$_</A>");
988      print FILES "<LI><A HREF=$ref.$fileext TARGET=main>$_</A>\n";
989    }
990  }
991
992  print FILES &create_footer ("");
993  close (FILES);
994
995  push (@output, "</UL>");
996  return @output;
997}
998
999#######
1000##  This function generates the function_index
1001##  RETURN : - table with the html lines to be printed
1002#######
1003sub create_function_index
1004{
1005  local (@output) = ("<H2 ALIGN=CENTER>Functions/Procedures</H2>");
1006  local ($initial) = "";
1007
1008  open (FUNCS, ">$output_dir/funcs.$fileext") || die "couldn't write $output_dir/funcs.$fileext";
1009  print FUNCS &create_header (""), join ("\n", @output), "\n";
1010
1011  ## If there are more than 20 entries, we just want to create some
1012  ## submenus
1013  if (scalar (keys %global_index) > 20)
1014  {
1015    local ($last_letter) = '';
1016    foreach (sort {&uppercases ($a) cmp &uppercases ($b)} keys %global_index)
1017    {
1018      if (&uppercases (substr ($_, 0, 1)) ne $last_letter)
1019      {
1020	if ($last_letter ne '')
1021	{
1022	  print INDEX_FILE "</UL></BODY></HTML>\n";
1023	  close (INDEX_FILE);
1024	}
1025
1026	$last_letter = &uppercases (substr ($_, 0, 1));
1027	$initial = $last_letter;
1028	if ($initial eq '"')
1029	{
1030	    $initial = "operators";
1031	}
1032	if ($initial ne '.')
1033	{
1034	    open (INDEX_FILE, ">$output_dir/funcs/$initial.$fileext")
1035		|| die "couldn't write $output_dir/funcs/$initial.$fileext";
1036	    print INDEX_FILE <<"EOF";
1037<HTML><HEAD><TITLE>$initial</TITLE></HEAD>
1038<BODY>
1039<H2>Functions - $initial</H2>
1040<A HREF=../funcs.$fileext TARGET=_self>[index]</A>
1041<UL COMPACT TYPE=DISC>
1042EOF
1043				    ;
1044	    local ($str) = "<A HREF=funcs/$initial.$fileext>[$initial]</A>";
1045	    push (@output, $str);
1046	    print FUNCS "$str\n";
1047	}
1048      }
1049      local ($ref);
1050      local ($is_overloaded) = ($#{$global_index {$_}} > 0 ? 1 : 0);
1051      foreach $ref (@{$global_index {$_}})
1052      {
1053	  ($file, $full_file, $lineno, $column) = @{$ref};
1054	  local ($symbol) = ($is_overloaded ? "$_ -  $file:$lineno" : $_);
1055	  print INDEX_FILE "<LI><A HREF=../$full_file.$fileext#$lineno\_$column TARGET=main>$symbol</A>";
1056      }
1057    }
1058
1059    print INDEX_FILE "</UL></BODY></HTML>\n";
1060    close INDEX_FILE;
1061  }
1062  else
1063  {
1064    push (@output, "<UL COMPACT TYPE=DISC>");
1065    print FUNCS "<UL COMPACT TYPE=DISC>";
1066    foreach (sort {&uppercases ($a) cmp &uppercases ($b)} keys %global_index)
1067    {
1068      local ($ref);
1069      local ($is_overloaded) = ($#{$global_index {$_}} > 0 ? 1 : 0);
1070      foreach $ref (@{$global_index {$_}})
1071      {
1072	  ($file, $full_file, $lineno, $column) = @{$ref};
1073	  local ($symbol) = ($is_overloaded ? "$_ -  $file:$lineno" : $_);
1074	  push (@output, "<LI><A HREF=$full_file.$fileext#$lineno\_$column>$symbol</A>");
1075	  print FUNCS "<LI><A HREF=$full_file.$fileext#$lineno\_$column TARGET=main>$symbol</A>";
1076      }
1077    }
1078  }
1079
1080  print FUNCS &create_footer ("");
1081  close (FUNCS);
1082
1083  push (@output, "</UL>");
1084  return (@output);
1085}
1086
1087######
1088##  Main function
1089######
1090
1091local ($index_file) = 0;
1092
1093mkdir ($output_dir, 0755)          if (! -d $output_dir);
1094mkdir ($output_dir."/files", 0755) if (! -d $output_dir."/files");
1095mkdir ($output_dir."/funcs", 0755) if (! -d $output_dir."/funcs");
1096
1097&parse_prj_file ($prjfile) if ($prjfile);
1098
1099while ($index_file <= $#list_files)
1100{
1101  local ($file) = $list_files [$index_file];
1102
1103  if (&output_file ($file) == 0)
1104    {
1105      $list_files [$index_file] = "";
1106    }
1107  $index_file ++;
1108}
1109&create_index_file;
1110
1111$indexfile = "$output_dir/index.$fileext";
1112$indexfile =~ s!//!/!g;
1113print "You can now download the $indexfile file to see the ",
1114  "created pages\n";
1115