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 my $MAX_INPUT=10000;
  49 my $verbose = 0;
  50 if (defined($ARGV[0])) {
  51   $verbose = length($ARGV[0]);
  52 }
  53 my @secmap = (
  54   "default",    #0
  55   "system",     #1
  56   "user",       #2
  57   "debian",     #3
  58   "search",     #4
  59   "shortcuts",  #5
  60   "services"    #6
  61 );
  62 my (
  63   $i,
  64   $ln,
  65   $inc,     # global counter for input lines
  66   @input,
  67   %data,    # HoA
  68   %other,   # @@INSERT-other-*@@
  69   %splits   # if lists get long, we might need to split them. HoA
  70 );
  71 my $splitstring="\\commandlistend\n\\pagebreak\n\\commandlistbegin";
  72 ###}}}
  73 ### subroutines {{{
  74 sub dumpdata() {
  75   my ($key, $entry);
  76   if ($verbose < 5) { return; }
  77   xprint(5, " --- Data ---\n");
  78   foreach $key (sort keys(%other)) {
  79     xprint(5, "    \@\@INSERT-other-$key\@\@ -> $other{$key}\n");
  80   }
  81   foreach $key (sort keys(%data)) {
  82     xprint(5, "    \@\@INSERT-$key\@\@ =>\n");
  83     foreach $entry (sort @{ $data{$key} }) {
  84       xprint(5, "$entry\n");
  85     }
  86   }
  87   foreach $key (sort keys(%splits)) {
  88     xprint(5, "    List-Splitting Offset for $key:\n");
  89     foreach $entry (@{ $splits{$key} }) {
  90       xprint(5, "$entry\n");
  91     }
  92   }
  93   xprint(5, " --- Dump ---\n");
  94 }
  95
  96 sub xprint {
  97   my $level = shift;
  98   if ($verbose >= $level) {
  99     print STDERR @_;
 100   }
 101 }
 102
 103 sub escape_string($) {
 104   my $in = shift;
 105   $in =~ s!([\\\{\}\*\&~\$_])!\\$1!g;
 106   return($in)
 107 }
 108
 109 sub demystify_keys($) {
 110   # what an ugly hack :-)
 111   my $keys = shift;
 112   my @tok = split(/(\\e[^\^]|\^.)/, $keys);
 113   my ($k, $out);
 114
 115   $out = '';
 116   foreach $k (@tok) {
 117     if ($k eq '') { next; }
 118     if ($k =~ m!^[^\\\^]!) {
 119       $k =~ s!(.)! $1!g;
 120     }
 121     else {
 122       $k =~ s!\\e!ESC-!g;
 123       $k =~ s!\^I!TAB!g;
 124       $k =~ s!\^[jJmM]!return!g;
 125       $k =~ s!\^!CTRL-!g;
 126     }
 127     $out .= $k;
 128   }
 129
 130   return($out);
 131 }
 132
 133 sub insert($$$) {
 134   my $linenum=shift; my $cat=shift; my $sec=shift;
 135   my ($entry, $count);
 136   if ($sec eq '') { $sec = 'default'; }
 137   if (!defined($data{"$cat-$sec"})) {
 138     warn("Unknown insertion tag in line $linenum (\@\@INSERT-$cat-$sec\@\@). IGNORING.\n");
 139     return;
 140   }
 141   xprint(1, "inserting: category($cat) section($sec), line: $linenum\n");
 142   $count = 0;
 143   foreach $entry (sort @{ $data{"$cat-$sec"} }) {
 144     my $is;
 145     foreach $is (@{ $splits{"$cat-$sec"} } ) {
 146       if ($count == $is) {
 147         print("$splitstring\n");
 148         last;
 149       }
 150     }
 151     print("$entry\n");
 152     $count++;
 153   }
 154 }
 155
 156 sub handle_hashdir($$) {
 157   my $sec = shift ; my $desc = shift;
 158   my ($dir, $value);
 159   if ($sec eq '') { $sec=0; }
 160   xprint(1, "Handling hashed dir (section: $secmap[$sec]) in line $ln ($desc)\n");
 161   $ln++;
 162   while ($ln <= $i) {
 163     if ($input[$ln] =~ m!^\s*\#d[0-9]*\#!) {
 164       xprint(1, "Ending hashed dir handling in line $ln.\n");
 165       $ln++;
 166       return;
 167     }
 168     if ($input[$ln] =~ m!\s*hash\s+-d\s+([^=]+)=(.*)!) {
 169       $dir=$1; $value=&escape_string($2);
 170       push(@{ $data{"hasheddirs-$secmap[$sec]"} }, "\\command\{$dir\}\{$value\}");
 171     }
 172     else {
 173       warn("Broken hashed dir in line $ln. IGNORING.\n");
 174     }
 175     $ln++;
 176   }
 177 }
 178
 179 sub handle_abbrev($$) {
 180   my $sec = shift ; my $desc = shift;
 181   my ($abbrev, $value, $doc);
 182   if ($sec eq '') { $sec=0; }
 183   xprint(1, "Handling abbreviation (section: $secmap[$sec]) in line $ln ($desc)\n");
 184   $ln++;
 185   while ($ln <= $i) { # the global $i
 186     if ($input[$ln] =~ m!^\s*\#A[0-9]*\#!) {
 187       xprint(1, "Ending abbreviation handling in line $ln.\n");
 188       $ln++;
 189       return;
 190     }
 191     $doc = '';
 192     if ($input[$ln] =~ s!\s+\#d\s*([^#]*)$!!) { $doc = $1; }
 193     if ($input[$ln] =~ m!\s*['"]([^"']*)['"]\s\$?['"]([^"']*)['"]!) {
 194       $abbrev = $1; $value = &escape_string($2);
 195       xprint(2, "ab: $abbrev -> $value ($doc);\n");
 196       push(@{ $data{"abbrev-$secmap[$sec]"} }, "\\command\{$abbrev\}\{\\kbd\{$value" . ($doc ne '' ? "\}\\quad $doc" : "\}") . "\}");
 197     }
 198     else {
 199       warn("Broken abbreviation in line $ln. IGNORING.\n");
 200     }
 201     $ln++;
 202   }
 203 }
 204
 205 sub handle_function($$) {
 206   my $sec = shift ; my $desc = shift;
 207   if ($sec eq '') { $sec=0; }
 208   xprint(1, "Handling function (section: $secmap[$sec]) in line $ln ($desc)\n");
 209   $ln++;
 210   if ($input[$ln] =~ m!\s*(function)?\s*([^(\s]*)!) {
 211     xprint(2, "  - $2()\n");
 212     push(@{ $data{"functions-$secmap[$sec]"} }, "\\command\{$2()\}\{$desc\}");
 213   }
 214   else {
 215     warn("Parsing function line $ln ($input[$ln]) failed. IGNORING.\n");
 216   }
 217 }
 218
 219 sub handle_alias($$) {
 220   my $sec = shift ; my $desc = shift;
 221   my ($alias, $value);
 222   if ($sec eq '') { $sec=0; }
 223   xprint(1, "Handling alias (section: $secmap[$sec]) in line $ln ($desc)\n");
 224   $ln++;
 225   if ($input[$ln] =~ m!\s*alias (-[haocC] +)*([^=]*)=["'](.*)["']!) {
 226     $alias=$2; $value=&escape_string($3);
 227     $desc =~ s!\@a\@!$value!;
 228     push(@{ $data{"aliases-$secmap[$sec]"} }, "\\command\{$alias\}\{$desc\}");
 229   }
 230   else {
 231     warn("Parsing alias line $ln ($input[$ln]) failed. IGNORING.\n");
 232   }
 233 }
 234
 235 sub handle_other($$) {
 236   my $sec = shift ; my $desc = shift;
 237   $desc =~ m!([^\s]+)\s+(.*)!;
 238   xprint(1, "Handling 'other' tag in line $ln ($1 -> $2))\n");
 239   $other{$1} = $2;
 240   $ln++;
 241 }
 242
 243 sub handle_keybinding($$) {
 244   my $sec = shift ; my $desc = shift;
 245   my ($kbd, $value);
 246   if ($sec eq '') { $sec=0; }
 247   xprint(1, "Handling keybinding (section: $secmap[$sec]) in line $ln ($desc)\n");
 248   $ln++;
 249   if ($input[$ln] =~ m!^.*bindkey\s+[^'"]*(.*)['"]\s+([\w-]*)\#?.*!) {
 250     $value=&escape_string($2);
 251     $kbd = $1;
 252     $kbd =~ s!^["']!!;
 253     $kbd =~ s!["']$!!;
 254     $kbd=&demystify_keys($kbd);
 255     $desc =~ s!\@k\@!$value!;
 256    #xprint(0, "!-> DEBUG: kbd: $kbd - value: $value - desc: $desc\n");
 257     push(@{ $data{"keybindings-$secmap[$sec]"} }, "\\command\{$kbd\}\{$desc\}");
 258   }
 259   else {
 260     warn("Parsing keybinding line $ln ($input[$ln]) failed. IGNORING.\n");
 261   }
 262 }
 263
 264 sub handle_variable($$) {
 265   my $sec = shift ; my $desc = shift;
 266   my ($var, $value);
 267   if ($sec eq '') { $sec=0; }
 268   xprint(1, "Handling variable (section: $secmap[$sec]) in line $ln ($desc)\n");
 269   $ln++;
 270   if ($input[$ln] =~ m!^.*\s+(\w*)=(.*)$!) {
 271     $var = $1 ; $value = $2;
 272     $value =~ s!^\$\{\w*:-(.*)\}!$1!;
 273     $value =~ s!^['"]!!;
 274     $value =~ s!['"]$!!;
 275     $value = &escape_string($value);
 276     push(@{ $data{"variables-$secmap[$sec]"} }, "\\command\{$var\}\{\\kbd\{$value" . ($desc ne '' ? "\}\\quad $desc" : "\}") . "\}");
 277   }
 278   else {
 279     warn("Parsing variable line $ln ($input[$ln]) failed. IGNORING.\n");
 280   }
 281 }
 282
 283 sub handle_manual($$$) {
 284   # this is different than the other handle_*() subs.
 285   my $code = shift ; my $key = shift ; my $value = shift;
 286   my $sec;
 287   xprint(1, "Handling manual entry (code: $code) in line $ln ($key -> $value)\n");
 288   $sec = ( (length($code) > 1) ? substr($code, 1) : 0);
 289   if    (substr($code, 0, 1) eq 'a') {
 290     push(@{ $data{"aliases-$secmap[$sec]"} }, "\\command\{$key\}\{$value\}");
 291   }
 292   elsif (substr($code, 0, 1) eq 'A') {
 293     push(@{ $data{"abbrev-$secmap[$sec]"} }, "\\command\{$key\}\{$value\}");
 294   }
 295   elsif (substr($code, 0, 1) eq 'd') {
 296     push(@{ $data{"hasheddirs-$secmap[$sec]"} }, "\\command\{$key\}\{$value\}");
 297   }
 298   elsif (substr($code, 0, 1) eq 'f') {
 299     push(@{ $data{"functions-$secmap[$sec]"} }, "\\command\{$key\}\{$value\}");
 300   }
 301   elsif (substr($code, 0, 1) eq 'k') {
 302     push(@{ $data{"keybindings-$secmap[$sec]"} }, "\\command\{$key\}\{$value\}");
 303   }
 304   elsif (substr($code, 0, 1) eq 'o') {
 305     push(@{ $data{"other-$secmap[$sec]"} }, "\\command\{$key\}\{$value\}");
 306   }
 307   elsif (substr($code, 0, 1) eq 'v') {
 308     push(@{ $data{"variables-$secmap[$sec]"} }, "\\command\{$key\}\{$value\}");
 309   }
 310   else {
 311     warn("Unknown doc-definition character in manual-line $ln ($1). IGNORING.\n");
 312     $ln++;
 313   }
 314   $ln++;
 315 }
 316
 317 sub set_option($) {
 318   my $optstring = shift;
 319   my ($opt, $val);
 320   $ln++;
 321   if ($optstring =~ m!([a-zA-Z0-9_-]+)\s+(.*)!) {
 322     $opt = $1;
 323     $val = $2;
 324     if ($opt eq 'split') {
 325       if ($val =~ m!([a-zA-Z0-9_-]+)\s+(.*)!) {
 326         my $what = $1;
 327         my $when = $2;
 328         xprint(2, "  splitting values (for $what): " . join(' ', split(/,/, $when)) . "\n");
 329         @{ $splits{"$what"} } = split(/,/, $when);
 330       }
 331       else {
 332         warn("Parsing split option failed in line $ln. IGNORING.\n");
 333       }
 334     }
 335     else {
 336       warn("Unknown option ($opt) in line $ln. IGNORING.\n");
 337     }
 338   }
 339   else {
 340     warn("Parsing option in line $ln failed. IGNORING.\n");
 341   }
 342 }
 343
 344 ###}}}
 345
 346 ### main()
 347 ### {{{ handling stdin
 348 $i = 0;
 349 $input[0]='index==linenumber :-)';
 350 while (<STDIN>) {
 351   $i++;
 352   if ($i > $MAX_INPUT) {
 353     die "Sorry dude, input lines exeeded maximum ($MAX_INPUT)}\n";
 354   }
 355   chomp;
 356   push(@input, $_);
 357 }
 358 $ln = 1;
 359 while ($ln <= $i) {
 360   if ($input[$ln] =~ m!^\#\@\#\s*(.*)$!) {
 361     &set_option($1);
 362     next;
 363   }
 364   if ($input[$ln] =~ m!^\s*\#([a-zA-Z])([0-9]*)\#\s*(.*)$!) {
 365     if    ($1 eq 'a') {
 366       &handle_alias($2, $3);
 367     }
 368     elsif ($1 eq 'A') {
 369       &handle_abbrev($2, $3);
 370     }
 371     elsif ($1 eq 'd') {
 372       &handle_hashdir($2, $3);
 373     }
 374     elsif ($1 eq 'f') {
 375       &handle_function($2, $3);
 376     }
 377     elsif ($1 eq 'k') {
 378       &handle_keybinding($2, $3);
 379     }
 380     elsif ($1 eq 'o') {
 381       &handle_other($2, $3);
 382     }
 383     elsif ($1 eq 'v') {
 384       &handle_variable($2, $3);
 385     }
 386     elsif ($1 eq 'm') {
 387       my $arg = $3;
 388       $arg =~ m!^\s*([a-zA-Z][0-9]*)\s+(\S+)\s+(.*)!;
 389       &handle_manual($1, $2, $3);
 390     }
 391     else {
 392       warn("Unknown doc-definition character in line $ln ($1). IGNORING.\n");
 393       $ln++;
 394     }
 395   }
 396   else {
 397     $ln++;
 398   }
 399 }
 400 #}}}
 401
 402 &dumpdata();
 403
 404 open(IN, "<$refin") or die "could not open $refin: $!\n";
 405 $i=0;
 406 while (<IN>) { #{{{ output loop
 407   $i++;
 408   while (m!\@\@INSERT-other-[^@]+\@\@!) {
 409     s!\@\@INSERT-other-([^@]+)\@\@!$other{$1}!;
 410     xprint(2, "Inserting \@\@INSERT-other-$1\@\@ -> $other{$1}\n");
 411   }
 412   if (m!^\@\@INSERT-([^-]*)-?(.*)\@\@!) {
 413     if ($1 eq '') {
 414       die "malformed insertion tag in line $i ($_). ABORT\n";
 415     }
 416     &insert($i, $1, $2);
 417   }
 418   else {
 419     print;
 420   }
 421 }#}}}
 422 close(IN);