summaryrefslogtreecommitdiff
path: root/lisp/subr.el
diff options
context:
space:
mode:
authorGregory Heytings <gregory@heytings.org>2022-11-25 21:43:48 +0000
committerGregory Heytings <gregory@heytings.org>2022-11-25 22:44:14 +0100
commita24652403951751b0bb7ed41033d3414a888310a (patch)
treed09866d0bf648efb658ff69cd85f639096f69bf1 /lisp/subr.el
parent9dee6df39cd14be78ff96cb24169842f4772488a (diff)
downloademacs-a24652403951751b0bb7ed41033d3414a888310a.tar.gz
emacs-a24652403951751b0bb7ed41033d3414a888310a.tar.bz2
emacs-a24652403951751b0bb7ed41033d3414a888310a.zip
Generic 'with-narrowing' macro.
* lisp/subr.el (with-narrowing): New generic macro, replacing the 'with-locked-narrowing' one. Suggested by Stefan Monnier. (with-narrowing-1, with-narrowing-2): Helper functions.
Diffstat (limited to 'lisp/subr.el')
-rw-r--r--lisp/subr.el47
1 files changed, 31 insertions, 16 deletions
diff --git a/lisp/subr.el b/lisp/subr.el
index 196e7f881b6..3e71f6f4edb 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -3935,25 +3935,40 @@ See also `locate-user-emacs-file'.")
"Return non-nil if the current buffer is narrowed."
(/= (- (point-max) (point-min)) (buffer-size)))
-(defmacro with-locked-narrowing (start end tag &rest body)
- "Execute BODY with restrictions set to START and END and locked with TAG.
-
-Inside BODY, `narrow-to-region' and `widen' can be used only
-within the START and END limits, unless the restrictions are
-unlocked by calling `narrowing-unlock' with TAG. See
-`narrowing-lock' for a more detailed description. The current
-restrictions, if any, are restored upon return."
- `(with-locked-narrowing-1 ,start ,end ,tag (lambda () ,@body)))
-
-(defun with-locked-narrowing-1 (start end tag body)
- "Helper function for `with-locked-narrowing', which see."
+(defmacro with-narrowing (start end &rest rest)
+ "Execute BODY with restrictions set to START and END.
+
+The current restrictions, if any, are restored upon return.
+
+With the optional :locked TAG argument, inside BODY,
+`narrow-to-region' and `widen' can be used only within the START
+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)
+ `(with-narrowing-1 ,start ,end ,(cadr rest)
+ (lambda () ,@(cddr rest)))
+ `(with-narrowing-2 ,start ,end
+ (lambda () ,@rest))))
+
+(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))))
+ (narrow-to-region start end)
+ (narrowing-lock tag)
+ (funcall body))
+ (narrowing-unlock tag))))
+
+(defun with-narrowing-2 (start end body)
+ "Helper function for `with-narrowing', which see."
+ (save-restriction
+ (progn
+ (narrow-to-region start end)
+ (funcall body))))
(defun find-tag-default-bounds ()
"Determine the boundaries of the default tag, based on text at point.