From 3186be22b6598fbd467b126347d1c7f48ccb7f71 Mon Sep 17 00:00:00 2001 From: Dan Albert Date: Thu, 14 Jan 2016 16:43:34 -0800 Subject: Check in a pristine copy of GCC 4.8.1. The copy of GCC that we use for Android is still not working for mingw. Rather than finding all the differences that have crept into our GCC, just check in a copy from ftp://ftp.gnu.org/gnu/gcc/gcc-4.9.3/gcc-4.8.1.tar.bz2. GCC 4.8.1 was chosen because it is what we have been using for mingw thus far, and the emulator doesn't yet work when upgrading to 4.9. Bug: http://b/26523949 Change-Id: Iedc0f05243d4332cc27ccd46b8a4b203c88dcaa3 --- gcc-4.8.1/gcc/ada/gnathtml.pl | 1114 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1114 insertions(+) create mode 100644 gcc-4.8.1/gcc/ada/gnathtml.pl (limited to 'gcc-4.8.1/gcc/ada/gnathtml.pl') diff --git a/gcc-4.8.1/gcc/ada/gnathtml.pl b/gcc-4.8.1/gcc/ada/gnathtml.pl new file mode 100644 index 000000000..548fde1ef --- /dev/null +++ b/gcc-4.8.1/gcc/ada/gnathtml.pl @@ -0,0 +1,1114 @@ +#! /usr/bin/env perl + +#----------------------------------------------------------------------------- +#- -- +#- GNAT COMPILER COMPONENTS -- +#- -- +#- G N A T H T M L -- +#- -- +#- Copyright (C) 1998-2009, Free Software Foundation, Inc. -- +#- -- +#- GNAT is free software; you can redistribute it and/or modify it under -- +#- terms of the GNU General Public License as published by the Free Soft- -- +#- ware Foundation; either version 3, or (at your option) any later ver- -- +#- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +#- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +#- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +#- for more details. You should have received a copy of the GNU General -- +#- Public License distributed with GNAT; see file COPYING3. If not see -- +#- . -- +#- -- +#- GNAT was originally developed by the GNAT team at New York University. -- +#- Extensive contributions were provided by Ada Core Technologies Inc. -- +#- -- +#----------------------------------------------------------------------------- + +## This script converts an Ada file (and its dependency files) to Html. +## Keywords, comments and strings are color-hilighted. If the cross-referencing +## information provided by Gnat (when not using the -gnatx switch) is found, +## the html files will also have some cross-referencing features, i.e. if you +## click on a type, its declaration will be displayed. +## +## To find more about the switches provided by this script, please use the +## following command : +## perl gnathtml.pl -h +## You may also change the first line of this script to indicates where Perl is +## installed on your machine, so that you can just type +## gnathtml.pl -h +## +## Unless you supply another directory with the -odir switch, the html files +## will be saved saved in a html subdirectory + +use Cwd 'abs_path'; +use File::Basename; + +### Print help if necessary +sub print_usage +{ + print "Usage is:\n"; + print " $0 [switches] main_file[.adb] main_file2[.adb] ...\n"; + print " -83 : Use Ada83 keywords only (default is Ada95)\n"; + print " -cc color : Choose the color for comments\n"; + print " -d : Convert also the files which main_file depends on\n"; + print " -D : same as -d, also looks for files in the standard library\n"; + print " -f : Include cross-references for local entities too\n"; + print " -absolute : Display absolute filenames in the headers\n"; + print " -h : Print this help page\n"; + print " -lnb : Display line numbers every nb lines\n"; + print " -Idir : Specify library/object files search path\n"; + print " -odir : Name of the directory where the html files will be\n"; + print " saved. Default is 'html/'\n"; + print " -pfile : Use file as a project file (.adp file)\n"; + print " -sc color : Choose the color for symbol definitions\n"; + print " -Tfile : Read the name of the files from file rather than the\n"; + print " command line\n"; + print " -ext ext : Choose the generated file names extension (default\n"; + print " is htm)\n"; + print "This program attempts to generate an html file from an Ada file\n"; + exit; +} + +### Parse the command line +local ($ada83_mode) = 0; +local ($prjfile) = ""; +local (@list_files) = (); +local ($line_numbers) = 0; +local ($dependencies) = 0; +local ($standard_library) = 0; +local ($output_dir) = "html"; +local ($xref_variable) = 0; +local (@search_dir) = ('.'); +local ($tab_size) = 8; +local ($comment_color) = "green"; +local ($symbol_color) = "red"; +local ($absolute) = 0; +local ($fileext) = "htm"; + +while ($_ = shift @ARGV) +{ + /^-83$/ && do { $ada83_mode = 1; }; + /^-d$/ && do { $dependencies = 1; }; + /^-D$/ && do { $dependencies = 1; + $standard_library = 1; }; + /^-f$/ && do { $xref_variable = 1; }; + /^-absolute$/ && do {$absolute = 1; }; + /^-h$/ && do { &print_usage; }; + /^[^-]/ && do { $_ .= ".adb" if (! /\.ad[bs]$/); + push (@list_files, $_); }; + + if (/^-o\s*(.*)$/) + { + $output_dir = ($1 eq "") ? shift @ARGV : $1; + chop $output_dir if ($output_dir =~ /\/$/); + &print_usage if ($output_dir =~ /^-/ || $output_dir eq ""); + } + + if (/^-T\s*(.*)$/) + { + my ($source_file) = ($1 eq "") ? shift @ARGV : $1; + local (*SOURCE); + open (SOURCE, "$source_file") || die "file not found: $source_file"; + while () { + @files = split; + foreach (@files) { + $_ .= ".adb" if (! /\.ad[bs]$/); + push (@list_files, $_); + } + } + } + + if (/^-cc\s*(.*)$/) + { + $comment_color = ($1 eq "") ? shift @ARGV : $1; + &print_usage if ($comment_color =~ /^-/ || $comment_color eq ""); + } + + if (/^-sc\s*(.*)$/) + { + $symbol_color = ($1 eq "") ? shift @ARGV : $1; + &print_usage if ($symbol_color =~ /^-/ || $symbol_color eq ""); + } + + if (/^-I\s*(.*)$/) + { + push (@search_dir, ($1 eq "") ? scalar (shift @ARGV) : $1); + } + + if (/^-p\s*(.*)$/) + { + $prjfile = ($1 eq "") ? shift @ARGV : $1; + &print_usage if ($prjfile =~ /^-/ || $prjfile eq ""); + } + + if (/^-l\s*(.*)$/) + { + $line_numbers = ($1 eq "") ? shift @ARGV : $1; + &print_usage if ($line_numbers =~ /^-/ || $line_numbers eq ""); + } + + if (/^-ext\s*(.*)$/) + { + $fileext = ($1 eq "") ? shift @ARGV : $1; + &print_usage if ($fileext =~ /^-/ || $fileext eq ""); + } +} + +&print_usage if ($#list_files == -1); +local (@original_list) = @list_files; + +## This regexp should match all the files from the standard library (and only them) +## Note that at this stage the '.' in the file names has been replaced with __ +$standard_file_regexp="^([agis]-|ada__|gnat__|system__|interface__).*\$"; + +local (@src_dir) = (); +local (@obj_dir) = (); + +if ($standard_library) { + open (PIPE, "gnatls -v | "); + local ($mode) = ""; + while (defined ($_ = )) { + chop; + s/^\s+//; + $_ = './' if (//); + next if (/^$/); + + if (/Source Search Path:/) { + $mode = 's'; + } + elsif (/Object Search Path:/) { + $mode = 'o'; + } + elsif ($mode eq 's') { + push (@src_dir, $_); + } + elsif ($mode eq 'o') { + push (@obj_dir, $_); + } + } + close (PIPE); +} +else +{ + push (@src_dir, "./"); + push (@obj_dir, "./"); +} + +foreach (@list_files) { + local ($dir) = $_; + $dir =~ s/\/([^\/]+)$//; + push (@src_dir, $dir. '/'); + push (@obj_dir, $dir. '/'); +} + +### Defines and compiles the Ada key words : +local (@Ada_keywords) = ('abort', 'abs', 'accept', 'access', 'all', 'and', + 'array', 'at', 'begin', 'body', 'case', 'constant', + 'declare', 'delay', 'delta', 'digits', 'do', 'else', + 'elsif', 'end', 'entry', 'exception', 'exit', 'for', + 'function', 'generic', 'goto', 'if', 'in', 'is', + 'limited', 'loop', 'mod', 'new', 'not', 'null', 'of', + 'or', 'others', 'out', 'package', 'pragma', 'private', + 'procedure', 'raise', 'range', 'record', 'rem', + 'renames', 'return', 'reverse', 'select', 'separate', + 'subtype', 'task', 'terminate', 'then', 'type', + 'until', 'use', 'when', 'while', 'with', 'xor'); +local (@Ada95_keywords) = ('abstract', 'aliased', 'protected', 'requeue', + 'tagged'); + +local (%keywords) = (); +grep (++ $keywords{$_}, @Ada_keywords); +grep (++ $keywords{$_}, @Ada95_keywords) unless ($ada83_mode); + +### Symbols declarations for the current file +### format is (line_column => 1, ...) +local (%symbols); + +### Symbols usage for the current file +### format is ($adafile#$line_$column => $htmlfile#$linedecl_$columndecl, ...) +local (%symbols_used); + +### the global index of all symbols +### format is ($name => [[file, line, column], [file, line, column], ...]) +local (%global_index); + +######### +## This function create the header of every html file. +## These header is returned as a string +## Params: - Name of the Ada file associated with this html file +######### +sub create_header +{ + local ($adafile) = shift; + local ($string) = "$adafile +\n"; + + if ($adafile ne "") + { + $string .= "

File : $adafile " + . "

\n
";
+  }
+  return $string;
+}
+
+#########
+##  Protect a string (or character) from the Html parser
+##  Params: - the string to protect
+##  Out:    - the protected string
+#########
+sub protect_string
+{
+    local ($string) = shift;
+    $string =~ s/&/&/g;
+    $string =~ s//>/g;
+    return $string;
+}
+
+#########
+##  This function creates the footer of the html file
+##  The footer is returned as a string
+##  Params :  - Name of the Ada file associated with this html file
+#########
+sub create_footer
+{
+  local ($adafile) = shift;
+  local ($string) = "";
+  $string = "
" if ($adafile ne ""); + return $string . "\n"; +} + +######### +## This function creates the string to use for comment output +## Params : - the comment itself +######### +sub output_comment +{ + local ($comment) = &protect_string (shift); + return "--$comment"; +} + +######## +## This function creates the string to use for symbols output +## Params : - the symbol to output +## - the current line +## - the current column +######## +sub output_symbol +{ + local ($symbol) = &protect_string (shift); + local ($lineno) = shift; + local ($column) = shift; + return "$symbol"; +} + +######## +## This function creates the string to use for keyword output +## Params : - the keyword to output +######## +sub output_keyword +{ + local ($keyw) = shift; + return "$keyw"; +} + +######## +## This function outputs a line number +## Params : - the line number to generate +######## +sub output_line_number +{ + local ($no) = shift; + if ($no != -1) + { + return "" . sprintf ("%4d ", $no) . ""; + } + else + { + return " "; + } +} + +######## +## Converts a character into the corresponding Ada type +## This is based on the ali format (see lib-xref.adb) in the GNAT sources +## Note: 'f' or 'K' should be returned in case a link from the body to the +## spec needs to be generated. +## Params : - the character to convert +######## +sub to_type +{ + local ($char) = shift; + $char =~ tr/a-z/A-Z/; + + return 'array' if ($char eq 'A'); + return 'boolean' if ($char eq 'B'); + return 'class' if ($char eq 'C'); + return 'decimal' if ($char eq 'D'); + return 'enumeration' if ($char eq 'E'); + return 'floating point' if ($char eq 'F'); + return 'signed integer' if ($char eq 'I'); + # return 'generic package' if ($char eq 'K'); + return 'block' if ($char eq 'L'); + return 'modular integer' if ($char eq 'M'); + return 'enumeration literal' if ($char eq 'N'); + return 'ordinary fixed point' if ($char eq 'O'); + return 'access' if ($char eq 'P'); + return 'label' if ($char eq 'Q'); + return 'record' if ($char eq 'R'); + return 'string' if ($char eq 'S'); + return 'task' if ($char eq 'T'); + return 'f' if ($char eq 'U'); + return 'f' if ($char eq 'V'); + return 'exception' if ($char eq 'X'); + return 'entry' if ($char eq 'Y'); + return "$char"; +} + +######## +## Changes a file name to be http compatible +######## +sub http_string +{ + local ($str) = shift; + $str =~ s/\//__/g; + $str =~ s/\\/__/g; + $str =~ s/:/__/g; + $str =~ s/\./__/g; + return $str; +} + +######## +## Creates the complete file-name, with directory +## use the variables read in the .prj file +## Params : - file name +## RETURNS : the relative path_name to the file +######## +sub get_real_file_name +{ + local ($filename) = shift; + local ($path) = $filename; + + foreach (@src_dir) + { + if ( -r "$_$filename") + { + $path = "$_$filename"; + last; + } + } + + $path =~ s/^\.\///; + return $path if (substr ($path, 0, 1) ne '/'); + + ## We want to return relative paths only, so that the name of the HTML files + ## can easily be generated + local ($pwd) = `pwd`; + chop ($pwd); + local (@pwd) = split (/\//, $pwd); + local (@path) = split (/\//, $path); + + while (@pwd) + { + if ($pwd [0] ne $path [0]) + { + return '../' x ($#pwd + 1) . join ("/", @path); + } + shift @pwd; + shift @path; + } + return join ('/', @path); +} + +######## +## Reads and parses .adp files +## Params : - adp file name +######## +sub parse_prj_file +{ + local ($filename) = shift; + local (@src) = (); + local (@obj) = (); + + print "Parsing project file : $filename\n"; + + open (PRJ, $filename) || do { print " ... sorry, file not found\n"; + return; + }; + while () + { + chop; + s/\/$//; + push (@src, $1 . "/") if (/^src_dir=(.*)/); + push (@obj, $1 . "/") if (/^obj_dir=(.*)/); + } + unshift (@src_dir, @src); + unshift (@obj_dir, @obj); + close (PRJ); +} + +######## +## Finds a file in the search path +## Params : - the name of the file +## RETURNS : - the directory/file_name +######## +sub find_file +{ + local ($filename) = shift; + + foreach (@search_dir) { + if (-f "$_/$filename") { + return "$_/$filename"; + } + } + return $filename; +} + +######## +## Inserts a new reference in the list of references +## Params: - Ref as it appears in the .ali file ($line$type$column) +## - Current file for the reference +## - Current offset to be added from the line (handling of +## pragma Source_Reference) +## - Current entity reference +## Modifies: - %symbols_used +######## +sub create_new_reference +{ + local ($ref) = shift; + local ($lastfile) = shift; + local ($offset) = shift; + local ($currentref) = shift; + local ($refline, $type, $refcol); + + ## Do not generate references to the standard library files if we + ## do not generate the corresponding html files + return if (! $standard_library && $lastfile =~ /$standard_file_regexp/); + + ($refline, $type, $extern, $refcol) = /(\d+)(.)(<[^>]+>)?(\d+)/; + $refline += $offset; + + ## If we have a body, then we only generate the cross-reference from + ## the spec to the body if we have a subprogram (or a package) + + + if ($type eq "b") +# && ($symbols {$currentref} eq 'f' || $symbols {$currentref} eq 'K')) + { + local ($cref_file, $cref) = ($currentref =~ /([^\#]+).$fileext\#(.+)/); + + $symbols_used {"$cref_file#$cref"} = "$lastfile.$fileext#$refline\_$refcol"; + $symbols_used {"$lastfile#$refline\_$refcol"} = $currentref; + $symbols {"$lastfile.$fileext#$refline\_$refcol"} = "body"; + } + + ## Do not generate cross-references for "e" and "t", since these point to the + ## semicolon that terminates the block -- irrelevant for gnathtml + ## "p" is also removed, since it is used for primitive subprograms + ## "d" is also removed, since it is used for discriminants + ## "i" is removed since it is used for implicit references + ## "z" is used for generic formals + ## "k" is for references to parent package + ## "=", "<", ">", "^" is for subprogram parameters + + elsif ($type !~ /[eztpid=<>^k]/) + { + $symbols_used {"$lastfile#$refline\_$refcol"} = $currentref; + } +} + +######## +## Parses the ali file associated with the current Ada file +## Params : - the complete ali file name +######## +sub parse_ali +{ + local ($filename) = shift; + local ($currentfile); + local ($currentref); + local ($lastfile); + + # A file | line type column reference + local ($reference) = "(?:(?:\\d+\\|)?\\d+.\\d+|\\w+)"; + + # The following variable is used to represent the possible xref information + # output by GNAT when -gnatdM is used. It includes renaming references, and + # references to the parent type, as well as references to the generic parent + + local ($typeref) = "(?:=$reference|<$reference>|\\{$reference\\}|\\($reference\\)|\\[$reference\\])?"; + + # The beginning of an entity declaration line in the ALI file + local ($decl_line) = "^(\\d+)(.)(\\d+)[ *]([\\w\\d.-]+|\"..?\")$typeref\\s+(\\S.*)?\$"; + + # Contains entries of the form [ filename source_reference_offset] + # Offset needs to be added to the lines read in the cross-references, and are + # used when the source comes from a gnatchop-ed file. See lib-write.ads, lines + # with ^D in the ALI file. + local (@reffiles) = (); + + open (ALI, &find_file ($filename)) || do { + print "no ", &find_file ($filename), " file...\n"; + return; + }; + local (@ali) = ; + close (ALI); + + undef %symbols; + undef %symbols_used; + + foreach (@ali) + { + ## The format of D lines is + ## D source-name time-stamp checksum [subunit-name] line:file-name + + if (/^D\s+([\w\d.-]+)\s+\S+ \S+(\s+\D[^: ]+)?( (\d+):(.*))?/) + { + # The offset will be added to each cross-reference line. If it is + # greater than 1, this means that we have a pragma Source_Reference, + # and this must not be counted in the xref information. + my ($file, $offset) = ($1, (defined $4) ? 2 - $4 : 0); + + if ($dependencies) + { + push (@list_files, $1) unless (grep (/$file/, @list_files)); + } + push (@reffiles, [&http_string (&get_real_file_name ($file)), $offset]); + } + + elsif (/^X\s+(\d+)/) + { + $currentfile = $lastfile = $1 - 1; + } + + elsif (defined $currentfile && /$decl_line/) + { + my ($line) = $1 + $reffiles[$currentfile][1]; + next if (! $standard_library + && $reffiles[$currentfile][0] =~ /$standard_file_regexp/); + if ($xref_variable || $2 eq &uppercases ($2)) + { + $currentref = $reffiles[$currentfile][0] . ".$fileext#$line\_$3"; + $symbols {$currentref} = &to_type ($2); + $lastfile = $currentfile; + + local ($endofline) = $5; + + foreach (split (" ", $endofline)) + { + (s/^(\d+)\|//) && do { $lastfile = $1 - 1; }; + &create_new_reference + ($_, $reffiles[$lastfile][0], + $reffiles[$lastfile][1], $currentref); + } + } + else + { + $currentref = ""; + } + } + elsif (/^\.\s(.*)/ && $reffiles[$currentfile][0] ne "" && $currentref ne "") + { + next if (! $standard_library + && $reffiles[$currentfile][0] =~ /$standard_file_regexp/); + foreach (split (" ", $1)) + { + (s/^(\d+)\|//) && do { $lastfile = $1 - 1; }; + &create_new_reference + ($_, $reffiles[$lastfile][0], $reffiles[$lastfile][1], + $currentref); + } + } + } +} + +######### +## Return the name of the ALI file to use for a given source +## Params: - Name of the source file +## return: Name and location of the ALI file +######### + +sub ali_file_name { + local ($source) = shift; + local ($alifilename, $unitname); + local ($in_separate) = 0; + + $source =~ s/\.ad[sb]$//; + $alifilename = $source; + $unitname = $alifilename; + $unitname =~ s/-/./g; + + ## There are two reasons why we might not find the ALI file: either the + ## user did not generate them at all, or we are working on a separate unit. + ## Thus, we search in the parent's ALI file. + + while ($alifilename ne "") { + + ## Search in the object path + foreach (@obj_dir) { + + ## Check if the ALI file does apply to the source file + ## We check the ^D lines, which have the following format: + ## D source-name time-stamp checksum [subunit-name] line:file-name + + if (-r "$_$alifilename.ali") { + if ($in_separate) { + open (FILE, "$_$alifilename.ali"); + + if (grep (/^D \S+\s+\S+\s+\S+ $unitname/, )) { + close FILE; + return "$_$alifilename.ali"; + + } else { + ## If the ALI file doesn't apply to the source file, we can + ## return now, since there won't be a parent ALI file above + ## anyway + close FILE; + return "$source.ali"; + } + } else { + return "$_$alifilename.ali"; + } + } + } + + ## Get the parent's ALI file name + + if (! ($alifilename =~ s/-[^-]+$//)) { + $alifilename = ""; + } + $in_separate = 1; + } + + return "$source.ali"; +} + +######### +## Convert a path to an absolute path +######### + +sub to_absolute +{ + local ($path) = shift; + local ($name, $suffix, $separator); + ($name,$path,$suffix) = fileparse ($path, ()); + $path = &abs_path ($path); + $separator = substr ($path, 0, 1); + return $path . $separator . $name; +} + +######### +## This function outputs the html version of the file FILE +## The output is send to FILE.htm. +## Params : - Name of the file to convert (ends with .ads or .adb) +######### +sub output_file +{ + local ($filename_param) = shift; + local ($lineno) = 1; + local ($column); + local ($found); + + local ($alifilename) = &ali_file_name ($filename_param); + + $filename = &get_real_file_name ($filename_param); + $found = &find_file ($filename); + + ## Read the whole file + open (FILE, $found) || do { + print $found, " not found ... skipping.\n"; + return 0; + }; + local (@file) = ; + close (FILE); + + ## Parse the .ali file to find the cross-references + print "converting ", $filename, "\n"; + &parse_ali ($alifilename); + + ## Create and initialize the html file + open (OUTPUT, ">$output_dir/" . &http_string ($filename) . ".$fileext") + || die "Couldn't write $output_dir/" . &http_string ($filename) + . ".$fileext\n"; + + if ($absolute) { + print OUTPUT &create_header (&to_absolute ($found)), "\n"; + } else { + print OUTPUT &create_header ($filename_param), "\n"; + } + + ## Print the file + $filename = &http_string ($filename); + foreach (@file) + { + local ($index); + local ($line) = $_; + local ($comment); + + $column = 1; + chop ($line); + + ## Print either the line number or a space if required + if ($line_numbers) + { + if ($lineno % $line_numbers == 0) + { + print OUTPUT &output_line_number ($lineno); + } + else + { + print OUTPUT &output_line_number (-1); + } + } + + ## First, isolate any comment on the line + undef $comment; + $index = index ($line, '--'); + if ($index != -1) { + $comment = substr ($line, $index + 2); + if ($index > 1) + { + $line = substr ($line, 0, $index); + } + else + { + undef $line; + } + } + + ## Then print the line + if (defined $line) + { + $index = 0; + while ($index < length ($line)) + { + local ($substring) = substr ($line, $index); + + if ($substring =~ /^\t/) + { + print OUTPUT ' ' x ($tab_size - (($column - 1) % $tab_size)); + $column += $tab_size - (($column - 1) % $tab_size); + $index ++; + } + elsif ($substring =~ /^(\w+)/ + || $substring =~ /^("[^\"]*")/ + || $substring =~ /^(\W)/) + { + local ($word) = $1; + $index += length ($word); + + local ($lowercase) = $word; + $lowercase =~ tr/A-Z/a-z/; + + if ($keywords{$lowercase}) + { + print OUTPUT &output_keyword ($word); + } + elsif ($symbols {"$filename.$fileext#$lineno\_$column"}) + { + ## A symbol can both have a link and be a reference for + ## another link, as is the case for bodies and + ## declarations + + if ($symbols_used{"$filename#$lineno\_$column"}) + { + print OUTPUT "", &protect_string ($word), ""; + print OUTPUT &output_symbol ('', $lineno, $column); + } + else + { + print OUTPUT &output_symbol ($word, $lineno, $column); + } + + ## insert only functions into the global index + + if ($symbols {"$filename.$fileext#$lineno\_$column"} eq 'f') + { + push (@{$global_index {$word}}, + [$filename_param, $filename, $lineno, $column]); + } + } + elsif ($symbols_used{"$filename#$lineno\_$column"}) + { + print OUTPUT "", &protect_string ($word), ""; + } + else + { + print OUTPUT &protect_string ($word); + } + $column += length ($word); + } + else + { + $index ++; + $column ++; + print OUTPUT &protect_string (substr ($substring, 0, 1)); + } + } + } + + ## Then output the comment + print OUTPUT &output_comment ($comment) if (defined $comment); + print OUTPUT "\n"; + + $lineno ++; + } + + print OUTPUT &create_footer ($filename); + close (OUTPUT); + return 1; +} + +######### +## This function generates the global index +######### +sub create_index_file +{ + open (INDEX, ">$output_dir/index.$fileext") || die "couldn't write $output_dir/index.$fileext"; + + print INDEX <<"EOF"; + +Source Browser + + +EOF + ; + + local (@files) = &create_file_index; + print INDEX join ("\n", @files), "\n"; + + print INDEX "
\n"; + local (@functions) = &create_function_index; + print INDEX join ("\n", @functions), "\n"; + + print INDEX <<"EOF"; + + + + + + + + +EOF + ; + close (INDEX); + + open (MAIN, ">$output_dir/main.$fileext") || die "couldn't write $output_dir/main.$fileext"; + print MAIN &create_header (""), + "

", + "[No frame version is here]", + "

", + join ("\n", @files), "\n

", + join ("\n", @functions), "\n"; + + if ($dependencies) { + print MAIN "
\n"; + print MAIN "You should start your browsing with one of these files:\n"; + print MAIN "
    \n"; + foreach (@original_list) { + print MAIN "
  • $_\n"; + } + } + print MAIN &create_footer (""); + close (MAIN); +} + +####### +## Convert to upper cases (did not exist in Perl 4) +####### + +sub uppercases { + local ($tmp) = shift; + $tmp =~ tr/a-z/A-Z/; + return $tmp; +} + +####### +## This function generates the file_index +## RETURN : - table with the html lines to be printed +####### +sub create_file_index +{ + local (@output) = ("

    Files

    "); + + + open (FILES, ">$output_dir/files.$fileext") || die "couldn't write $output_dir/files.$fileext"; + print FILES &create_header (""), join ("\n", @output), "\n"; + + + if ($#list_files > 20) + { + local ($last_letter) = ''; + foreach (sort {&uppercases ($a) cmp &uppercases ($b)} @list_files) + { + next if ($_ eq ""); + if (&uppercases (substr ($_, 0, 1)) ne $last_letter) + { + if ($last_letter ne '') + { + print INDEX_FILE "
\n"; + close (INDEX_FILE); + } + $last_letter = &uppercases (substr ($_, 0, 1)); + open (INDEX_FILE, ">$output_dir/files/$last_letter.$fileext") + || die "couldn't write $output_dir/files/$last_letter.$fileext"; + print INDEX_FILE <<"EOF"; +$last_letter + +

Files - $last_letter

+[index] +
    +EOF + ; + local ($str) = "[$last_letter]"; + push (@output, $str); + print FILES "$str\n"; + } + print INDEX_FILE "
  • $_\n"; ## Problem with TARGET when in no_frame mode! + } + + print INDEX_FILE "
\n"; + close INDEX_FILE; + } + else + { + push (@output, "
    "); + print FILES "
      "; + foreach (sort {&uppercases ($a) cmp &uppercases ($b)} @list_files) + { + next if ($_ eq ""); + local ($ref) = &http_string (&get_real_file_name ($_)); + push (@output, "
    • $_"); + print FILES "
    • $_\n"; + } + } + + print FILES &create_footer (""); + close (FILES); + + push (@output, "
    "); + return @output; +} + +####### +## This function generates the function_index +## RETURN : - table with the html lines to be printed +####### +sub create_function_index +{ + local (@output) = ("

    Functions/Procedures

    "); + local ($initial) = ""; + + open (FUNCS, ">$output_dir/funcs.$fileext") || die "couldn't write $output_dir/funcs.$fileext"; + print FUNCS &create_header (""), join ("\n", @output), "\n"; + + ## If there are more than 20 entries, we just want to create some + ## submenus + if (scalar (keys %global_index) > 20) + { + local ($last_letter) = ''; + foreach (sort {&uppercases ($a) cmp &uppercases ($b)} keys %global_index) + { + if (&uppercases (substr ($_, 0, 1)) ne $last_letter) + { + if ($last_letter ne '') + { + print INDEX_FILE "
\n"; + close (INDEX_FILE); + } + + $last_letter = &uppercases (substr ($_, 0, 1)); + $initial = $last_letter; + if ($initial eq '"') + { + $initial = "operators"; + } + if ($initial ne '.') + { + open (INDEX_FILE, ">$output_dir/funcs/$initial.$fileext") + || die "couldn't write $output_dir/funcs/$initial.$fileext"; + print INDEX_FILE <<"EOF"; +$initial + +

Functions - $initial

+[index] +
    +EOF + ; + local ($str) = "[$initial]"; + push (@output, $str); + print FUNCS "$str\n"; + } + } + local ($ref); + local ($is_overloaded) = ($#{$global_index {$_}} > 0 ? 1 : 0); + foreach $ref (@{$global_index {$_}}) + { + ($file, $full_file, $lineno, $column) = @{$ref}; + local ($symbol) = ($is_overloaded ? "$_ - $file:$lineno" : $_); + print INDEX_FILE "
  • $symbol"; + } + } + + print INDEX_FILE "
\n"; + close INDEX_FILE; + } + else + { + push (@output, "
    "); + print FUNCS "
      "; + foreach (sort {&uppercases ($a) cmp &uppercases ($b)} keys %global_index) + { + local ($ref); + local ($is_overloaded) = ($#{$global_index {$_}} > 0 ? 1 : 0); + foreach $ref (@{$global_index {$_}}) + { + ($file, $full_file, $lineno, $column) = @{$ref}; + local ($symbol) = ($is_overloaded ? "$_ - $file:$lineno" : $_); + push (@output, "
    • $symbol"); + print FUNCS "
    • $symbol"; + } + } + } + + print FUNCS &create_footer (""); + close (FUNCS); + + push (@output, "
    "); + return (@output); +} + +###### +## Main function +###### + +local ($index_file) = 0; + +mkdir ($output_dir, 0755) if (! -d $output_dir); +mkdir ($output_dir."/files", 0755) if (! -d $output_dir."/files"); +mkdir ($output_dir."/funcs", 0755) if (! -d $output_dir."/funcs"); + +&parse_prj_file ($prjfile) if ($prjfile); + +while ($index_file <= $#list_files) +{ + local ($file) = $list_files [$index_file]; + + if (&output_file ($file) == 0) + { + $list_files [$index_file] = ""; + } + $index_file ++; +} +&create_index_file; + +$indexfile = "$output_dir/index.$fileext"; +$indexfile =~ s!//!/!g; +print "You can now download the $indexfile file to see the ", + "created pages\n"; -- cgit v1.2.3