(view this code in a separate window)

#!/usr/bin/perl
#
# kbd_remap: QWERTY to DVORAK keyboard remapper.
#
# Author: Bri Hatch (bri@hackinglinuxexposed.com)
# Version: 1.0
#
# Copyright 2001, Bri Hatch.  Released under the GPL.
#
# Installation:
#	Save this file as 'kbd_remap' in your favorite bin directory.
#	Create symlinks to it as follows for convienience:
#
#		ln -s kbd_remap tod
#		ln -s kbd_remap toq
#
# Usage:
#		kbd_remap -d	# Change to dvorak layout
#		tod 		# ditto.  (tod == To Dvorak)
#
#		kbd_remap -q	# Change to querty layout
#		toq		# ditto.  (toq == To Querty)
#
# How it works:
#	This program dynamically remaps the keyboard
#	using xmodmap, and a list of which key goes where.
#	This means that it doesn't need to have a list of
#	keycodes for all the various keyboards in the world.
#	
# WARNING:
#	This program has no idea what the current state of the
#	keyboard is in.  This means if you run 'tod; tod' it will
# 	remap the keyboard into a state that is neither dvorak
#	nor querty.  This would be bad.  You have the following
#	options:
#
#		* stop and restart X.
#		* trial and error until you find the 'new' locations
#			of the keys you need.
#	
#	Since these are sucky options, I made sure that the program
#	always prints 'Use tod or toq to toggle' at completion.
#	This means you have something that you can copy/paste
#	to undo your fixes.
#
# Disclaimer:
#	You're remapping your keyboard in software, not hardware.
#	The keys themselves will not move.  If you don't already
#	know Dvorak, you're going to be very annoyed.  Suggest
#	you get some paste some sticky notes on the keys with the
#	new letters, or move the keys themselves.  Some places sell
#	little stickers you can put on your keys while you learn.
#	I'm not liable for you being unable to do anything if you're
#	thoughtless enough to run this and, suprisingly, have your
#	keyboard remapped.

# Initialize our lookup table
initLookups();

# Map appropriately depending on the command name or arguments
*map = *toq if $ARGV[0] eq '-q' || $0 =~ /toq$/;
*map = *tod if $ARGV[0] eq '-d' || $0 =~ /tod$/;
unless ($map{A} and @ARGV < 2 ) {
	print STDERR "Usage: kbd_remap [-q | -d]\n";
	print STDERR "   or: tod\n";
	print STDERR "   or: toq\n";
	exit 1;
}


# Snag current mapping
@list = `xmodmap -pke`;

for ( @list ) {
        my($key, $keycode);
        if ( /(\d+)\s+=\s+(\w+)/ ) {
                $key = $2;
                $keycode = $1;
                $key =~ tr/a-z/A-Z/;
                $keycode{$key} = $keycode;    # set keycode{A} to keycode '10'
        }
}

for ( @list ) {

        # grab the keycode / key
        /(\d+)\s+=\s+(\w+)/;
        $key=$2; $keycode = $1;
        $key =~ tr/a-z/A-Z/;

        # substitute the new keycode, if changed
        s/\d+\s+=/$keycode{$map{$key}} =/ if exists $map{$key};
}

# Re-write the keymapping
open XMODMAP, "|xmodmap -";
print XMODMAP @list;
close XMODMAP;
print "Map modified.  Use tod or toq to toggle.\n";
exit;


sub initLookups {
	
	# Our big lookup table
        @mapping = qw(
                EQUAL BRACKETRIGHT	APOSTROPHE Q
		COMMA W			W COMMA
                PERIOD E		V PERIOD
		Z SLASH			SEMICOLON Z		
                S SEMICOLON		BRACKETLEFT MINUS
                MINUS APOSTROPHE	SLASH BRACKETLEFT
                BRACKETRIGHT EQUAL
                A A	O S	J C	Q X	E D
                K V	U F	Y T	P R	B N
                X B	D H	I G	F Y	M M
                H J	G U	T K	C I	R O
                N L	L P
        );

	# Make both to and from dvorak maps
        while ( @mapping ) {
                $d = shift @mapping;
                $q = shift @mapping;
                $tod{$d} = $q;
                $toq{$q} = $d;
        }
}