Mercurial > geeqie
diff keymap/keymap.pl @ 962:113d8329cbd6
added keyboard map generator
author | nadvornik |
---|---|
date | Wed, 13 Aug 2008 21:07:06 +0000 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/keymap/keymap.pl Wed Aug 13 21:07:06 2008 +0000 @@ -0,0 +1,63 @@ +#!/usr/bin/perl +use strict; + +my %funcs; + +open(ACCELS, "<$ENV{HOME}/.geeqie/accels") or die "No accel file"; +while (<ACCELS>) + { + if (/gtk_accel_path "([^"]*)" *"([^"]*)"/) + { + my $name = $1; + my $key = $2; + $name =~ s/.*\///; + $key =~ s/</</g; + $key =~ s/>/>/g; + $funcs{uc($key)} = $name; + } + + } +close(ACCELS); + +open(ACCELS, "<hardcoded_keys") or die "No hardcoded_keys file"; +while (<ACCELS>) + { + if (/"([^"]*)" *"([^"]*)"/) + { + my $name = $1; + my $key = $2; + $name =~ s/.*\///; + $key =~ s/</</g; + $key =~ s/>/>/g; + $funcs{uc($key)} = $name; + } + + } +close(ACCELS); + +open(IN, "<keymap_template.svg") or die "No svg file"; +open(OUT, ">keymap.svg") or die "Can't write output file"; + +while (<IN>) + { + if (/>key:([^<]*)</) + { + my $key = uc($1); + my $name = $funcs{$key}; + s/>key:([^<]*)</>$name</; + delete $funcs{$key}; + } + print OUT; + } + +close(IN); +close(OUT); + +for my $key (keys %funcs) + { + if ($key) + { + print STDERR "not found: '$key'\n"; + } + } +