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