]> git.notmuchmail.org Git - notmuch/blob - devel/man-to-mdwn.pl
util: Fix two corner-cases in boolean term quoting function
[notmuch] / 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 man ../notmuch-wiki
10 #
11 # In case taken into more generic use, modify these comments and examples.
12
13 use 5.8.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 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 #undef $ENV{'GROFF_NO_SGR'};
52 #delete $ENV{'GROFF_NO_SGR'};
53 $ENV{'GROFF_NO_SGR'} = '1';
54 $ENV{'TERM'} = 'vt100'; # does this matter ?
55
56 my %htmlqh = qw/& &amp;   < &lt;   > &gt;   ' &apos;   " &quot;/;
57 # do html quotation to $_[0] (which is an alias to the given arg)
58 sub htmlquote($)
59 {
60     $_[0] =~ s/([&<>'"])/$htmlqh{$1}/ge;
61 }
62
63 sub maymakelink($);
64 sub mayconvert($$);
65
66 #warn keys %fhash, "\n";
67
68 while (my ($k, $v) = each %fhash)
69 {
70     #next if -l $v; # skip symlinks here. -- not... references there may be.
71
72     my @lines;
73     #open I, '-|', qw/groff -man -T utf8/, $v;
74     open I, '-|', qw/groff -man -T latin1/, $v; # this and GROFF_NO_SGR='1'
75
76     my ($emptyline, $pre, $hl) = (0, 0, 'h1');
77     while (<I>) {
78         if (/^\s*$/) {
79             $emptyline = 1;
80             next;
81         }
82         s/(?<=\S)\s{8,}.*//; # $hl = 'h1' if s/(?<=\S)\s{8,}.*//;
83         htmlquote $_;
84         s/[_&]\010&/&/g;
85         s/((?:_\010[^_])+)/<u>$1<\/u>/g;
86         s/_\010(.)/$1/g;
87         s/((?:.\010.)+)/<b>$1<\/b>/g;
88         s/.\010(.)/$1/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     print STDOUT 'Writing ', "'$k'\n";
115     select O;
116     my $pe = '';
117     foreach (@lines) {
118         if ($pe) {
119             if (s/^(\s+)<b>([^<]+)<\/b>\((\d+)\)//) {
120                 my $link = maymakelink "$pe-$2-$3";
121                 $link = maymakelink "$pe$2-$3" unless $link;
122                 if ($link) {
123                     print "<a href='$link'>$pe-</a>\n";
124                     print "$1<a href='$link'>$2</a>($3)";
125                 }
126                 else {
127                     print "<b>$pe-</b>\n";
128                     print "$1<b>$2</b>($3)";
129                 }
130             } else {
131                 print "<b>$pe-</b>\n";
132             }
133             $pe = '';
134         }
135         s/<b>([^<]+)<\/b>\((\d+)\)/mayconvert($1, $2)/ge;
136         $pe = $1 if s/<b>([^<]+)-<\/b>\s*$//;
137         print $_;
138     }
139 }
140
141 sub maymakelink($)
142 {
143 #    warn "$_[0]\n";
144     return "../$_[0]/" if exists $fhash{$_[0]};
145     return '';
146 }
147
148 sub mayconvert($$)
149 {
150     my $f = "$_[0]-$_[1]";
151 #    warn "$f\n";
152     return "<a href='../$f/'>$_[0]</a>($_[1])" if exists $fhash{$f};
153     return "<b>$_[0]</b>($_[1])";
154 }
155
156 # Finally, make manpages.mdwn
157
158 open O, '>', $ARGV[1] . '/manpages.mdwn' or die $!;
159 print STDOUT "Writing '$ARGV[1]/manpages.mdwn'\n";
160 select O;
161 print "Manual page index\n";
162 print "=================\n\n";
163
164 sub srt { my ($x, $y) = ($a, $b); $x =~ tr/./-/; $y =~ tr/./-/; $x cmp $y; }
165
166 foreach (sort srt values %fhash)
167 {
168     my $in = $_;
169     open I, '<', $in or die $!;
170     my $s;
171     while (<I>) {
172         if (/^\s*[.]TH\s+\S+\s+(\S+)/) {
173             $s = $1;
174             last;
175         }
176     }
177     while (<I>) {
178         last if /^\s*[.]SH NAME/
179     }
180     my $line = '';
181     while (<I>) {
182         tr/\\//d;
183         if (/\s*(\S+)\s+(.*)/) {
184             my $e = $2;
185             # Ignoring the NAME in file, get from file name instead.
186             #my $on = (-l $in)? readlink $in: $in;
187             my $on = $in;
188             $on =~ tr/./-/; $on =~ s|.*/||;
189             my $n = $in; $n =~ s|.*/||; $n =~ tr/./-/; $n =~ s/-[^-]+$//;
190             $line = "<a href='$on/'>$n</a>($s) $e\n";
191             last;
192         }
193     }
194     die "No NAME in '$in'\n" unless $line;
195     print "* $line";
196     #warn $line;
197 }