emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

scratch/fix-locked-narrowing d8438e2bb4 3/7: Add 'without-narrowing' mac


From: Gregory Heytings
Subject: scratch/fix-locked-narrowing d8438e2bb4 3/7: Add 'without-narrowing' macro
Date: Wed, 8 Feb 2023 20:49:28 -0500 (EST)

branch: scratch/fix-locked-narrowing
commit d8438e2bb44f448d1a0653321a8f262a1b6a3f2b
Author: Gregory Heytings <gregory@heytings.org>
Commit: Gregory Heytings <gregory@heytings.org>

    Add 'without-narrowing' macro
    
    * lisp/subr.el (without-narrowing): New macro, companion (and
    almost identical) to 'with-narrowing'.
---
 lisp/subr.el | 27 +++++++++++++++++++++++----
 1 file changed, 23 insertions(+), 4 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index 5cc0c94ba4..af3f1f1abd 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -3952,18 +3952,37 @@ and END limits, unless the restrictions are unlocked by 
calling
 `narrowing-unlock' with TAG.  See `narrowing-lock' for a more
 detailed description.
 
-\(fn START END [:locked TAG] BODY)"
-  (if (eq (car rest) :locked)
+\(fn START END [:label LABEL] BODY)"
+  (if (eq (car rest) :label)
       `(internal--with-narrowing ,start ,end (lambda () ,@(cddr rest))
                                  ,(cadr rest))
     `(internal--with-narrowing ,start ,end (lambda () ,@rest))))
 
-(defun internal--with-narrowing (start end body &optional tag)
+(defun internal--with-narrowing (start end body &optional label)
   "Helper function for `with-narrowing', which see."
   (save-restriction
     (progn
       (narrow-to-region start end)
-      (if tag (internal--lock-narrowing tag))
+      (if label (internal--lock-narrowing label))
+      (funcall body))))
+
+(defmacro without-narrowing (&rest rest)
+  "Execute BODY without restrictions.
+
+The current restrictions, if any, are restored upon return.
+
+\(fn [:label LABEL] BODY)"
+  (if (eq (car rest) :label)
+      `(internal--without-narrowing (lambda () ,@(cddr rest))
+                                    ,(cadr rest))
+    `(internal--without-narrowing (lambda () ,@rest))))
+
+(defun internal--without-narrowing (body &optional label)
+  "Helper function for `without-narrowing', which see."
+  (save-restriction
+    (progn
+      (if label (internal--unlock-narrowing label))
+      (widen)
       (funcall body))))
 
 (defun find-tag-default-bounds ()



reply via email to

[Prev in Thread] Current Thread [Next in Thread]