diff options
| -rw-r--r-- | NEWS.org | 1 | ||||
| -rw-r--r-- | compat-29.el | 50 | ||||
| -rw-r--r-- | compat-31.el | 65 | ||||
| -rw-r--r-- | compat-tests.el | 12 | ||||
| -rw-r--r-- | compat.texi | 39 |
5 files changed, 126 insertions, 41 deletions
@@ -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}. |