feature/improved-locked-narrowing a246524039: Generic 'with-narrowing' macro.

[Gregory Heytings]

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

    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.
---
 lisp/subr.el | 47 +++++++++++++++++++++++++++++++----------------
 1 file changed, 31 insertions(+), 16 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index 196e7f881b..3e71f6f4ed 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.