[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 ()
- branch scratch/fix-locked-narrowing created (now 2956e54b1d), Gregory Heytings, 2023/02/08
- scratch/fix-locked-narrowing a4aa32bdff 1/7: Fix 'save-restriction' for narrowing locks, Gregory Heytings, 2023/02/08
- scratch/fix-locked-narrowing 0d73e4aa26 4/7: Add specific symbols for narrowings, Gregory Heytings, 2023/02/08
- scratch/fix-locked-narrowing d8438e2bb4 3/7: Add 'without-narrowing' macro,
Gregory Heytings <=
- scratch/fix-locked-narrowing 97314447e6 2/7: Make 'narrowing-lock' and 'narrowing-unlock' internal, Gregory Heytings, 2023/02/08
- scratch/fix-locked-narrowing 2956e54b1d 7/7: Add an extensive test for labeled (locked) narrowing, Gregory Heytings, 2023/02/08
- scratch/fix-locked-narrowing a6cd4553d4 5/7: Rename two long line optimizations variables, Gregory Heytings, 2023/02/08
- scratch/fix-locked-narrowing 79ce185ad1 6/7: Update the documentation about labeled (locked) narrowing, Gregory Heytings, 2023/02/08