From 610f23fc37a3eb9b67255d700b5a78c1bc58a715 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Fri, 31 Mar 2023 16:49:11 +0200 Subject: [PATCH] xrender: ensure that the clip mask is always updated Previously the clip-mask and the server value were compared with EQL when the picture was synchronized, and the clip-mask was assigned to the server-value. This approach breaks when the client (preasumbly to avoid consing) modifies the vector directly. In that case the new value and the server value are EQ while the clip still needs to be updated. To avoid this problem when the clip-mask is a sequence, then we ensure that it is a distinct vector. Fixes #201. --- extensions/xrender.lisp | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/extensions/xrender.lisp b/extensions/xrender.lisp index b870a39..4cf6f7d 100644 --- a/extensions/xrender.lisp +++ b/extensions/xrender.lisp @@ -593,15 +593,27 @@ by every function, which attempts to generate RENDER requests." (aref (picture-%server-values picture) ,index))) (setf (aref (picture-%server-values picture) ,index) (aref (picture-%values picture) ,index)))))))) + ;; Ensure that the picture clip rectangles are updated when + ;; it is necessary. It is important to copy the mask values + ;; when it is a sequence (instead of assigning it), because + ;; the client may modify the sequence without changing its + ;; identity. We still test for EQUALP to avoid a roundtrip. + ;; -- jd 2023-03-31 ,(let ((index (position 'clip-mask specs :key #'second))) - `(unless (eql (aref (picture-%values picture) ,index) - (aref (picture-%server-values picture) - ,index)) - (%render-change-picture-clip-rectangles - picture (aref (picture-%values picture) ,index)) - (setf (aref (picture-%server-values picture) ,index) - (aref (picture-%values picture) ,index)))) - + `(let ((clip-mask (aref (picture-%values picture) ,index)) + (serv-mask (aref (picture-%server-values picture) ,index))) + (unless (equalp clip-mask serv-mask) + (if (typep clip-mask 'sequence) + (let ((clip-length (length clip-mask))) + (if (and (typep serv-mask 'sequence) + (= (length serv-mask) clip-length)) + (replace serv-mask clip-mask) + (setf (aref (picture-%server-values picture) ,index) + (make-array clip-length + :initial-contents clip-mask))) + (%render-change-picture-clip-rectangles picture clip-mask)) + (setf (aref (picture-%server-values picture) ,index) + clip-mask))))) (setf (picture-%changed-p picture) nil))) (defun render-create-picture