| #! /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"; |
