;;;; Function-only upgrade; never changes a live window's membership.
(in-package #:cl-user)

(defun lime-private-here-definitions ()
  ;; Resolve the inherited core symbol correctly before reading adapter forms.
  (export 'lime.core::make-client-private-in-presentation :lime.core)
  (let ((manifest
          '((:lime.core "src/membership.lisp" "MAKE-CLIENT-PRIVATE-IN-PRESENTATION")
            (:lime.x11 "src/x11/commands.lisp" "BACKEND-MAKE-CLIENT-PRIVATE" "BACKEND-SET-CLIENT-SHARED")
            (:lime.x11 "src/x11/ui.lisp" "%UI-PRIVATE-CONTEXT-VALID-P"
             "%UI-SET-CLIENT-SHARING-RESULT" "%UI-MEMBERSHIP-CANDIDATES")))
        (definitions nil))
    (dolist (entry manifest)
      (destructuring-bind (package file &rest names) entry
        (let* ((*package* (find-package package)) (*read-eval* nil)
               (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-private-here ()
  (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))
           (config (lime.x11::x11-backend-configuration backend))
           (bindings (lime.x11:list-keybindings backend))
           (definitions (lime-private-here-definitions))
           (old-functions
             (mapcar (lambda (form)
                       (let ((name (second form)))
                         (cons name (and (fboundp name) (fdefinition name))))) definitions)))
      (handler-case
          (progn
            (dolist (definition definitions) (eval definition))
            (export 'lime.x11::backend-make-client-private :lime.x11)
            (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
                  :function-count (length definitions)))
        (error (condition)
          (dolist (entry old-functions)
            (if (cdr entry) (setf (fdefinition (car entry)) (cdr entry)) (fmakunbound (car entry))))
          (error condition))))))