## keycode-to-keysym.pkg
#
# For the big picture see the imp dataflow diagrams in
#
# src/lib/x-kit/xclient/src/window/xclient-ximps.pkg#
# keycode_to_keymap is responsible for translating
# X keycodes to keysyms. (The keysyms later
# get translated to ascii by keysym_to_ascii.) # keysym_to_ascii is from src/lib/x-kit/xclient/src/window/keysym-to-ascii.pkg#
# We are essentially dedicated support for
# guishim_imp_for_x. # guishim_imp_for_x is from src/lib/x-kit/widget/xkit/app/guishim-imp-for-x.pkg#
# The workhorse external entrypoint is
#
# translate_keycode_to_keysym
#
#
# We also export a reverse translation function
#
# translate_keysym_to_keycode
#
# mainly for use by unit-test code.
# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublibstipulate
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
#
package un = unt; # unt is from src/lib/std/unt.pkg package v1u = vector_of_one_byte_unts; # vector_of_one_byte_unts is from src/lib/std/src/vector-of-one-byte-unts.pkg package v2w = value_to_wire; # value_to_wire is from src/lib/x-kit/xclient/src/wire/value-to-wire.pkg package w2v = wire_to_value; # wire_to_value is from src/lib/x-kit/xclient/src/wire/wire-to-value.pkg package g2d = geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkg package xtr = xlogger; # xlogger is from src/lib/x-kit/xclient/src/stuff/xlogger.pkg package ks = keysym; # keysym is from src/lib/x-kit/xclient/src/window/keysym.pkg package kb = keys_and_buttons; # keys_and_buttons is from src/lib/x-kit/xclient/src/wire/keys-and-buttons.pkg# package op = xsequencer_to_outbuf; # xsequencer_to_outbuf is from src/lib/x-kit/xclient/src/wire/xsequencer-to-outbuf.pkg package r2k = xevent_router_to_keymap; # xevent_router_to_keymap is from src/lib/x-kit/xclient/src/window/xevent-router-to-keymap.pkg package xps = xpacket_sink; # xpacket_sink is from src/lib/x-kit/xclient/src/wire/xpacket-sink.pkg package xt = xtypes; # xtypes is from src/lib/x-kit/xclient/src/wire/xtypes.pkg package xet = xevent_types; # xevent_types is from src/lib/x-kit/xclient/src/wire/xevent-types.pkg package x2s = xclient_to_sequencer; # xclient_to_sequencer is from src/lib/x-kit/xclient/src/wire/xclient-to-sequencer.pkg package dy = display; # display is from src/lib/x-kit/xclient/src/wire/display.pkg #
trace = xtr::log_if xtr::io_logging 0; # Conditionally write strings to tracing.log or whatever.
herein
package keycode_to_keysym
: (weak) Keycode_To_Keysym # Keycode_To_Keysym is from src/lib/x-kit/xclient/src/window/keycode-to-keysym.api {
(&) = unt::bitwise_and;
Keycode_To_Keysym_Map # Was "Keycode_Map/KEYCODE_MAP".
=
KEYCODE_TO_KEYSYM_MAP
{
min_keycode: Int,
max_keycode: Int,
vector: Rw_Vector( List(xt::Keysym) )
};
Lock_Meaning = NO_LOCK | LOCK_SHIFT | LOCK_CAPS; # The meaning of the Lock modifier key.
Shift_Mode = UNSHIFTED | SHIFTED | CAPS_LOCKED Bool; # The shifting mode of a key-button state.
Key_Mapping = KEY_MAPPING
{
lookup: xt::Keycode -> List(xt::Keysym),
keycode_to_keysym_map: Keycode_To_Keysym_Map,
#
is_mode_switched: xt::Modifier_Keys_State -> Bool,
shift_mode: xt::Modifier_Keys_State -> Shift_Mode
};
# Return the upper-case and lower-case
# keysyms for the given keysym:
#
fun convert_case (xt::KEYSYM symbol)
=>
case (unt::from_int symbol & 0uxFF00)
#
0u0 => # Latin1
if ((0x41 <= symbol) and (symbol <= 0x5A)) # A..Z
#
(xt::KEYSYM (symbol + (0x61 - 0x41)), xt::KEYSYM symbol);
elif ((0x61 <= symbol) and (symbol <= 0x7a)) # a..z
(xt::KEYSYM symbol, xt::KEYSYM (symbol - (0x61 - 0x41)));
elif ((0xC0 <= symbol) and (symbol <= 0xD6)) # Agrave..Odiaeresis
(xt::KEYSYM (symbol + (0xE0 - 0xC0)), xt::KEYSYM symbol);
elif ((0xE0 <= symbol) and (symbol <= 0xF6)) # Agrave..odiaeresis
(xt::KEYSYM symbol, xt::KEYSYM (symbol - (0xE0 - 0xC0)));
elif ((0xD8 <= symbol) and (symbol <= 0xDE)) # Ooblique..Thorn
(xt::KEYSYM (symbol + (0xD8 - 0xF8)), xt::KEYSYM symbol);
elif ((0xF8 <= symbol) and (symbol <= 0xFE)) # oslash..thorn
(xt::KEYSYM symbol, xt::KEYSYM (symbol - (0xD8 - 0xF8)));
else
(xt::KEYSYM symbol, xt::KEYSYM symbol);
fi;
_ => (xt::KEYSYM symbol, xt::KEYSYM symbol);
esac;
convert_case xt::NO_SYMBOL => { msg = "Bug: Unsupported case in convert_case -- keymap-ximp.pkg"; # This will be caught below in translate_keycode_to_keysym
raise exception DIE msg;
};
end;
fun query (encode, decode) (sp: x2s::Xclient_To_Sequencer)
=
{ send_xrequest_and_read_reply
=
sp.send_xrequest_and_read_reply; # XXX BUGGO FIXME should probably be using send_xrequest_and_pass_reply here.
# ============================
\\ request
=
decode (block_until_mailop_fires (send_xrequest_and_read_reply (encode request)));
# ========================
# XXX SUCKO FIXME
};
get_keyboard_mapping
=
query
( v2w::encode_get_keyboard_mapping,
w2v::decode_get_keyboard_mapping_reply
);
get_modifier_mapping
=
query
( {. v2w::request_get_modifier_mapping; },
w2v::decode_get_modifier_mapping_reply
);
fun new_keycode_to_keysym_map (xsequencer: x2s::Xclient_To_Sequencer, info: dy::Xdisplay)
=
{ info.min_keycode -> least_keycode as (xt::KEYCODE min_keycode);
info.max_keycode -> (xt::KEYCODE max_keycode);
keyboard_mapping
=
get_keyboard_mapping
xsequencer
{ first => least_keycode,
count => (max_keycode - min_keycode) + 1
};
KEYCODE_TO_KEYSYM_MAP { min_keycode, max_keycode, vector => rw_vector::from_list keyboard_mapping };
};
lower_case = #1 o convert_case;
upper_case = #2 o convert_case;
# Return the shift-mode defined by a list of modifiers
# with respect to the given lock meaning:
#
fun shift_mode lock_meaning modifiers
=
case ( kb::shift_key_is_set modifiers,
kb::shiftlock_key_is_set modifiers,
lock_meaning
)
#
(FALSE, FALSE, _) => UNSHIFTED;
(FALSE, TRUE, NO_LOCK) => UNSHIFTED;
(FALSE, TRUE, LOCK_SHIFT) => SHIFTED;
(TRUE, TRUE, NO_LOCK) => SHIFTED;
(TRUE, FALSE, _) => SHIFTED;
(shift, _, _) => CAPS_LOCKED shift;
esac;
# Translate a keycode plus modifier-state to a keysym:
#
fun translate_keycode_to_keysym (KEY_MAPPING { lookup, is_mode_switched, shift_mode, ... } ) (keycode, modifiers)
=
{ # If there are more than
# two keysyms for the keycode
# and the shift mode is switched,
# then discard the first two keysyms:
#
syms = case (lookup keycode, is_mode_switched modifiers)
#
(_ ! _ ! (r as _ ! _), TRUE) => r;
(l, _) => l;
esac;
symbol = case (syms, shift_mode modifiers)
#
([], _) => xt::NO_SYMBOL;
([ks], UNSHIFTED) => lower_case ks;
(ks ! _, UNSHIFTED) => ks;
([ks], SHIFTED) => upper_case ks;
(_ ! ks ! _, SHIFTED) => ks;
([ks], CAPS_LOCKED _) => upper_case ks;
(lks ! uks ! _, CAPS_LOCKED shift)
=>
{ (convert_case uks) -> (lsym, usym);
#
if (shift or (uks == usym and lsym != usym))
#
usym;
else
upper_case lks;
fi;
};
esac
except _ = ks::void_symbol; # Because CapsLock release makes convert_case raise an exception.
if (symbol == ks::void_symbol) xt::NO_SYMBOL;
else symbol;
fi;
}; # fun translate_keycode_to_keysym
# Translate a keysym to a keycode. This is intended
# only for occasional selfcheck use, so we just do
# a brute-force search down every list in every slot
# of the KEYCODE_TO_KEYSYM_MAP.
#
# Currently we ignore modifier key issues, so this
# logic won't work very well for SHIFT-ed chars or
# control chars. XXX BUGGO FIXME
#
fun translate_keysym_to_keycode
( KEY_MAPPING { keycode_to_keysym_map => KEYCODE_TO_KEYSYM_MAP { min_keycode, max_keycode, vector },
is_mode_switched,
shift_mode,
...
}
)
keysym
=
{
vector_len = max_keycode - min_keycode + 1;
search_slots (vector_len - 1)
where
include package rw_vector;
fun search_slots -1
=>
NULL;
search_slots i
=>
{
fun search_list []
=>
NULL;
search_list (keysym' ! rest)
=>
if (keysym == keysym') THE (xt::KEYCODE (i + min_keycode));
else search_list rest;
fi;
end;
case (search_list vector[i])
#
THE result => THE result;
NULL => search_slots (i - 1);
esac;
};
end;
end;
}; # fun translate_keysym_to_keycode
# NOTE: some X servers generate
# bogus keycodes on occasion:
#
fun look_up_keycode
(KEYCODE_TO_KEYSYM_MAP { min_keycode, max_keycode, vector })
(xt::KEYCODE keycode)
=
rw_vector::get (vector, keycode - min_keycode)
except
INDEX_OUT_OF_BOUNDS = [];
# Get the display's modifier mapping, and analyze it to set
# the lock semantics and which modes translate into switched mode.
#
fun create_key_mapping (xsequencer: x2s::Xclient_To_Sequencer, xdisplay: dy::Xdisplay)
=
{
mod_map = get_modifier_mapping xsequencer ();
keycode_to_keysym_map = new_keycode_to_keysym_map (xsequencer, xdisplay);
lookup = look_up_keycode keycode_to_keysym_map;
# Get the lock meaning, which will be:
# LockCaps if any lock key contains the CAPS_LOCK keysym (KEYSYM 0xFFE5),
# LockShift if any lock key contains the SHIFT_LOCK keysym (KEYSYM 0xFFE6),
# NoLock otherwise.
#
lock_meaning
=
find (mod_map.lock_keycodes, [], NO_LOCK)
where
fun find ([], [], meaning) => meaning;
find (keycode ! r, [], meaning) => find (r, lookup keycode, meaning);
find (keycodel, (xt::KEYSYM 0xFFE5) ! _, _) => LOCK_CAPS;
find (keycodel, (xt::KEYSYM 0xFFE6) ! r, _) => find (keycodel, r, LOCK_SHIFT);
find (keycodel, _ ! r, meaning) => find (keycodel, r, meaning);
end;
end;
# Compute a bit-vector with a 1 in bit-i if one of ModKey[i+1] keycodes
# has the Mode_switch keysym (KEYSYM 0xFF7E) in its keysym list.
#
switch_mode
=
{
fun is_mode_switch [] => FALSE;
is_mode_switch ((xt::KEYSYM 0xFF7E) ! _) => TRUE;
is_mode_switch (_ ! r) => is_mode_switch r;
end;
check_keycode = list::exists (\\ keycode = is_mode_switch (lookup keycode));
keys = check_keycode mod_map.mod1_keycodes ?? [xt::MOD1KEY] :: [ ];
keys = check_keycode mod_map.mod2_keycodes ?? (xt::MOD2KEY ! keys) :: keys;
keys = check_keycode mod_map.mod3_keycodes ?? (xt::MOD3KEY ! keys) :: keys;
keys = check_keycode mod_map.mod4_keycodes ?? (xt::MOD4KEY ! keys) :: keys;
keys = check_keycode mod_map.mod5_keycodes ?? (xt::MOD5KEY ! keys) :: keys;
kb::make_modifier_keys_state keys;
};
fun switch_fn state
=
not (kb::modifier_keys_state_is_empty (kb::intersection_of_modifier_keys_states (state, switch_mode)));
KEY_MAPPING
{ lookup,
keycode_to_keysym_map,
shift_mode => shift_mode lock_meaning,
is_mode_switched => switch_fn
};
}; # fun create_map
}; # package keycode_to_keysym
end;