1 ;;; auto-overlay-common.el --- general overlay functions
4 ;; Copyright (C) 2005-2015 Free Software Foundation, Inc
6 ;; Author: Toby Cubitt <toby-predictive@dr-qubit.org>
7 ;; Maintainer: Toby Cubitt <toby-predictive@dr-qubit.org>
8 ;; URL: http://www.dr-qubit.org/emacs.php
9 ;; Repository: http://www.dr-qubit.org/git/predictive.git
11 ;; This file is part of the Emacs.
13 ;; This file is free software: you can redistribute it and/or modify it under
14 ;; the terms of the GNU General Public License as published by the Free
15 ;; Software Foundation, either version 3 of the License, or (at your option)
18 ;; This program is distributed in the hope that it will be useful, but WITHOUT
19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
20 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
23 ;; You should have received a copy of the GNU General Public License along
24 ;; with this program. If not, see <http://www.gnu.org/licenses/>.
29 (provide 'auto-overlay-common)
33 (defun auto-overlays-at-point (&optional point prop-test inactive)
34 "Return overlays overlapping POINT
35 (or the point, if POINT is null). If PROP-TEST is supplied, it
36 should be a list which specifies a property test with one of the
37 following forms (or a list of such lists if more than one
38 property test is required):
42 (FUNCTION PROPERTY VALUE)
44 (FUNCTION (PROPERTY1 PROPERTY2 ...) (VALUE1 VALUE2 ...))
46 where PROPERTY indicates an overlay property name (a symbol), and
47 VALUE indicates an arbitrary value or lisp expression.
49 For each overlay overlapping POINT, first the values
50 corresponding to the property names are retrieved from the
51 overlay, then FUNCTION is called with the properties values
52 followed by the other values as its arguments. The test is
53 satisfied if the result is non-nil, otherwise it fails. Tests are
54 evaluated in order, but only up to the first failure. Only
55 overlays that satisfy all property tests are returned.
57 If INACTIVE is non-nil, both active and inactive overlays are
58 returned (usually inactive ones are ignored).
60 Note that this function returns any overlay. If you want to
61 restrict it to auto overlays, include '(identity auto-overlay) in
63 (when (null point) (setq point (point)))
66 ;; get overlays overlapping POINT and zero-length overlays at POINT
68 (auto-overlays-in point point prop-test nil inactive))
69 ;; get overlays that end at POINT
70 (dolist (o (auto-overlays-in (1- point) point prop-test nil inactive))
71 (when (and (< (overlay-start o) point)
72 (= (overlay-end o) point))
73 (push o overlay-list)))
74 ;; get overlays that start at POINT
75 (dolist (o (auto-overlays-in point (1+ point) prop-test nil inactive))
76 (when (and (> (overlay-end o) point)
77 (= (overlay-start o) point))
78 (push o overlay-list)))
85 (defun auto-overlays-in (start end &optional prop-test within inactive)
86 ;; FIXME: get rid of INACTIVE argument?
87 "Return auto overlays overlapping region between START and END.
89 If PROP-TEST is supplied, it should be a list which specifies a
90 property test with one of the following forms (or a list of such
91 lists if more than one property test is required):
95 (FUNCTION PROPERTY VALUE)
97 (FUNCTION (PROPERTY1 PROPERTY2 ...) (VALUE1 VALUE2 ...))
99 where PROPERTY indicates an overlay property name (a symbol), and
100 VALUE indicates an arbitrary value or lisp expression.
102 For each overlay between START and END, first the values
103 corresponding to the property names are retrieved from the
104 overlay, then FUNCTION is called with the properties values
105 followed by the other values as its arguments. The test is
106 satisfied if the result is non-nil, otherwise it fails. Tests are
107 evaluated in order, but only up to the first failure. Only
108 overlays that satisfy all property tests are returned.
110 If WITHIN is non-nil, only overlays entirely within START and END
111 are returned. If INACTIVE is non-nil, both active and inactive
112 overlays are returned (usually inactive ones are ignored).
114 Note that this function returns any overlay. If you want to
115 restrict it to auto overlays, include '(identity auto-overlay) in
118 ;; make sure prop-test is a list of lists, even if there's only one, and
119 ;; exclude inactive overlays unless told not to
122 (unless inactive (setq prop-test '((null inactive)))))
123 ((functionp (car prop-test))
125 (setq prop-test (list prop-test))
126 (setq prop-test (list '(null inactive) prop-test))))
128 (unless inactive (setq prop-test (push '(null inactive) prop-test)))))
130 (let (overlay-list function prop-list value-list result)
131 ;; check properties of each overlay in region
132 (dolist (o (overlays-in start end))
133 ;; check overlay is entirely within region
135 (or (< (overlay-start o) start) (> (overlay-end o) end)))
138 ;; if it is, or we don't care
141 ;; check if properties match
142 (dolist (test prop-test)
143 ;; (Note: the whole thing would be neater with something like
144 ;; (apply 'and (map ...)) but 'and is a special form, not a
145 ;; function, so can't be applied)
146 (setq function (nth 0 test))
147 (unless (listp (setq prop-list (nth 1 test)))
148 (setq prop-list (list prop-list)))
149 (setq value-list nil)
150 (unless (or (< (length test) 3)
151 (and (setq value-list (nth 2 test)) ; nil isn't list
153 (setq value-list (list value-list)))
159 (append (mapcar (lambda (p) (overlay-get o p))
162 (when (null result) (throw 'failed nil)))))
164 ;; add overlay to result list if its properties matched
165 (when result (push o overlay-list)))
166 ;; return result list
172 (defun auto-overlay-highest-priority-at-point (&optional point proptest)
173 "Return highest priority overlay at POINT (defaults to the point).
175 If two overlays have the same priority, the innermost one takes
176 precedence (i.e. the one that begins later, or if they begin at
177 the same point the one that ends earlier).
179 See `auto-overlays-at' for ane explanation of the PROPTEST argument."
181 (unless point (setq point (point)))
183 ;; get all overlays at point with a non-nil SYMBOL property
184 (let* ((overlay-list (auto-overlays-at-point point proptest))
185 (overlay (pop overlay-list))
188 ;; find the highest priority, innermost overlay
189 (dolist (o1 overlay-list)
190 (setq p (overlay-get overlay 'priority))
191 (setq p1 (overlay-get o1 'priority))
192 (when (or (and (null p) p1)
195 (or (> (overlay-start o1) (overlay-start overlay))
196 (and (= (overlay-start o1) (overlay-start overlay))
197 (< (overlay-end o1) (overlay-end o1))))))
200 ;; return the overlay
206 (defun auto-overlay-local-binding (symbol &optional point only-overlay)
207 "Return \"overlay local \" binding of SYMBOL at POINT,
208 or the current local binding if there is no overlay binding. If
209 there is no overlay binding and SYMBOL is not bound, return
210 nil. POINT defaults to the point.
212 If ONLY-OVERLAY is non-nil, only overlay bindings are
213 returned. If none exists at POINT, nil is returned
215 An \"overlay local\" binding is created by giving an overlay a
216 non-nil value for a property named SYMBOL. If more than one
217 overlay at POINT has a non-nil SYMBOL property, the value from
218 the highest priority overlay is returned.
220 See `auto-overlay-highest-priority-at-point' for a definition of
221 \"highest priority\"."
223 (let ((overlay (auto-overlay-highest-priority-at-point
224 point `(identity ,symbol))))
226 (overlay-get overlay symbol)
227 (and (not only-overlay) (boundp symbol) (symbol-value symbol)))))
229 ;; auto-overlay-common.el ends here