create-html-usage.pl

   1 #!/usr/bin/env perl
   2
   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.
   6
   7 use strict;
   8 use warnings;
   9
  10 use File::Basename;
  11
  12 my $mydir = dirname($0);
  13 my $last = undef;
  14
  15 sub get_tg_usage($)
  16 {
  17         my $name = shift;
  18         my $xname;
  19         for ("$mydir/tg-$name", "$mydir/tg--$name") {
  20                 -x $_ and $xname=$_, last;
  21         }
  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";
  41         }
  42         return undef;
  43 }
  44
  45 sub wrap
  46 {
  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";
  53         }
  54         $ans .= $s if $s !~ /^\s*$/;
  55         return $ans;
  56 }
  57
  58 sub maybe_uc
  59 {
  60         my $l = shift;
  61         $l =~ /^tg / and return $l;
  62         return uc($l);
  63 }
  64
  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'::$':';
  87         }
  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]};
  96                         }
  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));
 107                                 }
 108                                 $_ = "";
 109                         }
 110                 }
 111         }
 112         $last = $_;
 113 }
 114
 115 printf "%s\n", $last if defined($last);
 116 exit 0;