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