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