diff options
Diffstat (limited to 'gcc-4.8/gcc/ada/gnathtml.pl')
| -rw-r--r-- | gcc-4.8/gcc/ada/gnathtml.pl | 1114 |
1 files changed, 0 insertions, 1114 deletions
diff --git a/gcc-4.8/gcc/ada/gnathtml.pl b/gcc-4.8/gcc/ada/gnathtml.pl deleted file mode 100644 index 548fde1ef..000000000 --- a/gcc-4.8/gcc/ada/gnathtml.pl +++ /dev/null @@ -1,1114 +0,0 @@ -#! /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 -- -#- <http://www.gnu.org/licenses/>. -- -#- -- -#- 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 (<SOURCE>) { - @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 ($_ = <PIPE>)) { - chop; - s/^\s+//; - $_ = './' if (/<Current_Directory>/); - 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) = "<HEAD><TITLE>$adafile</TITLE></HEAD> -<BODY>\n"; - - if ($adafile ne "") - { - $string .= "<HR><DIV ALIGN=\"center\"><H1> File : $adafile " - . "</H1></DIV><HR>\n<PRE>"; - } - 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; - $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 = "</PRE>" if ($adafile ne ""); - return $string . "</BODY></HTML>\n"; -} - -######### -## This function creates the string to use for comment output -## Params : - the comment itself -######### -sub output_comment -{ - local ($comment) = &protect_string (shift); - return "<FONT COLOR=$comment_color><EM>--$comment</EM></FONT>"; -} - -######## -## 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 "<FONT COLOR=$symbol_color><A NAME=\"$lineno\_$column\">$symbol</A></FONT>"; -} - -######## -## This function creates the string to use for keyword output -## Params : - the keyword to output -######## -sub output_keyword -{ - local ($keyw) = shift; - return "<b>$keyw</b>"; -} - -######## -## This function outputs a line number -## Params : - the line number to generate -######## -sub output_line_number -{ - local ($no) = shift; - if ($no != -1) - { - return "<EM><FONT SIZE=-1>" . sprintf ("%4d ", $no) . "</FONT></EM>"; - } - else - { - return "<FONT SIZE=-1> </FONT>"; - } -} - -######## -## 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 (<PRJ>) - { - 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) = <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/, <FILE>)) { - 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) = <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 "<A HREF=\"", - $symbols_used{"$filename#$lineno\_$column"}, - "\">", &protect_string ($word), "</A>"; - 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 "<A HREF=\"", - $symbols_used{"$filename#$lineno\_$column"}, - "\">", &protect_string ($word), "</A>"; - } - 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"; -<HTML> -<HEAD><TITLE>Source Browser</TITLE></HEAD> -<FRAMESET COLS='250,*'> -<NOFRAME> -EOF - ; - - local (@files) = &create_file_index; - print INDEX join ("\n", @files), "\n"; - - print INDEX "<HR>\n"; - local (@functions) = &create_function_index; - print INDEX join ("\n", @functions), "\n"; - - print INDEX <<"EOF"; -</NOFRAME> -<FRAMESET ROWS='50%,50%'> -<FRAME NAME=files SRC=files.$fileext> -<FRAME NAME=funcs SRC=funcs.$fileext> -</FRAMESET> -<FRAME NAME=main SRC=main.$fileext> -</FRAMESET> -</HTML> -EOF - ; - close (INDEX); - - open (MAIN, ">$output_dir/main.$fileext") || die "couldn't write $output_dir/main.$fileext"; - print MAIN &create_header (""), - "<P ALIGN=right>", - "<A HREF=main.$fileext TARGET=_top>[No frame version is here]</A>", - "<P>", - join ("\n", @files), "\n<HR>", - join ("\n", @functions), "\n"; - - if ($dependencies) { - print MAIN "<HR>\n"; - print MAIN "You should start your browsing with one of these files:\n"; - print MAIN "<UL>\n"; - foreach (@original_list) { - print MAIN "<LI><A HREF=", &http_string (&get_real_file_name ($_)), - ".$fileext>$_</A>\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) = ("<H2 ALIGN=CENTER>Files</H2>"); - - - 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 "</UL></BODY></HTML>\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"; -<HTML><HEAD><TITLE>$last_letter</TITLE></HEAD> -<BODY> -<H2>Files - $last_letter</H2> -<A HREF=../files.$fileext TARGET=_self>[index]</A> -<UL COMPACT TYPE=DISC> -EOF - ; - local ($str) = "<A HREF=files/$last_letter.$fileext>[$last_letter]</A>"; - push (@output, $str); - print FILES "$str\n"; - } - print INDEX_FILE "<LI><A HREF=../", - &http_string (&get_real_file_name ($_)), - ".$fileext TARGET=main>$_</A>\n"; ## Problem with TARGET when in no_frame mode! - } - - print INDEX_FILE "</UL></BODY></HTML>\n"; - close INDEX_FILE; - } - else - { - push (@output, "<UL COMPACT TYPE=DISC>"); - print FILES "<UL COMPACT TYPE=DISC>"; - foreach (sort {&uppercases ($a) cmp &uppercases ($b)} @list_files) - { - next if ($_ eq ""); - local ($ref) = &http_string (&get_real_file_name ($_)); - push (@output, "<LI><A HREF=$ref.$fileext>$_</A>"); - print FILES "<LI><A HREF=$ref.$fileext TARGET=main>$_</A>\n"; - } - } - - print FILES &create_footer (""); - close (FILES); - - push (@output, "</UL>"); - return @output; -} - -####### -## This function generates the function_index -## RETURN : - table with the html lines to be printed -####### -sub create_function_index -{ - local (@output) = ("<H2 ALIGN=CENTER>Functions/Procedures</H2>"); - 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 "</UL></BODY></HTML>\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"; -<HTML><HEAD><TITLE>$initial</TITLE></HEAD> -<BODY> -<H2>Functions - $initial</H2> -<A HREF=../funcs.$fileext TARGET=_self>[index]</A> -<UL COMPACT TYPE=DISC> -EOF - ; - local ($str) = "<A HREF=funcs/$initial.$fileext>[$initial]</A>"; - 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 "<LI><A HREF=../$full_file.$fileext#$lineno\_$column TARGET=main>$symbol</A>"; - } - } - - print INDEX_FILE "</UL></BODY></HTML>\n"; - close INDEX_FILE; - } - else - { - push (@output, "<UL COMPACT TYPE=DISC>"); - print FUNCS "<UL COMPACT TYPE=DISC>"; - 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, "<LI><A HREF=$full_file.$fileext#$lineno\_$column>$symbol</A>"); - print FUNCS "<LI><A HREF=$full_file.$fileext#$lineno\_$column TARGET=main>$symbol</A>"; - } - } - } - - print FUNCS &create_footer (""); - close (FUNCS); - - push (@output, "</UL>"); - 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"; |