Initial Lime window manager

work/upgrade-live-cursor-session.lisp

@@ -0,0 +1,79 @@
+;;;; Add display-local application cursor settings without reloading WM structs.
+(in-package #:cl-user)
+(declaim (special lime.x11::*cursor-session-settings*))
+
+(defun lime-cursor-session-definitions ()
+  (let ((manifest '(("src/x11/cursor.lisp" "%CURSOR-THEME-NAME-P" "%VALIDATE-UI-CURSOR-STYLE"
+                    "%BACKEND-CURSOR-SETTINGS" "BACKEND-CURSOR-REPORT")
+                   ("src/x11/launcher.lisp" "BACKEND-LAUNCH-PROGRAM")
+                   ("src/x11/backend.lisp" "%DISPATCH-NEXT-EVENT" "STOP-BACKEND")
+                   ("src/x11/config.lisp" "APPLY-LIME-CONFIGURATION")))
+        (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-cursor-session ()
+  (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."))
+    (when (and (boundp 'lime.x11::*cursor-session-settings*)
+               (gethash backend lime.x11::*cursor-session-settings*))
+      (error "Cursor session publisher is already installed; do not repeat this upgrade."))
+    (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))
+           (focus (xlib:input-focus display))
+           (config (lime.x11::x11-backend-configuration backend))
+           (bindings (lime.x11:list-keybindings backend))
+           (cursors (lime.x11::x11-backend-cursor-set backend))
+           (selection (intern (format nil "_XSETTINGS_S~D"
+                                      (position (lime.x11::x11-backend-x-screen backend)
+                                                (xlib:display-roots display))) :keyword))
+           (owner (xlib:selection-owner display selection))
+           (definitions (lime-cursor-session-definitions))
+           (old-functions (mapcar (lambda (form) (cons (second form) (fdefinition (second form)))) definitions)))
+      (assert config)
+      (assert (equal "Bibata-Original-Ice" (lime.x11:ui-cursor-style-theme (lime.x11:lime-configuration-cursor config))))
+      (assert (= 24 (lime.x11:ui-cursor-style-size (lime.x11:lime-configuration-cursor config))))
+      (handler-case
+          (progn
+            ;; New module only: no redefinition of backend/model structures.
+            (load #p"/home/adan/code/common-lisp/lime/src/x11/session-settings.lisp")
+            (dolist (definition definitions) (eval definition))
+            (lime.x11::%apply-cursor-session-settings backend (lime.x11:lime-configuration-cursor config))
+            (assert (equalp before (lime.persistence:snapshot-world world)))
+            (assert (equal head (lime.x11:x11-backend-focused-head-id backend)))
+            (let ((after-focus (xlib:input-focus display)))
+              (assert (or (eql focus after-focus)
+                          (and (typep focus 'xlib:window) (typep after-focus 'xlib:window)
+                               (xlib:window-equal focus after-focus)))))
+            (assert (eq config (lime.x11::x11-backend-configuration backend)))
+            (assert (eq cursors (lime.x11::x11-backend-cursor-set backend)))
+            (assert (equal bindings (lime.x11:list-keybindings backend)))
+            (assert (lime.core:validate-world world))
+            (when owner (assert (xlib:window-equal owner (xlib:selection-owner display selection))))
+            (list :upgraded t :functions (length definitions) :world-unchanged t
+                  :focus-unchanged t :bindings-unchanged t :configuration-unchanged t
+                  :previous-settings-manager (and owner (xlib:window-id owner))
+                  :cursor-session (lime.x11::%cursor-session-report backend)))
+        (error (condition)
+          (when (fboundp 'lime.x11::%shutdown-cursor-session-settings)
+            (ignore-errors (lime.x11::%shutdown-cursor-session-settings backend)))
+          (dolist (entry old-functions) (setf (fdefinition (car entry)) (cdr entry)))
+          (ignore-errors (xlib:display-finish-output display))
+          (error condition))))))