## keymap-imp-old.pkg
## Copyright 1987 by Digital Equipment Corporation, Maynard, Massachusetts,
## and the Massachusetts Institute of Technology, Cambridge, Massachusetts.
# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublib# This mystery code was derived from the MIT Xlib implementation.
# The following description of the keycode to keysym translation
# is lifted from the X11 protocol definition:
#
# A KEYCODE represents a physical (or logical) key. Keycodes lie in the
# inclusive range [8, 255]. A keycode value carries no intrinsic information,
# although server implementors may attempt to encode geometry information
# (for example, matrix) to be interpreted in a server-dependent fashion. The
# mapping between keys and keycodes cannot be changed using the protocol.
#
# A KEYSYM is an encoding of a symbol on the cap of a key. The set of defined
# KEYSYMs include the character sets Latin 1, Latin 2, Latin 3, Latin 4, Kana,
# Arabic, Cryllic, Greek, Tech, Special, Publish, APL, and Hebrew as well as a
# set of symbols common on keyboards (Return, Help, Tab, and so on). KEYSYMs
# with the most-significant bit (of the 29 bits) set are reserved as
# vendor-specific.
#
# A list of KEYSYMs is associated with each KEYCODE. The list is intended to
# convey the set of symbols on the corresponding key. If the list (ignoring
# trailing NoSymbol entries) is a single KEYSYM ``[K], '' then the list is
# treated as if it were the list ``[K, NoSymbol, K, NoSymbol].'' If the list
# (ignoring trailing NoSymbol entries) is a pair of KEYSYMs ``[K1, K2]'',
# then the list is treated as if it were the list ``[K1, K2, K1, K2]''. If
# the list (ignoring trailing NoSymbol entries) is a triple of KEYSYMs
# ``[K1, K2, K3]'', then the list is treated as if it were the list
# ``[K1, K2, K3, NoSymbol]''. When an explicit ``void'' element is desired
# in the list, the value VoidSymbol can be used.
#
# The first four elements of the list are split into two groups of KEYSYMs.
# Group 1 contains the first and second KEYSYMs, Group 2 contains third and
# fourth KEYSYMs. Within each group, if the second element of the group is
# NoSymbol, then the group should be treated as if the second element were the
# same as the first element, except when the first element is an alphabetic
# KEYSYM ``K'' for which both lowercase and uppercase forms are defined. In
# that case, the group should be treated as if the first element were the
# lowercase form of ``K'' and the second element were the uppercase form
# of ``K''.
#
# The standard rules for obtaining a KEYSYM from a KeyPress event make use of
# only the Group 1 and Group 2 KEYSYMs; no interpretation of other KEYSYMs in
# the list is given here. Which group to use is determined by modifier state.
# Switching between groups is controlled by the KEYSYM named MODE SWITCH, by
# attaching that KEYSYM to some KEYCODE and attaching that KEYCODE to any one
# of the modifiers Mod1 through Mod5. This modifier is called the ``group
# modifier''. For any KEYCODE, Group 1 is used when the group modifier is
# off, and Group 2 is used when the group modifier is on.
#
# Within a group, which KEYSYM to use is also determined by modifier state. The
# first KEYSYM is used when the Shift and Lock modifiers are off. The second
# KEYSYM is used when the Shift modifier is on, or when the Lock modifier is on
# and the second KEYSYM is uppercase alphabetic, or when the Lock modifier is on
# and is interpreted as ShiftLock. Otherwise, when the Lock modifier is on and
# is interpreted as CapsLock, the state of the Shift modifier is applied first
# to select a KEYSYM, but if that KEYSYM is lowercase alphabetic, then the
# corresponding uppercase KEYSYM is used instead.
#
# The KEYMASK modifier named Lock is intended to be mapped to either a CapsLock
# or a ShiftLock key, but which one is left as application-specific and/or
# user-specific. However, it is suggested that the determination be made
# according to the associated KEYSYM (s) of the corresponding KEYCODE.
#
# NOTE: wire_to_value::decode_get_keyboard_mapping_reply removes trailing NoSymbol entries.
### "For in much wisdom is much grief: and he
### that increaseth knowledge increaseth sorrow."
###
### -- Ecclesiastes 1:18
stipulate
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package dy = display_old; # display_old is from src/lib/x-kit/xclient/src/wire/display-old.pkg package xet = xevent_types; # xevent_types is from src/lib/x-kit/xclient/src/wire/xevent-types.pkg package kb = keys_and_buttons; # keys_and_buttons is from src/lib/x-kit/xclient/src/wire/keys-and-buttons.pkg package ks = keysym; # keysym is from src/lib/x-kit/xclient/src/window/keysym.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 xok = xsocket_old; # xsocket_old is from src/lib/x-kit/xclient/src/wire/xsocket-old.pkg package xt = xtypes; # xtypes is from src/lib/x-kit/xclient/src/wire/xtypes.pkgherein
package keymap_imp_old
: (weak) Keymap_Imp_Old # Keymap_Imp_Old is from src/lib/x-kit/xclient/src/window/keymap-imp-old.api {
my (&) = unt::bitwise_and;
# my (|) = unt::bitwise_or;
# infix my & | ;
fun query (encode, decode) xsocket
=
{ send_xrequest_and_read_reply
=
xok::send_xrequest_and_read_reply xsocket;
\\ request
=
decode (block_until_mailop_fires (send_xrequest_and_read_reply (encode request)));
};
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
);
# Keycode to keysym map
#
Keycode_Map
=
KEYCODE_MAP (Int, Int, Rw_Vector( List( xt::Keysym ) ));
fun new_keycode_map (info: dy::Xdisplay)
=
{ info.min_keycode -> least_keycode as (xt::KEYCODE min_keycode);
info.max_keycode -> (xt::KEYCODE max_keycode);
kbd_map
=
get_keyboard_mapping
info.xsocket
{ first => least_keycode,
count => (max_keycode - min_keycode) + 1
};
KEYCODE_MAP (min_keycode, max_keycode, rw_vector::from_list kbd_map);
};
# NOTE: some X servers generate
# bogus keycodes on occasion:
#
fun look_up_keycode
(KEYCODE_MAP (min_keycode, max_keycode, a))
(xt::KEYCODE keycode)
=
rw_vector::get (a, keycode - min_keycode)
except
INDEX_OUT_OF_BOUNDS = [];
Lock_Meaning # The meaning of the Lock modifier key.
=
NO_LOCK | LOCK_SHIFT | LOCK_CAPS;
Shift_Mode # The shifting mode of a key-button state.
=
UNSHIFTED | SHIFTED | CAPS_LOCKED Bool;
Mapping = MAPPING
{
lookup: xt::Keycode -> List(xt::Keysym),
keycode_map: Keycode_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 => raise exception DIE "Bug: Unsupported case in convert_case";
end;
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 keycode_to_keysym (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)
=>
{ my (lsym, usym)
=
convert_case uks;
if (shift or (uks == usym and lsym != usym))
#
usym;
else
upper_case lks;
fi;
};
esac;
if (symbol == ks::void_symbol) xt::NO_SYMBOL;
else symbol;
fi;
}; # fun 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_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 keysym_to_keycode
( MAPPING { keycode_map as KEYCODE_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 keysym_to_keycode
# Get the display's modifier mapping, and analyze it to set
# the lock semantics and which modes translate into switched mode.
#
fun create_map (display as { xsocket, ... }: dy::Xdisplay)
=
{
mod_map = get_modifier_mapping xsocket ();
keycode_map = new_keycode_map display;
lookup = look_up_keycode keycode_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)));
MAPPING
{ lookup,
keycode_map,
shift_mode => shift_mode lock_meaning,
is_mode_switched => switch_fn
};
}; # fun create_map
Plea_Mail
#
= REFRESH
| LOOK_UP ((xt::Keycode, xt::Modifier_Keys_State), Mailslot(xt::Keysym))
| KEYSYM_TO_KEYCODE (xt::Keysym, Mailslot( Null_Or(xt::Keycode) ))
;
Keymap_Imp
=
KEYMAP_IMP
{ plea_slot: Mailslot( Plea_Mail )
};
# Create the keymap imp
# for the display xsocket:
#
fun make_keymap_imp (display as { xsocket, ... }: dy::Xdisplay)
=
KEYMAP_IMP { plea_slot }
where
plea_slot = make_mailslot ();
fun imp ()
=
loop (create_map display)
where
fun loop mapping
=
loop (
case (take_from_mailslot plea_slot)
#
REFRESH
=>
create_map display;
LOOK_UP (arg, reply_slot)
=>
{ put_in_mailslot (reply_slot, keycode_to_keysym mapping arg);
mapping;
};
KEYSYM_TO_KEYCODE (keysym, reply_slot)
=>
{ put_in_mailslot (reply_slot, keysym_to_keycode mapping keysym);
mapping;
};
esac
);
end;
xlogger::make_thread "keymap_imp" imp;
end; # fun make_keymap_imp
fun refresh_keymap (KEYMAP_IMP { plea_slot, ... } )
=
put_in_mailslot (plea_slot, REFRESH);
fun keycode_to_keysym
(KEYMAP_IMP { plea_slot } )
( { keycode, modifier_keys_state, ... } : xet::Key_Xevtinfo)
=
{ reply_slot = make_mailslot ();
#
put_in_mailslot (plea_slot, LOOK_UP ((keycode, modifier_keys_state), reply_slot));
( take_from_mailslot reply_slot,
modifier_keys_state
);
};
fun keysym_to_keycode (KEYMAP_IMP { plea_slot }, keysym)
=
{ reply_slot = make_mailslot ();
#
put_in_mailslot (plea_slot, KEYSYM_TO_KEYCODE (keysym, reply_slot));
take_from_mailslot reply_slot;
};
}; # package keymap_imp
end;