818 lines
37 KiB
EmacsLisp
818 lines
37 KiB
EmacsLisp
;;; xcb-keysyms.el --- Conversion between -*- lexical-binding: t -*-
|
||
;;; X keysyms, X keycodes and Emacs key event.
|
||
|
||
;; Copyright (C) 2015-2019 Free Software Foundation, Inc.
|
||
|
||
;; Author: Chris Feng <chris.w.feng@gmail.com>
|
||
|
||
;; This file is part of GNU Emacs.
|
||
|
||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;; This library mainly deals with the conversion between X keycodes, X keysyms
|
||
;; and Emacs key events, roughly corresponding to the xcb/util-keysyms project.
|
||
|
||
;; Usage tips:
|
||
;; + Do not forget to call `xcb:keysyms:init' for _every_ connection using
|
||
;; this library.
|
||
;; + xcb:keysyms:*-mask correctly relate Emacs modifier keys to X ones,
|
||
;; thus shall be used in preference to 'xcb:ModMask:*' or
|
||
;; 'xcb:KeyButMask:Mod*'.
|
||
|
||
;; References:
|
||
;; + X protocol (http://www.x.org/releases/X11R7.7/doc/xproto/x11protocol.txt)
|
||
;; + XKB protocol (https://www.x.org/releases/X11R7.7/doc/kbproto/xkbproto.txt)
|
||
;; + xcb/util-keysyms (git://anongit.freedesktop.org/xcb/util-keysyms)
|
||
|
||
;;; Code:
|
||
|
||
(eval-when-compile (require 'cl-lib))
|
||
|
||
(require 'xcb)
|
||
(require 'xcb-xkb)
|
||
|
||
(defclass xcb:keysyms:-device (xcb:--struct)
|
||
((keytypes :initform nil)
|
||
(keycodes :initform nil)
|
||
(min-keycode :initform 0)
|
||
(max-keycode :initform 0)
|
||
(updated :initform nil))
|
||
:documentation "Device (keyboard) properties.")
|
||
|
||
;; These variables are shared by all connections.
|
||
(defvar xcb:keysyms:meta-mask 0 "META key mask.")
|
||
(defvar xcb:keysyms:control-mask xcb:ModMask:Control "CONTROL key mask.")
|
||
(defvar xcb:keysyms:shift-mask xcb:ModMask:Shift "SHIFT key mask.")
|
||
(defvar xcb:keysyms:hyper-mask 0 "HYPER key mask.")
|
||
(defvar xcb:keysyms:super-mask 0 "SUPER key mask.")
|
||
(defvar xcb:keysyms:alt-mask 0 "ALT key mask.")
|
||
(defvar xcb:keysyms:lock-mask xcb:ModMask:Lock "LOCK key mask.")
|
||
(defvar xcb:keysyms:shift-lock-mask 0 "SHIFT-LOCK key mask.")
|
||
(defvar xcb:keysyms:num-lock-mask 0 "NUM-LOCK key mask.")
|
||
|
||
(cl-defmethod xcb:keysyms:-get-current-device ((conn xcb:connection))
|
||
"Return the device currently used."
|
||
(or (xcb:-get-extra-plist conn 'keysyms
|
||
(xcb:-get-extra-plist conn 'keysyms 'device-id))
|
||
(make-instance 'xcb:keysyms:-device)))
|
||
|
||
(cl-defmethod xcb:keysyms:init ((obj xcb:connection) &optional callback)
|
||
"Initialize keysyms module.
|
||
|
||
CALLBACK specifies a function to call every time the keyboard is updated.
|
||
|
||
This method must be called before using any other method in this module."
|
||
(cond
|
||
;; Avoid duplicated initializations.
|
||
((xcb:-get-extra-plist obj 'keysyms 'opcode))
|
||
((= 0 (slot-value (xcb:get-extension-data obj 'xcb:xkb)
|
||
'present))
|
||
(error "[XCB] XKB extension is not supported by the server"))
|
||
((not (slot-value (xcb:+request-unchecked+reply obj
|
||
(make-instance 'xcb:xkb:UseExtension
|
||
:wantedMajor 1
|
||
:wantedMinor 0))
|
||
'supported))
|
||
(error "[XCB] XKB extension version 1.0 is not supported by the server"))
|
||
(t
|
||
;; Save the major opcode of XKB and callback function.
|
||
(xcb:-set-extra-plist obj 'keysyms 'opcode
|
||
(slot-value (xcb:get-extension-data obj 'xcb:xkb)
|
||
'major-opcode))
|
||
(xcb:-set-extra-plist obj 'keysyms 'callback callback)
|
||
;; Set per-client flags.
|
||
(xcb:keysyms:-set-per-client-flags obj xcb:xkb:ID:UseCoreKbd)
|
||
;; Update data.
|
||
(xcb:keysyms:-update-keytypes obj xcb:xkb:ID:UseCoreKbd)
|
||
(xcb:-set-extra-plist obj 'keysyms 'device-id
|
||
(xcb:keysyms:-update-keycodes obj
|
||
xcb:xkb:ID:UseCoreKbd))
|
||
(xcb:keysyms:-update-modkeys obj xcb:xkb:ID:UseCoreKbd)
|
||
;; Attach event listeners.
|
||
(xcb:+event obj 'xcb:xkb:NewKeyboardNotify
|
||
(lambda (data _)
|
||
(xcb:keysyms:-on-NewKeyboardNotify obj data)))
|
||
(xcb:+event obj 'xcb:xkb:MapNotify
|
||
(lambda (data _)
|
||
(xcb:keysyms:-on-MapNotify obj data)))
|
||
;; Select XKB MapNotify and NewKeyboardNotify events.
|
||
(let ((map (logior xcb:xkb:MapPart:KeyTypes
|
||
xcb:xkb:MapPart:KeySyms
|
||
xcb:xkb:MapPart:ModifierMap))
|
||
(new-keyboard (logior xcb:xkb:NKNDetail:DeviceID
|
||
xcb:xkb:NKNDetail:Keycodes)))
|
||
(xcb:+request obj
|
||
(make-instance 'xcb:xkb:SelectEvents
|
||
:deviceSpec xcb:xkb:ID:UseCoreKbd
|
||
:affectWhich (logior
|
||
xcb:xkb:EventType:NewKeyboardNotify
|
||
xcb:xkb:EventType:MapNotify)
|
||
:clear 0
|
||
:selectAll 0
|
||
:affectMap map
|
||
:map map
|
||
:affectNewKeyboard new-keyboard
|
||
:newKeyboardDetails new-keyboard)))
|
||
(xcb:flush obj))))
|
||
|
||
(cl-defmethod xcb:keysyms:-set-per-client-flags ((obj xcb:connection)
|
||
device-id)
|
||
"Set per-client flags."
|
||
(let ((per-client-flags (logior
|
||
;; Instead of compatibility state.
|
||
xcb:xkb:PerClientFlag:GrabsUseXKBState
|
||
;; Instead of grab state.
|
||
xcb:xkb:PerClientFlag:LookupStateWhenGrabbed
|
||
;; Use XKB state in 'SendEvent'.
|
||
xcb:xkb:PerClientFlag:SendEventUsesXKBState)))
|
||
;; The reply is not used.
|
||
(xcb:+request-unchecked+reply obj
|
||
(make-instance 'xcb:xkb:PerClientFlags
|
||
:deviceSpec device-id
|
||
:change per-client-flags
|
||
:value per-client-flags
|
||
:ctrlsToChange 0
|
||
:autoCtrls 0
|
||
:autoCtrlsValues 0))))
|
||
|
||
(cl-defmethod xcb:keysyms:-on-NewKeyboardNotify ((obj xcb:connection) data)
|
||
"Handle 'NewKeyboardNotify' event."
|
||
(let ((device-id (xcb:-get-extra-plist obj 'keysyms 'device-id))
|
||
(callback (xcb:-get-extra-plist obj 'keysyms 'callback))
|
||
(obj1 (make-instance 'xcb:xkb:NewKeyboardNotify))
|
||
device updated)
|
||
(xcb:unmarshal obj1 data)
|
||
(with-slots (deviceID oldDeviceID requestMajor requestMinor changed) obj1
|
||
(if (= 0 (logand changed xcb:xkb:NKNDetail:DeviceID))
|
||
(when (/= 0 (logand changed xcb:xkb:NKNDetail:Keycodes))
|
||
(setq device (xcb:-get-extra-plist obj 'keysyms deviceID))
|
||
(when (and device
|
||
(not (slot-value device 'updated)))
|
||
(xcb:keysyms:-update-keycodes obj deviceID)
|
||
(when (= deviceID device-id)
|
||
(setq updated t)
|
||
(xcb:keysyms:-update-modkeys obj deviceID))
|
||
(setf (slot-value device 'updated) t)))
|
||
(xcb:keysyms:-set-per-client-flags obj deviceID)
|
||
(xcb:keysyms:-update-keytypes obj deviceID)
|
||
(xcb:keysyms:-update-keycodes obj deviceID)
|
||
(when (or (= oldDeviceID device-id)
|
||
;; 0 is a special value for servers not supporting
|
||
;; the X Input Extension.
|
||
(= oldDeviceID 0))
|
||
;; Device changed; update the per-client flags and local data.
|
||
(setq updated t)
|
||
(xcb:keysyms:-update-modkeys obj deviceID)
|
||
(xcb:-set-extra-plist obj 'keysyms 'device-id deviceID))))
|
||
(when (and callback updated)
|
||
(with-demoted-errors "[XELB ERROR] %S"
|
||
(funcall callback)))))
|
||
|
||
(cl-defmethod xcb:keysyms:-on-MapNotify ((obj xcb:connection) data)
|
||
"Handle 'MapNotify' event."
|
||
(let ((device-id (xcb:-get-extra-plist obj 'keysyms 'device-id))
|
||
(callback (xcb:-get-extra-plist obj 'keysyms 'callback))
|
||
(obj1 (make-instance 'xcb:xkb:MapNotify))
|
||
updated)
|
||
(xcb:unmarshal obj1 data)
|
||
(with-slots (deviceID changed firstType nTypes firstKeySym nKeySyms) obj1
|
||
;; Ensure this event is for the current device.
|
||
(when (/= 0 (logand changed xcb:xkb:MapPart:KeyTypes))
|
||
(setq updated t)
|
||
(xcb:keysyms:-update-keytypes obj deviceID firstType nTypes))
|
||
(when (/= 0 (logand changed xcb:xkb:MapPart:KeySyms))
|
||
(setq updated t)
|
||
(xcb:keysyms:-update-keycodes obj deviceID firstKeySym nKeySyms))
|
||
(when (/= 0 (logand changed xcb:xkb:MapPart:ModifierMap))
|
||
(setq updated t)
|
||
(xcb:keysyms:-update-modkeys obj deviceID))
|
||
(when (and updated
|
||
callback
|
||
(= deviceID device-id))
|
||
(with-demoted-errors "[XELB ERROR] %S"
|
||
(funcall callback))))))
|
||
|
||
(cl-defmethod xcb:keysyms:-update-keytypes ((obj xcb:connection) device-id
|
||
&optional first-keytype count)
|
||
"Update key types.
|
||
|
||
FIRST-KEYTYPE and count specify the range of key types to update."
|
||
(let (device full partial)
|
||
(if (and first-keytype count)
|
||
(setq full 0
|
||
partial xcb:xkb:MapPart:KeyTypes)
|
||
(setq full xcb:xkb:MapPart:KeyTypes
|
||
partial 0
|
||
first-keytype 0
|
||
count 0))
|
||
(with-slots (deviceID present firstType nTypes totalTypes types-rtrn)
|
||
(xcb:+request-unchecked+reply obj
|
||
(make-instance 'xcb:xkb:GetMap
|
||
:deviceSpec device-id
|
||
:full full
|
||
:partial partial
|
||
:firstType first-keytype
|
||
:nTypes count
|
||
:firstKeySym 0
|
||
:nKeySyms 0
|
||
:firstKeyAction 0
|
||
:nKeyActions 0
|
||
:firstKeyBehavior 0
|
||
:nKeyBehaviors 0
|
||
:virtualMods 0
|
||
:firstKeyExplicit 0
|
||
:nKeyExplicit 0
|
||
:firstModMapKey 0
|
||
:nModMapKeys 0
|
||
:firstVModMapKey 0
|
||
:nVModMapKeys 0))
|
||
(cl-assert (/= 0 (logand present xcb:xkb:MapPart:KeyTypes)))
|
||
(setq device (or (xcb:-get-extra-plist obj 'keysyms deviceID)
|
||
(make-instance 'xcb:keysyms:-device)))
|
||
(with-slots (keytypes) device
|
||
(when (or (/= 0 full)
|
||
(not keytypes))
|
||
(setf keytypes (make-vector totalTypes nil)))
|
||
(setf keytypes (vconcat (substring keytypes 0 firstType)
|
||
types-rtrn
|
||
(substring keytypes (min (+ firstType nTypes)
|
||
totalTypes)))))
|
||
(xcb:-set-extra-plist obj 'keysyms deviceID device)
|
||
deviceID)))
|
||
|
||
(cl-defmethod xcb:keysyms:-update-keycodes ((obj xcb:connection) device-id
|
||
&optional first-keycode count)
|
||
"Update keycode-keysym mapping.
|
||
|
||
FIRST-KEYCODE and COUNT specify the keycode range to update."
|
||
(let (device full partial)
|
||
(if (and first-keycode count)
|
||
(setq full 0
|
||
partial xcb:xkb:MapPart:KeySyms)
|
||
(setq full xcb:xkb:MapPart:KeySyms
|
||
partial 0
|
||
first-keycode 0
|
||
count 0))
|
||
(with-slots (deviceID minKeyCode maxKeyCode present
|
||
firstKeySym nKeySyms syms-rtrn)
|
||
(xcb:+request-unchecked+reply obj
|
||
(make-instance 'xcb:xkb:GetMap
|
||
:deviceSpec device-id
|
||
:full full
|
||
:partial partial
|
||
:firstType 0
|
||
:nTypes 0
|
||
:firstKeySym first-keycode
|
||
:nKeySyms count
|
||
:firstKeyAction 0
|
||
:nKeyActions 0
|
||
:firstKeyBehavior 0
|
||
:nKeyBehaviors 0
|
||
:virtualMods 0
|
||
:firstKeyExplicit 0
|
||
:nKeyExplicit 0
|
||
:firstModMapKey 0
|
||
:nModMapKeys 0
|
||
:firstVModMapKey 0
|
||
:nVModMapKeys 0))
|
||
(cl-assert (/= 0 (logand present xcb:xkb:MapPart:KeySyms)))
|
||
(setq device (or (xcb:-get-extra-plist obj 'keysyms deviceID)
|
||
(make-instance 'xcb:keysyms:-device)))
|
||
(with-slots (keycodes min-keycode max-keycode) device
|
||
(when (or (/= 0 full)
|
||
;; Unlikely?
|
||
(/= min-keycode minKeyCode)
|
||
(/= max-keycode maxKeyCode))
|
||
(setf keycodes (make-vector (- maxKeyCode minKeyCode -1) nil)
|
||
min-keycode minKeyCode
|
||
max-keycode maxKeyCode))
|
||
(setf keycodes
|
||
(vconcat
|
||
(substring keycodes 0 (- firstKeySym min-keycode))
|
||
syms-rtrn
|
||
(substring keycodes
|
||
(- (min (+ firstKeySym nKeySyms) max-keycode)
|
||
min-keycode)))))
|
||
(xcb:-set-extra-plist obj 'keysyms deviceID device)
|
||
deviceID)))
|
||
|
||
(cl-defmethod xcb:keysyms:-update-modkeys ((obj xcb:connection) _device-id)
|
||
"Update modifier keys."
|
||
;; Reference: 'x_find_modifier_meanings' in 'xterm.c'.
|
||
(with-slots (keycodes-per-modifier keycodes)
|
||
(xcb:+request-unchecked+reply obj
|
||
(make-instance 'xcb:GetModifierMapping))
|
||
(setq xcb:keysyms:meta-mask 0
|
||
xcb:keysyms:hyper-mask 0
|
||
xcb:keysyms:super-mask 0
|
||
xcb:keysyms:alt-mask 0
|
||
xcb:keysyms:shift-lock-mask 0
|
||
xcb:keysyms:num-lock-mask 0)
|
||
(dolist (row (number-sequence 3 7))
|
||
(let ((mask (lsh 1 row))
|
||
(col 0)
|
||
found-alt-or-meta keycode keysym)
|
||
(while (< col keycodes-per-modifier)
|
||
(setq keycode (elt keycodes (+ (* row keycodes-per-modifier) col)))
|
||
(when (/= keycode 0)
|
||
(setq keysym (car (xcb:keysyms:keycode->keysym obj keycode 0)))
|
||
(when (/= keysym 0)
|
||
(pcase (xcb:keysyms:keysym->event obj keysym nil t)
|
||
((or `lmeta* `rmeta*)
|
||
(setq found-alt-or-meta t
|
||
xcb:keysyms:meta-mask (logior xcb:keysyms:meta-mask
|
||
mask)))
|
||
((or `lalt* `ralt*)
|
||
(setq found-alt-or-meta t
|
||
xcb:keysyms:alt-mask (logior xcb:keysyms:alt-mask
|
||
mask)))
|
||
((or `lhyper* `rhyper*)
|
||
(unless found-alt-or-meta
|
||
(setq xcb:keysyms:hyper-mask (logior xcb:keysyms:hyper-mask
|
||
mask)))
|
||
(setq col keycodes-per-modifier))
|
||
((or `lsuper* `rsuper*)
|
||
(unless found-alt-or-meta
|
||
(setq xcb:keysyms:super-mask (logior xcb:keysyms:super-mask
|
||
mask)))
|
||
(setq col keycodes-per-modifier))
|
||
(`shift-lock*
|
||
(unless found-alt-or-meta
|
||
(setq xcb:keysyms:lock-mask (logior xcb:keysyms:lock-mask
|
||
mask)))
|
||
(setq col keycodes-per-modifier))
|
||
(`kp-numlock
|
||
(setq xcb:keysyms:num-lock-mask
|
||
(logior xcb:keysyms:num-lock-mask mask))))))
|
||
(cl-incf col)))))
|
||
;; Meta fallbacks to Alt.
|
||
(unless (/= 0 xcb:keysyms:meta-mask)
|
||
(setq xcb:keysyms:meta-mask xcb:keysyms:alt-mask
|
||
xcb:keysyms:alt-mask 0))
|
||
;; A key cannot be both Meta and Alt.
|
||
(when (and (/= 0 xcb:keysyms:meta-mask)
|
||
(/= 0 xcb:keysyms:alt-mask)
|
||
(/= 0 (logand xcb:keysyms:meta-mask xcb:keysyms:alt-mask)))
|
||
(setq xcb:keysyms:alt-mask (logand xcb:keysyms:alt-mask
|
||
(lognot xcb:keysyms:meta-mask)))))
|
||
|
||
(cl-defmethod xcb:keysyms:keycode->keysym ((obj xcb:connection) keycode
|
||
modifiers)
|
||
"Convert KEYCODE to keysym or get possible modifier combinations for keycode.
|
||
|
||
If MODIFIERS is non-nil, return (KEYSYM . CONSUMED-MODIFIERS) where
|
||
CONSUMED-MODIFIERS should be lognot'ed with MODIFIERS so as to make further
|
||
conversion correct. (0 . 0) is returned when conversion fails.
|
||
|
||
If MODIFIERS is nil, return all possible modifier combinations for this
|
||
keycode. The caller is responsible for checking which modifiers to use."
|
||
(let ((preserve 0)
|
||
group group-info group-number index keytype)
|
||
(with-slots (keytypes keycodes min-keycode max-keycode)
|
||
(xcb:keysyms:-get-current-device obj)
|
||
;; Reference: `XkbTranslateKeyCode' in 'XKBBind.c'.
|
||
(catch 'return
|
||
;; Check keycode range.
|
||
(unless (<= min-keycode keycode max-keycode)
|
||
(throw 'return '(0 . 0)))
|
||
;; Retrieve KeySymMap and group info.
|
||
(setq keycode (aref keycodes (- keycode min-keycode))
|
||
group-info (slot-value keycode 'groupInfo)
|
||
group-number (logand group-info #xF)) ; See <XKBstr.h>.
|
||
;; Check group number.
|
||
(when (= group-number 0)
|
||
(throw 'return '(0 . 0)))
|
||
(setq group (if (null modifiers)
|
||
0
|
||
(logand (lsh modifiers -13) #b11))) ;The 13, 14 bits.
|
||
;; Wrap group.
|
||
(when (>= group group-number)
|
||
(pcase (logand group-info #xC0) ;See <XKBstr.h>.
|
||
(`xcb:xkb:GroupsWrap:RedirectIntoRange
|
||
(setq group (logand #xFF (lsh group-info -4))) ;See <XKBstr.h>.
|
||
;; Check if it's also out of range.
|
||
(when (>= group group-number)
|
||
(setq group 0)))
|
||
(`xcb:xkb:GroupsWrap:ClampIntoRange
|
||
(setq group (1- group-number)))
|
||
(_
|
||
(setq group (% group group-number)))))
|
||
;; Calculate the index of keysym.
|
||
(setq index (* group (slot-value keycode 'width)))
|
||
;; Get key type.
|
||
(setq keytype (aref keytypes
|
||
(elt (slot-value keycode 'kt-index) group)))
|
||
(with-slots (mods-mask hasPreserve map (preserve* preserve)) keytype
|
||
(if (null modifiers)
|
||
;; Return all possible modifier combinations.
|
||
(delq nil
|
||
(mapcar (lambda (entry)
|
||
(when (= (slot-value entry 'active) 1)
|
||
(slot-value entry 'mods-mask)))
|
||
map))
|
||
;; Find the shift level and preserved modifiers.
|
||
(catch 'break
|
||
(dolist (entry map)
|
||
(with-slots (active (mods-mask* mods-mask) level) entry
|
||
(when (and (= 1 active)
|
||
(= (logand modifiers mods-mask) mods-mask*))
|
||
(cl-incf index level)
|
||
(when (= 1 hasPreserve)
|
||
(setq preserve (slot-value (elt preserve*
|
||
(cl-position entry map))
|
||
'mask)))
|
||
(throw 'break nil)))))
|
||
(cons (elt (slot-value keycode 'syms) index)
|
||
(logand mods-mask (lognot preserve)))))))))
|
||
|
||
(cl-defmethod xcb:keysyms:keysym->keycode ((obj xcb:connection) keysym)
|
||
"Convert keysym to (the first matching) keycode.
|
||
|
||
Return 0 if conversion fails."
|
||
(let ((index 0)
|
||
(continue t))
|
||
(with-slots (keycodes min-keycode max-keycode)
|
||
(xcb:keysyms:-get-current-device obj)
|
||
;; Traverse all keycodes, column by column.
|
||
;; Reference: `XKeysymToKeycode' in 'XKBBind.c'.
|
||
(catch 'break
|
||
(when (= 0 keysym)
|
||
(throw 'break 0))
|
||
(while continue
|
||
(setq continue nil)
|
||
(dotimes (i (- max-keycode min-keycode -1))
|
||
(with-slots (nSyms syms) (aref keycodes i)
|
||
(when (< index nSyms)
|
||
(setq continue t)
|
||
(when (= keysym (elt syms index))
|
||
(throw 'break (+ i min-keycode))))))
|
||
(cl-incf index))
|
||
0))))
|
||
|
||
;; This list is largely base on 'lispy_function_keys' in 'keyboard.c'.
|
||
(defconst xcb:keysyms:-function-keys
|
||
`[ ;#xff00 - #xff0f
|
||
,@(make-list 8 nil) backspace tab linefeed clear nil return nil nil
|
||
;#xff10 - #xff1f
|
||
nil nil nil pause nil nil nil nil nil nil nil escape nil nil nil nil
|
||
;#xff20 - #xff2f
|
||
nil kanji muhenkan henkan romaji hiragana katakana hiragana-katakana
|
||
zenkaku hankaku zenkaku-hankaku touroku massyo kana-lock kana-shift
|
||
eisu-shift
|
||
;#xff30 - #xff3f
|
||
eisu-toggle ,@(make-list 15 nil)
|
||
;#xff40 - #xff4f
|
||
,@(make-list 16 nil)
|
||
;#xff50 - #xff5f
|
||
home left up right down prior next end begin ,@(make-list 7 nil)
|
||
;#xff60 - #xff6f
|
||
select print execute insert nil undo redo menu find cancel help break
|
||
nil nil nil nil
|
||
;#xff70 - #xff7f
|
||
;; nil nil nil nil backtab ,@(make-list 10 nil) kp-numlock
|
||
nil nil nil nil backtab ,@(make-list 9 nil) mode-switch* kp-numlock
|
||
;#xff80 - #xff8f
|
||
kp-space ,@(make-list 8 nil) kp-tab nil nil nil kp-enter nil nil
|
||
;#xff90 - #xff9f
|
||
nil kp-f1 kp-f2 kp-f3 kp-f4 kp-home kp-left kp-up kp-right kp-down
|
||
kp-prior kp-next kp-end kp-begin kp-insert kp-delete
|
||
;#xffa0 - #xffaf
|
||
,@(make-list 10 nil)
|
||
kp-multiply kp-add kp-separator kp-subtract kp-decimal kp-divide
|
||
;#xffb0 - #xffbf
|
||
kp-0 kp-1 kp-2 kp-3 kp-4 kp-5 kp-6 kp-7 kp-8 kp-9 nil nil nil kp-equal
|
||
f1 f2
|
||
;#xffc0 - #xffcf
|
||
f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18
|
||
;#xffd0 - #xffdf
|
||
f19 f20 f21 f22 f23 f24 f25 f26 f27 f28 f29 f30 f31 f32 f33 f34
|
||
;#xffe0 - #xffef
|
||
;; f35 ,@(make-list 15 nil)
|
||
f35 lshift* rshift* lcontrol* rcontrol* caps-lock* shift-lock*
|
||
lmeta* rmeta* lalt* ralt* lsuper* rsuper* lhyper* rhyper* nil
|
||
;#xff00 - #xffff
|
||
,@(make-list 15 nil) delete]
|
||
"Emacs event representations of X function keys (keysym #xff00 to #xffff).")
|
||
|
||
;; From 'iso_lispy_function_keys' in 'keyboard.c'
|
||
(defconst xcb:keysyms:-iso-function-keys
|
||
`[
|
||
;#xfe00 - #xfe0f
|
||
,@(make-list 16 nil)
|
||
;#xfe10 - #xfe1f
|
||
,@(make-list 16 nil)
|
||
;#xfe20 - #xfe2f
|
||
iso-lefttab iso-move-line-up iso-move-line-down iso-partial-line-up
|
||
iso-partial-line-down iso-partial-space-left iso-partial-space-right
|
||
iso-set-margin-left iso-set-margin-right iso-release-margin-left
|
||
iso-release-margin-right iso-release-both-margins iso-fast-cursor-left
|
||
iso-fast-cursor-right iso-fast-cursor-up iso-fast-cursor-down
|
||
;#xfe30 - #xfe3f
|
||
iso-continuous-underline iso-discontinuous-underline iso-emphasize
|
||
iso-center-object iso-enter ,@(make-list 11 nil)
|
||
;everything else
|
||
,@(make-list 192 nil)]
|
||
"Emacs event representations of ISO function keys (#xfe00 to #xfeff).")
|
||
|
||
;; This list is adapted from 'XF86keysym.h' in X source.
|
||
;; FIXME: We've intentionally left out keysyms outside the range 0x1008FF00 ~
|
||
;; 0x1008FFFF.
|
||
;; REVIEW: Could anybody verify this list?
|
||
(defconst xcb:keysyms:-xf86-keys
|
||
`[ ;#x1008ff00 - #x1008ff0f
|
||
nil XF86ModeLock XF86MonBrightnessUp XF86MonBrightnessDown
|
||
XF86KbdLightOnOff XF86KbdBrightnessUp XF86KbdBrightnessDown
|
||
,@(make-list 9 nil)
|
||
;#x1008ff10 - #x1008ff1f
|
||
XF86Standby XF86AudioLowerVolume XF86AudioMute XF86AudioRaiseVolume
|
||
XF86AudioPlay XF86AudioStop XF86AudioPrev XF86AudioNext XF86HomePage
|
||
XF86Mail XF86Start XF86Search XF86AudioRecord XF86Calculator XF86Memo
|
||
XF86ToDoList
|
||
;#x1008ff20 - #x1008ff2f
|
||
XF86Calendar XF86PowerDown XF86ContrastAdjust XF86RockerUp
|
||
XF86RockerDown XF86RockerEnter XF86Back XF86Forward XF86Stop
|
||
XF86Refresh XF86PowerOff XF86WakeUp XF86Eject XF86ScreenSaver XF86WWW
|
||
XF86Sleep
|
||
;#x1008ff30 - #x1008ff3f
|
||
XF86Favorites XF86AudioPause XF86AudioMedia XF86MyComputer
|
||
XF86VendorHome XF86LightBulb XF86Shop XF86History XF86OpenURL
|
||
XF86AddFavorite XF86HotLinks XF86BrightnessAdjust XF86Finance
|
||
XF86Community XF86AudioRewind XF86BackForward
|
||
;#x1008ff40 - #x1008ff4f
|
||
XF86Launch0 XF86Launch1 XF86Launch2 XF86Launch3 XF86Launch4 XF86Launch5
|
||
XF86Launch6 XF86Launch7 XF86Launch8 XF86Launch9 XF86LaunchA XF86LaunchB
|
||
XF86LaunchC XF86LaunchD XF86LaunchE XF86LaunchF
|
||
;#x1008ff50 - #x1008ff5f
|
||
XF86ApplicationLeft XF86ApplicationRight XF86Book XF86CD XF86Calculater
|
||
XF86Clear XF86Close XF86Copy XF86Cut XF86Display XF86DOS XF86Documents
|
||
XF86Excel XF86Explorer XF86Game XF86Go
|
||
;#x1008ff60 - #x1008ff6f
|
||
XF86iTouch XF86LogOff XF86Market XF86Meeting nil XF86MenuKB XF86MenuPB
|
||
XF86MySites XF86New XF86News XF86OfficeHome XF86Open XF86Option
|
||
XF86Paste XF86Phone nil
|
||
;#x1008ff70 - #x1008ff7f
|
||
XF86Q nil XF86Reply XF86Reload XF86RotateWindows XF86RotationPB
|
||
XF86RotationKB XF86Save XF86ScrollUp XF86ScrollDown XF86ScrollClick
|
||
XF86Send XF86Spell XF86SplitScreen XF86Support XF86TaskPane
|
||
;#x1008ff80 - #x1008ff8f
|
||
XF86Terminal XF86Tools XF86Travel nil XF86UserPB XF86User1KB
|
||
XF86User2KB XF86Video XF86WheelButton XF86Word XF86Xfer XF86ZoomIn
|
||
XF86ZoomOut XF86Away XF86Messenger XF86WebCam
|
||
;#x1008ff90 - #x1008ff9f
|
||
XF86MailForward XF86Pictures XF86Music XF86Battery XF86Bluetooth
|
||
XF86WLAN XF86UWB XF86AudioForward XF86AudioRepeat XF86AudioRandomPlay
|
||
XF86Subtitle XF86AudioCycleTrack XF86CycleAngle XF86FrameBack
|
||
XF86FrameForward XF86Time
|
||
;#x1008ffa0 - #x1008ffaf
|
||
XF86Select XF86View XF86TopMenu XF86Red XF86Green XF86Yellow XF86Blue
|
||
XF86Suspend XF86Hibernate XF86TouchpadToggle ,@(make-list 6 nil)
|
||
;#x1008ffb0 - #x1008ffbf
|
||
XF86TouchpadOn XF86TouchpadOff XF86AudioMicMute ,@(make-list 13 nil)
|
||
;everything rest
|
||
,@(make-list 64 nil)]
|
||
"Emacs event representations of XF86keysym (#x1008ff00 - #x1008ffff).")
|
||
|
||
(cl-defmethod xcb:keysyms:event->keysym ((obj xcb:connection) event)
|
||
(declare (obsolete nil "27"))
|
||
(car (xcb:keysyms:event->keysyms obj event)))
|
||
|
||
(cl-defmethod xcb:keysyms:event->keysyms ((obj xcb:connection) event)
|
||
"Translate Emacs key event EVENT to list of (keysym . mod-mask).
|
||
|
||
Return ((0 . 0)) when conversion fails."
|
||
(let ((modifiers (event-modifiers event))
|
||
(event (event-basic-type event))
|
||
keysym)
|
||
(if (not (integerp event))
|
||
(setq keysym
|
||
(pcase event
|
||
(`mouse-1 xcb:ButtonIndex:1)
|
||
(`mouse-2 xcb:ButtonIndex:2)
|
||
(`mouse-3 xcb:ButtonIndex:3)
|
||
(`mouse-4 xcb:ButtonIndex:4)
|
||
(`mouse-5 xcb:ButtonIndex:5)
|
||
(_
|
||
(cond
|
||
((setq keysym (cl-position event
|
||
xcb:keysyms:-function-keys))
|
||
;; Function keys.
|
||
(logior keysym #xff00))
|
||
((setq keysym (cl-position event xcb:keysyms:-xf86-keys))
|
||
;; XF86 keys.
|
||
(logior keysym #x1008ff00))
|
||
((setq keysym (cl-position event
|
||
xcb:keysyms:-iso-function-keys))
|
||
;; ISO function keys.
|
||
(logior keysym #xfe00))
|
||
((and (symbolp event)
|
||
(= 1 (length (symbol-name event))))
|
||
;; Symbol representations of ASCII characters.
|
||
(aref (symbol-name event) 0))
|
||
(t
|
||
;; Finally try system-specific keysyms.
|
||
(car (rassq event system-key-alist)))))))
|
||
(setq keysym
|
||
(cond
|
||
((<= #x20 event #xff)
|
||
;; Latin-1.
|
||
event)
|
||
((<= #x100 event #x10ffff)
|
||
;; Unicode.
|
||
(+ #x1000000 event))
|
||
(t (or
|
||
;; Try system-specific keysyms.
|
||
(car (rassq event system-key-alist))
|
||
;; Try legacy keysyms.
|
||
(catch 'break
|
||
(maphash (lambda (key val)
|
||
(when (= event val)
|
||
(throw 'break key)))
|
||
x-keysym-table)))))))
|
||
(if (not keysym)
|
||
'((0 . 0))
|
||
(when modifiers
|
||
;; Do transforms: * -> x-*-keysym -> xcb:keysyms:*-mask.
|
||
(setq modifiers (mapcar (lambda (i)
|
||
(or (pcase i
|
||
(`alt x-alt-keysym)
|
||
(`meta x-meta-keysym)
|
||
(`hyper x-hyper-keysym)
|
||
(`super x-super-keysym))
|
||
i))
|
||
modifiers)
|
||
modifiers (mapcar (lambda (i)
|
||
(pcase i
|
||
((and x (pred integerp)) x)
|
||
(`meta
|
||
(when (= 0 xcb:keysyms:meta-mask)
|
||
(setq keysym 0))
|
||
xcb:keysyms:meta-mask)
|
||
(`control
|
||
(when (= 0 xcb:keysyms:control-mask)
|
||
(setq keysym 0))
|
||
xcb:keysyms:control-mask)
|
||
(`shift
|
||
(when (= 0 xcb:keysyms:shift-mask)
|
||
(setq keysym 0))
|
||
xcb:keysyms:shift-mask)
|
||
(`hyper
|
||
(when (= 0 xcb:keysyms:hyper-mask)
|
||
(setq keysym 0))
|
||
xcb:keysyms:hyper-mask)
|
||
(`super
|
||
(when (= 0 xcb:keysyms:super-mask)
|
||
(setq keysym 0))
|
||
xcb:keysyms:super-mask)
|
||
(`alt
|
||
(when (= 0 xcb:keysyms:alt-mask)
|
||
(setq keysym 0))
|
||
xcb:keysyms:alt-mask)
|
||
(_
|
||
;; Include but not limit to: down.
|
||
0)))
|
||
modifiers)
|
||
modifiers (apply #'logior modifiers)))
|
||
(let ((keycode (xcb:keysyms:keysym->keycode obj keysym))
|
||
extra-modifiers)
|
||
(when (/= 0 keycode)
|
||
(setq extra-modifiers (xcb:keysyms:keycode->keysym obj keycode nil)
|
||
;; Always try without other modifier.
|
||
extra-modifiers (append '(0) extra-modifiers)
|
||
;; Keep all modifiers helping convert keycode to this keysym.
|
||
extra-modifiers
|
||
(delq nil
|
||
(mapcar (lambda (modifier)
|
||
(when (= (car (xcb:keysyms:keycode->keysym
|
||
obj keycode modifier))
|
||
keysym)
|
||
modifier))
|
||
extra-modifiers))))
|
||
(mapcar (lambda (extra-modifier)
|
||
(cons keysym (logior (or modifiers 0) extra-modifier)))
|
||
extra-modifiers)))))
|
||
|
||
(cl-defmethod xcb:keysyms:keysym->event ((_obj xcb:connection) keysym
|
||
&optional mask allow-modifiers)
|
||
"Translate X Keysym KEYSYM into Emacs key event.
|
||
|
||
One may use MASK to provide modifier keys. If ALLOW-MODIFIERS is non-nil,
|
||
this function will also return symbols for pure modifiers keys."
|
||
;; Convert nil to 0.
|
||
(unless mask
|
||
(setq mask 0))
|
||
(let ((event (cond ((<= #x20 keysym #xff)
|
||
keysym)
|
||
((<= #xff00 keysym #xffff)
|
||
(aref xcb:keysyms:-function-keys (logand keysym #xff)))
|
||
((<= #x1000100 keysym #x110ffff)
|
||
(- keysym #x1000000))
|
||
((<= 1 keysym 5) ;ButtonPress assuemd
|
||
(intern-soft (format "down-mouse-%d" keysym)))
|
||
((<= #x1008ff00 keysym #x1008ffff)
|
||
(aref xcb:keysyms:-xf86-keys (logand keysym #xff)))
|
||
((<= #xfe00 keysym #xfeff)
|
||
(aref xcb:keysyms:-iso-function-keys
|
||
(logand keysym #xff)))
|
||
(t (or
|
||
;; Search system-specific keysyms.
|
||
(car (assq keysym system-key-alist))
|
||
;; Search `x-keysym-table' for legacy keysyms.
|
||
(gethash keysym x-keysym-table)))))
|
||
mod-alt mod-meta mod-hyper mod-super)
|
||
(when event
|
||
(if allow-modifiers
|
||
(when (/= 0 mask)
|
||
;; Clear modifier bits for modifier keys.
|
||
(pcase event
|
||
((or `lmeta* `rmeta*)
|
||
(setq mask (logand mask (lognot xcb:keysyms:meta-mask))))
|
||
((or `lcontrol* `rcontrol*)
|
||
(setq mask (logand mask (lognot xcb:keysyms:control-mask))))
|
||
((or `lshift* `rshift*)
|
||
(setq mask (logand mask (lognot xcb:keysyms:shift-mask))))
|
||
((or `lhyper* `rhyper*)
|
||
(setq mask (logand mask (lognot xcb:keysyms:hyper-mask))))
|
||
((or `lsuper* `rsuper*)
|
||
(setq mask (logand mask (lognot xcb:keysyms:super-mask))))
|
||
((or `lalt* `ralt*)
|
||
(setq mask (logand mask (lognot xcb:keysyms:alt-mask))))))
|
||
(when (memq event
|
||
'(lshift*
|
||
rshift*
|
||
lcontrol*
|
||
rcontrol*
|
||
caps-lock*
|
||
shift-lock*
|
||
lmeta*
|
||
rmeta*
|
||
lalt*
|
||
ralt*
|
||
lsuper*
|
||
rsuper*
|
||
lhyper*
|
||
rhyper*
|
||
mode-switch*
|
||
kp-numlock))
|
||
(setq event nil))))
|
||
(when event
|
||
(if (= 0 mask)
|
||
event
|
||
;; Set mod-* if possible.
|
||
(when x-alt-keysym
|
||
(pcase x-alt-keysym
|
||
(`meta (setq mod-meta 'alt))
|
||
(`hyper (setq mod-hyper 'alt))
|
||
(`super (setq mod-super 'alt))))
|
||
(when x-meta-keysym
|
||
(pcase x-meta-keysym
|
||
(`alt (setq mod-alt 'meta))
|
||
(`hyper (setq mod-hyper 'meta))
|
||
(`super (setq mod-super 'meta))))
|
||
(when x-hyper-keysym
|
||
(pcase x-hyper-keysym
|
||
(`alt (setq mod-alt 'hyper))
|
||
(`meta (setq mod-meta 'hyper))
|
||
(`super (setq mod-super 'hyper))))
|
||
(when x-super-keysym
|
||
(pcase x-super-keysym
|
||
(`alt (setq mod-alt 'super))
|
||
(`meta (setq mod-meta 'super))
|
||
(`hyper (setq mod-hyper 'super))))
|
||
;; Convert modifiers.
|
||
(setq event (list event))
|
||
(when (/= 0 (logand mask xcb:keysyms:meta-mask))
|
||
(push (or mod-meta 'meta) event))
|
||
(when (/= 0 (logand mask xcb:keysyms:control-mask))
|
||
(push 'control event))
|
||
(when (and (/= 0 (logand mask (logior xcb:keysyms:shift-mask
|
||
xcb:keysyms:shift-lock-mask)))
|
||
(or (not (<= #x20 keysym #xff)) ;Not a Latin-1 character
|
||
(<= ?A keysym ?Z))) ;An uppercase letter
|
||
(push 'shift event))
|
||
(when (/= 0 (logand mask xcb:keysyms:hyper-mask))
|
||
(push (or mod-hyper 'hyper) event))
|
||
(when (/= 0 (logand mask xcb:keysyms:super-mask))
|
||
(push (or mod-super 'super) event))
|
||
(when (/= 0 (logand mask xcb:keysyms:alt-mask))
|
||
(push (or mod-alt 'alt) event))
|
||
(event-convert-list event)))))
|
||
|
||
|
||
|
||
(provide 'xcb-keysyms)
|
||
|
||
;;; xcb-keysyms.el ends here
|