git.notmuchmail.org Git - notmuch/blob - devel/man-to-mdwn.pl

   1 #!/usr/bin/perl
   2 #
   3 # Author: Tomi Ollila
   4 # License: same as notmuch
   5 #
   6 # This program is used to generate mdwn-formatted notmuch manual pages
   7 # for notmuch wiki. Example run:
   8 #
   9 # $ ./devel/man-to-mdwn.pl doc/_build/man ../notmuch-wiki
  10 #
  11 # In case taken into more generic use, modify these comments and examples.
  12
  13 use 5.10.1;
  14 use strict;
  15 use warnings;
  16
  17 unless (@ARGV == 2) {
  18     warn "\n$0 <source-directory> <destination-directory>\n\n";
  19     # Remove/edit this comment if this script is taken into generic use.
  20     warn "Example: ./devel/man-to-mdwn.pl doc/_build/man ../notmuch-wiki\n\n";
  21     exit 1;
  22 }
  23
  24 die "'$ARGV[0]': no such source directory\n" unless -d $ARGV[0];
  25 die "'$ARGV[1]': no such destination directory\n" unless -d $ARGV[1];
  26
  27 #die "'manpages' exists\n" if -e 'manpages';
  28 #die "'manpages.mdwn' exists\n" if -e 'manpages.mdwn';
  29
  30 die "Expecting '$ARGV[1]/manpages' to exist.\n" .
  31   "Please create it first or adjust <destination-directory>.\n"
  32   unless -d $ARGV[1] . '/manpages';
  33
  34 my $ev = 0;
  35 my %fhash;
  36
  37 open P, '-|', 'find', $ARGV[0], qw/-name *.[0-9] -print/;
  38 while (<P>)
  39 {
  40     chomp;
  41     next unless -f $_; # follows symlink.
  42     $ev = 1, warn "'$_': no such file\n" unless -f $_;
  43     my ($in, $on) = ($_, $_);
  44     $on =~ s|.*/||; $on =~ tr/./-/;
  45     my $f = $fhash{$on};
  46     $ev = 1, warn "'$in' collides with '$f' ($on.mdwn)\n" if defined $f;
  47     $fhash{$on} = $in;
  48 }
  49 close P;
  50
  51 my %htmlqh = qw/& &amp;   < &lt;   > &gt;   ' &apos;   " &quot;/;
  52 # do html quotation to $_[0] (which is an alias to the given arg)
  53 sub htmlquote($)
  54 {
  55     $_[0] =~ s/([&<>'"])/$htmlqh{$1}/ge;
  56 }
  57
  58 sub maymakelink($);
  59 sub mayconvert($$);
  60
  61 #warn keys %fhash, "\n";
  62
  63 while (my ($k, $v) = each %fhash)
  64 {
  65     #next if -l $v; # skip symlinks here. -- not... references there may be.
  66
  67     my @lines;
  68     open I, '-|', qw/env -i/, "PATH=$ENV{PATH}",
  69         qw/TERM=vt100 LANG=en_US.UTF-8 LC_ALL=en_US.UTF-8/,
  70         qw/GROFF_NO_SGR=1 MAN_KEEP_FORMATTING=1 MANWIDTH=80/,
  71         qw/man/, $v or die "$!";
  72     binmode I, ':utf8';
  73
  74     my ($emptyline, $pre, $hl) = (0, 0, 'h1');
  75     while (<I>) {
  76         if (/^\s*$/) {
  77             $emptyline = 1;
  78             next;
  79         }
  80         # keep only leftmost in lines like 'NOTMUCH(1)   notmuch   NOTMUCH(1)'
  81         s/\S\K\s{8,}\S.+\s{8,}\S.*//; # $hl = 'h1' if s/(?<=\S)\s{8,}.*//;
  82         s/[_&]\010&/&/g;
  83         s/((?:_\010[^_])+)/\001u\002$1\001\/u\002/g;
  84         s/_\010(.)/$1/g;
  85         s/((?:.\010.)+)/\001b\002$1\001\/b\002/g;
  86         s/.\010(.)/$1/g;
  87         htmlquote $_;
  88         s/\001/</g; s/\002/>/g;
  89
  90         if (/^\S/) {
  91             $pre = 0, push @lines, "</pre>\n" if $pre;
  92             s/<\/?b>//g;
  93             chomp;
  94             $_ = "\n<$hl>$_</$hl>\n";
  95             $hl = 'h2';
  96             $emptyline = 0;
  97         }
  98         elsif (/^\s\s\s\S/) {
  99             $pre = 0, push @lines, "</pre>\n" if $pre;
 100             s/(?:^\s+)?<\/?b>//g;
 101             chomp;
 102             $_ = "\n<h3> &nbsp; $_</h3>\n";
 103             $emptyline = 0;
 104         }
 105         else {
 106             $pre = 1, push @lines, "<pre>\n" unless $pre;
 107             $emptyline = 0, push @lines, "\n" if $emptyline;
 108         }
 109         push @lines, $_;
 110     }
 111     $lines[0] =~ s/^\n//;
 112     $k = "$ARGV[1]/manpages/$k.mdwn";
 113     open O, '>', $k or die;
 114     binmode O, ':utf8';
 115     print STDOUT 'Writing ', "'$k'\n";
 116     select O;
 117     my ($pe, $hyphen) = ('', '');
 118     foreach (@lines) {
 119         #print $_; next;
 120         if ($pe) {
 121             if (s/^(\s+)<b>([^<]+)\((\d+)\)<\/b>//) {
 122                 my $link = maymakelink "$pe-$2-$3";
 123                 $link = maymakelink "$pe$2-$3" unless $link;
 124                 if ($link) {
 125                     print "<a href='$link'>$pe$hyphen</a>\n";
 126                     print "$1<a href='$link'>$2</a>($3)";
 127                 }
 128                 else {
 129                     print "<b>$pe-</b>\n";
 130                     print "$1<b>$2</b>($3)";
 131                 }
 132             } else {
 133                 print "<b>$pe-</b>\n";
 134             }
 135             $pe = '';
 136         }
 137         s/<b>([^<]+)\((\d+)\)<\/b>/mayconvert($1, $2)/ge;
 138         ($pe, $hyphen) = ($1, $2) if s/<b>([^<]+)([-\x{2010}])<\/b>\s*$//;
 139         print $_;
 140     }
 141 }
 142
 143 sub maymakelink($)
 144 {
 145 #    warn "$_[0]\n";
 146     return "../$_[0]/" if exists $fhash{$_[0]};
 147     return '';
 148 }
 149
 150 sub mayconvert($$)
 151 {
 152     my $f = "$_[0]-$_[1]";
 153 #    warn "$f\n";
 154     return "<a href='../$f/'>$_[0]</a>($_[1])" if exists $fhash{$f};
 155     return "<b>$_[0]</b>($_[1])";
 156 }
 157
 158 # Finally, make manpages.mdwn
 159
 160 open O, '>', $ARGV[1] . '/manpages.mdwn' or die $!;
 161 print STDOUT "Writing '$ARGV[1]/manpages.mdwn'\n";
 162 select O;
 163 print "Manual page index\n";
 164 print "=================\n\n";
 165
 166 sub srt { my ($x, $y) = ($a, $b); $x =~ tr/./-/; $y =~ tr/./-/; $x cmp $y; }
 167
 168 foreach (sort srt values %fhash)
 169 {
 170     my $in = $_;
 171     open I, '<', $in or die $!;
 172     my $s;
 173     while (<I>) {
 174         if (/^\s*[.]TH\s+\S+\s+"?(\S+?)"?\s/) {
 175             $s = $1;
 176             last;
 177         }
 178     }
 179     while (<I>) {
 180         last if /^\s*[.]SH NAME/
 181     }
 182     my $line = '';
 183     while (<I>) {
 184         tr/\\//d;
 185         if (/\s*(\S+)\s+(.*)/) {
 186             my $e = $2;
 187             # Ignoring the NAME in file, get from file name instead.
 188             #my $on = (-l $in)? readlink $in: $in;
 189             my $on = $in;
 190             $on =~ tr/./-/; $on =~ s|.*/||;
 191             my $n = $in; $n =~ s|.*/||; $n =~ tr/./-/; $n =~ s/-[^-]+$//;
 192             $line = "<a href='$on/'>$n</a>($s) $e\n";
 193             last;
 194         }
 195     }
 196     die "No NAME in '$in'\n" unless $line;
 197     print "* $line";
 198     #warn $line;
 199 }
 200 print <<'EOF';
 201
 202 The manual pages are licensed under
 203 [the GNU General Public License](https://www.gnu.org/licenses/gpl.txt),
 204 either version 3.0 or at your option any later version.
 205 EOF