1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
|
;;; text-property-search.el --- search for text properties -*- lexical-binding:t -*-
;; Copyright (C) 2018-2023 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: convenience
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(eval-when-compile (require 'cl-lib))
(cl-defstruct (prop-match)
beginning end value)
(defun text-property-search-forward (property &optional value predicate
not-current)
"Search for next region of text where PREDICATE returns non-nil for PROPERTY.
PREDICATE is used to decide whether the value of PROPERTY at a given
buffer position should be considered as a match for VALUE.
VALUE defaults to nil if omitted.
If PREDICATE is a function, it will be called with two arguments:
VALUE and the value of PROPERTY at some buffer position. 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 the value of PROPERTY must `equal' VALUE
to be considered a match.
If PREDICATE is nil (which is the default), the value of PROPERTY will
match if it is not `equal' to VALUE. Furthermore, a nil PREDICATE
means that the match region ends where the value changes. For
instance, this means that if you loop with
(while (setq prop (text-property-search-forward \\='face))
...)
you will get all the 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, current buffer position is not examined for
matches: 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."
(interactive
(list
(let ((string (completing-read "Search for property: " obarray)))
(when (> (length string) 0)
(intern string obarray)))))
(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 (text-property--match-p value (get-text-property (point) property)
predicate)
(not not-current))
(text-property--find-end-forward (point) property value predicate))
(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 (text-property--match-p value (get-text-property (point) property)
predicate)
(setq ended
(text-property--find-end-forward
(point) property value predicate))
;; 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)))))
(defun text-property--find-end-forward (start property value predicate)
(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 (text-property--match-p
value (get-text-property (point) property) predicate)
(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))))
(defun text-property-search-backward (property &optional value predicate
not-current)
"Search for previous region of text where PREDICATE returns non-nil for PROPERTY.
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."
(interactive
(list
(let ((string (completing-read "Search for property: " obarray)))
(when (> (length string) 0)
(intern string obarray)))))
(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.
((text-property--match-p
value (get-text-property (1- (point)) property)
predicate)
(let ((origin (point))
(match (text-property--find-end-backward
(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 (text-property--match-p value (get-text-property (point) property)
predicate)
(setq ended
(text-property--find-end-backward
(point) property value predicate))
;; 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)))))
(defun text-property--find-end-backward (start property value predicate)
(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 (text-property--match-p
value (get-text-property (point) property) predicate)
(goto-char end)
(setq ended t)))))
;; End this at the first place the property changes value.
(setq end
(if (and (> (point) (point-min))
(text-property--match-p
value (get-text-property (1- (point)) property)
predicate))
(previous-single-property-change (point)
property nil (point-min))
(point)))
(goto-char end))
(make-prop-match :beginning end
:end (1+ start)
:value (get-text-property end property))))
(defun text-property--match-p (value prop-value predicate)
(cond
((eq predicate t)
(setq predicate #'equal))
((eq predicate nil)
(setq predicate (lambda (val p-val)
(not (equal val p-val))))))
(funcall predicate value prop-value))
(provide 'text-property-search)
;;; text-property-search.el ends here
|
