;;;; Hotload the launcher cache and synchronous passive-grab handoff only.
(in-package #:cl-user)
(defvar lime.x11::*path-program-cache* nil)

(defun lime-launcher-input-definitions ()
  (let ((manifest '(("src/x11/launcher.lisp" "%NORMALIZE-PROGRAM-NAMES" "%SCAN-PATH-PROGRAM-NAMES"
                    "%PATH-PROGRAM-SIGNATURE" "%PATH-PROGRAM-NAMES")
                   ("src/x11/input.lisp" "BIND-KEY" "%HANDLE-KEY-PRESS")))
        (definitions nil) (*package* (find-package :lime.x11)) (*read-eval* nil))
    (dolist (entry manifest)
      (destructuring-bind (file &rest names) entry
        (let ((symbols (mapcar (lambda (name) (intern name *package*)) names)) (found nil))
          (with-open-file (in (merge-pathnames file #p"/home/adan/code/common-lisp/lime/"))
            (loop for form = (read in nil :eof) until (eq form :eof)
                  when (and (consp form) (eq (first form) 'defun) (member (second form) symbols))
                    do (push form found)))
          (assert (= (length symbols) (length found)))
          (dolist (symbol symbols) (assert (find symbol found :key #'second)))
          (setf definitions (append definitions
                                    (mapcar (lambda (symbol) (find symbol found :key #'second)) symbols))))))
    definitions))

(defun lime-upgrade-live-launcher-input ()
  (unless (= 1578331 (slynk-backend:getpid)) (error "Unexpected Lime process."))
  (lime.dev:with-development-backend (backend)
    (unless (and (lime.dev::development-session-running-p lime.dev:*development-session*)
                 (not (lime.dev::development-session-paused-p lime.dev:*development-session*)))
      (error "Lime is not running normally."))
    (when (or (lime.x11::x11-backend-pointer-drag backend) (lime.x11::x11-backend-ui-session backend))
      (error "Close the menu or finish the drag before upgrading."))
    (let* ((world (lime.x11:x11-backend-world backend))
           (before (lime.persistence:snapshot-world world))
           (head (lime.x11:x11-backend-focused-head-id backend))
           (display (lime.x11::x11-backend-display backend))
           (root (lime.x11::x11-backend-root backend))
           (config (lime.x11::x11-backend-configuration backend))
           (bindings (lime.x11:list-keybindings backend))
           (old-cache lime.x11::*path-program-cache*)
           (definitions (lime-launcher-input-definitions))
           (old-functions (mapcar (lambda (form)
                                    (cons (second form) (and (fboundp (second form)) (fdefinition (second form)))))
                                  definitions)))
      (flet ((regrab (synchronous-p)
               ;; Replace our own existing grabs in place: no ungrab interval,
               ;; no remapping, no config reload, no change to handler closures.
               (dolist (binding bindings)
                 (dolist (code (lime.x11::keybinding-keycodes binding))
                   (dolist (state (lime.x11::%input-state-variants (lime.x11::keybinding-state binding)))
                     (xlib:grab-key root code :modifiers state :sync-keyboard-p synchronous-p))))
               (xlib:display-finish-output display)))
        (handler-case
            (progn
              (dolist (definition definitions) (eval definition))
              (let ((program-count (length (lime.x11::%path-program-names :refresh-p t))))
                (regrab t)
                (assert (equalp before (lime.persistence:snapshot-world world)))
                (assert (equal head (lime.x11:x11-backend-focused-head-id backend)))
                (assert (eq config (lime.x11::x11-backend-configuration backend)))
                (assert (equal bindings (lime.x11:list-keybindings backend)))
                (assert (lime.core:validate-world world))
                (list :upgraded t :world-unchanged t :focus-unchanged t :bindings-unchanged t
                      :keyboard-handoff-updated t :cached-programs program-count)))
          (error (condition)
            (dolist (entry old-functions)
              (if (cdr entry) (setf (fdefinition (car entry)) (cdr entry)) (fmakunbound (car entry))))
            (setf lime.x11::*path-program-cache* old-cache)
            (ignore-errors (regrab nil))
            (ignore-errors (xlib:allow-events display :async-keyboard) (xlib:display-force-output display))
            (error condition)))))))