compat-31: New function remove-display-text-property

5 files changed, 126 insertions, 41 deletions

diff --git a/NEWS.org b/NEWS.org
index 086de05..fd34cdc 100644
--- a/NEWS.org
+++ b/NEWS.org
@@ -16,6 +16,7 @@
 - compat-31: New function =unbuttonize-region=.
 - compat-31: New extended function =seconds-to-string=.
 - compat-31: New function =hash-table-contains-p=.
+- compat-31: New function =remove-display-text-property=.
 - Drop support for Emacs 24.x. Emacs 25.1 is required now. In case
   Emacs 24.x support is still needed, Compat 30 can be used.
 
diff --git a/compat-29.el b/compat-29.el
index a0831e6..b6ab5f0 100644
--- a/compat-29.el
+++ b/compat-29.el
@@ -584,47 +584,15 @@ be marked unmodified, effectively ignoring those changes."
                         (equal ,hash (buffer-hash)))
                (restore-buffer-modified-p nil))))))))
 
-(compat-defun add-display-text-property (start end prop value ;; <compat-tests:add-display-text-property>
-                                               &optional object)
-  "Add display property PROP with VALUE to the text from START to END.
-If any text in the region has a non-nil `display' property, those
-properties are retained.
-
-If OBJECT is non-nil, it should be a string or a buffer.  If nil,
-this defaults to the current buffer."
-  (let ((sub-start start)
-        (sub-end 0)
-        disp)
-    (while (< sub-end end)
-      (setq sub-end (next-single-property-change sub-start 'display object
-                                                 (if (stringp object)
-                                                     (min (length object) end)
-                                                   (min end (point-max)))))
-      (if (not (setq disp (get-text-property sub-start 'display object)))
-          ;; No old properties in this range.
-          (put-text-property sub-start sub-end 'display (list prop value)
-                             object)
-        ;; We have old properties.
-        (let ((vector nil))
-          ;; Make disp into a list.
-          (setq disp
-                (cond
-                 ((vectorp disp)
-                  (setq vector t)
-                  (append disp nil))
-                 ((not (consp (car disp)))
-                  (list disp))
-                 (t
-                  disp)))
-          ;; Remove any old instances.
-          (when-let ((old (assoc prop disp)))
-            (setq disp (delete old disp)))
-          (setq disp (cons (list prop value) disp))
-          (when vector
-            (setq disp (vconcat disp)))
-          ;; Finally update the range.
-          (put-text-property sub-start sub-end 'display disp object)))
-      (setq sub-start sub-end))))
+(compat-defun add-display-text-property (start end spec value &optional object) ;; <compat-tests:add-display-text-property>
+  "Add the display specification (SPEC VALUE) to the text from START to END.
+If any text in the region has a non-nil `display' property, the existing
+display specifications are retained.
+
+OBJECT is either a string or a buffer to add the specification to.
+If omitted, OBJECT defaults to the current buffer."
+  (declare-function add-remove--display-text-property "compat-31")
+  (add-remove--display-text-property start end spec value object))
 
 (compat-defmacro while-let (spec &rest body) ;; <compat-tests:while-let>
   "Bind variables according to SPEC and conditionally evaluate BODY.
diff --git a/compat-31.el b/compat-31.el
index e27ef0f..fc5b487 100644
--- a/compat-31.el
+++ b/compat-31.el
@@ -232,6 +232,71 @@ METADATA should be an alist of completion metadata.  See
 
 ;;;; Defined in subr-x.el
 
+(compat-defun add-remove--display-text-property (start end spec value &optional object remove)  ;; <compat-tests:add-display-text-property>
+  "Helper function for `add-display-text-property' and `remove-display-text-property'."
+  (let ((sub-start start)
+        (sub-end 0)
+        (limit (if (stringp object)
+                   (min (length object) end)
+                 (min end (point-max))))
+        disp)
+    (while (< sub-end end)
+      (setq sub-end (next-single-property-change sub-start 'display object
+                                                 limit))
+      (if (not (setq disp (get-text-property sub-start 'display object)))
+          ;; No old properties in this range.
+          (unless remove
+            (put-text-property sub-start sub-end 'display (list spec value)
+                               object))
+        ;; We have old properties.
+        (let ((changed nil)
+              type)
+          ;; Make disp into a list.
+          (setq disp
+                (cond
+                 ((vectorp disp)
+                  (setq type 'vector)
+                  (seq-into disp 'list))
+                 ((or (not (consp (car-safe disp)))
+                      ;; If disp looks like ((margin ...) ...), that's
+                      ;; still a single display specification.
+                      (eq (caar disp) 'margin))
+                  (setq type 'scalar)
+                  (list disp))
+                 (t
+                  (setq type 'list)
+                  disp)))
+          ;; Remove any old instances.
+          (when-let* ((old (assoc spec disp)))
+            ;; If the property value was a list, don't modify the
+            ;; original value in place; it could be used by other
+            ;; regions of text.
+            (setq disp (if (eq type 'list)
+                           (remove old disp)
+                         (delete old disp))
+                  changed t))
+          (unless remove
+            (setq disp (cons (list spec value) disp)
+                  changed t))
+          (when changed
+            (if (not disp)
+                (remove-text-properties sub-start sub-end '(display nil) object)
+              (when (eq type 'vector)
+                (setq disp (seq-into disp 'vector)))
+              ;; Finally update the range.
+              (put-text-property sub-start sub-end 'display disp object)))))
+      (setq sub-start sub-end))))
+
+(compat-defun remove-display-text-property (start end spec &optional object) ;; <compat-tests:remove-display-text-property>
+  "Remove the display specification SPEC from the text from START to END.
+SPEC is the car of the display specification to remove, e.g. `height'.
+If any text in the region has other display specifications, those specs
+are retained.
+
+OBJECT is either a string or a buffer to remove the specification from.
+If omitted, OBJECT defaults to the current buffer."
+  (add-remove--display-text-property start end spec nil object 'remove))
+
 (compat-defvar work-buffer--list nil ;; <compat-tests:with-work-buffer>
   "List of work buffers.")
 
diff --git a/compat-tests.el b/compat-tests.el
index d9de74a..f07bed9 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -485,6 +485,18 @@
                      4 8 (display ((raise 0.5) (height 2.0)))
                      8 12 (display (raise 0.5))))))
 
+(ert-deftest compat-remove-display-text-property ()
+  (with-temp-buffer
+    (insert "Foo bar zot gazonk")
+    (add-display-text-property 4 12 'height 2.0)
+    (add-display-text-property 2 8 'raise 0.5)
+    (remove-display-text-property 6 10 'height)
+    (should-equal (get-text-property 2 'display) '(raise 0.5))
+    (should-equal (get-text-property 11 'display) '(height 2.0))
+    (should-equal (get-text-property 5 'display)
+                  '((raise 0.5) (height 2.0)))
+    (should-not (get-text-property 9 'display))))
+
 (ert-deftest compat-line-number-at-pos ()
   (with-temp-buffer
     (insert "\n\n\n")
diff --git a/compat.texi b/compat.texi
index d9f9358..ee4f07e 100644
--- a/compat.texi
+++ b/compat.texi
@@ -3452,6 +3452,45 @@ older than 31.1.  Note that due to upstream changes, it might happen
 that there will be the need for changes, so use these functions with
 care.
 
+@c copied from lispref/display.texi
+@defun remove-display-text-property start end spec &optional object
+Remove the display specification @var{spec} from the text from
+@var{start} to @var{end}.  @var{spec} is the @sc{car} of the display
+specification to remove, e.g.@: @code{height} or @code{'(margin nil)}.
+
+If any text in the region has any other @code{display} properties, those
+properties are retained.  For instance:
+
+@lisp
+@group
+(add-display-text-property 1 8 'raise 0.5)
+(add-display-text-property 4 8 'height 2.0)
+(remove-display-text-property 2 6 'raise)
+@end group
+@end lisp
+
+After doing this, the text will have the following @code{display}
+properties:
+
+@itemize @bullet
+@item
+The region from 1 to 2, only @code{raise}
+
+@item
+The region from 2 to 4, no properties
+
+@item
+The region from 4 to 6, only @code{height}
+
+@item
+The region from 6 to 8, both @code{raise} and @code{height}
+
+@end itemize
+
+@var{object} is either a string or a buffer to remove the specification
+from. If omitted, @var{object} defaults to the current buffer.
+@end defun
+
 @c based on lisp/subr.el
 @defmac hash-table-contains-p key table
 Return non-nil if @var{table} has an element with @var{key}.