187 lines
7.6 KiB
Common Lisp
187 lines
7.6 KiB
Common Lisp
(in-package #:lime.x11)
|
|
|
|
;;;; Opt-in keyboard input
|
|
;;;
|
|
;;; This layer translates a passive X11 key grab into a handler supplied by the
|
|
;;; user. Handlers receive the X11-BACKEND and normally call a command from
|
|
;;; x11/commands.lisp. It intentionally knows no View ids, Activity names,
|
|
;;; menus, or collision policy itself.
|
|
|
|
(defstruct keybinding
|
|
"One character/keysym binding owned by an X11 backend."
|
|
key
|
|
modifiers
|
|
state
|
|
keycodes
|
|
handler
|
|
description)
|
|
|
|
(defun %input-keysym (display key)
|
|
(typecase key
|
|
(character
|
|
(or (first (xlib:character->keysyms key display))
|
|
(error 'invalid-transition
|
|
:description (format nil "No X11 keysym is known for ~S." key))))
|
|
((integer 0 *) key)
|
|
(otherwise
|
|
(error 'invalid-transition
|
|
:description "A keybinding key must be a character or X11 keysym integer."))))
|
|
|
|
(defun %input-keycodes (display key)
|
|
(let ((keysym (%input-keysym display key)))
|
|
(or (remove nil (multiple-value-list (xlib:keysym->keycodes display keysym)))
|
|
(error 'invalid-transition
|
|
:description (format nil "No X11 keycode is available for ~S." key)))))
|
|
|
|
(defun %input-state (modifiers)
|
|
(typecase modifiers
|
|
(integer modifiers)
|
|
(list (apply #'xlib:make-state-mask modifiers))
|
|
(otherwise
|
|
(error 'invalid-transition
|
|
:description "Keybinding modifiers must be an integer mask or modifier list."))))
|
|
|
|
(defparameter +input-ignored-state-mask+
|
|
;; X11 commonly assigns Caps Lock to :LOCK and Num Lock to :MOD-2. Neither
|
|
;; should make a window-manager keybinding mysteriously stop matching. The
|
|
;; physical mapping is discovered from the server for more exotic setups in
|
|
;; a later input pass; these two portable CLX names cover Lime's current
|
|
;; Xorg sessions and the conventional X11 assignment.
|
|
(xlib:make-state-mask :lock :mod-2))
|
|
|
|
(defun %input-state-variants (state)
|
|
"Return STATE's lock-insensitive passive-grab variants.
|
|
|
|
Passive X11 grabs are exact, whereas a key press with Caps Lock or Num Lock
|
|
active should still invoke the same command. Register every combination and
|
|
store all of them in the dispatch table; callers continue to expose only the
|
|
user's original modifier list in keybinding descriptions."
|
|
(remove-duplicates
|
|
(loop for ignored-state in
|
|
(list 0
|
|
(xlib:make-state-mask :lock)
|
|
(xlib:make-state-mask :mod-2)
|
|
+input-ignored-state-mask+)
|
|
collect (logior state ignored-state))))
|
|
|
|
(defun %input-binding-key (keycode state)
|
|
(cons keycode state))
|
|
|
|
(defun %ungrab-binding (backend binding)
|
|
(let ((root (x11-backend-root backend)))
|
|
(dolist (keycode (keybinding-keycodes binding))
|
|
(dolist (state (%input-state-variants (keybinding-state binding)))
|
|
(xlib:ungrab-key root keycode :modifiers state)))))
|
|
|
|
(defun %remove-binding (backend binding)
|
|
"Ungrab BINDING and erase every table entry that still points to it."
|
|
(%ungrab-binding backend binding)
|
|
(let ((table (x11-backend-keybindings backend))
|
|
(keys '()))
|
|
(maphash (lambda (table-key candidate)
|
|
(when (eq candidate binding)
|
|
(push table-key keys)))
|
|
table)
|
|
(dolist (table-key keys)
|
|
(remhash table-key table))))
|
|
|
|
(defun bind-key (backend key modifiers handler &key description)
|
|
"Passively grab KEY with MODIFIERS and run HANDLER when it is pressed.
|
|
|
|
KEY is a character or an X11 keysym integer. MODIFIERS is an integer mask or
|
|
a CLX modifier list such as '(:MOD-4). HANDLER receives BACKEND as its sole
|
|
argument and should invoke a command-layer operation. Rebinding the same
|
|
physical key/modifier pair replaces its previous handler. The passive grab
|
|
briefly queues subsequent keyboard events until dispatch can hand them to a
|
|
new palette grab or release them normally, even if the trigger was released."
|
|
(unless (functionp handler)
|
|
(error 'invalid-transition :description "A keybinding handler must be a function."))
|
|
(let* ((display (x11-backend-display backend))
|
|
(root (x11-backend-root backend))
|
|
(state (%input-state modifiers))
|
|
(keycodes (%input-keycodes display key))
|
|
(binding (make-keybinding :key key
|
|
:modifiers modifiers
|
|
:state state
|
|
:keycodes keycodes
|
|
:handler handler
|
|
:description description))
|
|
(table (x11-backend-keybindings backend)))
|
|
(dolist (keycode keycodes)
|
|
(let* ((table-key (%input-binding-key keycode state))
|
|
(old (gethash table-key table)))
|
|
(when old
|
|
(%remove-binding backend old))
|
|
(dolist (grab-state (%input-state-variants state))
|
|
(xlib:grab-key root keycode :modifiers grab-state :sync-keyboard-p t)
|
|
(setf (gethash (%input-binding-key keycode grab-state) table)
|
|
binding))))
|
|
(xlib:display-force-output display)
|
|
binding))
|
|
|
|
(defun unbind-key (backend key modifiers)
|
|
"Release KEY/MODIFIERS and return whether at least one binding was removed."
|
|
(let* ((display (x11-backend-display backend))
|
|
(state (%input-state modifiers))
|
|
(keycodes (%input-keycodes display key))
|
|
(table (x11-backend-keybindings backend))
|
|
(removed-p nil))
|
|
(dolist (keycode keycodes)
|
|
(let* ((table-key (%input-binding-key keycode state))
|
|
(binding (gethash table-key table)))
|
|
(when binding
|
|
(%remove-binding backend binding)
|
|
(setf removed-p t))))
|
|
(xlib:display-force-output display)
|
|
removed-p))
|
|
|
|
(defun clear-keybindings (backend)
|
|
"Remove every passive key grab registered through BIND-KEY."
|
|
(let ((seen (make-hash-table :test #'eq)))
|
|
(maphash (lambda (table-key binding)
|
|
(declare (ignore table-key))
|
|
(unless (gethash binding seen)
|
|
(%ungrab-binding backend binding)
|
|
(setf (gethash binding seen) t)))
|
|
(x11-backend-keybindings backend))
|
|
(clrhash (x11-backend-keybindings backend))
|
|
(xlib:display-force-output (x11-backend-display backend)))
|
|
backend)
|
|
|
|
(defun list-keybindings (backend)
|
|
"Return unique KEYBINDING objects currently installed on BACKEND."
|
|
(let ((seen (make-hash-table :test #'eq))
|
|
(bindings '()))
|
|
(maphash (lambda (table-key binding)
|
|
(declare (ignore table-key))
|
|
(unless (gethash binding seen)
|
|
(push binding bindings)
|
|
(setf (gethash binding seen) t)))
|
|
(x11-backend-keybindings backend))
|
|
(nreverse bindings)))
|
|
|
|
(defun backend-last-command-error (backend)
|
|
"Return the most recent condition raised by an input handler, if any."
|
|
(x11-backend-last-command-error backend))
|
|
|
|
(defun %handle-key-press (backend keycode state)
|
|
"Dispatch a grabbed KeyPress without allowing a handler error to kill Lime."
|
|
(unwind-protect
|
|
(let ((binding (gethash (%input-binding-key keycode state)
|
|
(x11-backend-keybindings backend))))
|
|
(when binding
|
|
(handler-case
|
|
(progn
|
|
(setf (x11-backend-last-command-error backend) nil)
|
|
(funcall (keybinding-handler binding) backend)
|
|
t)
|
|
(error (condition)
|
|
(setf (x11-backend-last-command-error backend) condition)
|
|
nil))))
|
|
;; A successful palette grab already thaws input into its own queue.
|
|
;; Ordinary commands, failures, and removed bindings must thaw it too.
|
|
(let ((display (x11-backend-display backend)))
|
|
(when display
|
|
(xlib:allow-events display :async-keyboard)
|
|
(xlib:display-force-output display)))))
|