tools/fmt-bindings

   1 #!/usr/bin/perl
   2
   3 # import module
   4 use Getopt::Long;
   5 use File::Basename;
   6 use File::Spec;
   7
   8 $semicolon = ";"; # help out stupid emacs
   9 $title = "Ardour Shortcuts";
  10 $in_group_def = 0;
  11 $group_name;
  12 $group_text;
  13 $group_key;
  14 $group_number = 0;
  15 %group_names;
  16 %group_text;
  17 %owner_bindings;
  18 %group_owners;
  19 %group_bindings;
  20 %modifier_map;
  21 %group_numbering;
  22 %merge_bindings;
  23
  24 $platform = linux;
  25 $winkey = 'Win';
  26 $make_cheatsheet = 0;
  27 $make_accelmap = 1;
  28 $merge_from = "";
  29 $html = 0;
  30
  31 GetOptions ("platform=s" => \$platform,
  32             "winkey=s" => \$winkey,
  33             "cheatsheet" => \$make_cheatsheet,
  34             "accelmap" => \$make_accelmap,
  35             "merge=s" => \$merge_from,
  36             "html" => \$html);
  37
  38 if ($platform eq "darwin") {
  39
  40     $gtk_modifier_map{'PRIMARY'} = 'Primary'; # GTK supports Primary to allow platform-independent binding to the "primary" modifier, which on OS X is Command
  41     $gtk_modifier_map{'SECONDARY'} = 'Control';
  42     $gtk_modifier_map{'TERTIARY'} = 'Shift';
  43     $gtk_modifier_map{'LEVEL4'} = 'Mod1';
  44
  45     # cs_modifier_map == "Cheat Sheet Modifier Map"
  46     # Used to control what gets shown in the
  47     # cheat sheet for a given (meta)-modifier
  48
  49     $cs_modifier_map{'PRIMARY'} = 'Cmd';
  50     $cs_modifier_map{'SECONDARY'} = 'Control';
  51     $cs_modifier_map{'TERTIARY'} = 'Shift';
  52     $cs_modifier_map{'LEVEL4'} = 'Opt';
  53
  54     # used to display what gets shown in the
  55     # cheat sheet for mouse bindings. Differs
  56     # from cs_modifier map in using shorter
  57     # abbreviations.
  58
  59     $mouse_modifier_map{'PRIMARY'} = 'Cmd';
  60     $mouse_modifier_map{'SECONDARY'} = 'Ctrl';
  61     $mouse_modifier_map{'TERTIARY'} = 'Shift';
  62     $mouse_modifier_map{'LEVEL4'} = 'Opt';
  63
  64 } else {
  65
  66     $gtk_modifier_map{'PRIMARY'} = 'Control';
  67     $gtk_modifier_map{'SECONDARY'} = 'Alt';
  68     $gtk_modifier_map{'TERTIARY'} = 'Shift';
  69     $gtk_modifier_map{'LEVEL4'} = $winkey;  # something like "Mod4><Super"
  70
  71     # cs_modifier_map == "Cheat Sheet Modifier Map"
  72     # Used to control what gets shown in the
  73     # cheat sheet for a given (meta)-modifier
  74
  75     $cs_modifier_map{'PRIMARY'} = 'Control';
  76     $cs_modifier_map{'SECONDARY'} = 'Alt';
  77     $cs_modifier_map{'TERTIARY'} = 'Shift';
  78     $cs_modifier_map{'LEVEL4'} = 'Win';
  79
  80     # used to display what gets shown in the
  81     # cheat sheet for mouse bindings. Differs
  82     # from cs_modifier map in using shorter
  83     # abbreviations.
  84
  85     $mouse_modifier_map{'PRIMARY'} = 'Ctl';
  86     $mouse_modifier_map{'SECONDARY'} = 'Alt';
  87     $mouse_modifier_map{'TERTIARY'} = 'Shift';
  88     $mouse_modifier_map{'LEVEL4'} = 'Win';
  89 }
  90
  91 %keycodes = ();
  92
  93 if ($html) {
  94     %keycodes = (
  95         'asciicircum' => '^',
  96         'apostrophe' => '\'',
  97         'bracketleft' => '[',
  98         'bracketright' => ']',
  99         'braceleft' => '{',
 100         'braceright' => '}',
 101         'backslash' => '\\',
 102         'slash' => '/',
 103         'rightanglebracket' => '&gt;',
 104         'leftanglebracket' => '&lt;',
 105         'ampersand' => '&',
 106         'comma' => ',',
 107         'period' => '.',
 108         'semicolon' => ';',
 109         'colon' => ':',
 110         'equal' => '=',
 111         'minus' => '-',
 112         'plus' => '+',
 113         'grave' => '`',
 114         'rightarrow' => '&rarr;',
 115         'leftarrow' => '&larr;',
 116         'uparrow' => '&uarr;',
 117         'downarrow' => '&darr;',
 118         'Page_Down' => 'PageDown',
 119         'Page_Up' => 'PageUp',
 120         'space' => 'space',
 121         'KP_Right' => 'KP-&rarr;',
 122         'KP_Left' => 'KP-&larr;',
 123         'KP_Up' => 'KP-&uarr;',
 124         'KP_Down' => 'KP-&darr;',
 125         'KP_0' => 'KP-0;',
 126         'greater' => '&gt;',
 127         'less' => '&lt;',
 128         );
 129 } else {
 130
 131     %keycodes = (
 132         'asciicircum' => '\\verb=^=',
 133         'apostrophe' => '\'',
 134         'bracketleft' => '[',
 135         'bracketright' => ']',
 136         'braceleft' => '\\{',
 137         'braceright' => '\\}',
 138         'backslash' => '$\\backslash$',
 139         'slash' => '/',
 140         'rightanglebracket' => '>',
 141         'leftanglebracket' => '<',
 142         'ampersand' => '\\&',
 143         'comma' => ',',
 144         'period' => '.',
 145         'semicolon' => ';',
 146         'colon' => ':',
 147         'equal' => '=',
 148         'minus' => '-',
 149         'plus' => '+',
 150         'grave' => '`',
 151         'rightarrow' => '$\rightarrow$',
 152         'leftarrow' => '$\\leftarrow$',
 153         'uparrow' => '$\\uparrow$',
 154         'downarrow' => '$\\downarrow$',
 155         'Page_Down' => 'Page Down',
 156         'Page_Up' => 'Page Up',
 157         'space' => 'space',
 158         'KP_' => 'KP$\_$',
 159         'greater' => '>',
 160         'less' => '<',
 161     );
 162 }
 163
 164 if ($merge_from) {
 165     open (BINDINGS, $merge_from) || die ("merge from bindings: file not readable");
 166     while (<BINDINGS>) {
 167         next if (/^$semicolon/);
 168         if (/^\(gtk_accel/) {
 169             chop; # newline
 170             chop; # closing parenthesis
 171             s/"//g;
 172             ($junk, $action, $binding) = split;
 173             $merge_bindings{$action} = $binding;
 174         }
 175     }
 176     close (BINDINGS);
 177 }
 178
 179 if ($make_accelmap && !$merge_from) {
 180     print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
 181 }
 182
 183 $bindings_name = basename ($ARGV[0]);
 184 $bindings_name =~ s/.bindings\.in$//;
 185
 186 open SOURCE, "<", $ARGV[0] or die $!;
 187
 188 while (<SOURCE>) {
 189     next if /^$semicolon/;
 190
 191     if (/^\$/) {
 192         s/^\$//;
 193         $title = $_;
 194         next;
 195     }
 196
 197     if (/^%/) {
 198
 199         if ($in_group_def) {
 200             chop $group_text;
 201             $group_names{$group_key} = $group_name;
 202             $group_text{$group_key} = $group_text;
 203             $group_numbering{$group_key} = $group_number;
 204             # each binding entry is 2 element array. bindings
 205             # are all collected into a container array. create
 206             # the first dummy entry so that perl knows what we
 207             # are doing.
 208             $group_bindings{$group_key} = [ [] ];
 209         }
 210
 211         s/^%//;
 212         chop;
 213         ($group_key,$owner,$group_name) = split (/\s+/, $_, 3);
 214         if ($make_accelmap) {
 215             if (!exists ($owner_bindings{$owner})) {
 216                 $owner_bindings{$owner} = [ [] ];
 217             }
 218             $group_owners{$group_key} = $owner;
 219         }
 220         $group_number++;
 221         $group_text = "";
 222         $in_group_def = 1;
 223         next;
 224     }
 225
 226     if ($in_group_def) {
 227         if (/^@/) {
 228             chop $group_text;
 229             $group_names{$group_key} = $group_name;
 230             $group_text{$group_key} = $group_text;
 231             $in_group_def = 0;
 232         } else {
 233             next if (/^[ \t]+$/);
 234             $group_text .= $_;
 235             $group_text;
 236             next;
 237         }
 238     }
 239
 240     if (/^@/) {
 241         s/^@//;
 242         chop;
 243         ($key,$action,$binding,$text) = split (/\|/, $_, 4);
 244
 245         $gkey = $key;
 246         $gkey =~ s/^-//;
 247         $owner = $group_owners{$gkey};
 248
 249         # substitute bindings
 250
 251         $gtk_binding = $binding;
 252
 253         if ($merge_from) {
 254             $lookup = "<Actions>/" . $action;
 255             if ($merge_bindings{$lookup}) {
 256                 $binding = $merge_bindings{$lookup};
 257             } else {
 258                 if ($key =~ /^\+/) {
 259                     # forced inclusion of bindings from template
 260                 } else {
 261                     # this action is not defined in the merge from set, so forget it
 262                     next;
 263                 }
 264             }
 265         }
 266
 267         # store the accelmap output
 268
 269         if ($key =~ /^\+/) {
 270             # remove + and don't print it in the accelmap
 271             $key =~ s/^\+//;
 272         } else {
 273             # include this in the accelmap if it is part of a group that has an "owner"
 274             if (!$merge_from && $make_accelmap && exists ($owner_bindings{$owner})) {
 275
 276                 $b = $binding;
 277                 $b =~ s/<@//g;
 278                 $b =~ s/@>//g;
 279                 $b =~ s/PRIMARY/Primary-/;
 280                 $b =~ s/SECONDARY/Secondary-/;
 281                 $b =~ s/TERTIARY/Tertiary-/;
 282                 $b =~ s/LEVEL4/Level4-/;
 283
 284                 $g = $group_names{$gkey};
 285                 $g =~ s/\\&/&amp;/g;
 286
 287                 $bref = $owner_bindings{$owner};
 288                 push (@$bref, [ $action, $b, $g]);
 289             }
 290         }
 291
 292         if ($key =~ /^-/) {
 293             # do not include this binding in the cheat sheet
 294             next;
 295         }
 296
 297         $bref = $group_bindings{$key};
 298         push (@$bref, [$binding, $text]);
 299
 300         $sref = $section_text{$key};
 301         push (@$sref, [$owner]);
 302
 303         next;
 304     }
 305
 306     next;
 307 }
 308
 309 if ($make_accelmap) {
 310     print "<BindingSet name=\"" . $bindings_name . "\">\n";
 311
 312     foreach $owner (keys %owner_bindings) {
 313         print " <Bindings name=\"$owner\">\n  <Press>\n";
 314         $bindings = $owner_bindings{$owner};
 315         shift (@$bindings); # remove initial empty element
 316         for my $binding (@$bindings) {
 317             print '   <Binding key="' . @$binding[1] . '" action="' . @$binding[0] . '" group="' . @$binding[2] . "\"/>\n";
 318         }
 319         print "  </Press>\n </Bindings>\n";
 320     }
 321
 322     # merge in the "fixed" bindings that are not defined by the argument given to this program
 323     # this covers things like the step editor, monitor and processor box bindings
 324
 325     foreach $hardcoded_bindings ("mixer.bindings", "step_editing.bindings", "monitor.bindings", "processor_box.bindings") {
 326         $path = File::Spec->catfile (dirname ($ARGV[0]), $hardcoded_bindings);
 327         open HARDCODED, "<", $path or die $!;
 328         while (<HARDCODED>) {
 329             print $_;
 330         }
 331         close HARDCODED;
 332     }
 333
 334     print "</BindingSet>\n";
 335 }
 336
 337 if ($make_accelmap || !$make_cheatsheet) {
 338     exit 0;
 339 }
 340
 341 if ($html) {
 342
 343     @groups_sorted_by_number = sort { $group_numbering{$a} <=> $group_numbering{$b} } keys %group_numbering;
 344
 345     foreach $gk (@groups_sorted_by_number) {
 346
 347         if ($gk =~ /^m/) {
 348             # mouse stuff - ignore
 349             next;
 350         }
 351
 352         # $bref is a reference to the array of arrays for this group
 353         $bref = $group_bindings{$gk};
 354
 355         if (scalar @$bref > 1) {
 356
 357             $name = $group_names{$gk};
 358             $name =~ s/\\linebreak.*//;
 359             $name =~ s/\\&/&/;
 360             $name =~ s/\$\\_\$/-/g;
 361             $name =~ s/\\[a-z]+ //g;
 362             $name =~ s/[{}]//g;
 363             $name =~ s/\\par//g;
 364
 365             print "<h3>$name</h3>\n";
 366
 367             $gtext = $group_text{$gk};
 368             $gtext =~ s/\\linebreak.*//;
 369             $gtext =~ s/\\&/&/;
 370             $gtext =~ s/\$\\_\$/-/g;
 371             $gtext =~ s/\\[a-z]+ //g;
 372             $gtext =~ s/[{}]//g;
 373             $gtext =~ s/\\par//g;
 374
 375             if (!($gtext eq  "")) {
 376                 print "$gtext\n\n";
 377             }
 378
 379             # ignore the first entry, which was empty
 380
 381             shift (@$bref);
 382
 383             # set up the list
 384
 385             print "<dl class=\"bindings\">\n";
 386
 387             # sort the array of arrays by the descriptive text for nicer appearance,
 388             # and print them
 389
 390             for $bbref (sort { @$a[1] cmp @$b[1] } @$bref) {
 391                 # $bbref is a reference to an array
 392
 393                 $binding = @$bbref[0];
 394                 $text = @$bbref[1];
 395
 396                 if ($binding =~ /:/) { # mouse binding with "where" clause
 397                     ($binding,$where) = split (/:/, $binding, 2);
 398                 }
 399
 400                 foreach $k (keys %cs_modifier_map) {
 401                     $binding =~ s/\@$k\@/$cs_modifier_map{$k}/;
 402                 }
 403
 404                 # remove braces for HTML
 405
 406                 $binding =~ s/></\+/g;
 407                 $binding =~ s/^<//;
 408                 $binding =~ s/>/\+/;
 409
 410                 # substitute keycode names for something printable
 411
 412                 $re = qr/${ \(join'|', map quotemeta, keys %keycodes)}/;
 413                 $binding =~ s/($re)/$keycodes{$1}/g;
 414
 415                 # tidy up description
 416
 417                 $descr = @$bbref[1];
 418                 $descr =~ s/\\linebreak.*//;
 419                 $descr =~ s/\\&/&/;
 420                 $descr =~ s/\$\\_\$/-/g;
 421                 $descr =~ s/\\[a-z]+ //g;
 422                 $descr =~ s/[{}]//g;
 423                 $descr =~ s/\\par//g;
 424
 425                 print "<dt>$descr</dt><dd>$binding</dd>\n";
 426             }
 427
 428             print "</dl>\n";
 429
 430         }
 431     }
 432     print "&nbsp; <!-- remove this if more text is added below -->\n";
 433     exit 0;
 434 }
 435
 436
 437 # Now print the cheatsheet
 438
 439 $boilerplate_header = <<END_HEADER;
 440 \\documentclass[10pt,landscape]{article}
 441 %\\documentclass[10pt,landscape,a4paper]{article}
 442 %\\documentclass[10pt,landscape,letterpaper]{article}
 443 \\usepackage{multicol}
 444 \\usepackage{calc}
 445 \\usepackage{ifthen}
 446 \\usepackage{palatino}
 447 \\usepackage{geometry}
 448
 449 \\setlength{\\parskip}{0pt}
 450 \\setlength{\\parsep}{0pt}
 451 \\setlength{\\headsep}{0pt}
 452 \\setlength{\\topskip}{0pt}
 453 \\setlength{\\topmargin}{0pt}
 454 \\setlength{\\topsep}{0pt}
 455 \\setlength{\\partopsep}{0pt}
 456
 457 % This sets page margins to .5 inch if using letter paper, and to 1cm
 458 % if using A4 paper. (This probably isnott strictly necessary.)
 459 % If using another size paper, use default 1cm margins.
 460 \\ifthenelse{\\lengthtest { \\paperwidth = 11in}}
 461         { \\geometry{top=.5in,left=.5in,right=.5in,bottom=.5in} }
 462         {\\ifthenelse{ \\lengthtest{ \\paperwidth = 297mm}}
 463                 {\\geometry{top=1cm,left=1cm,right=1cm,bottom=1cm} }
 464                 {\\geometry{top=1cm,left=1cm,right=1cm,bottom=1cm} }
 465         }
 466
 467 % Turn off header and footer
 468 \\pagestyle{empty}
 469
 470 % Redefine section commands to use less space
 471 \\makeatletter
 472 \\renewcommand{\\section}{\\\@startsection{section}{1}{0mm}%
 473                                 {-1ex plus -.5ex minus -.2ex}%
 474                                 {0.5ex plus .2ex}%
 475                                 {\\normalfont\\large\\bfseries}}
 476 \\renewcommand{\\subsection}{\\\@startsection{subsection}{2}{0mm}%
 477                                 {-1explus -.5ex minus -.2ex}%
 478                                 {0.5ex plus .2ex}%
 479                                 {\\normalfont\\normalsize\\bfseries}}
 480 \\renewcommand{\\subsubsection}{\\\@startsection{subsubsection}{3}{0mm}%
 481                                 {-1ex plus -.5ex minus -.2ex}%
 482                                 {1ex plus .2ex}%
 483                                 {\\normalfont\\small\\bfseries}}
 484 \\makeatother
 485
 486 % Do not print section numbers% Do not print section numbers
 487 \\setcounter{secnumdepth}{0}
 488
 489 \\setlength{\\parindent}{0pt}
 490 \\setlength{\\parskip}{0pt plus 0.5ex}
 491
 492 %-------------------------------------------
 493
 494 \\begin{document}
 495 \\newlength{\\MyLen}
 496 \\raggedright
 497 \\footnotesize
 498 \\begin{multicols}{3}
 499 END_HEADER
 500
 501 $boilerplate_footer = <<END_FOOTER;
 502 \\rule{0.3\\linewidth}{0.25pt}
 503 \\scriptsize
 504
 505 Copyright \\copyright\\ 2013 ardour.org
 506
 507 % Should change this to be date of file, not current date.
 508
 509 http://manual.ardour.org
 510
 511 \\end{multicols}
 512 \\end{document}
 513 END_FOOTER
 514
 515 if ($make_cheatsheet) {
 516     print $boilerplate_header;
 517     print "\\begin{center}\\Large\\bf $title \\end{center}\n";
 518 }
 519
 520 @groups_sorted_by_number = sort { $group_numbering{$a} <=> $group_numbering{$b} } keys %group_numbering;
 521
 522 foreach $gk (@groups_sorted_by_number) {
 523     # $bref is a reference to the array of arrays for this group
 524     $bref = $group_bindings{$gk};
 525
 526     if (scalar @$bref > 1) {
 527         print "\\section{$group_names{$gk}}\n";
 528
 529         if (!($group_text{$gk} eq  "")) {
 530             print "$group_text{$gk}\n\\par\n";
 531         }
 532
 533         # ignore the first entry, which was empty
 534
 535         shift (@$bref);
 536
 537         # find the longest descriptive text (this is not 100% accuracy due to typography)
 538
 539         $maxtextlen = 0;
 540         $maxtext = "";
 541
 542         for $bbref (@$bref) {
 543             # $bbref is a reference to an array
 544             $text = @$bbref[1];
 545
 546             #
 547             # if there is a linebreak, just use everything up the linebreak
 548             # to determine the width
 549             #
 550
 551             if ($text =~ /\\linebreak/) {
 552                 $matchtext = s/\\linebreak.*//;
 553             } else {
 554                 $matchtext = $text;
 555             }
 556             if (length ($matchtext) > $maxtextlen) {
 557                 $maxtextlen = length ($matchtext);
 558                 $maxtext = $matchtext;
 559             }
 560         }
 561
 562         if ($gk =~ /^m/) {
 563             # mouse mode: don't extend max text at all - space it tight
 564             $maxtext .= ".";
 565         } else {
 566             $maxtext .= "....";
 567         }
 568
 569         # set up the table
 570
 571         print "\\settowidth{\\MyLen}{\\texttt{$maxtext}}\n";
 572         print "\\begin{tabular}{\@{}p{\\the\\MyLen}%
 573                                 \@{}p{\\linewidth-\\the\\MyLen}%
 574                                 \@{}}\n";
 575
 576         # sort the array of arrays by the descriptive text for nicer appearance,
 577         # and print them
 578
 579         for $bbref (sort { @$a[1] cmp @$b[1] } @$bref) {
 580             # $bbref is a reference to an array
 581
 582             $binding = @$bbref[0];
 583             $text = @$bbref[1];
 584
 585             if ($binding =~ /:/) { # mouse binding with "where" clause
 586                 ($binding,$where) = split (/:/, $binding, 2);
 587             }
 588
 589             if ($gk =~ /^m/) {
 590                 # mouse mode - use shorter abbrevs
 591                 foreach $k (keys %mouse_modifier_map) {
 592                     $binding =~ s/\@$k\@/$mouse_modifier_map{$k}/;
 593                 }
 594             } else {
 595                 foreach $k (keys %cs_modifier_map) {
 596                     $binding =~ s/\@$k\@/$cs_modifier_map{$k}/;
 597                 }
 598             }
 599
 600             $binding =~ s/></\+/g;
 601             $binding =~ s/^<//;
 602             $binding =~ s/>/\+/;
 603
 604             # substitute keycode names for something printable
 605
 606             $re = qr/${ \(join'|', map quotemeta, keys %keycodes)}/;
 607             $binding =~ s/($re)/$keycodes{$1}/g;
 608
 609             # split up mouse bindings to "click" and "where" parts
 610
 611             if ($gk eq "mobject") {
 612                 print "{\\tt @$bbref[1] } & {\\tt $binding} {\\it $where}\\\\\n";
 613             } else {
 614                 print "{\\tt @$bbref[1] } & {\\tt $binding} \\\\\n";
 615             }
 616         }
 617
 618         print "\\end{tabular}\n";
 619
 620     }
 621 }
 622
 623 print $boilerplate_footer;
 624
 625 exit 0;