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     while ($ln <= $i) { # the global $i
 267         if ($input[$ln] =~ m!^\s*\#A[0-9]*\#!) {
 268             xprint(1, "Ending abbreviation handling in line $ln.\n");
 269             $ln++;
 270             return 1;
 271         }
 272
 273         $doc = '';
 274         if ($input[$ln] =~ s/\s+\#d\s*([^#]*)$//) {
 275             $doc = $1;
 276         }
 277
 278         if ($input[$ln] =~ m!\s*['"]([^"']*)['"]\s\$?['"]([^"']*)['"]!) {
 279             $abbrev = $1; $value = &escape_string($2);
 280             xprint(2, "ab: $abbrev -> $value ($doc);\n");
 281             push(@{ $data{"abbrev-$secmap[$sec]"} }, "\\command\{$abbrev\}\{\\kbd\{$value" . ($doc ne '' ? "\}\\quad $doc" : "\}") . "\}");
 282         } else {
 283             return 0;
 284         }
 285         $ln++;
 286     }
 287     return 0;
 288 }
 289 #}}}
 290 sub __alias { #{{{
 291     my ($sec, $desc) = @_;
 292     my ($alias, $value);
 293
 294     if ($input[$ln] =~ m!\s*alias (-[haocC] +)*([^=]*)=["'](.*)["']!) {
 295         $alias=$2; $value=&escape_string($3);
 296         $desc =~ s!\@a\@!$value!;
 297         push(@{ $data{"aliases-$secmap[$sec]"} }, "\\command\{$alias\}\{$desc\}");
 298     } else {
 299         return 0;
 300     }
 301
 302     return 1;
 303 }
 304 #}}}
 305 sub __function { #{{{
 306     my ($sec, $desc) = @_;
 307
 308     if ($input[$ln] =~ m!\s*(function)?\s*([^(\s]*)!) {
 309         xprint(2, "  - $2()\n");
 310         push(@{ $data{"functions-$secmap[$sec]"} }, "\\command\{$2()\}\{$desc\}");
 311     } else {
 312         return 0;
 313     }
 314
 315     return 1;
 316 }
 317 #}}}
 318 sub __hashdir { #{{{
 319     my ($sec, $desc) = @_;
 320     my ($dir, $value);
 321
 322     while ($ln <= $i) {
 323
 324         if ($input[$ln] =~ m/^\s*\#d[0-9]*\#/) {
 325             xprint(1, "Ending hashed dir handling in line $ln.\n");
 326             $ln++;
 327             return 1;
 328         }
 329
 330         if ($input[$ln] =~ m!\s*hash\s+-d\s+([^=]+)=(.*)!) {
 331             $dir=$1; $value=&escape_string($2);
 332             push(@{ $data{"hasheddirs-$secmap[$sec]"} }, "\\command\{$dir\}\{$value\}");
 333         } else {
 334             return 0;
 335         }
 336
 337         $ln++;
 338     }
 339     return 0;
 340 }
 341 #}}}
 342 sub __keybinding { #{{{
 343     my ($sec, $desc) = @_;
 344     my ($kbd, $value);
 345
 346     if ($input[$ln] =~ m!^.*bindkey\s+[^'"]*(.*)['"]\s+([\w-]*)\#?.*!) {
 347         ($kbd, $value) = ($1, $2);
 348         $value=&escape_string($value);
 349         $kbd =~ s!^["']!!;
 350         $kbd =~ s/["']$//;
 351         $kbd=&demystify_keys($kbd);
 352         $desc =~ s!\@k\@!$value!;
 353
 354        #xprint(0, "!-> DEBUG: kbd: $kbd - value: $value - desc: $desc\n");
 355
 356         push(@{ $data{"keybindings-$secmap[$sec]"} }, "\\command\{$kbd\}\{$desc\}");
 357     } else {
 358         return 0;
 359     }
 360
 361     return 1;
 362 }
 363 #}}}
 364 sub __variable { #{{{
 365     my ($sec, $desc) = @_;
 366     my ($var, $value);
 367
 368     if ($input[$ln] =~ m/\s*(\S+)=(.+)$/) {
 369         $var = $1 ; $value = $2;
 370         $value =~ s!^\$\{\w*:-(.*)\}!$1!;
 371         $value =~ s!^['"]!!;
 372         $value =~ s/['"]$//;
 373         $value = &escape_string($value);
 374         push(@{ $data{"variables-$secmap[$sec]"} }, "\\command\{$var\}\{\\kbd\{$value" . ($desc ne '' ? "\}\\quad $desc" : "\}") . "\}");
 375     } else {
 376         return 0;
 377     }
 378
 379     return 1;
 380 }
 381 #}}}
 382
 383 ###}}}
 384
 385 ### main() {{{
 386
 387 ### read our input from stdin {{{
 388 $i = 0;
 389 $input[0]='index==linenumber :-)';
 390 while (<STDIN>) {
 391     $i++;
 392     if ($i > $MAX_INPUT) {
 393         die "Sorry dude, input lines exeeded maximum ($MAX_INPUT)}\n";
 394     }
 395     chomp;
 396     push(@input, $_);
 397 }
 398
 399 # work on the lines in memory (jumping back and forth is simple this way)
 400 $ln = 1;
 401 while ($ln <= $i) {
 402     if ($input[$ln] =~ m/^\#\@\#\s*(.*)$/) {
 403         &set_option($1);
 404         next;
 405     }
 406
 407     if ($input[$ln] =~ m/^\s*\#([a-zA-Z])([0-9]*)\#\s*(.*)$/) {
 408         if      ($1 eq 'a') {
 409             &handle("alias", \&__alias, $2, $3);
 410         } elsif ($1 eq 'A') {
 411             &handle("abbreviation", \&__abbrev, $2, $3);
 412         } elsif ($1 eq 'd') {
 413             &handle("hashed dir", \&__hashdir, $2, $3);
 414         } elsif ($1 eq 'f') {
 415             &handle("function", \&__function, $2, $3);
 416         } elsif ($1 eq 'k') {
 417             &handle("keybinding", \&__keybinding, $2, $3);
 418         } elsif ($1 eq 'v') {
 419             &handle("variable", \&__variable, $2, $3);
 420         } elsif ($1 eq 'o') {
 421             &handle_other($2, $3);
 422         } elsif ($1 eq 'm') {
 423             my $arg = $3;
 424             $arg =~ m!^\s*([a-zA-Z][0-9]*)\s+(\S+)\s+(.*)!;
 425             &handle_manual($1, $2, $3);
 426         } else {
 427             warn("Unknown doc-definition character in line $ln ($1). IGNORING.\n");
 428             $ln++;
 429         }
 430     } else {
 431         $ln++;
 432     }
 433 }
 434 #}}}
 435
 436 &dumpdata();
 437
 438 # read the .in file and put in stuff we gathered from stdin earlier
 439 open(IN, "<$refin") or die "could not open $refin: $!\n";
 440
 441 #{{{ output loop
 442 $i=0;
 443 while (<IN>) {
 444     $i++;
 445     while (m!\@\@INSERT-other-[^@]+\@\@!) {
 446         s!\@\@INSERT-other-([^@]+)\@\@!$other{$1}!;
 447         xprint(2, "Inserting \@\@INSERT-other-$1\@\@ -> $other{$1}\n");
 448     }
 449
 450     if (m!^\@\@INSERT-([^-]*)-?(.*)\@\@!) {
 451         if ($1 eq '') {
 452             die "malformed insertion tag in line $i ($_). ABORT\n";
 453         }
 454
 455         &insert($i, $1, $2);
 456     } else {
 457         print;
 458     }
 459 }
 460 #}}}
 461
 462 close(IN);
 463
 464 #}}}