annotate gcc/ada/gnathtml.pl @ 131:84e7813d76e9

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