525 lines
		
	
	
	
		
			23 KiB
		
	
	
	
		
			EmacsLisp
		
	
	
	
	
	
			
		
		
	
	
			525 lines
		
	
	
	
		
			23 KiB
		
	
	
	
		
			EmacsLisp
		
	
	
	
	
	
| ;;; exwm-input.el --- Input Module for EXWM  -*- lexical-binding: t -*-
 | ||
| 
 | ||
| ;; Copyright (C) 2015-2016 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 module deals with key/mouse matters, including:
 | ||
| ;; + Input focus,
 | ||
| ;; + Key/Button event handling,
 | ||
| ;; + Key events filtering and simulation.
 | ||
| 
 | ||
| ;; Todo:
 | ||
| ;; + Pointer simulation mode (e.g. 'C-c 1'/'C-c 2' for single/double click,
 | ||
| ;;   move with arrow keys).
 | ||
| ;; + Simulation keys to mimic Emacs key bindings for text edit (redo, select,
 | ||
| ;;   cancel, clear, etc). Some of them are not present on common keyboard
 | ||
| ;;   (keycode = 0). May need to use XKB extension.
 | ||
| 
 | ||
| ;;; Code:
 | ||
| 
 | ||
| (require 'xcb-keysyms)
 | ||
| (require 'exwm-core)
 | ||
| 
 | ||
| (defvar exwm-input-move-event 's-down-mouse-1
 | ||
|   "Emacs event to start moving a window.")
 | ||
| (defvar exwm-input-resize-event 's-down-mouse-3
 | ||
|   "Emacs event to start resizing a window.")
 | ||
| 
 | ||
| (defvar exwm-input--move-keysym nil)
 | ||
| (defvar exwm-input--move-mask nil)
 | ||
| (defvar exwm-input--resize-keysym nil)
 | ||
| (defvar exwm-input--resize-mask nil)
 | ||
| 
 | ||
| (defvar exwm-input--timestamp xcb:Time:CurrentTime
 | ||
|   "A recent timestamp received from X server.
 | ||
| 
 | ||
| It's updated in several occasions, and only used by `exwm-input--set-focus'.")
 | ||
| 
 | ||
| (defun exwm-input--set-focus (id)
 | ||
|   "Set input focus to window ID in a proper way."
 | ||
|   (when (exwm--id->buffer id)
 | ||
|     (with-current-buffer (exwm--id->buffer id)
 | ||
|       (if (and (not exwm--hints-input)
 | ||
|                (memq xcb:Atom:WM_TAKE_FOCUS exwm--protocols))
 | ||
|           (progn
 | ||
|             (exwm--log "Focus on #x%x with WM_TAKE_FOCUS" id)
 | ||
|             (xcb:+request exwm--connection
 | ||
|                 (make-instance 'xcb:icccm:SendEvent
 | ||
|                                :destination id
 | ||
|                                :event (xcb:marshal
 | ||
|                                        (make-instance 'xcb:icccm:WM_TAKE_FOCUS
 | ||
|                                                       :window id
 | ||
|                                                       :time
 | ||
|                                                       exwm-input--timestamp)
 | ||
|                                        exwm--connection))))
 | ||
|         (exwm--log "Focus on #x%x with SetInputFocus" id)
 | ||
|         (xcb:+request exwm--connection
 | ||
|             (make-instance 'xcb:SetInputFocus
 | ||
|                            :revert-to xcb:InputFocus:PointerRoot
 | ||
|                            :focus id
 | ||
|                            :time xcb:Time:CurrentTime)))
 | ||
|       (xcb:flush exwm--connection))))
 | ||
| 
 | ||
| (defvar exwm-input--focus-window nil "The (Emacs) window to be focused.")
 | ||
| (defvar exwm-input--timer nil "Currently running timer.")
 | ||
| 
 | ||
| (defun exwm-input--on-buffer-list-update ()
 | ||
|   "Run in buffer-list-update-hook to track input focus."
 | ||
|   (let ((frame (selected-frame))
 | ||
|         (window (selected-window))
 | ||
|         (buffer (current-buffer)))
 | ||
|     (when (and (not (minibufferp buffer))
 | ||
|                (frame-parameter frame 'exwm-outer-id) ;e.g. emacsclient frame
 | ||
|                (eq buffer (window-buffer))) ;e.g. `with-temp-buffer'
 | ||
|       (when exwm-input--timer (cancel-timer exwm-input--timer))
 | ||
|       (setq exwm-input--focus-window window
 | ||
|             exwm-input--timer
 | ||
|             (run-with-idle-timer 0.01 nil #'exwm-input--update-focus)))))
 | ||
| 
 | ||
| (defvar exwm-workspace--current)
 | ||
| (defvar exwm-workspace--switch-history-outdated)
 | ||
| (defvar exwm-workspace-current-index)
 | ||
| (defvar exwm-workspace--minibuffer)
 | ||
| 
 | ||
| (defun exwm-input--update-focus ()
 | ||
|   "Update input focus."
 | ||
|   (when (window-live-p exwm-input--focus-window)
 | ||
|     (with-current-buffer (window-buffer exwm-input--focus-window)
 | ||
|       (if (eq major-mode 'exwm-mode)
 | ||
|           (if (not (eq exwm--frame exwm-workspace--current))
 | ||
|               ;; Do not focus X windows on other workspace
 | ||
|               (progn
 | ||
|                 (set-frame-parameter exwm--frame 'exwm--urgency t)
 | ||
|                 (setq exwm-workspace--switch-history-outdated t)
 | ||
|                 (force-mode-line-update)
 | ||
|                 ;; The application may have changed its input focus
 | ||
|                 (exwm-workspace-switch exwm-workspace-current-index t))
 | ||
|             (exwm--log "Set focus on #x%x" exwm--id)
 | ||
|             (exwm-input--set-focus exwm--id)
 | ||
|             (when exwm--floating-frame
 | ||
|               ;; Adjust stacking orders of the floating container.
 | ||
|               (if (exwm-workspace--minibuffer-own-frame-p)
 | ||
|                   ;; Put this floating X window just below the minibuffer.
 | ||
|                   (xcb:+request exwm--connection
 | ||
|                       (make-instance 'xcb:ConfigureWindow
 | ||
|                                      :window exwm--container
 | ||
|                                      :value-mask
 | ||
|                                      (logior xcb:ConfigWindow:Sibling
 | ||
|                                              xcb:ConfigWindow:StackMode)
 | ||
|                                      :sibling (frame-parameter
 | ||
|                                                exwm-workspace--minibuffer
 | ||
|                                                'exwm-container)
 | ||
|                                      :stack-mode xcb:StackMode:Below))
 | ||
|                 ;; Put this floating X window at top.
 | ||
|                 (xcb:+request exwm--connection
 | ||
|                     (make-instance 'xcb:ConfigureWindow
 | ||
|                                    :window exwm--container
 | ||
|                                    :value-mask xcb:ConfigWindow:StackMode
 | ||
|                                    :stack-mode xcb:StackMode:Above)))
 | ||
|               (xcb:flush exwm--connection)))
 | ||
|         (when (eq (selected-window) exwm-input--focus-window)
 | ||
|           (exwm--log "Focus on %s" exwm-input--focus-window)
 | ||
|           (select-frame-set-input-focus (window-frame exwm-input--focus-window)
 | ||
|                                         t)))
 | ||
|       (setq exwm-input--focus-window nil))))
 | ||
| 
 | ||
| (defvar exwm-input--during-key-sequence nil
 | ||
|   "Non-nil indicates Emacs is waiting for more keys to form a key sequence.")
 | ||
| (defvar exwm-input--temp-line-mode nil
 | ||
|   "Non-nil indicates it's in temporary line-mode for char-mode.")
 | ||
| 
 | ||
| (defun exwm-input--finish-key-sequence ()
 | ||
|   "Mark the end of a key sequence (with the aid of `pre-command-hook')."
 | ||
|   (when (and exwm-input--during-key-sequence
 | ||
|              (not (equal [?\C-u] (this-single-command-keys))))
 | ||
|     (setq exwm-input--during-key-sequence nil)
 | ||
|     (when exwm-input--temp-line-mode
 | ||
|       (setq exwm-input--temp-line-mode nil)
 | ||
|       (exwm-input--release-keyboard))))
 | ||
| 
 | ||
| (declare-function exwm-floating--start-moveresize "exwm-floating.el"
 | ||
|                   (id &optional type))
 | ||
| 
 | ||
| (defvar exwm-workspace--list)
 | ||
| 
 | ||
| (defun exwm-input--on-ButtonPress (data _synthetic)
 | ||
|   "Handle ButtonPress event."
 | ||
|   (let ((obj (make-instance 'xcb:ButtonPress))
 | ||
|         (mode xcb:Allow:SyncPointer))
 | ||
|     (xcb:unmarshal obj data)
 | ||
|     (with-slots (detail time event state) obj
 | ||
|       (setq exwm-input--timestamp time)
 | ||
|       (cond ((and (= state exwm-input--move-mask)
 | ||
|                   (= detail exwm-input--move-keysym))
 | ||
|              ;; Move
 | ||
|              (exwm-floating--start-moveresize
 | ||
|               event xcb:ewmh:_NET_WM_MOVERESIZE_MOVE))
 | ||
|             ((and (= state exwm-input--resize-mask)
 | ||
|                   (= detail exwm-input--resize-keysym))
 | ||
|              ;; Resize
 | ||
|              (exwm-floating--start-moveresize event))
 | ||
|             (t
 | ||
|              ;; Click to focus
 | ||
|              (let ((window (get-buffer-window (exwm--id->buffer event) t))
 | ||
|                    frame)
 | ||
|                (unless (eq window (selected-window))
 | ||
|                  (setq frame (window-frame window))
 | ||
|                  (unless (eq frame exwm-workspace--current)
 | ||
|                    (if (memq frame exwm-workspace--list)
 | ||
|                        ;; The X window is on another workspace
 | ||
|                        (exwm-workspace-switch
 | ||
|                         (cl-position frame exwm-workspace--list))
 | ||
|                      (with-current-buffer (window-buffer window)
 | ||
|                        (when (and (eq major-mode 'exwm-mode)
 | ||
|                                   (not (eq exwm--frame
 | ||
|                                            exwm-workspace--current)))
 | ||
|                          ;; The floating X window is on another workspace
 | ||
|                          (exwm-workspace-switch
 | ||
|                           (cl-position exwm--frame exwm-workspace--list))))))
 | ||
|                  ;; It has been reported that the `window' may have be deleted
 | ||
|                  (if (window-live-p window)
 | ||
|                      (select-window window)
 | ||
|                    (setq window
 | ||
|                          (get-buffer-window (exwm--id->buffer event) t))
 | ||
|                    (when window (select-window window)))))
 | ||
|              ;; The event should be replayed
 | ||
|              (setq mode xcb:Allow:ReplayPointer))))
 | ||
|     (xcb:+request exwm--connection
 | ||
|         (make-instance 'xcb:AllowEvents :mode mode :time xcb:Time:CurrentTime))
 | ||
|     (xcb:flush exwm--connection)))
 | ||
| 
 | ||
| (defun exwm-input--on-KeyPress (data _synthetic)
 | ||
|   "Handle KeyPress event."
 | ||
|   (let ((obj (make-instance 'xcb:KeyPress)))
 | ||
|     (xcb:unmarshal obj data)
 | ||
|     (setq exwm-input--timestamp (slot-value obj 'time))
 | ||
|     (if (eq major-mode 'exwm-mode)
 | ||
|         (funcall exwm--on-KeyPress obj)
 | ||
|       (exwm-input--on-KeyPress-char-mode obj))))
 | ||
| 
 | ||
| (defvar exwm-input--global-keys nil "Global key bindings.")
 | ||
| (defvar exwm-input--global-prefix-keys nil
 | ||
|   "List of prefix keys of global key bindings.")
 | ||
| (defvar exwm-input-prefix-keys
 | ||
|   '(?\C-c ?\C-x ?\C-u ?\C-h ?\M-x ?\M-` ?\M-& ?\M-:)
 | ||
|   "List of prefix keys EXWM should forward to Emacs when in line-mode.")
 | ||
| (defvar exwm-input--simulation-keys nil "Simulation keys in line-mode.")
 | ||
| (defvar exwm-input--simulation-prefix-keys nil
 | ||
|   "List of prefix keys of simulation keys in line-mode.")
 | ||
| 
 | ||
| (defun exwm-input--update-global-prefix-keys ()
 | ||
|   "Update `exwm-input--global-prefix-keys'."
 | ||
|   (when exwm--connection
 | ||
|     (let ((original exwm-input--global-prefix-keys)
 | ||
|           keysym keycode ungrab-key grab-key workspace)
 | ||
|       (setq exwm-input--global-prefix-keys nil)
 | ||
|       (dolist (i exwm-input--global-keys)
 | ||
|         (cl-pushnew (elt i 0) exwm-input--global-prefix-keys))
 | ||
|       (unless (equal original exwm-input--global-prefix-keys)
 | ||
|         (setq ungrab-key (make-instance 'xcb:UngrabKey
 | ||
|                                         :key xcb:Grab:Any :grab-window nil
 | ||
|                                         :modifiers xcb:ModMask:Any)
 | ||
|               grab-key (make-instance 'xcb:GrabKey
 | ||
|                                       :owner-events 0
 | ||
|                                       :grab-window nil
 | ||
|                                       :modifiers nil
 | ||
|                                       :key nil
 | ||
|                                       :pointer-mode xcb:GrabMode:Async
 | ||
|                                       :keyboard-mode xcb:GrabMode:Async))
 | ||
|         (dolist (w exwm-workspace--list)
 | ||
|           (setq workspace (frame-parameter w 'exwm-workspace))
 | ||
|           (setf (slot-value ungrab-key 'grab-window) workspace)
 | ||
|           (if (xcb:+request-checked+request-check exwm--connection ungrab-key)
 | ||
|               (exwm--log "Failed to ungrab keys")
 | ||
|             (dolist (k exwm-input--global-prefix-keys)
 | ||
|               (setq keysym (xcb:keysyms:event->keysym exwm--connection k)
 | ||
|                     keycode (xcb:keysyms:keysym->keycode exwm--connection
 | ||
|                                                          (car keysym)))
 | ||
|               (setf (slot-value grab-key 'grab-window) workspace
 | ||
|                     (slot-value grab-key 'modifiers) (cadr keysym)
 | ||
|                     (slot-value grab-key 'key) keycode)
 | ||
|               (when (or (not keycode)
 | ||
|                         (xcb:+request-checked+request-check exwm--connection
 | ||
|                             grab-key))
 | ||
|                 (user-error "[EXWM] Failed to grab key: %s"
 | ||
|                             (single-key-description k))))))))))
 | ||
| 
 | ||
| (defun exwm-input-set-key (key command)
 | ||
|   "Set a global key binding."
 | ||
|   (interactive "KSet key globally: \nCSet key %s to command: ")
 | ||
|   (global-set-key key command)
 | ||
|   (cl-pushnew key exwm-input--global-keys))
 | ||
| 
 | ||
| (defvar exwm-input-command-whitelist nil
 | ||
|   "A list of commands that when active all keys should be forwarded to Emacs.")
 | ||
| (make-obsolete-variable 'exwm-input-command-whitelist
 | ||
|                         "This variable can be safely removed." "25.1")
 | ||
| 
 | ||
| (defvar exwm-input--during-command nil
 | ||
|   "Indicate whether between `pre-command-hook' and `post-command-hook'.")
 | ||
| 
 | ||
| (defun exwm-input--on-KeyPress-line-mode (key-press)
 | ||
|   "Parse X KeyPress event to Emacs key event and then feed the command loop."
 | ||
|   (with-slots (detail state) key-press
 | ||
|     (let ((keysym (xcb:keysyms:keycode->keysym exwm--connection detail state))
 | ||
|           event minibuffer-window mode)
 | ||
|       (when (and keysym
 | ||
|                  (setq event (xcb:keysyms:keysym->event exwm--connection
 | ||
|                                                         keysym state))
 | ||
|                  (or exwm-input--during-key-sequence
 | ||
|                      exwm-input--during-command
 | ||
|                      (setq minibuffer-window (active-minibuffer-window))
 | ||
|                      (memq event exwm-input--global-prefix-keys)
 | ||
|                      (memq event exwm-input-prefix-keys)
 | ||
|                      (memq event exwm-input--simulation-prefix-keys)))
 | ||
|         (setq mode xcb:Allow:AsyncKeyboard)
 | ||
|         (unless minibuffer-window (setq exwm-input--during-key-sequence t))
 | ||
|         (push event unread-command-events))
 | ||
|       (xcb:+request exwm--connection
 | ||
|           (make-instance 'xcb:AllowEvents
 | ||
|                          :mode (or mode xcb:Allow:ReplayKeyboard)
 | ||
|                          :time xcb:Time:CurrentTime))
 | ||
|       (xcb:flush exwm--connection))))
 | ||
| 
 | ||
| (defun exwm-input--on-KeyPress-char-mode (key-press)
 | ||
|   "Handle KeyPress event in char-mode."
 | ||
|   (with-slots (detail state) key-press
 | ||
|     (let ((keysym (xcb:keysyms:keycode->keysym exwm--connection detail state))
 | ||
|           event)
 | ||
|       (when (and keysym
 | ||
|                  (setq event (xcb:keysyms:keysym->event exwm--connection
 | ||
|                                                         keysym state)))
 | ||
|         (when (eq major-mode 'exwm-mode)
 | ||
|           (setq exwm-input--temp-line-mode t
 | ||
|                 exwm-input--during-key-sequence t)
 | ||
|           (exwm-input--grab-keyboard))  ;grab keyboard temporarily
 | ||
|         (push event unread-command-events))))
 | ||
|   (xcb:+request exwm--connection
 | ||
|       (make-instance 'xcb:AllowEvents
 | ||
|                      :mode xcb:Allow:AsyncKeyboard
 | ||
|                      :time xcb:Time:CurrentTime))
 | ||
|   (xcb:flush exwm--connection))
 | ||
| 
 | ||
| (defun exwm-input--update-mode-line (id)
 | ||
|   "Update the propertized `mode-line-process' for window ID."
 | ||
|   (let (help-echo cmd mode)
 | ||
|     (cl-case exwm--on-KeyPress
 | ||
|       ((exwm-input--on-KeyPress-line-mode)
 | ||
|        (setq mode "line"
 | ||
|              help-echo "mouse-1: Switch to char-mode"
 | ||
|              cmd `(lambda ()
 | ||
|                     (interactive)
 | ||
|                     (exwm-input-release-keyboard ,id))))
 | ||
|       ((exwm-input--on-KeyPress-char-mode)
 | ||
|        (setq mode "char"
 | ||
|              help-echo "mouse-1: Switch to line-mode"
 | ||
|              cmd `(lambda ()
 | ||
|                     (interactive)
 | ||
|                     (exwm-input-grab-keyboard ,id)))))
 | ||
|     (with-current-buffer (exwm--id->buffer id)
 | ||
|       (setq mode-line-process
 | ||
|             `(": "
 | ||
|               (:propertize ,mode
 | ||
|                            help-echo ,help-echo
 | ||
|                            mouse-face mode-line-highlight
 | ||
|                            local-map
 | ||
|                            (keymap
 | ||
|                             (mode-line
 | ||
|                              keymap
 | ||
|                              (down-mouse-1 . ,cmd)))))))))
 | ||
| 
 | ||
| (defun exwm-input--grab-keyboard (&optional id)
 | ||
|   "Grab all key events on window ID."
 | ||
|   (unless id (setq id (exwm--buffer->id (window-buffer))))
 | ||
|   (when id
 | ||
|     (when (xcb:+request-checked+request-check exwm--connection
 | ||
|               (make-instance 'xcb:GrabKey
 | ||
|                              :owner-events 0
 | ||
|                              :grab-window id
 | ||
|                              :modifiers xcb:ModMask:Any
 | ||
|                              :key xcb:Grab:Any
 | ||
|                              :pointer-mode xcb:GrabMode:Async
 | ||
|                              :keyboard-mode xcb:GrabMode:Sync))
 | ||
|       (exwm--log "Failed to grab keyboard for #x%x" id))
 | ||
|     (with-current-buffer (exwm--id->buffer id)
 | ||
|       (setq exwm--on-KeyPress #'exwm-input--on-KeyPress-line-mode))))
 | ||
| 
 | ||
| (defun exwm-input--release-keyboard (&optional id)
 | ||
|   "Ungrab all key events on window ID."
 | ||
|   (unless id (setq id (exwm--buffer->id (window-buffer))))
 | ||
|   (when id
 | ||
|     (when (xcb:+request-checked+request-check exwm--connection
 | ||
|               (make-instance 'xcb:UngrabKey
 | ||
|                              :key xcb:Grab:Any
 | ||
|                              :grab-window id
 | ||
|                              :modifiers xcb:ModMask:Any))
 | ||
|       (exwm--log "Failed to release keyboard for #x%x" id))
 | ||
|     (with-current-buffer (exwm--id->buffer id)
 | ||
|       (setq exwm--on-KeyPress #'exwm-input--on-KeyPress-char-mode))))
 | ||
| 
 | ||
| ;;;###autoload
 | ||
| (defun exwm-input-grab-keyboard (&optional id)
 | ||
|   "Switch to line-mode."
 | ||
|   (interactive (list (exwm--buffer->id (window-buffer))))
 | ||
|   (when id
 | ||
|     (with-current-buffer (exwm--id->buffer id)
 | ||
|       (exwm-input--grab-keyboard id)
 | ||
|       (exwm-input--update-mode-line id)
 | ||
|       (force-mode-line-update))))
 | ||
| 
 | ||
| ;;;###autoload
 | ||
| (defun exwm-input-release-keyboard (&optional id)
 | ||
|   "Switch to char-mode."
 | ||
|   (interactive (list (exwm--buffer->id (window-buffer))))
 | ||
|   (when id
 | ||
|     (with-current-buffer (exwm--id->buffer id)
 | ||
|       (exwm-input--release-keyboard id)
 | ||
|       (exwm-input--update-mode-line id)
 | ||
|       (force-mode-line-update))))
 | ||
| 
 | ||
| (defun exwm-input--fake-key (event)
 | ||
|   "Fake a key event equivalent to Emacs event EVENT."
 | ||
|   (let* ((keysym (xcb:keysyms:event->keysym exwm--connection event))
 | ||
|          keycode id)
 | ||
|     (unless keysym
 | ||
|       (user-error "[EXWM] Invalid key: %s" (single-key-description event)))
 | ||
|     (setq keycode (xcb:keysyms:keysym->keycode exwm--connection
 | ||
|                                                (car keysym)))
 | ||
|     (when keycode
 | ||
|       (setq id (exwm--buffer->id (window-buffer (selected-window))))
 | ||
|       (dolist (class '(xcb:KeyPress xcb:KeyRelease))
 | ||
|         (xcb:+request exwm--connection
 | ||
|             (make-instance 'xcb:SendEvent
 | ||
|                            :propagate 0 :destination id
 | ||
|                            :event-mask xcb:EventMask:NoEvent
 | ||
|                            :event (xcb:marshal
 | ||
|                                    (make-instance class
 | ||
|                                                   :detail keycode
 | ||
|                                                   :time xcb:Time:CurrentTime
 | ||
|                                                   :root exwm--root :event id
 | ||
|                                                   :child 0
 | ||
|                                                   :root-x 0 :root-y 0
 | ||
|                                                   :event-x 0 :event-y 0
 | ||
|                                                   :state (cadr keysym)
 | ||
|                                                   :same-screen 1)
 | ||
|                                    exwm--connection)))))
 | ||
|     (xcb:flush exwm--connection)))
 | ||
| 
 | ||
| ;;;###autoload
 | ||
| (defun exwm-input-send-next-key (times)
 | ||
|   "Send next key to client window."
 | ||
|   (interactive "p")
 | ||
|   (when (> times 12) (setq times 12))
 | ||
|   (let (key keys)
 | ||
|     (dotimes (i times)
 | ||
|       ;; Skip events not from keyboard
 | ||
|       (setq exwm-input--during-key-sequence t)
 | ||
|       (catch 'break
 | ||
|         (while t
 | ||
|           (setq key (read-key (format "Send key: %s (%d/%d)"
 | ||
|                                       (key-description keys)
 | ||
|                                       (1+ i) times)))
 | ||
|           (unless (listp key) (throw 'break nil))))
 | ||
|       (setq exwm-input--during-key-sequence nil)
 | ||
|       (setq keys (vconcat keys (vector key)))
 | ||
|       (exwm-input--fake-key key))))
 | ||
| 
 | ||
| ;; (defun exwm-input-send-last-key ()
 | ||
| ;;   (interactive)
 | ||
| ;;   (unless (listp last-input-event)      ;not a key event
 | ||
| ;;     (exwm-input--fake-key last-input-event)))
 | ||
| 
 | ||
| (defun exwm-input--update-simulation-prefix-keys ()
 | ||
|   "Update the list of prefix keys of simulation keys."
 | ||
|   (setq exwm-input--simulation-prefix-keys nil)
 | ||
|   (dolist (i exwm-input--simulation-keys)
 | ||
|     (define-key exwm-mode-map (car i) #'exwm-input-send-simulation-key)
 | ||
|     (cl-pushnew (elt (car i) 0) exwm-input--simulation-prefix-keys)))
 | ||
| 
 | ||
| (defun exwm-input-set-simulation-keys (simulation-keys)
 | ||
|   "Set simulation keys.
 | ||
| 
 | ||
| SIMULATION-KEYS is an alist of the form (original-key . simulated-key)."
 | ||
|   (setq exwm-input--simulation-keys nil)
 | ||
|   (dolist (i simulation-keys)
 | ||
|     (cl-pushnew `(,(vconcat (car i)) . ,(cdr i)) exwm-input--simulation-keys))
 | ||
|   (exwm-input--update-simulation-prefix-keys))
 | ||
| 
 | ||
| ;;;###autoload
 | ||
| (defun exwm-input-send-simulation-key (times)
 | ||
|   "Fake a key event according to last input key sequence."
 | ||
|   (interactive "p")
 | ||
|   (let ((pair (assoc (this-single-command-keys) exwm-input--simulation-keys)))
 | ||
|     (when pair
 | ||
|       (setq pair (cdr pair))
 | ||
|       (unless (listp pair)
 | ||
|         (setq pair (list pair)))
 | ||
|       (dotimes (_ times)
 | ||
|         (dolist (j pair)
 | ||
|           (exwm-input--fake-key j))))))
 | ||
| 
 | ||
| (declare-function exwm-floating--stop-moveresize "exwm-floating.el"
 | ||
|                   (&rest _args))
 | ||
| (declare-function exwm-floating--do-moveresize "exwm-floating.el"
 | ||
|                   (data _synthetic))
 | ||
| 
 | ||
| (defun exwm-input--init ()
 | ||
|   "Initialize the keyboard module."
 | ||
|   ;; Refresh keyboard mapping
 | ||
|   (xcb:keysyms:init exwm--connection)
 | ||
|   ;; Convert move/resize buttons
 | ||
|   (let ((move-key (xcb:keysyms:event->keysym exwm--connection
 | ||
|                                              exwm-input-move-event))
 | ||
|         (resize-key (xcb:keysyms:event->keysym exwm--connection
 | ||
|                                                exwm-input-resize-event)))
 | ||
|     (unless move-key
 | ||
|       (user-error "[EXWM] Invalid key: %s"
 | ||
|                   (single-key-description exwm-input-move-event)))
 | ||
|     (unless resize-key
 | ||
|       (user-error "[EXWM] Invalid key: %s"
 | ||
|                   (single-key-description exwm-input-resize-event)))
 | ||
|     (setq exwm-input--move-keysym (car move-key)
 | ||
|           exwm-input--move-mask (cadr move-key)
 | ||
|           exwm-input--resize-keysym (car resize-key)
 | ||
|           exwm-input--resize-mask (cadr resize-key)))
 | ||
|   ;; Attach event listeners
 | ||
|   (xcb:+event exwm--connection 'xcb:KeyPress #'exwm-input--on-KeyPress)
 | ||
|   (xcb:+event exwm--connection 'xcb:ButtonPress #'exwm-input--on-ButtonPress)
 | ||
|   (xcb:+event exwm--connection 'xcb:ButtonRelease
 | ||
|               #'exwm-floating--stop-moveresize)
 | ||
|   (xcb:+event exwm--connection 'xcb:MotionNotify
 | ||
|               #'exwm-floating--do-moveresize)
 | ||
|   ;; `pre-command-hook' marks the end of a key sequence (existing or not)
 | ||
|   (add-hook 'pre-command-hook #'exwm-input--finish-key-sequence)
 | ||
|   ;; Control `exwm-input--during-command'
 | ||
|   (add-hook 'pre-command-hook (lambda () (setq exwm-input--during-command t)))
 | ||
|   (add-hook 'post-command-hook
 | ||
|             (lambda () (setq exwm-input--during-command nil)))
 | ||
|   ;; Update focus when buffer list updates
 | ||
|   (add-hook 'buffer-list-update-hook #'exwm-input--on-buffer-list-update)
 | ||
|   ;; Update prefix keys for global keys
 | ||
|   (exwm-input--update-global-prefix-keys))
 | ||
| 
 | ||
| 
 | ||
| 
 | ||
| (provide 'exwm-input)
 | ||
| 
 | ||
| ;;; exwm-input.el ends here
 |