annotate keymap/keymap.pl @ 1801:93bb96b21be9

updated version string
author nadvornik
date Tue, 16 Feb 2010 21:10:12 +0000
parents 113d8329cbd6
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
962
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
1 #!/usr/bin/perl
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
2 use strict;
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
3
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
4 my %funcs;
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
5
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
6 open(ACCELS, "<$ENV{HOME}/.geeqie/accels") or die "No accel file";
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
7 while (<ACCELS>)
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
8 {
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
9 if (/gtk_accel_path "([^"]*)" *"([^"]*)"/)
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
10 {
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
11 my $name = $1;
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
12 my $key = $2;
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
13 $name =~ s/.*\///;
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
14 $key =~ s/</&lt;/g;
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
15 $key =~ s/>/&gt;/g;
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
16 $funcs{uc($key)} = $name;
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
17 }
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
18
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
19 }
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
20 close(ACCELS);
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
21
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
22 open(ACCELS, "<hardcoded_keys") or die "No hardcoded_keys file";
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
23 while (<ACCELS>)
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
24 {
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
25 if (/"([^"]*)" *"([^"]*)"/)
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
26 {
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
27 my $name = $1;
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
28 my $key = $2;
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
29 $name =~ s/.*\///;
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
30 $key =~ s/</&lt;/g;
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
31 $key =~ s/>/&gt;/g;
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
32 $funcs{uc($key)} = $name;
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
33 }
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
34
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
35 }
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
36 close(ACCELS);
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
37
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
38 open(IN, "<keymap_template.svg") or die "No svg file";
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
39 open(OUT, ">keymap.svg") or die "Can't write output file";
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
40
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
41 while (<IN>)
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
42 {
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
43 if (/>key:([^<]*)</)
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
44 {
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
45 my $key = uc($1);
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
46 my $name = $funcs{$key};
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
47 s/>key:([^<]*)</>$name</;
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
48 delete $funcs{$key};
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
49 }
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
50 print OUT;
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
51 }
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
52
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
53 close(IN);
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
54 close(OUT);
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
55
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
56 for my $key (keys %funcs)
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
57 {
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
58 if ($key)
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
59 {
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
60 print STDERR "not found: '$key'\n";
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
61 }
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
62 }
113d8329cbd6 added keyboard map generator
nadvornik
parents:
diff changeset
63