comparison lisp/utils/text-props.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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
93 ;;; duplicability aspect of it. In fact, either of these packages could be be
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