libixp

git clone git://oldgit.suckless.org/libixp/
Log | Files | Refs | LICENSE

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: