help2man revision 1.1 1 1.1 christos #!/usr/bin/perl -w
2 1.1 christos
3 1.1 christos # Generate a short man page from --help and --version output.
4 1.1 christos # Copyright 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
5 1.1 christos
6 1.1 christos # This program is free software; you can redistribute it and/or modify
7 1.1 christos # it under the terms of the GNU General Public License as published by
8 1.1 christos # the Free Software Foundation; either version 2, or (at your option)
9 1.1 christos # any later version.
10 1.1 christos
11 1.1 christos # This program is distributed in the hope that it will be useful,
12 1.1 christos # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 1.1 christos # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 1.1 christos # GNU General Public License for more details.
15 1.1 christos
16 1.1 christos # You should have received a copy of the GNU General Public License
17 1.1 christos # along with this program; if not, write to the Free Software Foundation,
18 1.1 christos # Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
19 1.1 christos
20 1.1 christos # Written by Brendan O'Dea <bod (at] compusol.com.au>
21 1.1 christos # Available from ftp://ftp.gnu.org/gnu/help2man/
22 1.1 christos
23 1.1 christos use 5.004;
24 1.1 christos use strict;
25 1.1 christos use Getopt::Long;
26 1.1 christos use Text::Tabs qw(expand);
27 1.1 christos use POSIX qw(strftime setlocale LC_TIME);
28 1.1 christos
29 1.1 christos my $this_program = 'help2man';
30 1.1 christos my $this_version = '1.24';
31 1.1 christos my $version_info = <<EOT;
32 1.1 christos GNU $this_program $this_version
33 1.1 christos
34 1.1 christos Copyright (C) 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
35 1.1 christos This is free software; see the source for copying conditions. There is NO
36 1.1 christos warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
37 1.1 christos
38 1.1 christos Written by Brendan O'Dea <bod\@compusol.com.au>
39 1.1 christos EOT
40 1.1 christos
41 1.1 christos my $help_info = <<EOT;
42 1.1 christos `$this_program' generates a man page out of `--help' and `--version' output.
43 1.1 christos
44 1.1 christos Usage: $this_program [OPTION]... EXECUTABLE
45 1.1 christos
46 1.1 christos -n, --name=STRING use `STRING' as the description for the NAME paragraph
47 1.1 christos -s, --section=SECTION use `SECTION' as the section for the man page
48 1.1 christos -i, --include=FILE include material from `FILE'
49 1.1 christos -I, --opt-include=FILE include material from `FILE' if it exists
50 1.1 christos -o, --output=FILE send output to `FILE'
51 1.1 christos -N, --no-info suppress pointer to Texinfo manual
52 1.1 christos --help print this help, then exit
53 1.1 christos --version print version number, then exit
54 1.1 christos
55 1.1 christos EXECUTABLE should accept `--help' and `--version' options.
56 1.1 christos
57 1.1 christos Report bugs to <bug-help2man\@gnu.org>.
58 1.1 christos EOT
59 1.1 christos
60 1.1 christos my $section = 1;
61 1.1 christos my ($opt_name, @opt_include, $opt_output, $opt_no_info);
62 1.1 christos my %opt_def = (
63 1.1 christos 'n|name=s' => \$opt_name,
64 1.1 christos 's|section=s' => \$section,
65 1.1 christos 'i|include=s' => sub { push @opt_include, [ pop, 1 ] },
66 1.1 christos 'I|opt-include=s' => sub { push @opt_include, [ pop, 0 ] },
67 1.1 christos 'o|output=s' => \$opt_output,
68 1.1 christos 'N|no-info' => \$opt_no_info,
69 1.1 christos );
70 1.1 christos
71 1.1 christos # Parse options.
72 1.1 christos Getopt::Long::config('bundling');
73 1.1 christos GetOptions (%opt_def,
74 1.1 christos help => sub { print $help_info; exit },
75 1.1 christos version => sub { print $version_info; exit },
76 1.1 christos ) or die $help_info;
77 1.1 christos
78 1.1 christos die $help_info unless @ARGV == 1;
79 1.1 christos
80 1.1 christos my %include = ();
81 1.1 christos my %append = ();
82 1.1 christos my @include = (); # retain order given in include file
83 1.1 christos
84 1.1 christos # Provide replacement `quote-regex' operator for pre-5.005.
85 1.1 christos BEGIN { eval q(sub qr { '' =~ $_[0]; $_[0] }) if $] < 5.005 }
86 1.1 christos
87 1.1 christos # Process include file (if given). Format is:
88 1.1 christos #
89 1.1 christos # [section name]
90 1.1 christos # verbatim text
91 1.1 christos #
92 1.1 christos # or
93 1.1 christos #
94 1.1 christos # /pattern/
95 1.1 christos # verbatim text
96 1.1 christos #
97 1.1 christos
98 1.1 christos while (@opt_include)
99 1.1 christos {
100 1.1 christos my ($inc, $required) = @{shift @opt_include};
101 1.1 christos
102 1.1 christos next unless -f $inc or $required;
103 1.1 christos die "$this_program: can't open `$inc' ($!)\n"
104 1.1 christos unless open INC, $inc;
105 1.1 christos
106 1.1 christos my $key;
107 1.1 christos my $hash = \%include;
108 1.1 christos
109 1.1 christos while (<INC>)
110 1.1 christos {
111 1.1 christos # [section]
112 1.1 christos if (/^\[([^]]+)\]/)
113 1.1 christos {
114 1.1 christos $key = uc $1;
115 1.1 christos $key =~ s/^\s+//;
116 1.1 christos $key =~ s/\s+$//;
117 1.1 christos $hash = \%include;
118 1.1 christos push @include, $key unless $include{$key};
119 1.1 christos next;
120 1.1 christos }
121 1.1 christos
122 1.1 christos # /pattern/
123 1.1 christos if (m!^/(.*)/([ims]*)!)
124 1.1 christos {
125 1.1 christos my $pat = $2 ? "(?$2)$1" : $1;
126 1.1 christos
127 1.1 christos # Check pattern.
128 1.1 christos eval { $key = qr($pat) };
129 1.1 christos if ($@)
130 1.1 christos {
131 1.1 christos $@ =~ s/ at .*? line \d.*//;
132 1.1 christos die "$inc:$.:$@";
133 1.1 christos }
134 1.1 christos
135 1.1 christos $hash = \%append;
136 1.1 christos next;
137 1.1 christos }
138 1.1 christos
139 1.1 christos # Check for options before the first section--anything else is
140 1.1 christos # silently ignored, allowing the first for comments and
141 1.1 christos # revision info.
142 1.1 christos unless ($key)
143 1.1 christos {
144 1.1 christos # handle options
145 1.1 christos if (/^-/)
146 1.1 christos {
147 1.1 christos local @ARGV = split;
148 1.1 christos GetOptions %opt_def;
149 1.1 christos }
150 1.1 christos
151 1.1 christos next;
152 1.1 christos }
153 1.1 christos
154 1.1 christos $hash->{$key} ||= '';
155 1.1 christos $hash->{$key} .= $_;
156 1.1 christos }
157 1.1 christos
158 1.1 christos close INC;
159 1.1 christos
160 1.1 christos die "$this_program: no valid information found in `$inc'\n"
161 1.1 christos unless $key;
162 1.1 christos }
163 1.1 christos
164 1.1 christos # Compress trailing blank lines.
165 1.1 christos for my $hash (\(%include, %append))
166 1.1 christos {
167 1.1 christos for (keys %$hash) { $hash->{$_} =~ s/\n+$/\n/ }
168 1.1 christos }
169 1.1 christos
170 1.1 christos # Turn off localisation of executable's ouput.
171 1.1 christos @ENV{qw(LANGUAGE LANG LC_ALL)} = ('C') x 3;
172 1.1 christos
173 1.1 christos # Turn off localisation of date (for strftime).
174 1.1 christos setlocale LC_TIME, 'C';
175 1.1 christos
176 1.1 christos # Grab help and version info from executable.
177 1.1 christos my ($help_text, $version_text) = map {
178 1.1 christos join '', map { s/ +$//; expand $_ } `$ARGV[0] --$_ 2>/dev/null`
179 1.1 christos or die "$this_program: can't get `--$_' info from $ARGV[0]\n"
180 1.1 christos } qw(help version);
181 1.1 christos
182 1.1 christos my $date = strftime "%B %Y", localtime;
183 1.1 christos (my $program = $ARGV[0]) =~ s!.*/!!;
184 1.1 christos my $package = $program;
185 1.1 christos my $version;
186 1.1 christos
187 1.1 christos if ($opt_output)
188 1.1 christos {
189 1.1 christos unlink $opt_output
190 1.1 christos or die "$this_program: can't unlink $opt_output ($!)\n"
191 1.1 christos if -e $opt_output;
192 1.1 christos
193 1.1 christos open STDOUT, ">$opt_output"
194 1.1 christos or die "$this_program: can't create $opt_output ($!)\n";
195 1.1 christos }
196 1.1 christos
197 1.1 christos # The first line of the --version information is assumed to be in one
198 1.1 christos # of the following formats:
199 1.1 christos #
200 1.1 christos # <version>
201 1.1 christos # <program> <version>
202 1.1 christos # {GNU,Free} <program> <version>
203 1.1 christos # <program> ({GNU,Free} <package>) <version>
204 1.1 christos # <program> - {GNU,Free} <package> <version>
205 1.1 christos #
206 1.1 christos # and seperated from any copyright/author details by a blank line.
207 1.1 christos
208 1.1 christos ($_, $version_text) = split /\n+/, $version_text, 2;
209 1.1 christos
210 1.1 christos if (/^(\S+) +\(((?:GNU|Free) +[^)]+)\) +(.*)/ or
211 1.1 christos /^(\S+) +- *((?:GNU|Free) +\S+) +(.*)/)
212 1.1 christos {
213 1.1 christos $program = $1;
214 1.1 christos $package = $2;
215 1.1 christos $version = $3;
216 1.1 christos }
217 1.1 christos elsif (/^((?:GNU|Free) +)?(\S+) +(.*)/)
218 1.1 christos {
219 1.1 christos $program = $2;
220 1.1 christos $package = $1 ? "$1$2" : $2;
221 1.1 christos $version = $3;
222 1.1 christos }
223 1.1 christos else
224 1.1 christos {
225 1.1 christos $version = $_;
226 1.1 christos }
227 1.1 christos
228 1.1 christos $program =~ s!.*/!!;
229 1.1 christos
230 1.1 christos # No info for `info' itself.
231 1.1 christos $opt_no_info = 1 if $program eq 'info';
232 1.1 christos
233 1.1 christos # --name overrides --include contents.
234 1.1 christos $include{NAME} = "$program \\- $opt_name\n" if $opt_name;
235 1.1 christos
236 1.1 christos # Default (useless) NAME paragraph.
237 1.1 christos $include{NAME} ||= "$program \\- manual page for $program $version\n";
238 1.1 christos
239 1.1 christos # Man pages traditionally have the page title in caps.
240 1.1 christos my $PROGRAM = uc $program;
241 1.1 christos
242 1.1 christos # Extract usage clause(s) [if any] for SYNOPSIS.
243 1.1 christos if ($help_text =~ s/^Usage:( +(\S+))(.*)((?:\n(?: {6}\1| *or: +\S).*)*)//m)
244 1.1 christos {
245 1.1 christos my @syn = $2 . $3;
246 1.1 christos
247 1.1 christos if ($_ = $4)
248 1.1 christos {
249 1.1 christos s/^\n//;
250 1.1 christos for (split /\n/) { s/^ *(or: +)?//; push @syn, $_ }
251 1.1 christos }
252 1.1 christos
253 1.1 christos my $synopsis = '';
254 1.1 christos for (@syn)
255 1.1 christos {
256 1.1 christos $synopsis .= ".br\n" if $synopsis;
257 1.1 christos s!^\S*/!!;
258 1.1 christos s/^(\S+) *//;
259 1.1 christos $synopsis .= ".B $1\n";
260 1.1 christos s/\s+$//;
261 1.1 christos s/(([][]|\.\.+)+)/\\fR$1\\fI/g;
262 1.1 christos s/^/\\fI/ unless s/^\\fR//;
263 1.1 christos $_ .= '\fR';
264 1.1 christos s/(\\fI)( *)/$2$1/g;
265 1.1 christos s/\\fI\\fR//g;
266 1.1 christos s/^\\fR//;
267 1.1 christos s/\\fI$//;
268 1.1 christos s/^\./\\&./;
269 1.1 christos
270 1.1 christos $synopsis .= "$_\n";
271 1.1 christos }
272 1.1 christos
273 1.1 christos $include{SYNOPSIS} ||= $synopsis;
274 1.1 christos }
275 1.1 christos
276 1.1 christos # Process text, initial section is DESCRIPTION.
277 1.1 christos my $sect = 'DESCRIPTION';
278 1.1 christos $_ = "$help_text\n\n$version_text";
279 1.1 christos
280 1.1 christos # Normalise paragraph breaks.
281 1.1 christos s/^\n+//;
282 1.1 christos s/\n*$/\n/;
283 1.1 christos s/\n\n+/\n\n/g;
284 1.1 christos
285 1.1 christos # Temporarily exchange leading dots, apostrophes and backslashes for
286 1.1 christos # tokens.
287 1.1 christos s/^\./\x80/mg;
288 1.1 christos s/^'/\x81/mg;
289 1.1 christos s/\\/\x82/g;
290 1.1 christos
291 1.1 christos # Start a new paragraph (if required) for these.
292 1.1 christos s/([^\n])\n(Report +bugs|Email +bug +reports +to|Written +by)/$1\n\n$2/g;
293 1.1 christos
294 1.1 christos sub convert_option;
295 1.1 christos
296 1.1 christos while (length)
297 1.1 christos {
298 1.1 christos # Convert some standard paragraph names.
299 1.1 christos if (s/^(Options|Examples): *\n//)
300 1.1 christos {
301 1.1 christos $sect = uc $1;
302 1.1 christos next;
303 1.1 christos }
304 1.1 christos
305 1.1 christos # Copyright section
306 1.1 christos if (/^Copyright +[(\xa9]/)
307 1.1 christos {
308 1.1 christos $sect = 'COPYRIGHT';
309 1.1 christos $include{$sect} ||= '';
310 1.1 christos $include{$sect} .= ".PP\n" if $include{$sect};
311 1.1 christos
312 1.1 christos my $copy;
313 1.1 christos ($copy, $_) = split /\n\n/, $_, 2;
314 1.1 christos
315 1.1 christos for ($copy)
316 1.1 christos {
317 1.1 christos # Add back newline
318 1.1 christos s/\n*$/\n/;
319 1.1 christos
320 1.1 christos # Convert iso9959-1 copyright symbol or (c) to nroff
321 1.1 christos # character.
322 1.1 christos s/^Copyright +(?:\xa9|\([Cc]\))/Copyright \\(co/mg;
323 1.1 christos
324 1.1 christos # Insert line breaks before additional copyright messages
325 1.1 christos # and the disclaimer.
326 1.1 christos s/(.)\n(Copyright |This +is +free +software)/$1\n.br\n$2/g;
327 1.1 christos
328 1.1 christos # Join hyphenated lines.
329 1.1 christos s/([A-Za-z])-\n */$1/g;
330 1.1 christos }
331 1.1 christos
332 1.1 christos $include{$sect} .= $copy;
333 1.1 christos $_ ||= '';
334 1.1 christos next;
335 1.1 christos }
336 1.1 christos
337 1.1 christos # Catch bug report text.
338 1.1 christos if (/^(Report +bugs|Email +bug +reports +to) /)
339 1.1 christos {
340 1.1 christos $sect = 'REPORTING BUGS';
341 1.1 christos }
342 1.1 christos
343 1.1 christos # Author section.
344 1.1 christos elsif (/^Written +by/)
345 1.1 christos {
346 1.1 christos $sect = 'AUTHOR';
347 1.1 christos }
348 1.1 christos
349 1.1 christos # Examples, indicated by an indented leading $, % or > are
350 1.1 christos # rendered in a constant width font.
351 1.1 christos if (/^( +)([\$\%>] )\S/)
352 1.1 christos {
353 1.1 christos my $indent = $1;
354 1.1 christos my $prefix = $2;
355 1.1 christos my $break = '.IP';
356 1.1 christos $include{$sect} ||= '';
357 1.1 christos while (s/^$indent\Q$prefix\E(\S.*)\n*//)
358 1.1 christos {
359 1.1 christos $include{$sect} .= "$break\n\\f(CW$prefix$1\\fR\n";
360 1.1 christos $break = '.br';
361 1.1 christos }
362 1.1 christos
363 1.1 christos next;
364 1.1 christos }
365 1.1 christos
366 1.1 christos my $matched = '';
367 1.1 christos $include{$sect} ||= '';
368 1.1 christos
369 1.1 christos # Sub-sections have a trailing colon and the second line indented.
370 1.1 christos if (s/^(\S.*:) *\n / /)
371 1.1 christos {
372 1.1 christos $matched .= $& if %append;
373 1.1 christos $include{$sect} .= qq(.SS "$1"\n);
374 1.1 christos }
375 1.1 christos
376 1.1 christos my $indent = 0;
377 1.1 christos my $content = '';
378 1.1 christos
379 1.1 christos # Option with description.
380 1.1 christos if (s/^( {1,10}([+-]\S.*?))(?:( +)|\n( {20,}))(\S.*)\n//)
381 1.1 christos {
382 1.1 christos $matched .= $& if %append;
383 1.1 christos $indent = length ($4 || "$1$3");
384 1.1 christos $content = ".TP\n\x83$2\n\x83$5\n";
385 1.1 christos unless ($4)
386 1.1 christos {
387 1.1 christos # Indent may be different on second line.
388 1.1 christos $indent = length $& if /^ {20,}/;
389 1.1 christos }
390 1.1 christos }
391 1.1 christos
392 1.1 christos # Option without description.
393 1.1 christos elsif (s/^ {1,10}([+-]\S.*)\n//)
394 1.1 christos {
395 1.1 christos $matched .= $& if %append;
396 1.1 christos $content = ".HP\n\x83$1\n";
397 1.1 christos $indent = 80; # not continued
398 1.1 christos }
399 1.1 christos
400 1.1 christos # Indented paragraph with tag.
401 1.1 christos elsif (s/^( +(\S.*?) +)(\S.*)\n//)
402 1.1 christos {
403 1.1 christos $matched .= $& if %append;
404 1.1 christos $indent = length $1;
405 1.1 christos $content = ".TP\n\x83$2\n\x83$3\n";
406 1.1 christos }
407 1.1 christos
408 1.1 christos # Indented paragraph.
409 1.1 christos elsif (s/^( +)(\S.*)\n//)
410 1.1 christos {
411 1.1 christos $matched .= $& if %append;
412 1.1 christos $indent = length $1;
413 1.1 christos $content = ".IP\n\x83$2\n";
414 1.1 christos }
415 1.1 christos
416 1.1 christos # Left justified paragraph.
417 1.1 christos else
418 1.1 christos {
419 1.1 christos s/(.*)\n//;
420 1.1 christos $matched .= $& if %append;
421 1.1 christos $content = ".PP\n" if $include{$sect};
422 1.1 christos $content .= "$1\n";
423 1.1 christos }
424 1.1 christos
425 1.1 christos # Append continuations.
426 1.1 christos while (s/^ {$indent}(\S.*)\n//)
427 1.1 christos {
428 1.1 christos $matched .= $& if %append;
429 1.1 christos $content .= "\x83$1\n"
430 1.1 christos }
431 1.1 christos
432 1.1 christos # Move to next paragraph.
433 1.1 christos s/^\n+//;
434 1.1 christos
435 1.1 christos for ($content)
436 1.1 christos {
437 1.1 christos # Leading dot and apostrophe protection.
438 1.1 christos s/\x83\./\x80/g;
439 1.1 christos s/\x83'/\x81/g;
440 1.1 christos s/\x83//g;
441 1.1 christos
442 1.1 christos # Convert options.
443 1.1 christos s/(^| )(-[][\w=-]+)/$1 . convert_option $2/mge;
444 1.1 christos }
445 1.1 christos
446 1.1 christos # Check if matched paragraph contains /pat/.
447 1.1 christos if (%append)
448 1.1 christos {
449 1.1 christos for my $pat (keys %append)
450 1.1 christos {
451 1.1 christos if ($matched =~ $pat)
452 1.1 christos {
453 1.1 christos $content .= ".PP\n" unless $append{$pat} =~ /^\./;
454 1.1 christos $content .= $append{$pat};
455 1.1 christos }
456 1.1 christos }
457 1.1 christos }
458 1.1 christos
459 1.1 christos $include{$sect} .= $content;
460 1.1 christos }
461 1.1 christos
462 1.1 christos # Refer to the real documentation.
463 1.1 christos unless ($opt_no_info)
464 1.1 christos {
465 1.1 christos $sect = 'SEE ALSO';
466 1.1 christos $include{$sect} ||= '';
467 1.1 christos $include{$sect} .= ".PP\n" if $include{$sect};
468 1.1 christos $include{$sect} .= <<EOT;
469 1.1 christos The full documentation for
470 1.1 christos .B $program
471 1.1 christos is maintained as a Texinfo manual. If the
472 1.1 christos .B info
473 1.1 christos and
474 1.1 christos .B $program
475 1.1 christos programs are properly installed at your site, the command
476 1.1 christos .IP
477 1.1 christos .B info $program
478 1.1 christos .PP
479 1.1 christos should give you access to the complete manual.
480 1.1 christos EOT
481 1.1 christos }
482 1.1 christos
483 1.1 christos # Output header.
484 1.1 christos print <<EOT;
485 1.1 christos .\\" DO NOT MODIFY THIS FILE! It was generated by $this_program $this_version.
486 1.1 christos .TH $PROGRAM "$section" "$date" "$package $version" GNU
487 1.1 christos EOT
488 1.1 christos
489 1.1 christos # Section ordering.
490 1.1 christos my @pre = qw(NAME SYNOPSIS DESCRIPTION OPTIONS EXAMPLES);
491 1.1 christos my @post = ('AUTHOR', 'REPORTING BUGS', 'COPYRIGHT', 'SEE ALSO');
492 1.1 christos my $filter = join '|', @pre, @post;
493 1.1 christos
494 1.1 christos # Output content.
495 1.1 christos for (@pre, (grep ! /^($filter)$/o, @include), @post)
496 1.1 christos {
497 1.1 christos if ($include{$_})
498 1.1 christos {
499 1.1 christos my $quote = /\W/ ? '"' : '';
500 1.1 christos print ".SH $quote$_$quote\n";
501 1.1 christos
502 1.1 christos for ($include{$_})
503 1.1 christos {
504 1.1 christos # Replace leading dot, apostrophe and backslash tokens.
505 1.1 christos s/\x80/\\&./g;
506 1.1 christos s/\x81/\\&'/g;
507 1.1 christos s/\x82/\\e/g;
508 1.1 christos print;
509 1.1 christos }
510 1.1 christos }
511 1.1 christos }
512 1.1 christos
513 1.1 christos exit;
514 1.1 christos
515 1.1 christos # Convert option dashes to \- to stop nroff from hyphenating 'em, and
516 1.1 christos # embolden. Option arguments get italicised.
517 1.1 christos sub convert_option
518 1.1 christos {
519 1.1 christos local $_ = '\fB' . shift;
520 1.1 christos
521 1.1 christos s/-/\\-/g;
522 1.1 christos unless (s/\[=(.*)\]$/\\fR[=\\fI$1\\fR]/)
523 1.1 christos {
524 1.1 christos s/=(.)/\\fR=\\fI$1/;
525 1.1 christos s/ (.)/ \\fI$1/;
526 1.1 christos $_ .= '\fR';
527 1.1 christos }
528 1.1 christos
529 1.1 christos $_;
530 1.1 christos }
531