|
0
|
1 ;;; text-props.el --- implements properties of characters
|
|
|
2
|
|
|
3 ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
|
|
|
4 ;; Copyright (C) 1995 Amdahl Corporation.
|
|
|
5 ;; Copyright (C) 1995 Ben Wing.
|
|
|
6
|
|
|
7 ;; Keywords: extensions, wp, faces
|
|
|
8 ;; Author: Jamie Zawinski <jwz@lucid.com>
|
|
|
9 ;; Modified: Ben Wing <wing@666.com> -- many of the Lisp functions below
|
|
|
10 ;; were completely broken.
|
|
|
11 ;;
|
|
|
12 ;; This file is part of XEmacs.
|
|
|
13
|
|
|
14 ;; XEmacs is free software; you can redistribute it and/or modify
|
|
|
15 ;; it under the terms of the GNU General Public License as published by
|
|
|
16 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
17 ;; any later version.
|
|
|
18
|
|
|
19 ;; XEmacs is distributed in the hope that it will be useful,
|
|
|
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
22 ;; GNU General Public License for more details.
|
|
|
23
|
|
|
24 ;; You should have received a copy of the GNU General Public License
|
|
|
25 ;; along with XEmacs; see the file COPYING. If not, write to
|
|
|
26 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
27
|
|
|
28 ;;; Synched up with: Not in FSF.
|
|
|
29
|
|
|
30 ;;; Commentary:
|
|
|
31
|
|
|
32 ;;; This is a nearly complete implementation of the FSF19 text properties API.
|
|
|
33 ;;; Please let me know if you notice any differences in behavior between
|
|
|
34 ;;; this implementation and the FSF implementation.
|
|
|
35 ;;;
|
|
|
36 ;;; However, keep in mind that this interface has been implemented because it
|
|
|
37 ;;; is useful. Compatibility with code written for FSF19 is a secondary goal
|
|
|
38 ;;; to having a clean and useful interface.
|
|
|
39 ;;;
|
|
|
40 ;;; The cruftier parts of the FSF API, such as the special handling of
|
|
|
41 ;;; properties like `mouse-face', `front-sticky', and other properties whose
|
|
|
42 ;;; value is a list of names of *other* properties set at this position, are
|
|
|
43 ;;; not implemented. The reason for this is that if you feel you need that
|
|
|
44 ;;; kind of functionality, it's a good hint that you should be using extents
|
|
|
45 ;;; instead of text properties.
|
|
|
46 ;;;
|
|
|
47 ;;; When should I use Text Properties, and when should I use Extents?
|
|
|
48 ;;; ==================================================================
|
|
|
49 ;;;
|
|
|
50 ;;; If you are putting a `button' or `hyperlink' of some kind into a buffer,
|
|
|
51 ;;; the most natural interface is one which deals with properties of regions
|
|
|
52 ;;; with explicit endpoints that behave more-or-less like markers. That is
|
|
|
53 ;;; what `make-extent', `extent-at', and `extent-property' are for.
|
|
|
54 ;;;
|
|
|
55 ;;; If you are dealing with styles of text, where things do not have explicit
|
|
|
56 ;;; endpoints (as is done in font-lock.el and shell-font.el) or if you want to
|
|
|
57 ;;; partition a buffer (that is, change some attribute of a range from one
|
|
|
58 ;;; value to another without disturbing the properties outside of that range)
|
|
|
59 ;;; then an interface that deals with properties of characters may be most
|
|
|
60 ;;; natural.
|
|
|
61 ;;;
|
|
|
62 ;;; Another way of thinking of it is, do you care where the endpoints of the
|
|
|
63 ;;; region are? If you do, then you should use extents. If it's ok for the
|
|
|
64 ;;; region to become divided, and for two regions with identical properties to
|
|
|
65 ;;; be merged into one region, then you might want to use text properties.
|
|
|
66 ;;;
|
|
|
67 ;;; Some applications want the attributes they add to be copied by the killing
|
|
|
68 ;;; and yanking commands, and some do not. This is orthogonal to whether text
|
|
|
69 ;;; properties or extents are used. Remember that text properties are
|
|
|
70 ;;; implemented in terms of extents, so anything you can do with one you can
|
|
|
71 ;;; do with the other. It's just a matter of which way of creating and
|
|
|
72 ;;; managing them is most appropriate to your application.
|
|
|
73 ;;;
|
|
|
74 ;;; Implementation details:
|
|
|
75 ;;; =======================
|
|
|
76 ;;;
|
|
|
77 ;;; This package uses extents with a non-nil 'text-prop property. It assumes
|
|
|
78 ;;; free reign over the endpoints of any extent with that property. It will
|
|
|
79 ;;; not alter any extent which does not have that property.
|
|
|
80 ;;;
|
|
|
81 ;;; Right now, the text-property functions create one extent for each distinct
|
|
|
82 ;;; property; that is, if a range of text has two text-properties on it, there
|
|
|
83 ;;; will be two extents. As the set of text-properties is going to be small,
|
|
|
84 ;;; this is probably not a big deal. It would be possible to share extents.
|
|
|
85 ;;;
|
|
|
86 ;;; One tricky bit is that undo/kill/yank must be made to not fragment things:
|
|
|
87 ;;; these extents must not be allowed to overlap. We accomplish this by using
|
|
|
88 ;;; a custom `paste-function' property on the extents.
|
|
|
89 ;;;
|
|
|
90 ;;; shell-font.el and font-lock.el could put-text-property to attach fonts to
|
|
|
91 ;;; the buffer. However, what these packages are interested in is the
|
|
|
92 ;;; efficient extent partitioning behavior which this code exhibits, not the
|
|
2
|
93 ;;; duplicability aspect of it. In fact, either of these packages could be
|
|
0
|
94 ;;; implemented by creating a one-character non-expandable extent for each
|
|
|
95 ;;; character in the buffer, except that that would be extremely wasteful of
|
|
|
96 ;;; memory. (Redisplay performance would be fine, however.)
|
|
|
97 ;;;
|
|
|
98 ;;; If these packages were to use put-text-property to make the extents, then
|
|
|
99 ;;; when one copied text from a shell buffer or a font-locked source buffer
|
|
|
100 ;;; and pasted it somewhere else (a sendmail buffer, or a buffer not in
|
|
|
101 ;;; font-lock mode) then the fonts would follow, and there's no easy way to
|
|
|
102 ;;; get rid of them (other than pounding out a call to put-text-property by
|
|
|
103 ;;; hand.) This is annoying. Maybe it wouldn't be so annoying if there was a
|
|
|
104 ;;; more general set of commands for handling styles of text (in fact, if
|
|
|
105 ;;; there were such a thing, copying the fonts would probably be exactly what
|
|
|
106 ;;; one wanted) but we aren't there yet. So these packages use the interface
|
|
|
107 ;;; of `put-nonduplicable-text-property' which is the same, except that it
|
|
|
108 ;;; doesn't make duplicable extents.
|
|
|
109 ;;;
|
|
|
110 ;;; `put-text-property' and `put-nonduplicable-text-property' don't get along:
|
|
|
111 ;;; they will interfere with each other, reusing each others' extents without
|
|
|
112 ;;; checking that the "duplicableness" is correct. This is a bug, but it's
|
|
|
113 ;;; one that I don't care enough to fix this right now.
|
|
|
114
|
|
|
115
|
|
|
116 ;;; Code:
|
|
|
117
|
|
|
118
|
|
|
119 ;; The following functions were ported to C for speed; the overhead of doing
|
|
|
120 ;; this many full lisp function calls was not small.
|
|
|
121
|
|
|
122 ;; #### The C functions have changed since then; the Lisp equivalents
|
|
|
123 ;; should be updated.
|
|
|
124
|
|
|
125 ;(defun put-text-property (start end prop value &optional buffer)
|
|
|
126 ; "Adds the given property/value to all characters in the specified region.
|
|
|
127 ;The property is conceptually attached to the characters rather than the
|
|
|
128 ;region. The properties are copied when the characters are copied/pasted."
|
|
|
129 ; (put-text-property-1 start end prop value buffer t)
|
|
|
130 ; prop)
|
|
|
131 ;
|
|
|
132 ;(defun put-nonduplicable-text-property (start end prop value &optional buffer)
|
|
|
133 ; "Adds the given property/value to all characters in the specified region.
|
|
|
134 ;The property is conceptually attached to the characters rather than the
|
|
|
135 ;region, however the properties will not be copied the characters are copied."
|
|
|
136 ; (put-text-property-1 start end prop value buffer nil)
|
|
|
137 ; prop)
|
|
|
138 ;
|
|
|
139 ;(defun put-text-property-1 (start end prop value buffer duplicable)
|
|
|
140 ; ;; returns whether any property of a character was changed
|
|
|
141 ; (if (= start end)
|
|
|
142 ; nil
|
|
|
143 ; (save-excursion
|
|
|
144 ; (and buffer (set-buffer buffer))
|
|
|
145 ; (let ((the-extent nil)
|
|
|
146 ; (changed nil))
|
|
|
147 ; ;; prop, value, the-extent, start, end, and changed are of dynamic
|
|
|
148 ; ;; scope. changed and the-extent are assigned.
|
|
|
149 ; (map-extents (function put-text-property-mapper) nil
|
|
|
150 ; (max 1 (1- start))
|
|
|
151 ; (min (buffer-size) (1+ end)))
|
|
|
152 ;
|
|
|
153 ; ;; If we made it through the loop without reusing an extent
|
|
|
154 ; ;; (and we want there to be one) make it now.
|
|
|
155 ; (cond ((and value (not the-extent))
|
|
|
156 ; (setq the-extent (make-extent start end))
|
|
|
157 ; (set-extent-property the-extent 'text-prop prop)
|
|
|
158 ; (set-extent-property the-extent prop value)
|
|
|
159 ; (setq changed t)
|
|
|
160 ; (cond (duplicable
|
|
|
161 ; (set-extent-property the-extent 'duplicable t)
|
|
|
162 ; (set-extent-property the-extent 'paste-function
|
|
|
163 ; 'text-prop-extent-paste-function)))
|
|
|
164 ; ))
|
|
|
165 ; changed))))
|
|
|
166 ;
|
|
|
167 ;(defun put-text-property-mapper (e ignore)
|
|
|
168 ; ;; prop, value, the-extent, start, end, and changed are of dynamic scope.
|
|
|
169 ; ;; changed and the-extent are assigned.
|
|
|
170 ; (let ((e-start (extent-start-position e))
|
|
|
171 ; (e-end (extent-end-position e))
|
|
|
172 ; (e-val (extent-property e prop)))
|
|
|
173 ; (cond ((not (eq (extent-property e 'text-prop) prop))
|
|
|
174 ; ;; It's not for this property; do nothing.
|
|
|
175 ; nil)
|
|
|
176 ;
|
|
|
177 ; ((and value
|
|
|
178 ; (not the-extent)
|
|
|
179 ; (eq value e-val))
|
|
|
180 ; ;; we want there to be an extent here at the end, and we haven't
|
|
|
181 ; ;; picked one yet, so use this one. Extend it as necessary.
|
|
|
182 ; ;; We only reuse an extent which has an EQ value for the prop in
|
|
|
183 ; ;; question to avoid side-effecting the kill ring (that is, we
|
|
|
184 ; ;; never change the property on an extent after it has been
|
|
|
185 ; ;; created.)
|
|
|
186 ; (cond
|
|
|
187 ; ((or (/= e-start start) (/= e-end end))
|
|
|
188 ; (set-extent-endpoints e (min e-start start) (max e-end end))
|
|
|
189 ; (setq changed t)))
|
|
|
190 ; (setq the-extent e))
|
|
|
191 ;
|
|
|
192 ; ;; Even if we're adding a prop, at this point, we want all other
|
|
|
193 ; ;; extents of this prop to go away (as now they overlap.)
|
|
|
194 ; ;; So the theory here is that, when we are adding a prop to a
|
|
|
195 ; ;; region that has multiple (disjoint) occurences of that prop
|
|
|
196 ; ;; in it already, we pick one of those and extend it, and remove
|
|
|
197 ; ;; the others.
|
|
|
198 ;
|
|
|
199 ; ((eq e the-extent)
|
|
|
200 ; ;; just in case map-extents hits it again (does that happen?)
|
|
|
201 ; nil)
|
|
|
202 ;
|
|
|
203 ; ((and (>= e-start start)
|
|
|
204 ; (<= e-end end))
|
|
|
205 ; ;; extent is contained in region; remove it. Don't destroy or
|
|
|
206 ; ;; modify it, because we don't want to change the attributes
|
|
|
207 ; ;; pointed to by the duplicates in the kill ring.
|
|
|
208 ; (setq changed t)
|
|
|
209 ; (detach-extent e))
|
|
|
210 ;
|
|
|
211 ; ((and the-extent
|
|
|
212 ; (eq value e-val)
|
|
|
213 ; (<= e-start end)
|
|
|
214 ; (>= e-end start))
|
|
|
215 ; ;; this extent overlaps, and has the same prop/value as the
|
|
|
216 ; ;; extent we've decided to reuse, so we can remove this existing
|
|
|
217 ; ;; extent as well (the whole thing, even the part outside of the
|
|
|
218 ; ;; region) and extend the-extent to cover it, resulting in the
|
|
|
219 ; ;; minimum number of extents in the buffer.
|
|
|
220 ; (cond
|
|
|
221 ; ((and (/= (extent-start-position the-extent) e-start)
|
|
|
222 ; (/= (extent-end-position the-extent) e-end))
|
|
|
223 ; (set-extent-endpoints the-extent
|
|
|
224 ; (min (extent-start-position the-extent)
|
|
|
225 ; e-start)
|
|
|
226 ; (max (extent-end-position the-extent)
|
|
|
227 ; e-end))
|
|
|
228 ; (setq changed t)))
|
|
|
229 ; (detach-extent e))
|
|
|
230 ;
|
|
|
231 ; ((<= (extent-end-position e) end)
|
|
|
232 ; ;; extent begins before start but ends before end,
|
|
|
233 ; ;; so we can just decrease its end position.
|
|
|
234 ; (if (and (= (extent-start-position e) e-start)
|
|
|
235 ; (= (extent-end-position e) start))
|
|
|
236 ; nil
|
|
|
237 ; (set-extent-endpoints e e-start start)
|
|
|
238 ; (setq changed t)))
|
|
|
239 ;
|
|
|
240 ; ((>= (extent-start-position e) start)
|
|
|
241 ; ;; extent ends after end but begins after start,
|
|
|
242 ; ;; so we can just increase its start position.
|
|
|
243 ; (if (and (= (extent-start-position e) end)
|
|
|
244 ; (= (extent-start-position e) e-end))
|
|
|
245 ; nil
|
|
|
246 ; (set-extent-endpoints e end e-end)
|
|
|
247 ; (setq changed t)))
|
|
|
248 ;
|
|
|
249 ; (t
|
|
|
250 ; ;; Otherwise, the extent straddles the region.
|
|
|
251 ; ;; We need to split it.
|
|
|
252 ; (set-extent-endpoints e e-start start)
|
|
|
253 ; (setq e (copy-extent e))
|
|
|
254 ; (set-extent-endpoints e end e-end)
|
|
|
255 ; (setq changed t))))
|
|
|
256 ; ;; return nil to continue mapping over region.
|
|
|
257 ; nil)
|
|
|
258 ;
|
|
|
259 ;
|
|
|
260 ;(defun text-prop-extent-paste-function (extent from to)
|
|
|
261 ; ;; Whenever a text-prop extent is pasted into a buffer (via `yank' or
|
|
|
262 ; ;; `insert' or whatever) we attach the properties to the buffer by calling
|
|
|
263 ; ;; `put-text-property' instead of by simply alowing the extent to be copied
|
|
|
264 ; ;; or re-attached. Then we return nil, telling the C code not to attach
|
|
|
265 ; ;; it again. By handing the insertion hackery in this way, we make kill/yank
|
|
|
266 ; ;; behave consistently iwth put-text-property and not fragment the extents
|
|
|
267 ; ;; (since text-prop extents must partition, not overlap.)
|
|
|
268 ; (let* ((prop (or (extent-property extent 'text-prop)
|
|
|
269 ; (error "internal error: no text-prop on %S" extent)))
|
|
|
270 ; (val (or (extent-property extent prop)
|
|
|
271 ; (error "internal error: no text-prop %S on %S"
|
|
|
272 ; prop extent))))
|
|
|
273 ; (put-text-property from to prop val)
|
|
|
274 ; nil))
|
|
|
275 ;
|
|
|
276 ;(defun add-text-properties (start end props &optional buffer)
|
|
|
277 ; "Add properties to the characters from START to END.
|
|
|
278 ;The third argument PROPS is a property list specifying the property values
|
|
|
279 ;to add. The optional fourth argument, OBJECT, is the buffer containing the
|
|
|
280 ;text. Returns t if any property was changed, nil otherwise."
|
|
|
281 ; (let ((changed nil))
|
|
|
282 ; (while props
|
|
|
283 ; (setq changed
|
|
|
284 ; (or (put-text-property-1 start end (car props) (car (cdr props))
|
|
|
285 ; buffer t)
|
|
|
286 ; changed))
|
|
|
287 ; (setq props (cdr (cdr props))))
|
|
|
288 ; changed))
|
|
|
289 ;
|
|
|
290 ;(defun remove-text-properties (start end props &optional buffer)
|
|
|
291 ; "Remove the given properties from all characters in the specified region.
|
|
|
292 ;PROPS should be a plist, but the values in that plist are ignored (treated
|
|
|
293 ;as nil.) Returns t if any property was changed, nil otherwise."
|
|
|
294 ; (let ((changed nil))
|
|
|
295 ; (while props
|
|
|
296 ; (setq changed
|
|
|
297 ; (or (put-text-property-1 start end (car props) nil buffer t)
|
|
|
298 ; changed))
|
|
|
299 ; (setq props (cdr (cdr props))))
|
|
|
300 ; changed))
|
|
|
301 ;
|
|
|
302
|
|
|
303 (defun set-text-properties (start end props &optional buffer-or-string)
|
|
|
304 "You should NEVER use this function. It is ideologically blasphemous.
|
|
|
305 It is provided only to ease porting of broken FSF Emacs programs.
|
|
|
306
|
|
|
307 Completely replace properties of text from START to END.
|
|
|
308 The third argument PROPS is the new property list.
|
|
|
309 The optional fourth argument, BUFFER-OR-STRING,
|
|
|
310 is the string or buffer containing the text."
|
|
|
311 (map-extents #'(lambda (extent ignored)
|
|
|
312 (remove-text-properties start end
|
|
|
313 (list (extent-property extent
|
|
|
314 'text-prop)
|
|
|
315 nil)
|
|
|
316 buffer-or-string))
|
|
|
317 buffer-or-string start end nil nil 'text-prop)
|
|
|
318 (add-text-properties start end props buffer-or-string))
|
|
|
319
|
|
|
320
|
|
|
321 ;;; The following functions can probably stay in lisp, since they're so simple.
|
|
|
322
|
|
|
323 ;(defun get-text-property (pos prop &optional buffer)
|
|
|
324 ; "Returns the value of the PROP property at the given position."
|
|
|
325 ; (let ((e (extent-at pos buffer prop)))
|
|
|
326 ; (if e
|
|
|
327 ; (extent-property e prop)
|
|
|
328 ; nil)))
|
|
|
329
|
|
|
330 (defun extent-properties-at-1 (position buffer-or-string text-props-only)
|
|
|
331 (let ((extent nil)
|
|
|
332 (props nil)
|
|
|
333 new-props)
|
|
|
334 (while (setq extent (extent-at position buffer-or-string
|
|
|
335 (if text-props-only 'text-prop nil)
|
|
|
336 extent))
|
|
|
337 (if text-props-only
|
|
|
338 ;; Only return the one prop which the `text-prop' property points at.
|
|
|
339 (let ((prop (extent-property extent 'text-prop)))
|
|
|
340 (setq new-props (list prop (extent-property extent prop))))
|
|
|
341 ;; Return all the properties...
|
|
|
342 (setq new-props (extent-properties extent))
|
|
|
343 ;; ...but! Don't return the `begin-glyph' or `end-glyph' properties
|
|
|
344 ;; unless the position is exactly at the appropriate endpoint. Yeah,
|
|
|
345 ;; this is kind of a kludge.
|
|
|
346 ;; #### Bug, this doesn't work for end-glyphs (on end-open extents)
|
|
|
347 ;; because we've already passed the extent with the glyph by the time
|
|
|
348 ;; it's appropriate to return the glyph. We could return the end
|
|
|
349 ;; glyph one character early I guess... But then next-property-change
|
|
|
350 ;; would have to stop one character early as well. It could back up
|
|
|
351 ;; when it hit an end-glyph...
|
|
|
352 ;; #### Another bug, if there are multiple glyphs at the same position,
|
|
|
353 ;; we only see the first one.
|
|
|
354 (cond ((or (extent-begin-glyph extent) (extent-end-glyph extent))
|
|
|
355 (if (/= position (if (extent-property extent 'begin-glyph)
|
|
|
356 (extent-start-position extent)
|
|
|
357 (extent-end-position extent)))
|
|
|
358 (let ((rest new-props)
|
|
|
359 prev)
|
|
|
360 (while rest
|
|
|
361 (cond ((or (eq (car rest) 'begin-glyph)
|
|
|
362 (eq (car rest) 'end-glyph))
|
|
|
363 (if prev
|
|
|
364 (setcdr prev (cdr (cdr rest)))
|
|
|
365 (setq new-props (cdr (cdr new-props))))
|
|
|
366 (setq rest nil)))
|
|
|
367 (setq prev rest
|
|
|
368 rest (cdr rest))))))))
|
|
|
369 (cond ((null props)
|
|
|
370 (setq props new-props))
|
|
|
371 (t
|
|
|
372 (while new-props
|
|
|
373 (or (getf props (car new-props))
|
|
|
374 (setq props (cons (car new-props)
|
|
|
375 (cons (car (cdr new-props))
|
|
|
376 props))))
|
|
|
377 (setq new-props (cdr (cdr new-props)))))))
|
|
|
378 props))
|
|
|
379
|
|
|
380 (defun extent-properties-at (position &optional object)
|
|
|
381 "Returns the properties of the character at the given position
|
|
|
382 in OBJECT (a string or buffer) by merging the properties of overlapping
|
|
|
383 extents. The returned value is a property list, some of which may be
|
|
|
384 shared with other structures. You must not modify it.
|
|
|
385
|
|
|
386 If POSITION is at the end of OBJECT, the value is nil.
|
|
|
387
|
|
|
388 This returns all properties on all extents.
|
|
|
389 See also `text-properties-at'."
|
|
|
390 (extent-properties-at-1 position object nil))
|
|
|
391
|
|
|
392 (defun text-properties-at (position &optional object)
|
|
|
393 "Returns the properties of the character at the given position
|
|
|
394 in OBJECT (a string or buffer) by merging the properties of overlapping
|
|
|
395 extents. The returned value is a property list, some of which may be
|
|
|
396 shared with other structures. You must not modify it.
|
|
|
397
|
|
|
398 If POSITION is at the end of OBJECT, the value is nil.
|
|
|
399
|
|
|
400 This returns only those properties added with `put-text-property'.
|
|
|
401 See also `extent-properties-at'."
|
|
|
402 (extent-properties-at-1 position object t))
|
|
|
403
|
|
|
404 (defun text-property-any (start end prop value &optional buffer-or-string)
|
|
|
405 "Check text from START to END to see if PROP is ever `eq' to VALUE.
|
|
|
406 If so, return the position of the first character whose PROP is `eq'
|
|
|
407 to VALUE. Otherwise return nil.
|
|
|
408 The optional fifth argument, BUFFER-OR-STRING, is the buffer or string
|
|
|
409 containing the text and defaults to the current buffer."
|
|
|
410 (while (and start (< start end)
|
|
|
411 (not (eq value (get-text-property start prop buffer-or-string))))
|
|
|
412 (setq start (next-single-property-change start prop buffer-or-string end)))
|
|
|
413 ;; we have to insert a special check for end due to the illogical
|
|
|
414 ;; definition of next-single-property-change (blame FSF for this).
|
|
|
415 (if (eq start end) nil start))
|
|
|
416
|
|
|
417 (defun text-property-not-all (start end prop value &optional buffer-or-string)
|
|
|
418 "Check text from START to END to see if PROP is ever not `eq' to VALUE.
|
|
|
419 If so, return the position of the first character whose PROP is not
|
|
|
420 `eq' to VALUE. Otherwise, return nil.
|
|
|
421 The optional fifth argument, BUFFER-OR-STRING, is the buffer or string
|
|
|
422 containing the text and defaults to the current buffer."
|
|
|
423 (if (not (eq value (get-text-property start prop buffer-or-string)))
|
|
|
424 start
|
|
|
425 (let ((retval (next-single-property-change start prop
|
|
|
426 buffer-or-string end)))
|
|
|
427 ;; we have to insert a special check for end due to the illogical
|
|
|
428 ;; definition of previous-single-property-change (blame FSF for this).
|
|
|
429 (if (eq retval end) nil retval))))
|
|
|
430
|
|
|
431 ;; Older versions that only work sometimes (when VALUE is non-nil
|
|
|
432 ;; for text-property-any, and maybe only when VALUE is nil for
|
|
|
433 ;; text-property-not-all). They might be faster in those cases,
|
|
|
434 ;; but that's not obvious.
|
|
|
435
|
|
|
436 ;(defun text-property-any (start end prop value &optional buffer)
|
|
|
437 ; "Check text from START to END to see if PROP is ever `eq' to VALUE.
|
|
|
438 ;If so, return the position of the first character whose PROP is `eq'
|
|
|
439 ;to VALUE. Otherwise return nil."
|
|
|
440 ; ;; #### what should (text-property-any x y 'foo nil) return when there
|
|
|
441 ; ;; is no foo property between x and y? Either t or nil seems sensible,
|
|
|
442 ; ;; since a character with a property of nil is indistinguishable from
|
|
|
443 ; ;; a character without that property set.
|
|
|
444 ; (map-extents
|
|
|
445 ; #'(lambda (e ignore)
|
|
|
446 ; (if (eq value (extent-property e prop))
|
|
|
447 ; ;; return non-nil to stop mapping
|
|
|
448 ; (max start (extent-start-position e))
|
|
|
449 ; nil))
|
|
|
450 ; nil start end buffer))
|
|
|
451 ;
|
|
|
452 ;(defun text-property-not-all (start end prop value &optional buffer)
|
|
|
453 ; "Check text from START to END to see if PROP is ever not `eq' to VALUE.
|
|
|
454 ;If so, return the position of the first character whose PROP is not
|
|
|
455 ;`eq' to VALUE. Otherwise, return nil."
|
|
|
456 ; (let (maxend)
|
|
|
457 ; (map-extents
|
|
|
458 ; #'(lambda (e ignore)
|
|
|
459 ; ;;### no, actually, this is harder. We need to collect all props
|
|
|
460 ; ;; for a given character, and then determine whether no extent
|
|
|
461 ; ;; contributes the given value. Doing this without consing lots
|
|
|
462 ; ;; of lists is the tricky part.
|
|
|
463 ; (if (eq value (extent-property e prop))
|
|
|
464 ; (progn
|
|
|
465 ; (setq maxend (extent-end-position e))
|
|
|
466 ; nil)
|
|
|
467 ; (max start maxend)))
|
|
|
468 ; nil start end buffer)))
|
|
|
469
|
|
|
470 (defun next-property-change (pos &optional buffer-or-string limit)
|
|
|
471 "Return the position of next property change.
|
|
|
472 Scans forward from POS in BUFFER-OR-STRING (defaults to the current buffer)
|
|
|
473 until it finds a change in some text property, then returns the position of
|
|
|
474 the change.
|
|
|
475 Returns nil if the properties remain unchanged all the way to the end.
|
|
|
476 If the value is non-nil, it is a position greater than POS, never equal.
|
|
|
477 If the optional third argument LIMIT is non-nil, don't search
|
|
|
478 past position LIMIT; return LIMIT if nothing is found before LIMIT.
|
|
|
479 If two or more extents with conflicting non-nil values for a property overlap
|
|
|
480 a particular character, it is undefined which value is considered to be
|
|
|
481 the value of the property. (Note that this situation will not happen if
|
|
|
482 you always use the text-property primitives.)"
|
|
|
483 (let ((limit-was-nil (null limit)))
|
|
|
484 (or limit (setq limit (if (bufferp buffer-or-string)
|
|
|
485 (point-max buffer-or-string)
|
|
|
486 (length buffer-or-string))))
|
|
|
487 (let ((value (extent-properties-at pos buffer-or-string)))
|
|
|
488 (while
|
|
|
489 (and (< (setq pos (next-extent-change pos buffer-or-string)) limit)
|
|
|
490 (plists-eq value (extent-properties-at pos buffer-or-string)))))
|
|
|
491 (if (< pos limit) pos
|
|
|
492 (if limit-was-nil nil
|
|
|
493 limit))))
|
|
|
494
|
|
|
495 (defun previous-property-change (pos &optional buffer-or-string limit)
|
|
|
496 "Return the position of previous property change.
|
|
|
497 Scans backward from POS in BUFFER-OR-STRING (defaults to the current buffer)
|
|
|
498 until it finds a change in some text property, then returns the position of
|
|
|
499 the change.
|
|
|
500 Returns nil if the properties remain unchanged all the way to the beginning.
|
|
|
501 If the value is non-nil, it is a position less than POS, never equal.
|
|
|
502 If the optional third argument LIMIT is non-nil, don't search back
|
|
|
503 past position LIMIT; return LIMIT if nothing is found until LIMIT.
|
|
|
504 If two or more extents with conflicting non-nil values for a property overlap
|
|
|
505 a particular character, it is undefined which value is considered to be
|
|
|
506 the value of the property. (Note that this situation will not happen if
|
|
|
507 you always use the text-property primitives.)"
|
|
|
508 (let ((limit-was-nil (null limit)))
|
|
|
509 (or limit (setq limit (if (bufferp buffer-or-string)
|
|
|
510 (point-min buffer-or-string)
|
|
|
511 0)))
|
|
|
512 (let ((value (extent-properties-at (1- pos) buffer-or-string)))
|
|
|
513 (while
|
|
|
514 (and (> (setq pos (previous-extent-change pos buffer-or-string))
|
|
|
515 limit)
|
|
|
516 (plists-eq value (extent-properties-at (1- pos)
|
|
|
517 buffer-or-string)))))
|
|
|
518 (if (> pos limit) pos
|
|
|
519 (if limit-was-nil nil
|
|
|
520 limit))))
|
|
|
521
|
|
|
522 (defun text-property-bounds (pos prop &optional object at-flag)
|
|
|
523 "Return the bounds of property PROP at POS.
|
|
|
524 This returns a cons (START . END) of the largest region of text containing
|
|
|
525 POS which has a non-nil value for PROP. The return value is nil if POS
|
|
|
526 does not have a non-nil value for PROP. OBJECT specifies the buffer
|
|
|
527 or string to search in. Optional arg AT-FLAG controls what \"at POS\"
|
|
|
528 means, and has the same meaning as for `extent-at'."
|
|
|
529 (or object (setq object (current-buffer)))
|
|
|
530 (and (get-char-property pos prop object at-flag)
|
|
|
531 (let ((begin (if (stringp object) 0 (point-min object)))
|
|
|
532 (end (if (stringp object) (length object) (point-max object))))
|
|
|
533 (cons (previous-single-property-change (1+ pos) prop object begin)
|
|
|
534 (next-single-property-change pos prop object end)))))
|
|
|
535
|
|
|
536 (defun next-text-property-bounds (count pos prop &optional object)
|
|
|
537 "Return the COUNTth bounded property region of property PROP after POS.
|
|
|
538 If COUNT is less than zero, search backwards. This returns a cons
|
|
|
539 \(START . END) of the COUNTth maximal region of text that begins after POS
|
|
|
540 \(starts before POS) and has a non-nil value for PROP. If there aren't
|
|
|
541 that many regions, nil is returned. OBJECT specifies the buffer or
|
|
|
542 string to search in."
|
|
|
543 (or object (setq object (current-buffer)))
|
|
|
544 (let ((begin (if (stringp object) 0 (point-min object)))
|
|
|
545 (end (if (stringp object) (length object) (point-max object))))
|
|
|
546 (catch 'hit-end
|
|
|
547 (if (> count 0)
|
|
|
548 (progn
|
|
|
549 (while (> count 0)
|
|
|
550 (if (>= pos end)
|
|
|
551 (throw 'hit-end nil)
|
|
|
552 (and (get-char-property pos prop object)
|
|
|
553 (setq pos (next-single-property-change pos prop
|
|
|
554 object end)))
|
|
|
555 (setq pos (next-single-property-change pos prop object end)))
|
|
|
556 (setq count (1- count)))
|
|
|
557 (and (< pos end)
|
|
|
558 (cons pos (next-single-property-change pos prop object end))))
|
|
|
559 (while (< count 0)
|
|
|
560 (if (<= pos begin)
|
|
|
561 (throw 'hit-end nil)
|
|
|
562 (and (get-char-property (1- pos) prop object)
|
|
|
563 (setq pos (previous-single-property-change pos prop
|
|
|
564 object begin)))
|
|
|
565 (setq pos (previous-single-property-change pos prop object
|
|
|
566 begin)))
|
|
|
567 (setq count (1+ count)))
|
|
|
568 (and (> pos begin)
|
|
|
569 (cons (previous-single-property-change pos prop object begin)
|
|
|
570 pos))))))
|
|
|
571
|
|
|
572 ;(defun detach-all-extents (&optional buffer)
|
|
|
573 ; (map-extents #'(lambda (x i) (detach-extent x) nil)
|
|
|
574 ; buffer))
|
|
|
575
|
|
|
576
|
|
|
577 (provide 'text-props)
|
|
|
578
|
|
|
579 ;;; text-props.el ends here
|
