polish-help-txt.pl

   1 #!/usr/bin/env perl
   2
   3 # polish-help-txt.pl -- polish text format help (e.g. tg-tag.txt)
   4 # Copyright (C) 2015,2017,2020,2021 Kyle J. McKay.
   5 # All rights reserved.
   6 # License GPLv2 or, at your option, any later version.
   7
   8 use strict;
   9 use warnings;
  10
  11 sub wrap
  12 {
  13         my ($w, $i, $s) = @_;
  14         my $h = ' ' x $i;
  15         my $ans = '';
  16         while (length($s) > $w && $s =~ /^(.{1,$w})(?<=\w)\b[ \t]+(.+)$/s) {
  17                 $ans .= $1."\n";
  18                 $s = "$h$2";
  19         }
  20         $ans .= $s if $s !~ /^\s*$/;
  21         return $ans;
  22 }
  23
  24 sub maybe_uc
  25 {
  26         my $l = shift;
  27         $l =~ /^tg / and return $l;
  28         return uc($l);
  29 }
  30
  31 while (<>) {
  32         s/(?:\r\n|\n|\r)$//;
  33         # From the Perl camel book "Fluent Perl" section (slightly modified)
  34         s/(.*?)(\t+)/$1 . ' ' x (length($2) * 8 - length($1) % 8)/eg;
  35         m'^```+$' and next;
  36         s'^``(.*)``$'wrap(78, 4, $1)'e;
  37         s'^(\s*):`(`.+?`)`: '"$1$2  "'e;
  38         s'^(\s*):`(.+?)`_: '"$1\"$2\"  "'e;
  39         s'^(\s*):(\w+?)_?: '"$1\"$2\""'e;
  40         s'`([^`]+?)`_'"\"".maybe_uc($1)."\""'ge;
  41         s'`(`[^`]+?`)`'"$1"'ge;
  42         s'"(`[^`]+?`)"'"$1"'ge;
  43         s' ([A-Za-z]+?)_(?![A-Za-z])'" \"".maybe_uc($1)."\""'ge;
  44         s'::$':';
  45         printf "%s\n", $_;
  46 }
  47 exit 0;