Mercurial > hg > xemacs-beta
annotate lisp/extents.el @ 5618:cc1ec4c93a67
Improve Lisp style in a few places, select.el
lisp/ChangeLog addition:
2011-12-23 Aidan Kehoe <kehoea@parhasard.net>
* select.el (activate-region-as-selection):
* select.el (select-make-extent-for-selection):
* select.el (select-convert-in):
* select.el (select-convert-out):
* select.el (select-coerce):
* select.el (select-convert-to-targets):
Improve Lisp style in a few places here; don't re-implement
#'delete-duplicates, use #'funcall instead of consing up a list to
pass to #'apply.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Fri, 23 Dec 2011 10:34:40 +0000 |
| parents | 308d34e9f07d |
| children |
| rev | line source |
|---|---|
| 428 | 1 ;;; extents.el --- miscellaneous extent functions not written in C |
| 2 | |
| 3 ;; Copyright (C) 1993-4, 1997 Free Software Foundation, Inc. | |
| 442 | 4 ;; Copyright (C) 2000 Ben Wing. |
| 428 | 5 |
| 6 ;; Keywords: internal, dumped | |
| 7 | |
| 8 ;; This file is part of XEmacs. | |
| 9 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5264
diff
changeset
|
10 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5264
diff
changeset
|
11 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5264
diff
changeset
|
12 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5264
diff
changeset
|
13 ;; option) any later version. |
| 428 | 14 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5264
diff
changeset
|
15 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5264
diff
changeset
|
16 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5264
diff
changeset
|
17 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5264
diff
changeset
|
18 ;; for more details. |
| 428 | 19 |
| 20 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5264
diff
changeset
|
21 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 22 |
| 23 ;;; Synched up with: Not in FSF. | |
| 24 | |
| 25 ;;; Commentary: | |
| 26 | |
| 442 | 27 ;;; Authorship: |
| 28 | |
| 29 ;; Created 1995 Ben Wing. | |
| 30 ;; mapcar-extents (and extent-list?) from stig@hackvan.com, c. 1996. | |
| 428 | 31 |
| 32 ;;; Code: | |
| 33 | |
| 34 ;; an alternative to map-extents. | |
| 35 (defun mapcar-extents (function &optional predicate buffer-or-string from to | |
| 36 flags property value) | |
| 37 "Apply FUNCTION to all extents which overlap a region in BUFFER-OR-STRING. | |
| 38 The region is delimited by FROM and TO. FUNCTION is called with | |
| 39 one argument, the extent. A list of the values returned by FUNCTION | |
| 40 is returned. An optional PREDICATE may be used to further limit the | |
| 41 extents over which FUNCTION is mapped. The optional arguments FLAGS, | |
| 42 PROPERTY, and VALUE may also be used to control the extents passed to | |
| 43 PREDICATE or FUNCTION. See also `map-extents'." | |
| 44 (let (*result*) | |
| 45 (map-extents (if predicate | |
| 46 #'(lambda (ex junk) | |
| 47 (and (funcall predicate ex) | |
| 48 (setq *result* (cons (funcall function ex) | |
| 49 *result*))) | |
| 50 nil) | |
| 51 #'(lambda (ex junk) | |
| 52 (setq *result* (cons (funcall function ex) | |
| 53 *result*)) | |
| 54 nil)) | |
| 55 buffer-or-string from to nil flags property value) | |
| 56 (nreverse *result*))) | |
| 57 | |
| 442 | 58 (defun extent-list (&optional buffer-or-string from to flags property value) |
| 428 | 59 "Return a list of the extents in BUFFER-OR-STRING. |
| 60 BUFFER-OR-STRING defaults to the current buffer if omitted. | |
| 61 FROM and TO can be used to limit the range over which extents are | |
| 62 returned; if omitted, all extents in the buffer or string are returned. | |
| 63 | |
| 64 More specifically, if a range is specified using FROM and TO, only | |
| 65 extents that overlap the range (i.e. begin or end inside of the range) | |
| 66 are included in the list. FROM and TO default to the beginning and | |
| 67 end of BUFFER-OR-STRING, respectively. | |
| 68 | |
| 69 FLAGS controls how end cases are treated. For a discussion of this, | |
| 442 | 70 and exactly what ``overlap'' means, see `map-extents'. PROPERTY and VALUE |
| 71 are also as in `map-extents'. | |
| 428 | 72 |
| 73 If you want to map a function over the extents in a buffer or string, | |
| 442 | 74 consider using `map-extents' or `mapcar-extents' instead. |
| 75 | |
| 76 See also `extents-at'." | |
| 77 (mapcar-extents 'identity nil buffer-or-string from to flags property value)) | |
| 78 | |
| 79 (defun extent-at-event (event &optional property before at-flag) | |
| 80 "Return the smallest extent under EVENT, if any. | |
| 81 PROPERTY, BEFORE, and AT-FLAG are as in `extent-at'." | |
| 82 (let* ((win (event-window event)) | |
| 83 (p (event-point event))) | |
| 84 (and win p (extent-at p (window-buffer win) property before at-flag)))) | |
| 85 | |
| 86 (defun extents-at-event (event &optional property before at-flag) | |
| 87 "Return a list of all extents under EVENT. | |
| 88 PROPERTY, BEFORE, and AT-FLAG are as in `extent-at'." | |
| 89 (let* ((win (event-window event)) | |
| 90 (p (event-point event))) | |
| 91 (and win p (extents-at p (window-buffer win) property before at-flag)))) | |
| 428 | 92 |
| 93 (defun extent-string (extent) | |
| 94 "Return the string delimited by the bounds of EXTENT." | |
| 95 (let ((object (extent-object extent))) | |
| 96 (if (bufferp object) | |
| 97 (buffer-substring (extent-start-position extent) | |
| 98 (extent-end-position extent) | |
| 99 object) | |
| 100 (substring object | |
| 101 (extent-start-position extent) | |
| 102 (extent-end-position extent))))) | |
| 103 | |
| 104 (defun extent-descendants (extent) | |
| 105 "Return a list of all descendants of EXTENT, including EXTENT. | |
| 106 This recursively applies `extent-children' to any children of | |
| 107 EXTENT, until no more children can be found." | |
| 108 (let ((children (extent-children extent))) | |
| 109 (if children | |
|
5264
0d43872986b6
Change (apply 'nconc (mapcar ...)) to (mapcan ...); warn about first form.
Aidan Kehoe <kehoea@parhasard.net>
parents:
442
diff
changeset
|
110 (mapcan 'extent-descendants children) |
| 428 | 111 (list extent)))) |
| 112 | |
| 113 (defun set-extent-keymap (extent keymap) | |
| 114 "Set EXTENT's `keymap' property to KEYMAP." | |
| 115 (set-extent-property extent 'keymap keymap)) | |
| 116 | |
| 117 (defun extent-keymap (extent) | |
| 118 "Return EXTENT's `keymap' property." | |
| 119 (extent-property extent 'keymap)) | |
| 120 | |
| 121 ;;; extents.el ends here |