master b36fd07560f: Fix deletion of text holding `inhibit-read-only' properties

[Po Lu]

branch: master
commit b36fd07560fd12c5e819e808a6f0eb9579f77c25
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>

    Fix deletion of text holding `inhibit-read-only' properties
    
    * src/intervals.h (INTERVAL_VISIBLE_P): Split into ...
    (INTERVAL_GENERALLY_WRITABLE_P, INTERVAL_EXPRESSLY_WRITABLE_P):
    ... two new macros.
    
    * src/textprop.c (verify_interval_modification): If the buffer
    is read only, verify not that there is only a single exempting
    interval spanning the area of a multiple-character operation,
    but that every intervening interval in such an operation exempts
    it from write restrictions, either by providing a read-only
    property that appears in Vinhibit_read_only, or by providing an
    inhibit-read-only property.
    
    * test/src/textprop-tests.el (textprop-interval-immutability):
    New test.
---
 src/intervals.h            | 23 +++++++++++++--------
 src/textprop.c             | 33 +++++++++++++++++++++++-------
 test/src/textprop-tests.el | 51 ++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 92 insertions(+), 15 deletions(-)

diff --git a/src/intervals.h b/src/intervals.h
index 610c803cc77..5c6ef33a3a9 100644
--- a/src/intervals.h
+++ b/src/intervals.h
@@ -204,14 +204,21 @@ set_interval_plist (INTERVAL i, Lisp_Object plist)
 #define INTERVAL_VISIBLE_P(i) \
   (i && NILP (textget ((i)->plist, Qinvisible)))
 
-/* Is this interval writable?  Replace later with cache access.  */
-#define INTERVAL_WRITABLE_P(i)                                 \
-  (NILP (textget ((i)->plist, Qread_only))                     \
-   || !NILP (textget ((i)->plist, Qinhibit_read_only))         \
-   || ((CONSP (Vinhibit_read_only)                             \
-       ? !NILP (Fmemq (textget ((i)->plist, Qread_only),       \
-                       Vinhibit_read_only))                    \
-       : !NILP (Vinhibit_read_only))))
+/* Is this interval writable by virtue of not being marked read-only, or
+   a general value of Vinhibit_read_only?  Replace later with cache
+   access.  */
+#define INTERVAL_GENERALLY_WRITABLE_P(i, ro)                   \
+  (NILP (ro) || (!NILP (Vinhibit_read_only)                    \
+                && !CONSP (Vinhibit_read_only)))
+
+/* Is this interval writable by virtue of an explicit inhibit-read-only
+   property, or the specific presence of its Qread_only property in
+   Vinhibit_read_only?  */
+#define INTERVAL_EXPRESSLY_WRITABLE_P(i, ro)                   \
+  (!NILP (textget ((i)->plist, Qinhibit_read_only))            \
+   || (!NILP (ro)                                              \
+       && CONSP (Vinhibit_read_only)                           \
+       && !NILP (Fmemq ((ro), Vinhibit_read_only))))
 
 /* Macros to tell whether insertions before or after this interval
    should stick to it.  Now we have Vtext_property_default_nonsticky,
diff --git a/src/textprop.c b/src/textprop.c
index 7d9aae0d2c5..84d6b5f1545 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -2186,6 +2186,7 @@ verify_interval_modification (struct buffer *buf,
 {
   INTERVAL intervals = buffer_intervals (buf);
   INTERVAL i;
+  ptrdiff_t p;
   Lisp_Object hooks;
   Lisp_Object prev_mod_hooks;
   Lisp_Object mod_hooks;
@@ -2314,14 +2315,30 @@ verify_interval_modification (struct buffer *buf,
     }
   else
     {
+      bool buffer_read_only;
+
       /* Loop over intervals on or next to START...END,
         collecting their hooks.  */
 
+      /* Extent of last writable interval.  */
       i = find_interval (intervals, start);
+      p = 0;
+      buffer_read_only = (!NILP (BVAR (current_buffer, read_only))
+                         && NILP (Vinhibit_read_only));
       do
        {
-         if (! INTERVAL_WRITABLE_P (i))
-           text_read_only (textget (i->plist, Qread_only));
+         bool implied, express;
+         Lisp_Object read_only;
+
+         read_only = textget ((i)->plist, Qread_only);
+         implied = INTERVAL_GENERALLY_WRITABLE_P (i, read_only);
+         express = INTERVAL_EXPRESSLY_WRITABLE_P (i, read_only);
+         if (!implied && !express)
+           text_read_only (read_only);
+         /* If this interval is only implicitly read only and the
+            buffer is read only as a whole, signal an error.  */
+         else if (!express && buffer_read_only)
+           xsignal1 (Qbuffer_read_only, Fcurrent_buffer ());
 
          if (!inhibit_modification_hooks)
            {
@@ -2333,16 +2350,18 @@ verify_interval_modification (struct buffer *buf,
                }
            }
 
-         if (i->position + LENGTH (i) < end
-             && (!NILP (BVAR (current_buffer, read_only))
-                 && NILP (Vinhibit_read_only)))
-           xsignal1 (Qbuffer_read_only, Fcurrent_buffer ());
-
+         p = i->position + LENGTH (i);
          i = next_interval (i);
        }
       /* Keep going thru the interval containing the char before END.  */
       while (i && i->position < end);
 
+      /* Should the buffer be read only while the last interval with an
+        `inhibit-read-only' property does not enclose the entire change
+        under consideration, signal error.  */
+      if (p < end && buffer_read_only)
+       xsignal1 (Qbuffer_read_only, Fcurrent_buffer ());
+
       if (!inhibit_modification_hooks)
        {
          hooks = Fnreverse (hooks);
diff --git a/test/src/textprop-tests.el b/test/src/textprop-tests.el
index d728b539955..7c2aa13bb34 100644
--- a/test/src/textprop-tests.el
+++ b/test/src/textprop-tests.el
@@ -68,5 +68,56 @@
     (should (and (equal-including-properties (pop stack) string)
                 (null stack)))))
 
+(ert-deftest textprop-interval-immutability ()
+  "Test modification of text with properties affecting mutability."
+  (let ((template (concat
+                   (propertize "12345" 'inhibit-read-only t) ; 1-5
+                   (propertize "67890" 'read-only 'abcdefg)  ; 6-10
+                   (propertize "ABCDE" 'inhibit-read-only t) ; 11-15
+                   (propertize "FGHIJ" 'inhibit-read-only 'yes) ; 16-20
+                   "KLMNO" ; 21-25
+                   (propertize "PQRST" 'inhibit-read-only 't) ; 26-30
+                   (propertize "UVWXYZ" 'read-only 'not-suppressed)))
+        inhibit-read-only)
+    (with-temp-buffer
+      (insert template)
+      (setq buffer-read-only t)
+      ;; Delete an entire inhibit-read-only region.
+      (progn (should (equal (delete-and-extract-region 1 6)
+                            "12345"))
+             (let ((inhibit-read-only t)) (erase-buffer)
+                  (insert template)))
+      ;; Delete multiple characters inside an inhibit-read-only section.
+      (progn (should (equal (delete-and-extract-region 2 5)
+                            "234"))
+             (let ((inhibit-read-only t)) (erase-buffer)
+                  (insert template)))
+      ;; Attempt to delete characters across both an inhibit-read-only
+      ;; and a read only region.
+      (setq buffer-read-only nil)
+      (should-error (delete-and-extract-region 4 7))
+      (setq inhibit-read-only '(abcdefg))
+      ;; Attempt the same, but with the read-only property of the second
+      ;; section suppressed.
+      (progn (should (equal (delete-and-extract-region 4 7) "456"))
+             (let ((inhibit-read-only t)) (erase-buffer)
+                  (insert template)))
+      (setq buffer-read-only t)
+      ;; Delete text across the suppressed read-only region and two
+      ;; other inhibit-read-only regions each with distinct intervals.
+      (progn (should (equal (delete-and-extract-region 7 17)
+                            "7890ABCDEF"))
+             (let ((inhibit-read-only t)) (erase-buffer)
+                  (insert template)))
+      (setq inhibit-read-only nil)
+      ;; Attempt to delete text spanning two inhibit-read-only sections
+      ;; separated by immutable text.
+      (should-error (delete-and-extract-region 17 27))
+      (setq inhibit-read-only '(abcdefg))
+      ;; Attempt to delete text from the start of an inhibit-read-only
+      ;; section extending into protected text exempt from
+      ;; `inhibit-read-only''s influence towards the end of the buffer.
+      (should-error (delete-and-extract-region 26 37)))))
+
 (provide 'textprop-tests)
 ;;; textprop-tests.el ends here