docs/exdoc

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5
   6 my $sourcedir = '';
   7 my $dir = '';
   8 my $html = 0;
   9 my $css = '';
  10 my @files = ();
  11 my $filecount = 0;
  12 my @files_content = ();
  13 my @apis = ();
  14 my %deprecated = ();
  15 my %prototype = ();
  16 my %arguments = ();
  17 my %returns = ();
  18 my %bodies = ();
  19
  20 if ($ARGV[0] eq "-h") {
  21     $sourcedir = $ARGV[1];
  22     $dir = $sourcedir;
  23     $html = 1;
  24     shift @ARGV;
  25     shift @ARGV;
  26 }
  27 open (FILE, "$dir/api-style.css" || die "Did not find $dir/api-style.css");
  28 while (<FILE>) {
  29     $css = $css . $_;
  30 }
  31
  32 if ($ARGV[0] eq "-t") {
  33     $dir = $ARGV[1];
  34     shift @ARGV;
  35 }
  36
  37 if ($html) {
  38     opendir (D, "$sourcedir/sources/") || die "Can not open $dir";
  39     while (my $n = readdir (D)) {
  40         if ($n =~ /mono-api-.*\.html$/) {
  41             open (IN, "$sourcedir/sources/$n") || die "Can not open $n";
  42             $files[$filecount] = $n;
  43             $files_content[$filecount] = '';
  44             while (<IN>) {
  45                 $files_content[$filecount] .= $_;
  46                 if (/name="api:(.*?)"/) {
  47                     $_ =~ s/.*name="api:(\w+?)".*/$1/;
  48                     $apis[$filecount] .= "$_";
  49                 }
  50             }
  51             $filecount++;
  52             close IN;
  53         }
  54     }
  55 }
  56
  57 while (<ARGV>) {
  58     if (/\/\*\* *\n/) {
  59         &process_doc;
  60     } else {
  61         #print "IGNORING: $_";
  62     }
  63 }
  64
  65 if ($html) {
  66     my $last = '';
  67     for (my $f = 0; $f < $filecount; $f++) {
  68         my $name = $files[$f];
  69         open (OUT, "> $dir/html/$name") || die "Can not create $dir/html/$name";
  70         print "Merging: $name\n";
  71         print OUT <<EOF;
  72 <?xml version="1.0" encoding="utf-8"?>
  73 <html xmlns="http://www.w3.org/1999/xhtml">
  74 <head>
  75     <title>$name</title>
  76     <style type="text/css">
  77 $css
  78    </style>
  79 </head>
  80 <body>
  81 <div class="mapi-docs">
  82 EOF
  83         my @a = split (/\n/, $files_content[$f]);
  84         my $strike = '';
  85         my $strikeextra = '';
  86         my $api_shown = 0;
  87         for (my $ai = 0; $ai < $#a; $ai++) {
  88             my $line = $a[$ai];
  89             if (my ($api, $caption) = ($line =~ /<h4><a name=\"api:(\w+)\">(\w+)<\/a><\/h4>/)) {
  90                 if ($api_shown == 1) {
  91                     print OUT "</div> <!-- class=mapi -->\n\n";
  92                     if ($deprecated{$api}) {
  93                         $strike = "mapi-strike";
  94                         $strikeextra = "</div><br><div class='mapi-deprecated'><b>Deprecated:</b> " . $deprecated{$api};
  95                     } else {
  96                         $strike = "";
  97                         $strikeextra = "";
  98                     }
  99                 }
 100                 $api_shown = 1;
 101                 my $proto = $prototype{$api} // $api;
 102
 103                 print OUT <<EOF;
 104 <a name="api:$api"></a>
 105 <div class="mapi">
 106     <div class="mapi-entry $strike"><code>$api$strikeextra</code></div>
 107     <div class="mapi-height-container">
 108         <div class="mapi-ptr-container"></div>
 109         <div class="mapi-description">
 110             <div class="mapi-ptr"></div>
 111
 112             <div class="mapi-declaration mapi-section">Syntax</div>
 113             <div class="mapi-prototype">$proto</div>
 114             <p>
 115 EOF
 116                 if (exists ($arguments{$api})) {
 117                     my $ppars = $arguments{$api};
 118                     if ($ppars !~ /^[ \t]+$/) {
 119                         print OUT "            <div class=\"mapi-section\">Parameters</div>\n";
 120                         print OUT "            <table class=\"mapi-parameters\"><tbody>".${arguments{$api}}."</tbody></table>";
 121                     }
 122                 }
 123
 124                 &opt_print ("Return value", $returns{$api}, 0);
 125                 &opt_print ("Description", $bodies{$api}, 0);
 126                 print OUT "        </div><!--mapi-description-->\n    </div><!--height container-->\n";
 127             } else {
 128                 if ($line =~ /\@API_IDX\@/) {
 129                     my $apis_toc = &create_toc ($apis[$f]);
 130                     $line =~ s/\@API_IDX\@/$apis_toc/;
 131                 }
 132                 if ($line =~ /^<h4/) {
 133                     print OUT "</div>\n";
 134                     $api_shown = 0;
 135                 }
 136                 if ($line =~ /`/) {
 137                 }
 138                 print OUT "$line\n";
 139             }
 140         }
 141         print OUT <<EOF;
 142    </div>
 143 </body>
 144 </html>
 145 EOF
 146         close OUT;
 147         system ("$ENV{runtimedir}/mono-wrapper convert.exe $dir/html/$name $dir/html/x-$name");
 148
 149
 150         # clean up the mess that AgilityPack does, it CDATAs our CSS
 151         open HACK, "$dir/html/x-$name" || die "Could not open $dir/html/x-$name";
 152         open HACKOUT, ">$dir/deploy/$name" || die "Could not open output";
 153
 154         my $line = 0;
 155         my $doprint = 0;
 156         while (<HACK>) {
 157             print HACKOUT $last if ($doprint);
 158             $line++;
 159             s/^\/\/<!\[CDATA\[//;
 160             s/^\/\/\]\]>\/\///;
 161
 162             # Remove the junk <span> wrapper generated by AgilityPack
 163             if ($line==1) {
 164                 s/<span>//;
 165             }
 166             if (/<style type/) {
 167                 # Replace the CSS in the XHTML output with the original CSS
 168                 print HACKOUT $_;
 169                 print HACKOUT $css;
 170                 while (<HACK>) {
 171                     last if (/<\/style>/);
 172                 }
 173             }
 174             $last = $_;
 175             $doprint = 1;
 176         }
 177         if (!($last =~ /span/)) {
 178             print HACKOUT $last;
 179         }
 180
 181         # system ("cp.exe $dir/html/$name $dir/deploy/$name");
 182     }
 183 }
 184
 185 sub process_doc {
 186     my $doc = "";
 187     my $func = <>;
 188     chop $func;
 189     $func =~ s/^ \* //;
 190     $func =~ s/:$//;
 191     print "Function: $func\n" if (!$html);
 192     my $args = "";
 193     my $inbody = 0;
 194     my $returns = "";
 195     my $body = "";
 196     my $deprecated = 0;
 197     # Process arguments
 198     while (<>) {
 199         s/NULL/<code>NULL<\/code>/g;
 200         s/TRUE/<code>TRUE<\/code>/g;
 201         s/FALSE/<code>FALSE<\/code>/g;
 202         if (/^ \*\*?\//) {
 203             $body =~ s/\@(\w+)/<i>$1<\/i>/g;
 204             $returns =~ s/\@(\w+)/<i>$1<\/i>/g;
 205             $args =~ s/\@(\w+)/<i>$1<\/i>/g;
 206
 207             $body =~ s/#(\w+)/<code>$1<\/code>/g;
 208             $returns =~ s/#(\w+)/<code>$1<\/code>/g;
 209             $args =~ s/#(\w+)/<code>$1<\/code>/g;
 210
 211             $returns =~ s/\`([:.\w\*]+)\`/<code>$1<\/code>/g;
 212             $args =~ s/\`([:.\w\*]+)\`/<code>$1<\/code>/g;
 213             $body =~ s/\`([:.\w\*]+)\`/<code>$1<\/code>/g;
 214
 215             $body =~ s/\n/ /;
 216             $bodies{$func} = $body;
 217             $arguments{$func} = $args;
 218             $deprecated{$func} = $deprecated;
 219             $returns{$func} = $returns;
 220             my $proto = "";
 221             while (<>) {
 222                 $proto .= $_;
 223                 last if (/\{/);
 224             }
 225             $proto =~ s/{//;
 226             # clean it up a little, remove newlines, empty space at end
 227             $proto =~ s/ +$//;
 228             # Turn "Type * xxx" into "Type* xxx"
 229             $proto =~ s/^(\w+)\W+\*/$1\*/;
 230             $prototype{$func} = $proto;
 231             return;
 232         }
 233         chop;
 234         s/^\ \*//;
 235         $_ = "<p>" if (/^\s*$/);
 236
 237         if ($inbody == 0) {
 238             if (/\s*(\w+):(.*)/) {
 239                 if ($1 eq "deprecated") {
 240                     $deprecated = $2;
 241                 } else {
 242                     # $args .= "<dt><i>$1:</i></dt><dd>$2</dd>";
 243                     $args .= "<tr><td><i>$1</i><td>$2</td></td></tr>";
 244                 }
 245             } else {
 246
 247                 $body = "\t$_\n";
 248
 249                 $inbody = 1;
 250             }
 251         } elsif ($inbody == 1) {
 252             if (/Returns?:/) {
 253                 s/Returns?://;
 254                 $returns = "\t$_\n";
 255                 $inbody = 2;
 256             } else {
 257                 $body .= "\n\t$_";
 258             }
 259         } else {
 260             $returns .= "\n\t$_";
 261         }
 262
 263     }
 264 }
 265
 266 sub create_toc {
 267     my ($apis_listed) = @_;
 268     my $type_size = 0;
 269     my $name_size = 0;
 270     my ($ret, $xname, $args);
 271     my $apis_toc = "";
 272
 273
 274     # Try to align things, so compute type size, method size, and arguments
 275     foreach my $line (split /\n/, $apis_listed) {
 276         if (exists ($prototype{$line})) {
 277             my $p = $prototype{$line};
 278             if (my ($ret, $xname, $args) = ($p =~ /(.*)\n(\w+)[ \t](.*)/)) {
 279                 my $tl = length ($ret);
 280                 my $pl = length ($xname);
 281                 $type_size = $tl if ($tl > $type_size);
 282                 $name_size = $pl if ($pl > $name_size);
 283             }
 284         }
 285     }
 286
 287     $type_size++;
 288     $name_size++;
 289
 290     foreach my $line (split /\n/, $apis_listed) {
 291         chomp($line);
 292         if (exists($prototype{$line})) {
 293             my $p = $prototype{$line};
 294             if (my ($ret, $xname, $args) = ($p =~ /(.*)\n(\w+)[ \t](.*)/)) {
 295                 $xname = $line if $xname eq "";
 296                 my $rspace = " " x ($type_size - length ($ret));
 297                 my $nspace = " " x ($name_size - length ($xname));
 298                 $args = &format ($args, length ($ret . $rspace . $xname . $nspace), 60);
 299                 $apis_toc .= "$ret$rspace<a href=\"\#api:$line\">$xname</a>$nspace$args\n";
 300             }
 301         }
 302     }
 303     return $apis_toc;
 304 }
 305
 306 #
 307 # Formats the rest of the arguments in a way that will fit in N columns
 308 #
 309 sub format {
 310     my ($args, $size, $limit) = @_;
 311     my $sret = "";
 312
 313     # return $args if ((length (args) + size) < $limit);
 314
 315     my $remain = $limit - $size;
 316     my @sa = split /,/, $args;
 317     my $linelen = $size;
 318     foreach my $arg (@sa) {
 319         if ($sret eq "") {
 320             $sret = $arg . ", ";
 321             $linelen += length ($sret);
 322         } else {
 323             if ($linelen + length ($arg) < $limit) {
 324                 $sret .= "FITS" . $arg . ", ";
 325             } else {
 326                 my $newline = " " x ($size) . $arg . ", ";
 327                 my $linelen = length ($newline);
 328                 $sret .= "\n" . $newline;
 329             }
 330         }
 331     }
 332     $sret =~ s/, $/;/;
 333     return $sret;
 334 }
 335
 336 sub opt_print {
 337     my ($caption, $opttext, $quote) = @_;
 338
 339     if (defined($opttext) && $opttext !~ /^[ \t]+$/) {
 340         print OUT "             <div class=\"mapi-section\">$caption</div>\n";
 341         print OUT "             <div>$opttext</div>\n";
 342     }
 343 }