genrefcard.pl

   1 #!/usr/bin/perl -w
   2 use strict;
   3 #{{{ readme
   4 ### Author: Frank Terbeck <ft@bewatermyfriend.org>
   5 ### GPLv2
   6 ###
   7 ### generate grml zsh refcard.
   8 ### #v#: variables
   9 ### #f#: functions
  10 ### #a#: aliases
  11 ### #k#: keybindings
  12 ### #A#: abbreviations
  13 ### #d#: hasheddirs
  14 ### #o#: other
  15 ###
  16 ### consider these lines in zshrc:
  17 ### #a3# execute \kbd{apt-cache policy}
  18 ### alias acp='apt-cache policy'
  19 ###
  20 ### Now this script will add a new description for 'acp' into
  21 ### the replacement list created by the @@INSERT-aliases-debian@@
  22 ### tag.
  23 ###
  24 ### @@INSERT-aliases-default@@ == @@INSERT-aliases@@
  25 ### @@INSERT-aliases-all@@ will create a sorted list of _all_
  26 ### aliases from all subsections.
  27 ###
  28 ### @@INSERT-other-foobar@@ is special, just does text replaces
  29 ### without any special formatting, useful for:
  30 ### \command{umask @@INSERT-other-umask@@}{...
  31 ### 'other' does not have -default nor -all.
  32 ###
  33 ### you may specify certain subsections like this:
  34 ### #a3#, which will put the input in the into the
  35 ### @@INSERT-aliases-debian@@ tag.
  36 ###
  37 ### See the @secmap array below for section numbers.
  38 ### Yes, this could be done with real names instead of numbers.
  39 ### But names tend to be rather long. I don't want that.
  40 ###
  41 #}}}
  42
  43 ### variables {{{
  44 my $refin = "./grml-zsh-refcard.tex.in";
  45 if (defined($ARGV[0]) && $ARGV[0] =~ m!^[^+]!) {
  46     $refin = shift;
  47 }
  48
  49 my $MAX_INPUT=10000;
  50 my $verbose = 0;
  51
  52 if (defined($ARGV[0])) {
  53   $verbose = length($ARGV[0]);
  54 }
  55 my @secmap = (
  56     "default",    #0
  57     "system",     #1
  58     "user",       #2
  59     "debian",     #3
  60     "search",     #4
  61     "shortcuts",  #5
  62     "services"    #6
  63 );
  64 my (
  65     $i,
  66     $ln,
  67     $inc,     # global counter for input lines
  68     @input,
  69     %data,    # HoA
  70     %other,   # @@INSERT-other-*@@
  71     %splits   # if lists get long, we might need to split them. HoA
  72 );
  73
  74 my $splitstring="\\commandlistend\n\\pagebreak\n\\commandlistbegin";
  75 ###}}}
  76 ### subroutines {{{
  77 sub dumpdata {
  78     my ($key, $entry);
  79
  80     if ($verbose < 5) { return; }
  81     xprint(5, " --- Data ---\n");
  82     foreach $key (sort keys(%other)) {
  83         xprint(5, "    \@\@INSERT-other-$key\@\@ -> $other{$key}\n");
  84     }
  85     foreach $key (sort keys(%data)) {
  86         xprint(5, "    \@\@INSERT-$key\@\@ =>\n");
  87         foreach $entry (sort @{ $data{$key} }) {
  88             xprint(5, "$entry\n");
  89         }
  90     }
  91     foreach $key (sort keys(%splits)) {
  92         xprint(5, "    List-Splitting Offset for $key:\n");
  93         foreach $entry (@{ $splits{$key} }) {
  94         xprint(5, "$entry\n");
  95         }
  96     }
  97     xprint(5, " --- Dump ---\n");
  98 }
  99
 100 sub xprint {
 101     my $level = shift;
 102
 103     if ($verbose >= $level) {
 104         print STDERR @_;
 105     }
 106 }
 107
 108 sub escape_string {
 109     my ($in) = @_;
 110
 111     $in =~ s!([\\\{\}\*\&~\$_])!\\$1!g;
 112     return($in)
 113 }
 114
 115 sub demystify_keys {
 116     # what an ugly hack :-)
 117     my ($keys) = @_;
 118     my ($k, $out, @tok);
 119
 120     @tok = split(/(\\e[^\^]|\^.)/, $keys);
 121     $out = '';
 122     foreach $k (@tok) {
 123         if ($k eq '') { next; }
 124
 125         if ($k =~ m!^[^\\\^]!) {
 126             $k =~ s!(.)! $1!g;
 127         }
 128         else {
 129             $k =~ s!\\e!ESC-!g;
 130             $k =~ s!\^I!TAB!g;
 131             $k =~ s!\^[jJmM]!return!g;
 132             $k =~ s!\^!CTRL-!g;
 133         }
 134         $out .= $k;
 135     }
 136
 137     return($out);
 138 }
 139
 140 sub insert {
 141     my ($linenum, $cat, $sec) = @_;
 142     my ($entry, $count);
 143
 144     if ($sec eq '') { $sec = 'default'; }
 145     if (!defined($data{"$cat-$sec"})) {
 146         warn("Unknown insertion tag in line $linenum (\@\@INSERT-$cat-$sec\@\@). IGNORING.\n");
 147         return;
 148     }
 149     xprint(1, "inserting: category($cat) section($sec), line: $linenum\n");
 150     $count = 0;
 151     foreach $entry (sort @{ $data{"$cat-$sec"} }) {
 152         my $is;
 153
 154         foreach $is (@{ $splits{"$cat-$sec"} } ) {
 155             if ($count == $is) {
 156                 print("$splitstring\n");
 157                 last;
 158             }
 159         }
 160         print("$entry\n");
 161         $count++;
 162     }
 163 }
 164
 165 sub handle_hashdir {
 166     my ($sec, $desc) = @_;
 167     my ($dir, $value);
 168
 169     if ($sec eq '') { $sec=0; }
 170
 171     xprint(1, "Handling hashed dir (section: $secmap[$sec]) in line $ln ($desc)\n");
 172
 173     $ln++;
 174     while ($ln <= $i) {
 175         if ($input[$ln] =~ m!^\s*\#d[0-9]*\#!) {
 176             xprint(1, "Ending hashed dir handling in line $ln.\n");
 177             $ln++;
 178             return;
 179         }
 180         if ($input[$ln] =~ m!\s*hash\s+-d\s+([^=]+)=(.*)!) {
 181             $dir=$1; $value=&escape_string($2);
 182             push(@{ $data{"hasheddirs-$secmap[$sec]"} }, "\\command\{$dir\}\{$value\}");
 183         }
 184         else {
 185             warn("Broken hashed dir in line $ln. IGNORING.\n");
 186         }
 187         $ln++;
 188     }
 189 }
 190
 191 sub handle_abbrev {
 192     my ($sec, $desc) = @_;
 193     my ($abbrev, $value, $doc);
 194
 195     if ($sec eq '') { $sec=0; }
 196
 197     xprint(1, "Handling abbreviation (section: $secmap[$sec]) in line $ln ($desc)\n");
 198
 199     $ln++;
 200     while ($ln <= $i) { # the global $i
 201         if ($input[$ln] =~ m!^\s*\#A[0-9]*\#!) {
 202             xprint(1, "Ending abbreviation handling in line $ln.\n");
 203             $ln++;
 204             return;
 205         }
 206         $doc = '';
 207         if ($input[$ln] =~ s/\s+\#d\s*([^#]*)$//) { $doc = $1; }
 208         if ($input[$ln] =~ m!\s*['"]([^"']*)['"]\s\$?['"]([^"']*)['"]!) {
 209             $abbrev = $1; $value = &escape_string($2);
 210             xprint(2, "ab: $abbrev -> $value ($doc);\n");
 211             push(@{ $data{"abbrev-$secmap[$sec]"} }, "\\command\{$abbrev\}\{\\kbd\{$value" . ($doc ne '' ? "\}\\quad $doc" : "\}") . "\}");
 212         }
 213         else {
 214             warn("Broken abbreviation in line $ln. IGNORING.\n");
 215         }
 216         $ln++;
 217     }
 218 }
 219
 220 sub handle_function {
 221     my ($sec, $desc) = @_;
 222
 223     if ($sec eq '') { $sec=0; }
 224
 225     xprint(1, "Handling function (section: $secmap[$sec]) in line $ln ($desc)\n");
 226
 227     $ln++;
 228     if ($input[$ln] =~ m!\s*(function)?\s*([^(\s]*)!) {
 229         xprint(2, "  - $2()\n");
 230         push(@{ $data{"functions-$secmap[$sec]"} }, "\\command\{$2()\}\{$desc\}");
 231     }
 232     else {
 233         warn("Parsing function line $ln ($input[$ln]) failed. IGNORING.\n");
 234     }
 235 }
 236
 237 sub handle_alias {
 238     my ($sec, $desc) = @_;
 239     my ($alias, $value);
 240
 241     if ($sec eq '') { $sec=0; }
 242
 243     xprint(1, "Handling alias (section: $secmap[$sec]) in line $ln ($desc)\n");
 244
 245     $ln++;
 246     if ($input[$ln] =~ m!\s*alias (-[haocC] +)*([^=]*)=["'](.*)["']!) {
 247         $alias=$2; $value=&escape_string($3);
 248         $desc =~ s!\@a\@!$value!;
 249         push(@{ $data{"aliases-$secmap[$sec]"} }, "\\command\{$alias\}\{$desc\}");
 250     }
 251     else {
 252         warn("Parsing alias line $ln ($input[$ln]) failed. IGNORING.\n");
 253     }
 254 }
 255
 256 sub handle_other {
 257     my ($sec, $desc) = @_;
 258
 259     $desc =~ m!([^\s]+)\s+(.*)!;
 260     xprint(1, "Handling 'other' tag in line $ln ($1 -> $2))\n");
 261     $other{$1} = $2;
 262     $ln++;
 263 }
 264
 265 sub handle_keybinding {
 266     my ($sec, $desc) = @_;
 267     my ($kbd, $value);
 268
 269     if ($sec eq '') { $sec=0; }
 270
 271     xprint(1, "Handling keybinding (section: $secmap[$sec]) in line $ln ($desc)\n");
 272
 273     $ln++;
 274     if ($input[$ln] =~ m!^.*bindkey\s+[^'"]*(.*)['"]\s+([\w-]*)\#?.*!) {
 275         $value=&escape_string($2);
 276         $kbd = $1;
 277         $kbd =~ s!^["']!!;
 278         $kbd =~ s/["']$//;
 279         $kbd=&demystify_keys($kbd);
 280         $desc =~ s!\@k\@!$value!;
 281     #xprint(0, "!-> DEBUG: kbd: $kbd - value: $value - desc: $desc\n");
 282         push(@{ $data{"keybindings-$secmap[$sec]"} }, "\\command\{$kbd\}\{$desc\}");
 283     }
 284     else {
 285         warn("Parsing keybinding line $ln ($input[$ln]) failed. IGNORING.\n");
 286     }
 287 }
 288
 289 sub handle_variable {
 290     my ($sec, $desc) = @_;
 291     my ($var, $value);
 292
 293     if ($sec eq '') { $sec=0; }
 294
 295     xprint(1, "Handling variable (section: $secmap[$sec]) in line $ln ($desc)\n");
 296
 297     $ln++;
 298     if ($input[$ln] =~ m/\s*(\S+)=(.+)$/) {
 299         $var = $1 ; $value = $2;
 300         $value =~ s!^\$\{\w*:-(.*)\}!$1!;
 301         $value =~ s!^['"]!!;
 302         $value =~ s/['"]$//;
 303         $value = &escape_string($value);
 304         push(@{ $data{"variables-$secmap[$sec]"} }, "\\command\{$var\}\{\\kbd\{$value" . ($desc ne '' ? "\}\\quad $desc" : "\}") . "\}");
 305     }
 306     else {
 307         warn("Parsing variable line $ln ($input[$ln]) failed. IGNORING.\n");
 308     }
 309 }
 310
 311 sub handle_manual {
 312     # this is different than the other handle_*() subs.
 313     my ($code, $key, $value) = @_;
 314     my ($sec);
 315
 316     xprint(1, "Handling manual entry (code: $code) in line $ln ($key -> $value)\n");
 317
 318     $sec = ( (length($code) > 1) ? substr($code, 1) : 0);
 319     if    (substr($code, 0, 1) eq 'a') {
 320         push(@{ $data{"aliases-$secmap[$sec]"} }, "\\command\{$key\}\{$value\}");
 321     }
 322     elsif (substr($code, 0, 1) eq 'A') {
 323         push(@{ $data{"abbrev-$secmap[$sec]"} }, "\\command\{$key\}\{$value\}");
 324     }
 325     elsif (substr($code, 0, 1) eq 'd') {
 326         push(@{ $data{"hasheddirs-$secmap[$sec]"} }, "\\command\{$key\}\{$value\}");
 327     }
 328     elsif (substr($code, 0, 1) eq 'f') {
 329         push(@{ $data{"functions-$secmap[$sec]"} }, "\\command\{$key\}\{$value\}");
 330     }
 331     elsif (substr($code, 0, 1) eq 'k') {
 332         push(@{ $data{"keybindings-$secmap[$sec]"} }, "\\command\{$key\}\{$value\}");
 333     }
 334     elsif (substr($code, 0, 1) eq 'o') {
 335         push(@{ $data{"other-$secmap[$sec]"} }, "\\command\{$key\}\{$value\}");
 336     }
 337     elsif (substr($code, 0, 1) eq 'v') {
 338         push(@{ $data{"variables-$secmap[$sec]"} }, "\\command\{$key\}\{$value\}");
 339     }
 340     else {
 341         warn("Unknown doc-definition character in manual-line $ln ($1). IGNORING.\n");
 342         $ln++;
 343     }
 344     $ln++;
 345 }
 346
 347 sub set_option {
 348     my ($optstring) = @_;
 349     my ($opt, $val);
 350
 351     $ln++;
 352     if ($optstring =~ m!([a-zA-Z0-9_-]+)\s+(.*)!) {
 353         $opt = $1;
 354         $val = $2;
 355         if ($opt eq 'split') {
 356             if ($val =~ m!([a-zA-Z0-9_-]+)\s+(.*)!) {
 357                 my $what = $1;
 358                 my $when = $2;
 359                 xprint(2, "  splitting values (for $what): " . join(' ', split(/,/, $when)) . "\n");
 360                 @{ $splits{"$what"} } = split(/,/, $when);
 361             }
 362             else {
 363                 warn("Parsing split option failed in line $ln. IGNORING.\n");
 364             }
 365         }
 366         else {
 367             warn("Unknown option ($opt) in line $ln. IGNORING.\n");
 368         }
 369     }
 370     else {
 371         warn("Parsing option in line $ln failed. IGNORING.\n");
 372     }
 373 }
 374
 375 ###}}}
 376
 377 ### main()
 378 ### {{{ handling stdin
 379 $i = 0;
 380 $input[0]='index==linenumber :-)';
 381 while (<STDIN>) {
 382     $i++;
 383     if ($i > $MAX_INPUT) {
 384         die "Sorry dude, input lines exeeded maximum ($MAX_INPUT)}\n";
 385     }
 386     chomp;
 387     push(@input, $_);
 388 }
 389
 390 $ln = 1;
 391 while ($ln <= $i) {
 392     if ($input[$ln] =~ m/^\#\@\#\s*(.*)$/) {
 393         &set_option($1);
 394         next;
 395     }
 396     if ($input[$ln] =~ m/^\s*\#([a-zA-Z])([0-9]*)\#\s*(.*)$/) {
 397         if    ($1 eq 'a') {
 398             &handle_alias($2, $3);
 399         }
 400         elsif ($1 eq 'A') {
 401             &handle_abbrev($2, $3);
 402         }
 403         elsif ($1 eq 'd') {
 404             &handle_hashdir($2, $3);
 405         }
 406         elsif ($1 eq 'f') {
 407             &handle_function($2, $3);
 408         }
 409         elsif ($1 eq 'k') {
 410             &handle_keybinding($2, $3);
 411         }
 412         elsif ($1 eq 'o') {
 413             &handle_other($2, $3);
 414         }
 415         elsif ($1 eq 'v') {
 416             &handle_variable($2, $3);
 417         }
 418         elsif ($1 eq 'm') {
 419             my $arg = $3;
 420             $arg =~ m!^\s*([a-zA-Z][0-9]*)\s+(\S+)\s+(.*)!;
 421             &handle_manual($1, $2, $3);
 422         }
 423         else {
 424             warn("Unknown doc-definition character in line $ln ($1). IGNORING.\n");
 425             $ln++;
 426         }
 427     }
 428     else {
 429         $ln++;
 430     }
 431 }
 432 #}}}
 433
 434 &dumpdata();
 435
 436 open(IN, "<$refin") or die "could not open $refin: $!\n";
 437 $i=0;
 438 while (<IN>) { #{{{ output loop
 439     $i++;
 440     while (m!\@\@INSERT-other-[^@]+\@\@!) {
 441         s!\@\@INSERT-other-([^@]+)\@\@!$other{$1}!;
 442         xprint(2, "Inserting \@\@INSERT-other-$1\@\@ -> $other{$1}\n");
 443     }
 444     if (m!^\@\@INSERT-([^-]*)-?(.*)\@\@!) {
 445         if ($1 eq '') {
 446             die "malformed insertion tag in line $i ($_). ABORT\n";
 447         }
 448         &insert($i, $1, $2);
 449     }
 450     else {
 451         print;
 452     }
 453 }#}}}
 454 close(IN);