Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-06-14 04:21:24 +00:00
Code Issues Projects Releases Packages Wiki Activity

Change the format for adjust-marker entries in the undo-list

Browse source 
The format is now:
(apply 0 BEG END undo--adjust-weak-markers ({TPOS {(ID . OFFSET)}*}*))

This no longer exposes the hash table and creates fewer entries.  The
marker for an id can be obtained with the new function
undo--lookup-marker.

The TPOS argument is new; it's needed to test the expected marker
position.  Previously this was implicitly given by the preceding
(TEXT . POSITION) deletion entry.  As undo--adjust-weak-markers is now a
proper function this was necessary.

* lisp/simple.el (undo--adjust-weak-markers): New function.
(primitive-undo): Move the adjust-weak-marker code to
undo--adjust-weak-markers.
* src/undo.c (Qundo__adjust_weak_markers): Renamed
from Qundo__adjust_weak_marker.
(Fundo__lookup_marker): New defun.
(scrub_id_object_pairs): New helper.
(scrub_undo_list, record_marker_adjustments): Adjust for the new format.
(syms_of_undo): Register Fundo__lookup_marker.
* test/src/editfns-tests.el (delete-region-undo-markers-1)
(delete-region-undo-markers-2): Adjust form the new format.
* test/lisp/erc/erc-tests.el (erc-update-undo-list): Adjust for the new
format.
This commit is contained in:
Helmut Eller 2026-06-12 17:02:40 +02:00
parent 2a5adbb807
commit c09d1f61c9
4 changed files with 152 additions and 45 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
lisp/simple.el
View file

@ -3741,18 +3741,6 @@ Return what remains of the list."
(and (eq (marker-buffer m) (current-buffer))
(= apos m)
(push marker-adj valid-marker-adjustments))))
;; The same for weakly held markers
(while (pcase-exhaustive (car list)
(`(apply undo--adjust-weak-marker ,ht ,id ,distance)
(pop list)
(let ((m (gethash id ht)))
(when (and m
(eq (marker-buffer m) (current-buffer))
(= apos m))
(push (cons m distance)
valid-marker-adjustments)))
t)
(`,_ nil)))
;; Insert string and adjust point
(if (< pos 0)
(progn
@ -3791,6 +3779,33 @@ Return what remains of the list."
(cons (list 'apply 'cdr nil) buffer-undo-list))))
list)
;; ARGS has the format: ({TPOS {(ID . OFFSET)}* }* )
;;
;; ID is the id for a marker. The marker can be obtained with
;; undo--lookup-marker.
;;
;; OFFSET should be added to the marker's current position.
;;
;; TPOS is an integer that encodes the expected position and the
;; insertion type of the marker. The expected position is (abs TPOS)
;; and the insertion type is t if TPOS is negative. Markers that don't
;; match the expected position and insertion type are ignored.
(defun undo--adjust-weak-markers (&rest args)
(while args
(let* ((tpos (pop args))
(insertion-type (< tpos 0))
(pos (abs tpos)))
(while (consp (car args))
(let* ((pair (pop args))
(id (car pair))
(offset (cdr pair))
(m (undo--lookup-marker id)))
(when (and m
(eq (marker-buffer m) (current-buffer))
(eq (marker-insertion-type m) insertion-type)
(= pos m))
(set-marker m (+ pos offset))))))))
;; Deep copy of a list
(defun undo-copy-list (list)
"Make a copy of undo list LIST."

116
src/undo.c
View file

@ -149,6 +149,33 @@ struct weak_marker_table
static struct weak_marker_table weak_marker_table;
static Lisp_Object
scrub_id_object_pairs (Lisp_Object id_to_marker, Lisp_Object list)
{
Lisp_Object tail = list, *prev = &list;
while (CONSP (tail))
{
eassert (XFIXNUM (XCAR (tail)));
Lisp_Object *prev2 = prev;
prev = xcdr_addr (tail);
tail = XCDR (tail);
while (CONSP (tail) && CONSP (XCAR (tail)))
{
Lisp_Object id = XCAR (XCAR (tail));
if (NILP (Fgethash (id, id_to_marker, Qnil)))
*prev = XCDR (tail);
else
prev = xcdr_addr (tail);
tail = XCDR (tail);
}
if (NILP (XCDR (*prev2)) || FIXNUMP (XCAR (XCDR (*prev2))))
{
prev = prev2;
*prev = tail;
}
}
return list;
}
/* Remove (apply undo--adjust-weak-marker HASHTABLE KEY D) entries
where KEY is no longer in HASHTABLE. */
@ -159,11 +186,21 @@ scrub_undo_list (Lisp_Object list)
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
bool drop = false;
Lisp_Object entry = XCAR (tail);
if (CONSP (entry) && EQ (Qapply, XCAR (entry))
&& EQ (Qundo__adjust_weak_marker, XCAR (XCDR (entry)))
&& NILP (Fgethash (Fnth (make_fixnum (3), entry),
Fnth (make_fixnum (2), entry), Qnil)))
&& FIXNUMP (Fnth (make_fixnum (1), entry))
&& EQ (Fnth (make_fixnum (4), entry),
Qundo__adjust_weak_markers))
{
Lisp_Object htab = weak_marker_table.id_to_marker;
Lisp_Object head = Fnthcdr (make_fixnum (4), entry);
Lisp_Object pairs =
scrub_id_object_pairs (htab, XCDR (head));
XSETCDR (head, pairs);
drop = NILP (pairs);
}
if (drop)
*prev = XCDR (tail);
else
prev = xcdr_addr (tail);
@ -217,6 +254,15 @@ alloc_weak_marker_id (struct weak_marker_table *t, Lisp_Object marker)
return id;
}
DEFUN ("undo--lookup-marker", Fundo__lookup_marker, Sundo__lookup_marker,
1, 1, 0,
doc: /* Find the marker for id ID.
If the marker no longer exists, return nil. */)
(Lisp_Object id)
{
return Fgethash (id, weak_marker_table.id_to_marker, Qnil);
}
#endif
/* Record the fact that markers in the region of FROM, TO are about to
@ -230,6 +276,49 @@ record_marker_adjustments (ptrdiff_t from, ptrdiff_t to)
{
prepare_record ();
#ifdef HAVE_MPS
Lisp_Object left = Qnil;
Lisp_Object right = Qnil;
DO_MARKERS (current_buffer, m)
{
ptrdiff_t charpos = m->charpos;
eassert (charpos <= Z);
if (!(from <= charpos && charpos <= to))
continue;
ptrdiff_t delta = charpos - (m->insertion_type ? to : from);
if (delta == 0)
continue;
Lisp_Object marker = make_lisp_ptr (m, Lisp_Vectorlike);
Lisp_Object id
= alloc_weak_marker_id (&weak_marker_table, marker);
Lisp_Object offset = make_fixnum (delta);
Lisp_Object pair = Fcons (id, offset);
if (m->insertion_type)
left = Fcons (pair, left);
else
right = Fcons (pair, right);
}
END_DO_MARKERS;
if (!NILP (right) || !NILP (left))
{
Lisp_Object l
= list5 (Qapply, make_fixnum (0), make_fixnum (from),
make_fixnum (to), Qundo__adjust_weak_markers);
Lisp_Object args = Qnil;
if (!NILP (right))
args = Fcons (make_fixnum (from), right);
if (!NILP (left))
args = Fcons (make_fixnum (-to), nconc2 (left, args));
Lisp_Object entry = nconc2 (l, args);
bset_undo_list (current_buffer,
Fcons (entry,
BVAR (current_buffer, undo_list)));
}
#else
DO_MARKERS (current_buffer, m)
{
ptrdiff_t charpos = m->charpos;
@ -249,27 +338,15 @@ record_marker_adjustments (ptrdiff_t from, ptrdiff_t to)
if (adjustment)
{
Lisp_Object marker = make_lisp_ptr (m, Lisp_Vectorlike);
#ifdef HAVE_MPS
Lisp_Object id
= alloc_weak_marker_id (&weak_marker_table, marker);
Lisp_Object distance = make_fixnum (adjustment);
Lisp_Object entry
= list5 (Qapply, Qundo__adjust_weak_marker,
weak_marker_table.id_to_marker, id,
distance);
bset_undo_list (current_buffer,
Fcons (entry, BVAR (current_buffer,
undo_list)));
#else
bset_undo_list
(current_buffer,
Fcons (Fcons (marker, make_fixnum (adjustment)),
BVAR (current_buffer, undo_list)));
#endif
}
}
}
END_DO_MARKERS;
#endif
}
/* Record that a deletion is about to take place, of the characters in
@ -608,11 +685,12 @@ so it must make sure not to do a lot of consing. */);
doc: /* Non-nil means do not record `point' in `buffer-undo-list'. */);
undo_inhibit_record_point = false;
DEFSYM (Qundo__adjust_weak_marker, "undo--adjust-weak-marker");
DEFSYM (Qundo__adjust_weak_markers, "undo--adjust-weak-markers");
defsubr (&Sundo__lookup_marker);
staticpro (&weak_marker_table.id_to_marker);
staticpro (&weak_marker_table.marker_to_id);
weak_marker_table.id_to_marker
= CALLN (Fmake_hash_table, QCweakness, Qvalue);
weak_marker_table.marker_to_id
= CALLN (Fmake_hash_table, QCweakness, Qkey);
staticpro (&weak_marker_table.id_to_marker);
staticpro (&weak_marker_table.marker_to_id);
}

10
test/lisp/erc/erc-tests.el
View file

@ -3140,9 +3140,10 @@
(should
(pcase-exhaustive buffer-undo-list
(`(nil ("c" . -47)
(apply undo--adjust-weak-marker ,ht ,id -1)
(apply 0 47 48 undo--adjust-weak-markers
47 (,id . 1))
(nil face nil 46 . 47) 48 nil (45 . 48))
(eq (gethash id ht) marker))
(eq (undo--lookup-marker id) marker))
(`_ nil))))
(t
(should (equal buffer-undo-list `(nil
@ -3167,9 +3168,10 @@
(should
(pcase-exhaustive buffer-undo-list
(`(nil ("c" . -58)
(apply undo--adjust-weak-marker ,ht ,id -1)
(apply 0 47 48 undo--adjust-weak-markers
47 (,id . 1))
(nil face nil 57 . 58) 59 nil (56 . 59))
(eq (gethash id ht) marker))
(eq (undo--lookup-marker id) marker))
(`_ nil))))
(t
(should (equal buffer-undo-list `(nil

32
test/src/editfns-tests.el
View file

@ -677,14 +677,20 @@ sufficiently large to avoid truncation."
;; `garbage-collect' will also abort if it finds any reachable
;; freed objects.
(cond ((featurep 'mps)
(dolist (i '(1 2))
(should (pcase-exhaustive (nth i buffer-undo-list)
(`(apply undo--adjust-weak-marker . ,_) t)
(`,_ nil)))))
(should (pcase-exhaustive (nth 1 buffer-undo-list)
(`(apply 0 1 6 undo--adjust-weak-markers
-6 (,_ . -1) 1 (,_ . 1))
t)
(`,_ nil))))
(t
(should (eq (type-of (car (nth 1 buffer-undo-list))) 'marker))
(should (eq (type-of (car (nth 2 buffer-undo-list))) 'marker))))
(garbage-collect)))
(cond ((featurep 'mps)
(igc--collect)
(igc--process-messages)
(should (equal buffer-undo-list '(("12345" . 1)))))
(t
(garbage-collect)))))
(ert-deftest delete-region-undo-markers-2 ()
"Make sure we don't end up with freed markers reachable from Lisp."
@ -708,14 +714,20 @@ sufficiently large to avoid truncation."
;; `garbage-collect' will also abort if it finds any reachable
;; freed objects.
(cond ((featurep 'mps)
(dolist (i '(3 4))
(should (pcase-exhaustive (nth i buffer-undo-list)
(`(apply undo--adjust-weak-marker . ,_) t)
(`,_ nil)))))
(should (pcase-exhaustive (nth 2 buffer-undo-list)
(`(apply 0 1 6 undo--adjust-weak-markers
1 (,_ . 1) (,_ . 1) (,_ . 4))
t)
(`,_ nil))))
(t
(should (eq (type-of (car (nth 3 buffer-undo-list))) 'marker))
(should (eq (type-of (car (nth 4 buffer-undo-list))) 'marker))))
(garbage-collect)))
(cond ((featurep 'mps)
(igc--collect)
(igc--process-messages)
(should (equal buffer-undo-list '(("678" . 1) ("12345" . 1)))))
(t
(garbage-collect)))))
(ert-deftest format-bignum ()
(let* ((s1 "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF")