topgit: version 0.19.13
[topgit/pro.git] / create-html-usage.pl
blob4925b4bcdf10b2fef950392a8f6139c35d0bbd0b
1 #!/usr/bin/env perl
3 # create-html-usage.pl -- insert usage lines into README_DOCS.rst
4 # Copyright (C) 2015,2017,2020,2021 Kyle J. McKay. All rights reserved.
5 # License GPLv2 or, at your option, any later version.
7 use strict;
8 use warnings;
10 use File::Basename;
12 my $mydir = dirname($0);
13 my $last = undef;
15 sub get_tg_usage($)
17 my $name = shift;
18 my $xname;
19 for ("$mydir/tg-$name", "$mydir/tg--$name") {
20 -x $_ and $xname=$_, last;
22 if (defined $xname) {
23 my $usage = `"$xname" -h 2>&1`;
24 chomp $usage;
25 my $opts;
26 ($usage,$opts) = split "\nOptions:\n", $usage;
27 $usage =~ s/^(Usage|\s+Or):\s*/: /mig;
28 $usage =~ s/[ \t]*\n[ \t]+/ /gs;
29 $usage =~ s/^: //mig;
30 defined $opts or $opts="";
31 $opts =~ s/^[ \t]*(?=-)/: /mig;
32 $opts =~ s/[ \t]*\n[ \t]+/ /gs;
33 $opts =~ s/^: //mig;
34 return ([split "\n", $usage],[split "\n", $opts]);
35 } elsif ($name eq "help") {
36 return (["tg help [-w] [<command>]"],
37 ["-w view help in browser"]);
38 } elsif ($name eq "status") {
39 my $tgsthelp = $ENV{TG_STATUS_HELP_USAGE} || "status";
40 return "tg $tgsthelp";
42 return undef;
45 sub wrap
47 my ($w, $i, $s) = @_;
48 my $h = ' ' x $i;
49 my $ans = '';
50 while (length($s) > $w && $s =~ /^(.{1,$w})(?<=[]|\w])[ \t]+(.+)$/s) {
51 $ans .= $1."\n";
52 $s = "$h$2";
54 $ans .= $s if $s !~ /^\s*$/;
55 return $ans;
58 sub maybe_uc
60 my $l = shift;
61 $l =~ /^tg / and return $l;
62 return uc($l);
65 my $textmode;
66 $textmode=1, shift if defined($ARGV[0]) && $ARGV[0] eq '--text';
67 my $tab = ' ' x 8;
68 my $discard = 0;
69 while (<>) {
70 chomp;
71 # From the Perl camel book "Fluent Perl" section (slightly modified)
72 s/(.*?)(\t+)/$1 . ' ' x (length($2) * 8 - length($1) % 8)/eg;
73 if ($textmode) {
74 $discard and do {$discard = 0; next};
75 /^::\s*$/ and do {$discard = 1; next};
76 m'^```+$' and next;
77 s'^``([^``\n].*)``$'wrap(78, 4, $1)'e;
78 s'^(\s*):`(`.+?`)`: '"$1$2 "'e;
79 s'^(\s*):`(.+?)`_: '"$1\"$2\" "'e;
80 s'^(\s*):(\w+?)_?: '"$1\"$2\""'e;
81 s'`([^`]+?>)`_'"$1"'ge;
82 s'`([^`]+?)`_'"\"".maybe_uc($1)."\""'ge;
83 s'`(`[^`]+?`)`'"$1"'ge;
84 s'"(`[^`]+?`)"'"$1"'ge;
85 s' ([A-Za-z]+?)_(?![A-Za-z])'" \"".maybe_uc($1)."\""'ge;
86 s'::$':';
88 if (defined($last)) {
89 printf "%s\n", $last;
90 if (/^[~]+$/ && $last =~ /^tg ([^\s]+)$/) {
91 my @usage = get_tg_usage($1);
92 my @options = ();
93 if (@usage && ref($usage[0]) eq 'ARRAY') {
94 @options = @{$usage[1]} if ref($usage[1]) eq 'ARRAY';
95 @usage = @{$usage[0]};
97 if (@usage) {
98 printf "%s\n", $_;
99 if ($textmode) {
100 printf "%s", join("",map({wrap(78, 12, "$tab$_")."\n"} @usage));
101 @options and printf "${tab}Options:\n%s",
102 join("",map({wrap(78, 32, "$tab $_")."\n"} @options));
103 } else {
104 printf "%s", join("",map({"$tab| ".'``'.$_.'``'."\n"} @usage));
105 @options and printf "$tab|\n$tab| ".'``Options:``'."\n%s",
106 join("",map({"$tab| ".'``&#160;&#160;'.$_.'``'."\n"} @options));
108 $_ = "";
112 $last = $_;
115 printf "%s\n", $last if defined($last);
116 exit 0;