]> mj.ucw.cz Git - libucw.git/blob - build/doc-defs
FB Socket: Fixed tracking of written bytes.
[libucw.git] / build / doc-defs
1 #!/usr/bin/perl
2 # Script for formatting documentation from definition lists
3 # (they get out of extract-doc.pl as a side-product).
4 # (c) 2008 Michal Vaner <vorner@ucw.cz>
5 use strict;
6 use warnings;
7
8 my $head = shift;
9 my $out = shift;
10
11 open OUT, ">$out" or die "Could not write output $out ($!)\n";
12 open HEAD, $head or die "Could not open head $head ($!)\n";
13 print OUT foreach( <HEAD> );
14 close HEAD;
15
16 my $dir = $out;
17 $dir =~ s/\/[^\/]+$//;
18
19 my @dump;
20
21 while( defined( my $line = <> ) ) {
22         chomp $line;
23         push @dump, [ split /,/, $line, 5 ];
24 }
25
26 my @types = (
27         [ 'enum', 'Enumerations' ],
28         [ 'struct', 'Structures' ],
29         [ 'type', 'Types' ],
30         [ 'fun', 'Functions' ],
31         [ 'var', 'Variables' ],
32         [ 'def', 'Preprocessor definitions' ]
33 );
34
35 my( $index, %groups, %heads ) = ( 0 );
36
37 foreach( @types ) {
38         my( $name, $value ) = @{$_};
39         $groups{$name} = ++ $index;
40         $heads{$name} = $value;
41 }
42
43 my $lasttype = '';
44
45 foreach( sort { ( $groups{$a->[2]} <=> $groups{$b->[2]} ) or ( $a->[3] cmp $b->[3] ); } @dump ) {
46         my( $file, $anchor, $type, $name, $text ) = @{$_};
47         if( $lasttype ne $type ) {
48                 $lasttype = $type;
49                 print OUT "\n== $heads{$type} [[$type]]\n\n";
50         }
51         my $dircp = $dir;
52         while( shift @{[ $dircp =~ /([^\/]+)/, "//" ]} eq shift @{[ $file =~ /([^\/]+)/, "///" ]} ) {
53                 $dircp =~ s/[^\/]+\/?//;
54                 $file =~ s/[^\/]+\/?//;
55         }
56         $dircp =~ s/[^\/]+/../g;
57         $file = $dircp."/".$file;
58         $file =~ s/^\///;
59         $file =~ s/\.[^.]+$//;
60         $text =~ s/(\.\.\.|\*|'|#|_)/\\$1/g;
61         print OUT "<<$file:$anchor,`$name`>>:: `$text`\n";
62 }
63
64 close OUT;