From 0190dff96ac15e48ad57f33d69f5900b3851b9e0 Mon Sep 17 00:00:00 2001
From: Eli Zaretskii <eliz@gnu.org>
Date: Mon, 27 Jun 2022 15:32:53 +0300
Subject: [PATCH] Fix deletion of composed text

* lisp/composite.el (lgstring-glyph-boundary): New function.
* lisp/simple.el (delete-forward-char): Call
'lgstring-glyph-boundary' to find where to end the deletion inside
an automatic composition.  (Bug#56237)
---
 lisp/composite.el | 19 +++++++++++++++++++
 lisp/simple.el    | 22 ++++++++++++++++------
 2 files changed, 35 insertions(+), 6 deletions(-)

diff --git a/lisp/composite.el b/lisp/composite.el
index d7ac75708c9..6fcf637584e 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -474,6 +474,25 @@ after a sequence of character events."
     (aset gstring (1- len) nil))
   gstring)
 
+(defun lgstring-glyph-boundary (gstring startpos endpos)
+  "Return buffer position at or after ENDPOS where grapheme from GSTRING ends.
+STARTPOS is the position where the grapheme cluster starts; it is returned
+by `find-composition'."
+  (let ((nglyphs (lgstring-glyph-len gstring))
+        (idx 0)
+        glyph found)
+    (while (and (not found) (< idx nglyphs))
+      (setq glyph (lgstring-glyph gstring idx))
+      (cond
+       ((or (null glyph)
+            (= (+ startpos (lglyph-from glyph)) endpos))
+        (setq found endpos))
+       ((>= (+ startpos (lglyph-to glyph)) endpos)
+        (setq found (+ startpos (lglyph-to glyph) 1)))
+       (t
+        (setq idx (1+ idx)))))
+    (or found endpos)))
+
 (defun compose-glyph-string (gstring from to)
   (let ((glyph (lgstring-glyph gstring from))
 	from-pos to-pos)
diff --git a/lisp/simple.el b/lisp/simple.el
index 83185c4e1a8..ea94727b3a7 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1507,12 +1507,22 @@ the actual saved text might be different from what was killed."
            (while (> n 0)
              ;; 'find-composition' will return (FROM TO ....) or nil.
              (setq cmp (find-composition pos))
-             (if cmp
-                 ;; TO can be at POS, in which case we want to make
-                 ;; sure we advance at least by 1 character.
-                 (let ((cmp-end (cadr cmp)))
-                   (setq pos (max (1+ pos) cmp-end)))
-               (setq pos (1+ pos)))
+             (setq pos
+                   (if cmp
+                       (let ((from (car cmp))
+                             (to (cadr cmp)))
+                         (cond
+                          ((= (length cmp) 2) ; static composition
+                           to)
+                          ;; TO can be at POS, in which case we want
+                          ;; to make sure we advance at least by 1
+                          ;; character.
+                          ((<= to pos)
+                           (1+ pos))
+                          (t
+                           (lgstring-glyph-boundary (nth 2 cmp)
+                                                    from (1+ pos)))))
+                     (1+ pos)))
              (setq n (1- n)))
            (delete-char (- pos start) killflag)))
 
-- 
2.39.2