[bug #80610] Tentative fix based on new subr macro with-sync-command-loop

lisp/ses.el

@@ -2742,7 +2742,7 @@ right-justified) or a list of one string (will be left-justified)."
   "Set the printer function for the current column.
 See `ses-read-cell-printer' for input forms."
   (interactive
-   (let ((col (cdr (progn
+   (let ((col (cdr (with-sync-command-loop
                      (ses-check-curcell)
                      (ses-sym-rowcol ses--curcell)))))
      (list col (ses-read-printer (format "Column %s printer"

lisp/subr.el

@@ -8093,4 +8093,35 @@ and return the value found in PLACE instead."
       ((pred numberp) v)
       (`(,above . ,below) (+ above below)))))
 
+(defmacro with-sync-command-loop (&rest body)
+  (let ((mutex (make-symbol "mutex"))
+        (sig-vector (make-symbol "sv"))
+        (cond (make-symbol "cond")))
+    `(let ((,mutex (make-mutex "sync-command-loop"))
+           (,sig-vector (vector t nil)))
+       (let ((,cond (make-condition-variable ,mutex)))
+         (with-mutex ,mutex
+           ;;post body to command loop
+           (insert-special-event
+            (cons
+             'sync-command-loop
+             (lambda ()
+               (aset ,sig-vector 1 (progn ,@body))
+               (aset ,sig-vector 0 nil)
+               (condition-notify ,cond))))
+           ;; wait for command loop to execute body.
+           (while (aref ,sig-vector 0)
+             (condition-wait ,cond))))
+       (aref ,sig-vector 1))))
+
+(defun sync-command-loop-handler (event)
+  (interactive (list last-input-event))
+  (cl-assert (eq 'sync-command-loop (car-safe event)))
+  (funcall (cdr event)))
+
+(keymap-set special-event-map "<sync-command-loop>" 'sync-command-loop-handler)
+
+
+
+
 ;;; subr.el ends here

test/lisp/ses-tests.el

@@ -307,7 +307,6 @@ cell has to be rewritten to data area."
 (ert-deftest ses-tests-read-column-printer ()
   "Test fix of bug#80610.
 The test fails because of bug#80839."
-  :expected-result :failed
   (let ((ses-initial-size '(4 . 3))
         (ses-after-entry-functions nil))
     (ert-with-test-buffer (:selected t)