Subject: bug#79200: 31.0.50; Duplicated elements for '#<marker at' in buffer-undo-list

From: Gerd Möllmann <[email-masked]>
Date: Tue, 12 Aug 2025 16:08:24 +0200

Gerd Möllmann <[email-masked]> writes:

> Let's see what the others think about such a plan. 

Please find attached a patch which gives an impression what that could
look like. Entirely untested of course, plus for my Emacs, which has a
different marker implementation, plus I'm not certain which other Lisp
or C could be affected by such a change.

>From f67933803031460bee7db7be4dcd8e0b60c0bce9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gerd=20M=C3=B6llmann?= <[email-masked]>
Date: Tue, 12 Aug 2025 15:58:54 +0200
Subject: [PATCH] Use adjust-marker entries in undo-lists

* src/alloc.c (next_marker_id): Return the next marker id to use.
(Fmake_marker, build_marker): Assign ids to markers.
* src/lisp.h (Lisp_Marker): Add id member.
* src/marker-vector.c (marker_vector_adjust_for_replace): New function.
* src/marker-vector.h: Declare it.
* src/marker.c (Fmarker_id): New DEFUN.
(Fmarker_with_id): New DEFUN.
(syms_of_marker): defsubr new DEFUNs
* src/pdumper.c (dump_marker): Dump marker id as negative number.
* src/undo.c (record_marker_adjustments): Produce adust-marker entries.
(syms_of_undo): New DEFSYM.
* lisp/simple.el (primitive-undo): Use adjust-marker entries.
---
 lisp/simple.el      | 17 ++++++++++-------
 src/alloc.c         |  9 +++++++++
 src/lisp.h          |  2 ++
 src/marker-vector.c | 11 +++++++++++
 src/marker-vector.h |  3 +++
 src/marker.c        | 22 ++++++++++++++++++++++
 src/pdumper.c       |  2 ++
 src/undo.c          |  5 +++--
 8 files changed, 62 insertions(+), 9 deletions(-)

diff --git a/lisp/simple.el b/lisp/simple.el
index 9d6feeecfe6..49034518d08 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -3740,13 +3740,16 @@ primitive-undo
              ;; the markers haven't moved.  We check their validity
              ;; before reinserting the string so as we don't need to
              ;; mind marker insertion-type.
-             (while (and (markerp (car-safe (car list)))
-                         (integerp (cdr-safe (car list))))
-               (let* ((marker-adj (pop list))
-                      (m (car marker-adj)))
-                 (and (eq (marker-buffer m) (current-buffer))
-                      (= apos m)
-                      (push marker-adj valid-marker-adjustments))))
+             (while (eq 'adjust-marker (car-safe (car list)))
+               (let* ((entry (cdr-safe (car list)))
+                      (id (car entry))
+                      (offset (cdr entry))
+                      (marker (marker-with-id id)))
+                 (pop list)
+                 (when (and marker
+                            (eq (marker-buffer marker) (current-buffer))
+                            (= apos marker))
+                   (push (cons marker offset) valid-marker-adjustments))))
              ;; Insert string and adjust point
              (if (< pos 0)
                  (progn
diff --git a/src/alloc.c b/src/alloc.c
index 07272c6c373..3ab0b5357c1 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3944,12 +3944,20 @@ build_overlay (bool front_advance, bool rear_advance,
   return overlay;
 }
 
+static ptrdiff_t
+next_marker_id (void)
+{
+  static ptrdiff_t next = 0;
+  return next++;
+}
+
 DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0,
        doc: /* Return a newly allocated marker which does not point at any place.  */)
   (void)
 {
   struct Lisp_Marker *p = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Marker,
 						       PVEC_MARKER);
+  p->id = next_marker_id ();
   p->buffer = 0;
   p->entry = 0;
   p->insertion_type = 0;
@@ -3968,6 +3976,7 @@ build_marker (struct buffer *buf, ptrdiff_t charpos)
 
   struct Lisp_Marker *m = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Marker,
 						       PVEC_MARKER);
+  m->id = next_marker_id ();
   m->buffer = buf;
   m->insertion_type = 0;
   m->need_adjustment = 0;
diff --git a/src/lisp.h b/src/lisp.h
index a0ce6e4dc13..9120001e654 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3074,6 +3074,8 @@ knuth_hash (hash_hash_t hash, unsigned bits)
 {
   struct vectorlike_header header;
 
+  ptrdiff_t id;
+
   /* This is the buffer that the marker points into, or 0 if it points nowhere.
      Note: a chain of markers can contain markers pointing into different
      buffers (the chain is per buffer_text rather than per buffer, so it's
diff --git a/src/marker-vector.c b/src/marker-vector.c
index b8a87d72d86..0e1d80a3b86 100644
--- a/src/marker-vector.c
+++ b/src/marker-vector.c
@@ -375,3 +375,14 @@ marker_vector_adjust_for_replace (struct buffer *b,
 	CHARPOS (v, m->entry) = make_fixnum (from_charpos);
     }
 }
+
+struct Lisp_Marker *
+marker_vector_marker_with_id (struct buffer *b, ptrdiff_t id)
+{
+  FOR_EACH_MARKER (b, m)
+    {
+      if (id == m->id)
+	return m;
+    }
+  return NULL;
+}
diff --git a/src/marker-vector.h b/src/marker-vector.h
index 6a0ee8a9507..3410c18947f 100644
--- a/src/marker-vector.h
+++ b/src/marker-vector.h
@@ -102,5 +102,8 @@ #define FOR_EACH_MARKER(b, m) \
 void marker_vector_adjust_for_replace (struct buffer *b, ptrdiff_t from,
 				       ptrdiff_t old_chars, ptrdiff_t new_chars);
 ptrdiff_t marker_vector_last_charpos (const struct Lisp_Marker *m);
+struct Lisp_Marker *
+marker_vector_marker_with_id (struct buffer *b, ptrdiff_t id);
+
 
 #endif /* EMACS_MARKER_VECTOR_H */
diff --git a/src/marker.c b/src/marker.c
index e36c05d0f2e..2e8fd1164fa 100644
--- a/src/marker.c
+++ b/src/marker.c
@@ -101,6 +101,26 @@ buf_bytepos_to_charpos (struct buffer *b, ptrdiff_t bytepos)
 
 /* Operations on markers.  */
 
+DEFUN ("marker-id", Fmarker_id, Smarker_id, 1, 1, 0,
+       doc: /* Return the id of MARKER.  */)
+  (Lisp_Object marker)
+{
+  CHECK_MARKER (marker);
+  return make_fixnum (XMARKER (marker)->id);
+}
+
+DEFUN ("marker-with-id", Fmarker_with_id, Smarker_with_id, 1, 1, 0,
+       doc: /* Return the marker in the current buffer with id ID.
+Value is nil if no such marker exists.  */)
+  (Lisp_Object id)
+{
+  CHECK_FIXNUM (id);
+  struct Lisp_Marker *m = marker_vector_marker_with_id (current_buffer, XFIXNUM (id));
+  if (m == NULL)
+    return Qnil;
+  return make_lisp_ptr (m, Lisp_Vectorlike);
+}
+
 DEFUN ("marker-buffer", Fmarker_buffer, Smarker_buffer, 1, 1, 0,
        doc: /* Return the buffer that MARKER points into, or nil if none.
 Returns nil if MARKER points into a dead buffer.  */)
@@ -463,6 +483,8 @@ syms_of_marker (void)
 {
   defsubr (&Smarker_position);
   defsubr (&Smarker_last_position);
+  defsubr (&Smarker_id);
+  defsubr (&Smarker_with_id);
   defsubr (&Smarker_buffer);
   defsubr (&Sset_marker);
   defsubr (&Scopy_marker);
diff --git a/src/pdumper.c b/src/pdumper.c
index 92bc3089267..b9583a69b3d 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2228,6 +2228,8 @@ dump_marker (struct dump_context *ctx, const struct Lisp_Marker *marker)
   dump_pseudovector_lisp_fields (ctx, &out->header, &marker->header);
   DUMP_FIELD_COPY (out, marker, need_adjustment);
   DUMP_FIELD_COPY (out, marker, insertion_type);
+  DUMP_FIELD_COPY (out, marker, id);
+  out->id *= -1;
   if (marker->buffer)
     {
       dump_field_lv_rawptr (ctx, out, marker, &marker->buffer,
diff --git a/src/undo.c b/src/undo.c
index aa05a9aee14..9f07ac5d4b6 100644
--- a/src/undo.c
+++ b/src/undo.c
@@ -146,10 +146,10 @@ record_marker_adjustments (ptrdiff_t from, ptrdiff_t to)
 
           if (adjustment)
             {
-	      Lisp_Object marker = make_lisp_ptr (m, Lisp_Vectorlike);
+	      Lisp_Object id = make_fixnum (m->id);
               bset_undo_list
                 (current_buffer,
-                 Fcons (Fcons (marker, make_fixnum (adjustment)),
+                 Fcons (Fcons (Qadjust_marker, Fcons (id, make_fixnum (adjustment))),
                         BVAR (current_buffer, undo_list)));
             }
         }
@@ -432,6 +432,7 @@ syms_of_undo (void)
 
   /* Marker for function call undo list elements.  */
   DEFSYM (Qapply, "apply");
+  DEFSYM (Qadjust_marker, "adjust_marker");
 
   pending_boundary = Qnil;
   staticpro (&pending_boundary);
-- 
2.50.1