diff options
| -rw-r--r-- | NEWS.org | 2 | ||||
| -rw-r--r-- | compat-27.el | 194 | ||||
| -rw-r--r-- | compat-tests.el | 58 | ||||
| -rw-r--r-- | compat.texi | 93 |
4 files changed, 4 insertions, 343 deletions
@@ -5,6 +5,8 @@ - compat-27: Drop obsolete ~compat-call dired-get-marked-files~. - compat-29: Add ~with-restriction~ and ~without-restriction~. - compat-29: Drop ~with-narrowing~. +- compat-27: Drop ~text-property-search-forward~ and ~-backward~. These functions + should be provided by a separate ~text-property-search~ ELPA package. * Release of "Compat" Version 29.1.3.4 diff --git a/compat-27.el b/compat-27.el index 30aa97c..c39ce52 100644 --- a/compat-27.el +++ b/compat-27.el @@ -607,200 +607,6 @@ January 1st being 1." month (1+ month))) (list nil nil nil ordinal month year nil nil nil))) -;;;; Defined in text-property-search.el - -(declare-function make-prop-match nil) -(compat-guard (not (fboundp 'make-prop-match)) ;; <compat-tests:prop-match> - (cl-defstruct (prop-match) beginning end value)) - -(compat-defun text-property-search-forward ;; <compat-tests:text-property-search-forward> - (property &optional value predicate not-current) - "Search for the next region of text where PREDICATE is true. -PREDICATE is used to decide whether a value of PROPERTY should be -considered as matching VALUE. - -If PREDICATE is a function, it will be called with two arguments: -VALUE and the value of PROPERTY. The function should return -non-nil if these two values are to be considered a match. - -Two special values of PREDICATE can also be used: -If PREDICATE is t, that means a value must `equal' VALUE to be -considered a match. -If PREDICATE is nil (which is the default value), a value will -match if is not `equal' to VALUE. Furthermore, a nil PREDICATE -means that the match region is ended if the value changes. For -instance, this means that if you loop with - - (while (setq prop (text-property-search-forward \\='face)) - ...) - -you will get all distinct regions with non-nil `face' values in -the buffer, and the `prop' object will have the details about the -match. See the manual for more details and examples about how -VALUE and PREDICATE interact. - -If NOT-CURRENT is non-nil, the function will search for the first -region that doesn't include point and has a value of PROPERTY -that matches VALUE. - -If no matches can be found, return nil and don't move point. -If found, move point to the end of the region and return a -`prop-match' object describing the match. To access the details -of the match, use `prop-match-beginning' and `prop-match-end' for -the buffer positions that limit the region, and -`prop-match-value' for the value of PROPERTY in the region." - (let* ((match-p - (lambda (prop-value) - (funcall - (cond - ((eq predicate t) - #'equal) - ((eq predicate nil) - (lambda (val p-val) - (not (equal val p-val)))) - (predicate)) - value prop-value))) - (find-end - (lambda (start) - (let (end) - (if (and value - (null predicate)) - ;; This is the normal case: We're looking for areas where the - ;; values aren't, so we aren't interested in sub-areas where the - ;; property has different values, all non-matching value. - (let ((ended nil)) - (while (not ended) - (setq end (next-single-property-change (point) property)) - (if (not end) - (progn - (goto-char (point-max)) - (setq end (point) - ended t)) - (goto-char end) - (unless (funcall match-p (get-text-property (point) property)) - (setq ended t))))) - ;; End this at the first place the property changes value. - (setq end (next-single-property-change (point) property nil (point-max))) - (goto-char end)) - (make-prop-match - :beginning start - :end end - :value (get-text-property start property)))))) - (cond - ;; No matches at the end of the buffer. - ((eobp) - nil) - ;; We're standing in the property we're looking for, so find the - ;; end. - ((and (funcall match-p (get-text-property (point) property)) - (not not-current)) - (funcall find-end (point))) - (t - (let ((origin (point)) - (ended nil) - pos) - ;; Find the next candidate. - (while (not ended) - (setq pos (next-single-property-change (point) property)) - (if (not pos) - (progn - (goto-char origin) - (setq ended t)) - (goto-char pos) - (if (funcall match-p (get-text-property (point) property)) - (setq ended (funcall find-end (point))) - ;; Skip past this section of non-matches. - (setq pos (next-single-property-change (point) property)) - (unless pos - (goto-char origin) - (setq ended t))))) - (and (not (eq ended t)) - ended)))))) - -(compat-defun text-property-search-backward ;; <compat-tests:text-property-search-backward> - (property &optional value predicate not-current) - "Search for the previous region of text whose PROPERTY matches VALUE. - -Like `text-property-search-forward', which see, but searches backward, -and if a matching region is found, place point at the start of the region." - (let* ((match-p - (lambda (prop-value) - (funcall - (cond - ((eq predicate t) - #'equal) - ((eq predicate nil) - (lambda (val p-val) - (not (equal val p-val)))) - (predicate)) - value prop-value))) - (find-end - (lambda (start) - (let (end) - (if (and value - (null predicate)) - ;; This is the normal case: We're looking for areas where the - ;; values aren't, so we aren't interested in sub-areas where the - ;; property has different values, all non-matching value. - (let ((ended nil)) - (while (not ended) - (setq end (previous-single-property-change (point) property)) - (if (not end) - (progn - (goto-char (point-min)) - (setq end (point) - ended t)) - (goto-char (1- end)) - (unless (funcall match-p (get-text-property (point) property)) - (goto-char end) - (setq ended t))))) - ;; End this at the first place the property changes value. - (setq end (previous-single-property-change - (point) property nil (point-min))) - (goto-char end)) - (make-prop-match - :beginning end - :end (1+ start) - :value (get-text-property end property)))))) - (cond - ;; We're at the start of the buffer; no previous matches. - ((bobp) - nil) - ;; We're standing in the property we're looking for, so find the - ;; end. - ((funcall match-p (get-text-property (1- (point)) property)) - (let ((origin (point)) - (match (funcall find-end (1- (point)) property value predicate))) - ;; When we want to ignore the current element, then repeat the - ;; search if we haven't moved out of it yet. - (if (and not-current - (equal (get-text-property (point) property) - (get-text-property origin property))) - (text-property-search-backward property value predicate) - match))) - (t - (let ((origin (point)) - (ended nil) - pos) - ;; Find the previous candidate. - (while (not ended) - (setq pos (previous-single-property-change (point) property)) - (if (not pos) - (progn - (goto-char origin) - (setq ended t)) - (goto-char (1- pos)) - (if (funcall match-p (get-text-property (point) property)) - (setq ended - (funcall find-end (point))) - ;; Skip past this section of non-matches. - (setq pos (previous-single-property-change (point) property)) - (unless pos - (goto-char origin) - (setq ended t))))) - (and (not (eq ended t)) - ended)))))) - ;;;; Defined in ring.el (compat-defun ring-resize (ring size) ;; <compat-tests:ring-resize> diff --git a/compat-tests.el b/compat-tests.el index ba6cec4..d18e973 100644 --- a/compat-tests.el +++ b/compat-tests.el @@ -55,7 +55,6 @@ (require 'subr-x) (require 'time-date) (require 'image) -(require 'text-property-search nil t) ;; Setup tramp mock (require 'tramp) @@ -2380,63 +2379,6 @@ (should-equal (compat-call plist-get plist "one" #'string=) "eins") (should-equal plist '("one" "eins" "two" 2 "three" 3)))) -(ert-deftest prop-match () - (should (prop-match-p (make-prop-match))) - (should (prop-match-p (make-prop-match :end 1))) - (should (prop-match-p (make-prop-match :beginning 1 :end 2 :value 3))) - (should-equal 1 (prop-match-beginning (make-prop-match :beginning 1 :end 2 :value 3))) - (should-equal 2 (prop-match-end (make-prop-match :beginning 1 :end 2 :value 3))) - (should-equal 3 (prop-match-value (make-prop-match :beginning 1 :end 2 :value 3))) - (should-not (prop-match-p nil)) - (should-not (prop-match-p [])) - (should-not (prop-match-p 'symbol)) - (should-not (prop-match-p "string")) - (should-not (prop-match-p '(1 2 3)))) - -(ert-deftest text-property-search-forward () - (with-temp-buffer - (insert "one " - (propertize "two " 'prop 'val) - "three " - (propertize "four " 'prop 'wert) - "five ") - (goto-char (point-min)) - (let ((match (text-property-search-forward 'prop))) - (should (prop-match-p match)) - (should-equal (prop-match-beginning match) 5) - (should-equal (prop-match-end match) 9) - (should-equal (prop-match-value match) 'val)) - (let ((match (text-property-search-forward 'prop))) - (should (prop-match-p match)) - (should-equal (prop-match-beginning match) 15) - (should-equal (prop-match-end match) 20) - (should-equal (prop-match-value match) 'wert)) - (should-not (text-property-search-forward 'prop)) - (goto-char (point-min)) - (should-not (text-property-search-forward 'non-existant)))) - -(ert-deftest text-property-search-backward () - (with-temp-buffer - (insert "one " - (propertize "two " 'prop 'val) - "three " - (propertize "four " 'prop 'wert) - "five ") - (goto-char (point-max)) - (let ((match (text-property-search-backward 'prop))) - (should (prop-match-p match)) - (should-equal (prop-match-beginning match) 15) - (should-equal (prop-match-end match) 20) - (should-equal (prop-match-value match) 'wert)) - (let ((match (text-property-search-backward 'prop))) - (should (prop-match-p match)) - (should-equal (prop-match-beginning match) 5) - (should-equal (prop-match-end match) 9) - (should-equal (prop-match-value match) 'val)) - (should-not (text-property-search-backward 'prop)) - (goto-char (point-max)) - (should-not (text-property-search-backward 'non-existant)))) - (ert-deftest color-dark-p () (should (color-dark-p '(0 0 0))) (should (color-dark-p '(0.5 0.5 0.5))) diff --git a/compat.texi b/compat.texi index 521ca11..c64565e 100644 --- a/compat.texi +++ b/compat.texi @@ -1424,97 +1424,6 @@ This function creates an empty file named @var{filename}. As function signals an error. @end defun -@defun text-property-search-forward prop &optional value predicate not-current -Search for the next region that has text property @var{prop} set to -@var{value} according to @var{predicate}. - -This function is modeled after @code{search-forward} and friends in -that it moves point, but it returns a structure that describes the -match instead of returning it in @code{match-beginning} and friends. - -If the text property can't be found, the function returns @code{nil}. -If it's found, point is placed at the end of the region that has this -text property match, and a @code{prop-match} structure is returned. - -@var{predicate} can either be @code{t} (which is a synonym for -@code{equal}), @code{nil} (which means ``not equal''), or a predicate -that will be called with two parameters: The first is @var{value}, and -the second is the value of the text property we're inspecting. - -If @var{not-current}, if point is in a region where we have a match, -then skip past that and find the next instance instead. - -The @code{prop-match} structure has the following accessors: -@code{prop-match-beginning} (the start of the match), -@code{prop-match-end} (the end of the match), and -@code{prop-match-value} (the value of @var{property} at the start of -the match). - -In the examples below, imagine that you're in a buffer that looks like -this: - -@example -This is a bold and here's bolditalic and this is the end. -@end example - -That is, the ``bold'' words are the @code{bold} face, and the -``italic'' word is in the @code{italic} face. - -With point at the start: - -@lisp -(while (setq match (text-property-search-forward 'face 'bold t)) - (push (buffer-substring (prop-match-beginning match) - (prop-match-end match)) - words)) -@end lisp - -This will pick out all the words that use the @code{bold} face. - -@lisp -(while (setq match (text-property-search-forward 'face nil t)) - (push (buffer-substring (prop-match-beginning match) - (prop-match-end match)) - words)) -@end lisp - -This will pick out all the bits that have no face properties, which -will result in the list @samp{("This is a " "and here's " "and this is -the end")} (only reversed, since we used @code{push}). - -@lisp -(while (setq match (text-property-search-forward 'face nil nil)) - (push (buffer-substring (prop-match-beginning match) - (prop-match-end match)) - words)) -@end lisp - -This will pick out all the regions where @code{face} is set to -something, but this is split up into where the properties change, so -the result here will be @samp{("bold" "bold" "italic")}. - -For a more realistic example where you might use this, consider that -you have a buffer where certain sections represent URLs, and these are -tagged with @code{shr-url}. - -@lisp -(while (setq match (text-property-search-forward 'shr-url nil nil)) - (push (prop-match-value match) urls)) -@end lisp - -This will give you a list of all those URLs. - -@xref{elisp,,,Property Search}. -@end defun - -@defun text-property-search-backward prop &optional value predicate not-current -This is just like @code{text-property-search-forward}, but searches -backward instead. Point is placed at the beginning of the matched -region instead of the end, though. - -@xref{elisp,,,Property Search}. -@end defun - @subsection Extended Definitions These functions must be called explicitly via @code{compat-call}, since their calling convention or behavior was extended in Emacs 27.1: @@ -1673,6 +1582,8 @@ The @code{iso8601} library. @item The @code{exif} library. @item +The @code{text-property-search} library. +@item The @code{image-converter} library. @end itemize |