(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)))))