aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGregory Heytings2022-11-26 22:38:12 +0000
committerGregory Heytings2022-11-26 23:38:40 +0100
commit321d4e61551a0f6dfb1abfc0b54e6177735bde58 (patch)
treea774e7961eb13fae476ad678201f654e586c1d37
parent1bf0b72eb758440bc4571ebcb49ef0a59f37e51a (diff)
downloademacs-321d4e61551a0f6dfb1abfc0b54e6177735bde58.tar.gz
emacs-321d4e61551a0f6dfb1abfc0b54e6177735bde58.zip
Minor improvements for locked narrowing
* src/editfns.c (narrowing_lock_pop): Clarify comment, replace assertion by return. (narrowing_locks_restore): Add comments. * lisp/subr.el (with-narrowing, internal--with-narrowing): Simplify, use a single helper function with an optional argument.
-rw-r--r--lisp/subr.el18
-rw-r--r--src/editfns.c10
2 files changed, 13 insertions, 15 deletions
diff --git a/lisp/subr.el b/lisp/subr.el
index b83805e8986..3d5efec761c 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -3948,24 +3948,16 @@ detailed description.
3948 3948
3949\(fn START END [:locked TAG] BODY)" 3949\(fn START END [:locked TAG] BODY)"
3950 (if (eq (car rest) :locked) 3950 (if (eq (car rest) :locked)
3951 `(with-narrowing-1 ,start ,end ,(cadr rest) 3951 `(internal--with-narrowing ,start ,end (lambda () ,@(cddr rest))
3952 (lambda () ,@(cddr rest))) 3952 ,(cadr rest))
3953 `(with-narrowing-2 ,start ,end 3953 `(internal--with-narrowing ,start ,end (lambda () ,@rest))))
3954 (lambda () ,@rest))))
3955 3954
3956(defun with-narrowing-1 (start end tag body) 3955(defun internal--with-narrowing (start end body &optional tag)
3957 "Helper function for `with-narrowing', which see."
3958 (save-restriction
3959 (progn
3960 (narrow-to-region start end)
3961 (narrowing-lock tag)
3962 (funcall body))))
3963
3964(defun with-narrowing-2 (start end body)
3965 "Helper function for `with-narrowing', which see." 3956 "Helper function for `with-narrowing', which see."
3966 (save-restriction 3957 (save-restriction
3967 (progn 3958 (progn
3968 (narrow-to-region start end) 3959 (narrow-to-region start end)
3960 (if tag (narrowing-lock tag))
3969 (funcall body)))) 3961 (funcall body))))
3970 3962
3971(defun find-tag-default-bounds () 3963(defun find-tag-default-bounds ()
diff --git a/src/editfns.c b/src/editfns.c
index 5bfb0b86d14..e99a007a70c 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -2712,12 +2712,14 @@ narrowing_lock_push (Lisp_Object buf, Lisp_Object lock)
2712 XCAR (XCDR (buffer_locks))))); 2712 XCAR (XCDR (buffer_locks)))));
2713} 2713}
2714 2714
2715/* Remove the innermost lock in BUF from the narrowing_lock alist. */ 2715/* Remove the innermost lock in BUF from the narrowing_lock alist.
2716 Do nothing if BUF is not in narrowing_lock. */
2716static void 2717static void
2717narrowing_lock_pop (Lisp_Object buf) 2718narrowing_lock_pop (Lisp_Object buf)
2718{ 2719{
2719 Lisp_Object buffer_locks = assq_no_quit (buf, narrowing_locks); 2720 Lisp_Object buffer_locks = assq_no_quit (buf, narrowing_locks);
2720 eassert (! NILP (buffer_locks)); 2721 if (NILP (buffer_locks))
2722 return;
2721 if (EQ (narrowing_lock_peek_tag (buf), Qoutermost_narrowing)) 2723 if (EQ (narrowing_lock_peek_tag (buf), Qoutermost_narrowing))
2722 narrowing_locks = Fdelq (Fassoc (buf, narrowing_locks, Qnil), 2724 narrowing_locks = Fdelq (Fassoc (buf, narrowing_locks, Qnil),
2723 narrowing_locks); 2725 narrowing_locks);
@@ -2779,8 +2781,12 @@ narrowing_locks_restore (Lisp_Object buf_and_saved_locks)
2779 if (NILP (buf_and_saved_locks)) 2781 if (NILP (buf_and_saved_locks))
2780 return; 2782 return;
2781 Lisp_Object buf = XCAR (buf_and_saved_locks); 2783 Lisp_Object buf = XCAR (buf_and_saved_locks);
2784 /* This cannot fail when buf_and_saved_locks was returned by
2785 narrowing_locks_save. */
2782 eassert (BUFFERP (buf)); 2786 eassert (BUFFERP (buf));
2783 Lisp_Object saved_locks = XCDR (buf_and_saved_locks); 2787 Lisp_Object saved_locks = XCDR (buf_and_saved_locks);
2788 /* This cannot fail when buf_and_saved_locks was returned by
2789 narrowing_locks_save. */
2784 eassert (! NILP (saved_locks)); 2790 eassert (! NILP (saved_locks));
2785 Lisp_Object current_locks = assq_no_quit (buf, narrowing_locks); 2791 Lisp_Object current_locks = assq_no_quit (buf, narrowing_locks);
2786 if (! NILP (current_locks)) 2792 if (! NILP (current_locks))