view keymap/keymap.pl @ 2901:ce889887354f

Avoid non-portable == for the test command The test command doesn't accept `==` as operator. It should be a single `=` for portable use. The `==` is a gnu extension. Note that the x-trick hasn't been needed for a long, long time. You can reliably write it with quotes: ``` if test "$gtk3" = yes; then ``` but I left that alone since it doesn't hurt other than being ugly.
author Rhialto The M <Rhialto@users.noreply.github.com>
date Sat, 06 Oct 2018 18:26:43 +0200
parents 947ed00faccd
children
line wrap: on
line source

#!/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/</&lt;/g;
		$key =~ s/>/&gt;/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/</&lt;/g;
		$key =~ s/>/&gt;/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";
		}
	}