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