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                 $bref = $owner_bindings{$owner};
 285                 push (@$bref, [ $action, $b, $group_names{$gkey} ]);
 286             }
 287         }
 288
 289         if ($key =~ /^-/) {
 290             # do not include this binding in the cheat sheet
 291             next;
 292         }
 293
 294         $bref = $group_bindings{$key};
 295         push (@$bref, [$binding, $text]);
 296
 297         $sref = $section_text{$key};
 298         push (@$sref, [$owner]);
 299
 300         next;
 301     }
 302
 303     next;
 304 }
 305
 306 if ($make_accelmap) {
 307     print "<BindingSet name=\"" . $bindings_name . "\">\n";
 308
 309     foreach $owner (keys %owner_bindings) {
 310         print " <Bindings name=\"$owner\">\n  <Press>\n";
 311         $bindings = $owner_bindings{$owner};
 312         shift (@$bindings); # remove initial empty element
 313         for my $binding (@$bindings) {
 314             print '   <Binding key="' . @$binding[1] . '" action="' . @$binding[0] . '" group="' . @$binding[2] . "\"/>\n";
 315         }
 316         print "  </Press>\n </Bindings>\n";
 317     }
 318
 319     # merge in the "fixed" bindings that are not defined by the argument given to this program
 320     # this covers things like the step editor, monitor and processor box bindings
 321
 322     foreach $hardcoded_bindings ("mixer.bindings", "step_editing.bindings", "monitor.bindings", "processor_box.bindings") {
 323         $path = File::Spec->catfile (dirname ($ARGV[0]), $hardcoded_bindings);
 324         open HARDCODED, "<", $path or die $!;
 325         while (<HARDCODED>) {
 326             print $_;
 327         }
 328         close HARDCODED;
 329     }
 330
 331     print "</BindingSet>\n";
 332 }
 333
 334 if ($make_accelmap || !$make_cheatsheet) {
 335     exit 0;
 336 }
 337
 338 if ($html) {
 339
 340     @groups_sorted_by_number = sort { $group_numbering{$a} <=> $group_numbering{$b} } keys %group_numbering;
 341
 342     foreach $gk (@groups_sorted_by_number) {
 343
 344         if ($gk =~ /^m/) {
 345             # mouse stuff - ignore
 346             next;
 347         }
 348
 349         # $bref is a reference to the array of arrays for this group
 350         $bref = $group_bindings{$gk};
 351
 352         if (scalar @$bref > 1) {
 353
 354             $name = $group_names{$gk};
 355             $name =~ s/\\linebreak.*//;
 356             $name =~ s/\\&/&/;
 357             $name =~ s/\$\\_\$/-/g;
 358             $name =~ s/\\[a-z]+ //g;
 359             $name =~ s/[{}]//g;
 360             $name =~ s/\\par//g;
 361
 362             print "<h3>$name</h3>\n";
 363
 364             $gtext = $group_text{$gk};
 365             $gtext =~ s/\\linebreak.*//;
 366             $gtext =~ s/\\&/&/;
 367             $gtext =~ s/\$\\_\$/-/g;
 368             $gtext =~ s/\\[a-z]+ //g;
 369             $gtext =~ s/[{}]//g;
 370             $gtext =~ s/\\par//g;
 371
 372             if (!($gtext eq  "")) {
 373                 print "$gtext\n\n";
 374             }
 375
 376             # ignore the first entry, which was empty
 377
 378             shift (@$bref);
 379
 380             # set up the list
 381
 382             print "<dl class=\"bindings\">\n";
 383
 384             # sort the array of arrays by the descriptive text for nicer appearance,
 385             # and print them
 386
 387             for $bbref (sort { @$a[1] cmp @$b[1] } @$bref) {
 388                 # $bbref is a reference to an array
 389
 390                 $binding = @$bbref[0];
 391                 $text = @$bbref[1];
 392
 393                 if ($binding =~ /:/) { # mouse binding with "where" clause
 394                     ($binding,$where) = split (/:/, $binding, 2);
 395                 }
 396
 397                 foreach $k (keys %cs_modifier_map) {
 398                     $binding =~ s/\@$k\@/$cs_modifier_map{$k}/;
 399                 }
 400
 401                 # remove braces for HTML
 402
 403                 $binding =~ s/></\+/g;
 404                 $binding =~ s/^<//;
 405                 $binding =~ s/>/\+/;
 406
 407                 # substitute keycode names for something printable
 408
 409                 $re = qr/${ \(join'|', map quotemeta, keys %keycodes)}/;
 410                 $binding =~ s/($re)/$keycodes{$1}/g;
 411
 412                 # tidy up description
 413
 414                 $descr = @$bbref[1];
 415                 $descr =~ s/\\linebreak.*//;
 416                 $descr =~ s/\\&/&/;
 417                 $descr =~ s/\$\\_\$/-/g;
 418                 $descr =~ s/\\[a-z]+ //g;
 419                 $descr =~ s/[{}]//g;
 420                 $descr =~ s/\\par//g;
 421
 422                 print "<dt>$descr</dt><dd>$binding</dd>\n";
 423             }
 424
 425             print "</dl>\n";
 426
 427         }
 428     }
 429     print "&nbsp; <!-- remove this if more text is added below -->\n";
 430     exit 0;
 431 }
 432
 433
 434 # Now print the cheatsheet
 435
 436 $boilerplate_header = <<END_HEADER;
 437 \\documentclass[10pt,landscape]{article}
 438 %\\documentclass[10pt,landscape,a4paper]{article}
 439 %\\documentclass[10pt,landscape,letterpaper]{article}
 440 \\usepackage{multicol}
 441 \\usepackage{calc}
 442 \\usepackage{ifthen}
 443 \\usepackage{palatino}
 444 \\usepackage{geometry}
 445
 446 \\setlength{\\parskip}{0pt}
 447 \\setlength{\\parsep}{0pt}
 448 \\setlength{\\headsep}{0pt}
 449 \\setlength{\\topskip}{0pt}
 450 \\setlength{\\topmargin}{0pt}
 451 \\setlength{\\topsep}{0pt}
 452 \\setlength{\\partopsep}{0pt}
 453
 454 % This sets page margins to .5 inch if using letter paper, and to 1cm
 455 % if using A4 paper. (This probably isnott strictly necessary.)
 456 % If using another size paper, use default 1cm margins.
 457 \\ifthenelse{\\lengthtest { \\paperwidth = 11in}}
 458         { \\geometry{top=.5in,left=.5in,right=.5in,bottom=.5in} }
 459         {\\ifthenelse{ \\lengthtest{ \\paperwidth = 297mm}}
 460                 {\\geometry{top=1cm,left=1cm,right=1cm,bottom=1cm} }
 461                 {\\geometry{top=1cm,left=1cm,right=1cm,bottom=1cm} }
 462         }
 463
 464 % Turn off header and footer
 465 \\pagestyle{empty}
 466
 467 % Redefine section commands to use less space
 468 \\makeatletter
 469 \\renewcommand{\\section}{\\\@startsection{section}{1}{0mm}%
 470                                 {-1ex plus -.5ex minus -.2ex}%
 471                                 {0.5ex plus .2ex}%
 472                                 {\\normalfont\\large\\bfseries}}
 473 \\renewcommand{\\subsection}{\\\@startsection{subsection}{2}{0mm}%
 474                                 {-1explus -.5ex minus -.2ex}%
 475                                 {0.5ex plus .2ex}%
 476                                 {\\normalfont\\normalsize\\bfseries}}
 477 \\renewcommand{\\subsubsection}{\\\@startsection{subsubsection}{3}{0mm}%
 478                                 {-1ex plus -.5ex minus -.2ex}%
 479                                 {1ex plus .2ex}%
 480                                 {\\normalfont\\small\\bfseries}}
 481 \\makeatother
 482
 483 % Do not print section numbers% Do not print section numbers
 484 \\setcounter{secnumdepth}{0}
 485
 486 \\setlength{\\parindent}{0pt}
 487 \\setlength{\\parskip}{0pt plus 0.5ex}
 488
 489 %-------------------------------------------
 490
 491 \\begin{document}
 492 \\newlength{\\MyLen}
 493 \\raggedright
 494 \\footnotesize
 495 \\begin{multicols}{3}
 496 END_HEADER
 497
 498 $boilerplate_footer = <<END_FOOTER;
 499 \\rule{0.3\\linewidth}{0.25pt}
 500 \\scriptsize
 501
 502 Copyright \\copyright\\ 2013 ardour.org
 503
 504 % Should change this to be date of file, not current date.
 505
 506 http://manual.ardour.org
 507
 508 \\end{multicols}
 509 \\end{document}
 510 END_FOOTER
 511
 512 if ($make_cheatsheet) {
 513     print $boilerplate_header;
 514     print "\\begin{center}\\Large\\bf $title \\end{center}\n";
 515 }
 516
 517 @groups_sorted_by_number = sort { $group_numbering{$a} <=> $group_numbering{$b} } keys %group_numbering;
 518
 519 foreach $gk (@groups_sorted_by_number) {
 520     # $bref is a reference to the array of arrays for this group
 521     $bref = $group_bindings{$gk};
 522
 523     if (scalar @$bref > 1) {
 524         print "\\section{$group_names{$gk}}\n";
 525
 526         if (!($group_text{$gk} eq  "")) {
 527             print "$group_text{$gk}\n\\par\n";
 528         }
 529
 530         # ignore the first entry, which was empty
 531
 532         shift (@$bref);
 533
 534         # find the longest descriptive text (this is not 100% accuracy due to typography)
 535
 536         $maxtextlen = 0;
 537         $maxtext = "";
 538
 539         for $bbref (@$bref) {
 540             # $bbref is a reference to an array
 541             $text = @$bbref[1];
 542
 543             #
 544             # if there is a linebreak, just use everything up the linebreak
 545             # to determine the width
 546             #
 547
 548             if ($text =~ /\\linebreak/) {
 549                 $matchtext = s/\\linebreak.*//;
 550             } else {
 551                 $matchtext = $text;
 552             }
 553             if (length ($matchtext) > $maxtextlen) {
 554                 $maxtextlen = length ($matchtext);
 555                 $maxtext = $matchtext;
 556             }
 557         }
 558
 559         if ($gk =~ /^m/) {
 560             # mouse mode: don't extend max text at all - space it tight
 561             $maxtext .= ".";
 562         } else {
 563             $maxtext .= "....";
 564         }
 565
 566         # set up the table
 567
 568         print "\\settowidth{\\MyLen}{\\texttt{$maxtext}}\n";
 569         print "\\begin{tabular}{\@{}p{\\the\\MyLen}%
 570                                 \@{}p{\\linewidth-\\the\\MyLen}%
 571                                 \@{}}\n";
 572
 573         # sort the array of arrays by the descriptive text for nicer appearance,
 574         # and print them
 575
 576         for $bbref (sort { @$a[1] cmp @$b[1] } @$bref) {
 577             # $bbref is a reference to an array
 578
 579             $binding = @$bbref[0];
 580             $text = @$bbref[1];
 581
 582             if ($binding =~ /:/) { # mouse binding with "where" clause
 583                 ($binding,$where) = split (/:/, $binding, 2);
 584             }
 585
 586             if ($gk =~ /^m/) {
 587                 # mouse mode - use shorter abbrevs
 588                 foreach $k (keys %mouse_modifier_map) {
 589                     $binding =~ s/\@$k\@/$mouse_modifier_map{$k}/;
 590                 }
 591             } else {
 592                 foreach $k (keys %cs_modifier_map) {
 593                     $binding =~ s/\@$k\@/$cs_modifier_map{$k}/;
 594                 }
 595             }
 596
 597             $binding =~ s/></\+/g;
 598             $binding =~ s/^<//;
 599             $binding =~ s/>/\+/;
 600
 601             # substitute keycode names for something printable
 602
 603             $re = qr/${ \(join'|', map quotemeta, keys %keycodes)}/;
 604             $binding =~ s/($re)/$keycodes{$1}/g;
 605
 606             # split up mouse bindings to "click" and "where" parts
 607
 608             if ($gk eq "mobject") {
 609                 print "{\\tt @$bbref[1] } & {\\tt $binding} {\\it $where}\\\\\n";
 610             } else {
 611                 print "{\\tt @$bbref[1] } & {\\tt $binding} \\\\\n";
 612             }
 613         }
 614
 615         print "\\end{tabular}\n";
 616
 617     }
 618 }
 619
 620 print $boilerplate_footer;
 621
 622 exit 0;