From 16b8b0d1e07d394e01f76d9eed6006219b4d745b Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Sat, 26 Nov 2022 00:14:15 +0000 Subject: [PATCH] Save and restore narrowing locks in 'save-restriction'. * src/editfns.c: (Fsave_restriction): Save and restore narrowing locks. Suggested by Stefan Monnier. (narrowing_locks_save, narrowing_locks_restore): Helper functions. * lisp/subr.el (with-narrowing-1): Simplify. --- lisp/subr.el | 10 ++++------ src/editfns.c | 31 +++++++++++++++++++++++++++++++ 2 files changed, 35 insertions(+), 6 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index 3e71f6f4edb..b83805e8986 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3956,12 +3956,10 @@ detailed description. (defun with-narrowing-1 (start end tag body) "Helper function for `with-narrowing', which see." (save-restriction - (unwind-protect - (progn - (narrow-to-region start end) - (narrowing-lock tag) - (funcall body)) - (narrowing-unlock tag)))) + (progn + (narrow-to-region start end) + (narrowing-lock tag) + (funcall body)))) (defun with-narrowing-2 (start end body) "Helper function for `with-narrowing', which see." diff --git a/src/editfns.c b/src/editfns.c index 9c81d9c723f..f73331fb53c 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2760,6 +2760,36 @@ reset_outermost_narrowings (void) } } +/* Helper functions to save and restore the narrowing locks of the + current buffer in save-restriction. */ +static Lisp_Object +narrowing_locks_save (void) +{ + Lisp_Object buf = Fcurrent_buffer (); + Lisp_Object locks = assq_no_quit (buf, narrowing_locks); + if (NILP (locks)) + return Qnil; + locks = Fcar (Fcdr (locks)); + return Fcons (buf, Fcopy_sequence (locks)); +} + +static void +narrowing_locks_restore (Lisp_Object buf_and_saved_locks) +{ + if (NILP (buf_and_saved_locks)) + return; + Lisp_Object buf = Fcar (buf_and_saved_locks); + eassert (BUFFERP (buf)); + Lisp_Object saved_locks = Fcdr (buf_and_saved_locks); + eassert (! NILP (saved_locks)); + Lisp_Object current_locks = assq_no_quit (buf, narrowing_locks); + if (! NILP (current_locks)) + narrowing_locks = Fdelq (Fassoc (buf, narrowing_locks, Qnil), + narrowing_locks); + narrowing_locks = nconc2 (list1 (list2 (buf, saved_locks)), + narrowing_locks); +} + static void unwind_narrow_to_region_locked (Lisp_Object tag) { @@ -3050,6 +3080,7 @@ usage: (save-restriction &rest BODY) */) specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect (save_restriction_restore, save_restriction_save ()); + record_unwind_protect (narrowing_locks_restore, narrowing_locks_save ()); val = Fprogn (body); return unbind_to (count, val); } -- 2.39.2