Mercurial > hg > xemacs-beta
comparison lisp/prim/extents.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 ;;; extents.el --- miscellaneous extent functions not written in C | |
2 | |
3 ;;;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. | |
4 | |
5 ;; Keywords: internal | |
6 | |
7 ;; This file is part of XEmacs. | |
8 | |
9 ;; XEmacs is free software; you can redistribute it and/or modify it | |
10 ;; under the terms of the GNU General Public License as published by | |
11 ;; the Free Software Foundation; either version 2, or (at your option) | |
12 ;; any later version. | |
13 | |
14 ;; XEmacs is distributed in the hope that it will be useful, but | |
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
17 ;; General Public License for more details. | |
18 | |
19 ;; You should have received a copy of the GNU General Public License | |
20 ;; along with XEmacs; see the file COPYING. If not, write to the Free | |
21 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
22 | |
23 ;;; Synched up with: Not in FSF. | |
24 | |
25 ; some help from stig@hackvan.com here. | |
26 | |
27 ;; an alternative to map-extents. | |
28 (defun mapcar-extents (function &optional predicate buffer-or-string from to | |
29 flags property value) | |
30 "Applies FUNCTION to all extents which overlap a region in BUFFER-OR-STRING. | |
31 The region is is delimited by FROM and TO. FUNCTION is called with | |
32 one argument, the extent. A list of the values returned by FUNCTION | |
33 is returned. An optional PREDICATE may be used to further limit the | |
34 extents over which FUNCTION is mapped. The optional arguments FLAGS, | |
35 PROPERTY, and VALUE may also be used to control the extents passed to | |
36 PREDICATE or FUNCTION. See also `map-extents'." | |
37 (let (*result*) | |
38 (map-extents (if predicate | |
39 #'(lambda (ex junk) | |
40 (and (funcall predicate ex) | |
41 (setq *result* (cons (funcall function ex) | |
42 *result*))) | |
43 nil) | |
44 #'(lambda (ex junk) | |
45 (setq *result* (cons (funcall function ex) | |
46 *result*)) | |
47 nil)) | |
48 buffer-or-string from to nil flags property value) | |
49 (nreverse *result*))) | |
50 | |
51 (defun extent-list (&optional buffer-or-string from to flags) | |
52 "Return a list of the extents in BUFFER-OR-STRING. | |
53 BUFFER-OR-STRING defaults to the current buffer if omitted. | |
54 FROM and TO can be used to limit the range over which extents are | |
55 returned; if omitted, all extents in the buffer or string are returned. | |
56 | |
57 More specifically, if a range is specified using FROM and TO, only | |
58 extents that overlap the range (i.e. begin or end inside of the range) | |
59 are included in the list. FROM and TO default to the beginning and | |
60 end of BUFFER-OR-STRING, respectively. | |
61 | |
62 FLAGS controls how end cases are treated. For a discussion of this, | |
63 and exactly what ``overlap'' means, see `map-extents'. | |
64 | |
65 If you want to map a function over the extents in a buffer or string, | |
66 consider using `map-extents' or `mapcar-extents' instead." | |
67 (mapcar-extents 'identity nil buffer-or-string from to flags)) | |
68 | |
69 (defun extent-string (extent) | |
70 "Return the string delimited by the bounds of EXTENT." | |
71 (let ((object (extent-object extent))) | |
72 (if (bufferp object) | |
73 (buffer-substring (extent-start-position extent) | |
74 (extent-end-position extent) | |
75 object) | |
76 (substring object | |
77 (extent-start-position extent) | |
78 (extent-end-position extent))))) | |
79 | |
80 (defun extent-descendants (extent) | |
81 "Return a list of all descendants of EXTENT, including EXTENT. | |
82 This recursively applies `extent-children' to any children of | |
83 EXTENT, until no more children can be found." | |
84 (let ((children (extent-children extent))) | |
85 (if children | |
86 (apply 'nconc (mapcar 'extent-descendants children)) | |
87 (list extent)))) | |
88 | |
89 (defun set-extent-keymap (extent keymap) | |
90 "Set EXTENT's `keymap' property to KEYMAP." | |
91 (set-extent-property extent 'keymap keymap)) |