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