genrefcard.pl

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