feature/improved-locked-narrowing 16b8b0d1e0: Save and restore narrowing locks in 'save-restriction'.

[Gregory Heytings]

branch: feature/improved-locked-narrowing
commit 16b8b0d1e07d394e01f76d9eed6006219b4d745b
Author: Gregory Heytings <gregory@heytings.org>
Commit: Gregory Heytings <gregory@heytings.org>

    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 3e71f6f4ed..b83805e898 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 9c81d9c723..f73331fb53 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);
 }