diff options
Diffstat (limited to 'elpa/xelb-0.20/xcb-keysyms.el')
| -rw-r--r-- | elpa/xelb-0.20/xcb-keysyms.el | 813 |
1 files changed, 813 insertions, 0 deletions
diff --git a/elpa/xelb-0.20/xcb-keysyms.el b/elpa/xelb-0.20/xcb-keysyms.el new file mode 100644 index 0000000..8999d71 --- /dev/null +++ b/elpa/xelb-0.20/xcb-keysyms.el @@ -0,0 +1,813 @@ +;;; xcb-keysyms.el --- Conversion between -*- lexical-binding: t -*- +;;; X keysyms, X keycodes and Emacs key event. + +;; Copyright (C) 2015-2024 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: + +(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 a \\='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 (ash 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 (ash 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 (ash 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->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 |