66 lines
4.1 KiB
Common Lisp
66 lines
4.1 KiB
Common Lisp
;;;; Function-only upgrade: Activity numbering changes, not the live world.
|
|
(in-package #:cl-user)
|
|
|
|
(defun lime-activity-order-definitions ()
|
|
(let* ((*package* (find-package :lime.x11)) (*read-eval* nil)
|
|
(names '(lime.x11::%navigation-activity-slots lime.x11::%navigation-state
|
|
lime.x11:backend-set-activity-slot lime.x11::%navigation-read-data))
|
|
(found nil))
|
|
(with-open-file (in #p"/home/adan/code/common-lisp/lime/src/x11/navigation.lisp")
|
|
(loop for form = (read in nil :eof) until (eq form :eof)
|
|
when (and (consp form) (eq (first form) 'defun) (member (second form) names))
|
|
do (push form found)))
|
|
(assert (= (length names) (length found)))
|
|
(mapcar (lambda (name) (or (find name found :key #'second) (error "Missing ~S" name))) names)))
|
|
|
|
(defun lime-upgrade-live-activity-order (backup-path)
|
|
(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* ((session (lime.x11::%session-snapshot backend))
|
|
(world (lime.x11:x11-backend-world backend))
|
|
(before (getf session :world))
|
|
(before-nav (getf session :navigation))
|
|
(state (lime.x11::%navigation-state backend))
|
|
(old-state (lime.x11::copy-navigation-state state))
|
|
(config (lime.x11::x11-backend-configuration backend))
|
|
(definitions (lime-activity-order-definitions))
|
|
(old-functions (mapcar (lambda (form)
|
|
(let ((name (second form)))
|
|
(cons name (and (fboundp name) (fdefinition name))))) definitions)))
|
|
(when (probe-file backup-path) (error "Refusing to overwrite the pre-upgrade backup."))
|
|
(let ((store (lime.persistence:open-session-store backup-path)))
|
|
(unwind-protect (lime.persistence:write-session-store store session)
|
|
(lime.persistence:close-session-store store)))
|
|
(handler-case
|
|
(progn
|
|
(dolist (definition definitions) (eval definition))
|
|
;; The existing cache already observed this model revision; force
|
|
;; one metadata-only synchronization using the new slot policy.
|
|
(setf (lime.x11::navigation-state-observed-revision state) nil)
|
|
(let ((after-nav (lime.x11::%navigation-snapshot backend)))
|
|
(assert (equal (mapcar #'first (getf before-nav :activities))
|
|
(mapcar #'first (getf after-nav :activities))))
|
|
(assert (equal (loop for n from 1 to (length (getf after-nav :activities)) collect n)
|
|
(mapcar #'second (getf after-nav :activities))))
|
|
(assert (equal (getf before-nav :views) (getf after-nav :views)))
|
|
(assert (equal (getf before-nav :resume) (getf after-nav :resume)))
|
|
(assert (equalp before (lime.persistence:snapshot-world world)))
|
|
(assert (eq config (lime.x11::x11-backend-configuration backend)))
|
|
(lime.x11::render-head-bars backend)
|
|
(xlib:display-finish-output (lime.x11::x11-backend-display backend))
|
|
(assert (lime.core:validate-world world))
|
|
(list :upgraded t :world-unchanged t :views-unchanged t :bar-order-unchanged t
|
|
:activities (getf after-nav :activities) :backup backup-path)))
|
|
(error (condition)
|
|
(dolist (entry old-functions)
|
|
(if (cdr entry) (setf (fdefinition (car entry)) (cdr entry)) (fmakunbound (car entry))))
|
|
(setf (gethash backend lime.x11::*backend-navigation-states*) old-state)
|
|
(ignore-errors (lime.x11::render-head-bars backend))
|
|
(error condition))))))
|