grepdoc (3705B)
1 #!/usr/bin/env perl 2 use warnings; 3 use strict; 4 use POSIX qw(strftime); 5 use Data::Dumper; 6 7 sub subst(&$_) { 8 my ($fn, $re, $str) = @_; 9 $str =~ s{$re}{$fn->()}ge; 10 return $str; 11 } 12 13 sub detab(_) { 14 my ($text) = @_; 15 1 while $text =~ s/^(.*?)\t/$1 . " " x (8 - length($1) % 8)/me; 16 return $text; 17 } 18 19 my @c = grep /\.c$/, @ARGV; 20 my @h = grep /\.h$/, @ARGV; 21 22 my %protos; 23 my %headers; 24 open(my $stderr, '>&', \*STDERR); 25 open STDERR, '>', '/dev/null'; 26 27 open my $fd, '-|', 'cproto', '-DCPROTO', '-I./include', @c, '/dev/null'; 28 for(<$fd>) { 29 chomp; 30 s/\b_ixp//g; 31 if(m/(\w+)\(/) { 32 push @{$protos{$1}}, $_; 33 } 34 } 35 open STDERR, '>&', $stderr; 36 37 my @txt; 38 @ARGV = (@h, '/dev/null'); 39 for my $f(@h) { 40 open my $fd, '<', $f; 41 $_ = join "", map detab, <$fd>; 42 push @txt, $_; 43 44 $f =~ s|^(\./)?include/||; 45 46 my $junk = qr/(?:\[.*\]|\)\(.*\))?/; 47 while(m/^extern\s+(.*\b(\w+)$junk;)$/gm) { 48 $headers{$2} = $f; 49 push @{$protos{$2}}, $1; 50 } 51 while(m/^(?!extern)[a-z][^(]+\b(\w+)\(/gmi) { 52 my $id = $1; 53 $headers{$id} = $f unless $& =~ m{^\s*(?:#|//|/\*|\*)}; 54 } 55 while(m/^typedef\b.*?\b(\w+)$junk;/gm) { 56 $headers{$1} = $f; 57 push @{$protos{$1}}, $& unless $& =~ m{\Q/* Deprecated */}; 58 } 59 while(m/^\s*#\s*define\s+(\w+)((?:\(.*?\))?)/gm) { 60 $headers{$1} = $f; 61 push @{$protos{$1}}, "#define $1$2 ..."; 62 } 63 while(m/^(?:enum|struct|union)\s+(\w+).*?^\}/gsm) { 64 $headers{$1} = $f; 65 my $proto = \@{$protos{$1}}; 66 push @$proto, subst {"$1$2$1..."} qr[(^ +)(\Q/* Private members */\E\n).*(?=\n\})]sm, $& 67 unless $& =~ m{\Q/* Deprecated */}; 68 } 69 } 70 71 # print Data::Dumper->Dump([\%protos], ['%protos']); 72 # print Data::Dumper->Dump([\%headers], ['%headers']); 73 74 @ARGV = (@c, '/dev/null'); 75 $_ = join "", @txt, map detab, <>; 76 77 sub section($$) { 78 my ($sect, $text) = @_; 79 $text =~ s/^\s+|\s+$//g; 80 $text =~ s/[^:`]$/$&\n/; 81 print "= $sect =\n\n$text\n"; 82 } 83 84 print "MANPAGES ="; 85 while(m{(?<=/\*\*\n)(?:[^*]|\*[^/])+}g) { 86 local $_ = $&; 87 chop; 88 89 my @names; 90 my %section; 91 my $header = ''; 92 s/ \* ?//gm; 93 94 s{^(\w+:.*?)\n\n}{ 95 $header = $1; 96 $header =~ s{^(?:Function|Type|Variable|Macro): (\w+)}{ 97 push @names, $1; 98 join("\n", @{$protos{$1} or [$1]}) . "\n" 99 }gem; 100 ""; 101 }se; 102 103 unless(@names) { 104 print STDERR $_; 105 next; 106 } 107 108 my %hdrs = map {($headers{$_}, "")} @names; 109 my $includes = join "", map {"#include <$_>\n"} sort keys %hdrs; 110 $header = "$includes\n$header" if $includes; 111 112 sub despace { 113 my ($space) = m/^(\s*)/; 114 s/^$space//gm; 115 $_ 116 } 117 118 s{^((?:\w.+):\n(?:.|\n)*?)(?:\n\n|\Z)}{ 119 %section = (%section, '', map despace, split /\n?^(\w.+):\n/m, $1); 120 ""; 121 }gem; 122 123 print " \\\n\t'", (join " ", map {"$_.3"} @names), "'"; 124 125 open my $stdout, ">&", STDOUT; 126 open STDOUT, '>', "man/$names[0].man3"; 127 128 print <<EOF; 129 @{[uc $names[0]]} 130 libixp Manual 131 @{[strftime "%Y %b", localtime]} 132 133 \%!includeconf: header.t2t 134 135 EOF 136 137 section 'NAME', join ", ", @names; 138 139 section 'SYNOPSIS', "```\n$header```"; 140 141 section 'PARAMETERS', subst {": $2\n" . (' ' x length $1)} qr/^(\s*(.*):)/m, $section{Params} . "\n:" 142 if exists $section{Params}; 143 144 section 'DESCRIPTION', $_; 145 section 'RETURN VALUE', $section{Returns} if exists $section{Returns}; 146 section 'BUGS', $section{Bugs} if exists $section{Bugs}; 147 section 'SEE ALSO', subst {"$1(3)"} qr/\b[FMSTV]<(.*?)>/, $section{'See also'} 148 if exists $section{'See also'}; 149 open STDOUT, ">&", $stdout 150 } 151 print "\n"; 152 153 # vim:se sts=4 sw=4 et tw=0: