Allow <Delete> key to delete entire grapheme clusters

* lisp/simple.el (delete-forward-char): If deleting forward,
delete complete grapheme clusters as single units.

* etc/NEWS: Announce the change.

etc/NEWS

@@ -119,6 +119,16 @@ This is to open up the 'C-x 8 .' map to bind further characters there.
 This is for compatibility with the shell versions of these commands,
 which don't handle options like '--help' in any special way.
 
+---
+** The 'delete-forward-char' command now deletes by grapheme clusters.
+This command is by default bound to the <Delete> function key
+(a.k.a. <deletechar>).  When invoked without a prefix argument or with
+a positive prefix numeric argument, the command will now delete
+complete grapheme clusters produced by character composition.  For
+example, if point is before an Emoji sequence, pressing <Delete> will
+delete the entire sequence, not just a single character at its
+beginning.
+
 
 * Changes in Emacs 29.1
 

lisp/simple.el

@@ -1292,6 +1292,11 @@ If Transient Mark mode is enabled, the mark is active, and N is 1,
 delete the text in the region and deactivate the mark instead.
 To disable this, set variable `delete-active-region' to nil.
 
+If N is positive, characters composed into a single grapheme cluster
+count as a single character and are deleted together.  Thus,
+\"\\[universal-argument] 2 \\[delete-forward-char]\" when two grapheme clusters follow point will
+delete the characters composed into both of the grapheme clusters.
+
 Optional second arg KILLFLAG non-nil means to kill (save in kill
 ring) instead of delete.  If called interactively, a numeric
 prefix argument specifies N, and KILLFLAG is also set if a prefix
@@ -1312,6 +1317,21 @@ the actual saved text might be different from what was killed."
 	     (kill-region (region-beginning) (region-end) 'region)
 	   (funcall region-extract-function 'delete-only)))
 
+	;; For forward deletion, treat composed characters as a single
+	;; character to delete.
+        ((>= n 1)
+         (let ((pos (point))
+               start cmp)
+           (setq start pos)
+           (while (> n 0)
+             ;; 'find-composition' will return (FROM TO ....) or nil.
+             (setq cmp (find-composition pos))
+             (if cmp
+                 (setq pos (cadr cmp))
+               (setq pos (1+ pos)))
+             (setq n (1- n)))
+           (delete-char (- pos start) killflag)))
+
 	;; Otherwise, do simple deletion.
 	(t (delete-char n killflag))))