mirror of
https://github.com/stumpwm/stumpwm.git
synced 2026-09-10 07:26:20 -04:00
7f4ea71512
This appears to be a simple matter of switching out read-key for read-key-no-modifiers so that it sends a full key chord instead of a single keypress
136 lines
4.7 KiB
Common Lisp
136 lines
4.7 KiB
Common Lisp
;; Copyright (C) 2018 Ram Krishnan
|
|
;;
|
|
;; This file is part of stumpwm.
|
|
;;
|
|
;; stumpwm 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 2, or (at your option)
|
|
;; any later version.
|
|
|
|
;; stumpwm 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 this software; see the file COPYING. If not, see
|
|
;; <http://www.gnu.org/licenses/>.
|
|
|
|
;; Commentary:
|
|
;;
|
|
;; Provides a simple way to remap keybindings in applications running
|
|
;; under StumpWM
|
|
;;
|
|
;; Code:
|
|
|
|
(in-package #:stumpwm)
|
|
|
|
(export '(define-remapped-keys *remapped-keys-enabled-p*))
|
|
|
|
(defvar *remap-keys-window-match-list* nil)
|
|
|
|
(defvar *remapped-keys-enabled-p* t
|
|
"Bool to toggle remapped-keys on/off. Defaults to t ")
|
|
|
|
(defun find-remap-keys-by-window (window)
|
|
(first
|
|
(member-if (lambda (pattern)
|
|
(cond
|
|
((stringp pattern)
|
|
(string-match (window-class window) pattern))
|
|
|
|
((or (symbolp pattern) (functionp pattern))
|
|
(funcall pattern window))))
|
|
*remap-keys-window-match-list*
|
|
:key 'car)))
|
|
|
|
(defun make-remap-keys (kmap)
|
|
(labels ((as-list (x) (if (consp x) x (list x)))
|
|
(validated-kbd (key)
|
|
(or (kbd key)
|
|
(throw 'error
|
|
(format nil "Invalid keyspec: ~S" key)))))
|
|
(mapcar (lambda (kspec)
|
|
(let ((src-key (car kspec))
|
|
(target-keyseq (as-list (cdr kspec))))
|
|
(cons src-key
|
|
(mapcar #'validated-kbd target-keyseq))))
|
|
kmap)))
|
|
|
|
(defun remap-keys-grab-keys (win)
|
|
(let* ((keymap (cdr (find-remap-keys-by-window win)))
|
|
(src-keys (mapcar 'car keymap)))
|
|
(dolist (key src-keys)
|
|
(xwin-grab-key (window-xwin win) (kbd key)))))
|
|
|
|
(defun remap-keys-focus-window-hook (new-focus cur-focus)
|
|
(declare (ignorable cur-focus))
|
|
(when new-focus
|
|
(remap-keys-grab-keys new-focus)))
|
|
|
|
(defun remap-keys-event-handler (code state)
|
|
(let* ((raw-key (code-state->key code state))
|
|
(window (current-window))
|
|
(keymap (when window
|
|
(cdr (find-remap-keys-by-window window))))
|
|
(keys (cdr (assoc (print-key raw-key) keymap :test 'equal))))
|
|
(when keys
|
|
(dolist (key keys)
|
|
(send-fake-key window (if *remapped-keys-enabled-p*
|
|
key
|
|
raw-key)))
|
|
t)))
|
|
|
|
(defun define-remapped-keys (specs)
|
|
"Define the keys to be remapped and their mappings. The SPECS
|
|
argument needs to be of the following structure:
|
|
|
|
(regexp-or-function . ((\"key-to-remap\" . <new-keycodes>) ...))
|
|
|
|
EXAMPLE:
|
|
(define-remapped-keys
|
|
'((\"Firefox\"
|
|
(\"C-n\" . \"Down\")
|
|
(\"C-p\" . \"Up\")
|
|
(\"C-k\" . (\"C-S-End\" \"C-x\")))))
|
|
|
|
The above form remaps Ctrl-n to Down arrow, and Ctrl-p to Up arrow
|
|
keys. The Ctrl-k key is remapped to the sequence of keys
|
|
Ctrl-Shift-End followed by Ctrl-x."
|
|
(setq *custom-key-event-handler* nil
|
|
*remap-keys-window-match-list*
|
|
(mapcar (lambda (spec)
|
|
(let ((pattern (car spec))
|
|
(kmap (cdr spec)))
|
|
(cons pattern (make-remap-keys kmap))))
|
|
specs))
|
|
(when *remap-keys-window-match-list*
|
|
(add-hook *focus-window-hook* 'remap-keys-focus-window-hook)
|
|
(setq *custom-key-event-handler* 'remap-keys-event-handler)))
|
|
|
|
(defcommand send-raw-key () ()
|
|
"Prompts for a key and forwards it to the CURRENT-WINDOW."
|
|
(message "Press a key to send: ")
|
|
(let* ((screen (current-screen))
|
|
(win (screen-current-window screen))
|
|
(k (with-focus (screen-key-window screen)
|
|
(read-key-no-modifiers)))
|
|
(code (car k))
|
|
(state (cdr k)))
|
|
(unmap-message-window screen)
|
|
(when win
|
|
(let ((xwin (window-xwin win)))
|
|
(dolist (event '(:key-press :key-release))
|
|
(xlib:send-event xwin
|
|
event
|
|
(xlib:make-event-mask event)
|
|
:display *display*
|
|
:root (screen-root screen)
|
|
;; Apparently we need these in here, though they
|
|
;; make no sense for a key event.
|
|
:x 0 :y 0 :root-x 0 :root-y 0
|
|
:window xwin
|
|
:event-window xwin
|
|
:code code
|
|
:state state))))))
|