|
22
|
1 ;;; overlay.el --- overlay support.
|
|
|
2
|
|
|
3 ;;;; Copyright (C) 1997 Free Software Foundation, Inc.
|
|
|
4
|
|
163
|
5 ;; Author: Joe Nuspl <nuspl@sequent.com>
|
|
|
6 ;; Maintainer: XEmacs Development Team (in <hniksic@srce.hr> incarnation)
|
|
22
|
7 ;; Keywords: internal
|
|
|
8
|
|
|
9 ;; This file is part of XEmacs.
|
|
|
10
|
|
|
11 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
12 ;; under the terms of the GNU General Public License as published by
|
|
|
13 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
14 ;; any later version.
|
|
|
15
|
|
|
16 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
19 ;; General Public License for more details.
|
|
|
20
|
|
|
21 ;; You should have received a copy of the GNU General Public License
|
|
|
22 ;; along with XEmacs; see the file COPYING. If not, write to the
|
|
|
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
24 ;; Boston, MA 02111-1307, USA.
|
|
|
25
|
|
|
26 ;;; Synched up with: Not in FSF.
|
|
|
27
|
|
163
|
28 ;;; Commentary:
|
|
|
29
|
|
|
30 ;; Unlike the text-properties interface, these functions are in fact
|
|
|
31 ;; totally useless in XEmacs. They are a more or less straightforward
|
|
|
32 ;; interface to the much better extent API, provided exclusively for
|
|
|
33 ;; GNU Emacs compatibility. If you notice an incompatibility not
|
|
|
34 ;; mentioned below, be sure to mention it. Anyways, you should really
|
|
|
35 ;; not use this.
|
|
|
36
|
|
|
37 ;; Known incompatibilities with the FSF interface:
|
|
|
38
|
|
|
39 ;; 1. There is not an `overlay' type. Any extent with non-nil
|
|
|
40 ;; 'overlay property is considered an "overlay".
|
|
|
41 ;;
|
|
|
42 ;; 2. Some features of FSF overlays have not been implemented in
|
|
|
43 ;; extents (or are unneeded). Specifically, those are the
|
|
|
44 ;; following special properties: window, insert-in-front-hooks,
|
|
|
45 ;; insert-behind-hooks, and modification-hooks. Some of these will
|
|
|
46 ;; probably be implemented for extents in the future.
|
|
|
47 ;;
|
|
|
48 ;; 3. In FSF, beginning and end of an overlay are markers, which means
|
|
|
49 ;; that you can use `insert-before-markers' to change insertion
|
|
|
50 ;; property of overlay. It will not work in this emulation, and we
|
|
|
51 ;; have no plans of providing it.
|
|
|
52 ;;
|
|
|
53 ;; 4. The `overlays-in' and `overlays-at' functions in some cases
|
|
|
54 ;; don't work as they should. To be fixed RSN.
|
|
|
55 ;;
|
|
|
56 ;; 5. Finally, setting or modification of overlay properties specific
|
|
|
57 ;; to extents will have unusual results. While (overlay-put
|
|
|
58 ;; overlay 'start-open t) does nothing under FSF, it has a definite
|
|
|
59 ;; effect under XEmacs. This is solved by simply avoiding such
|
|
|
60 ;; names (see `set-extent-property' for a list).
|
|
|
61
|
|
|
62 ;; Some functions were broken; fixed-up by Hrvoje Niksic, June 1997.
|
|
|
63
|
|
|
64
|
|
|
65 ;;; Code:
|
|
|
66
|
|
22
|
67 (defun overlayp (object)
|
|
|
68 "Return t if OBJECT is an overlay."
|
|
|
69 (and (extentp object)
|
|
|
70 (extent-property object 'overlay)))
|
|
|
71
|
|
|
72 (defun make-overlay (beg end &optional buffer front-advance rear-advance)
|
|
|
73 "Create a new overlay with range BEG to END in BUFFER.
|
|
|
74 If omitted, BUFFER defaults to the current buffer.
|
|
|
75 BEG and END may be integers or markers.
|
|
|
76 The fourth arg FRONT-ADVANCE, if non-nil, makes the
|
|
|
77 front delimiter advance when text is inserted there.
|
|
|
78 The fifth arg REAR-ADVANCE, if non-nil, makes the
|
|
|
79 rear delimiter advance when text is inserted there."
|
|
163
|
80 (if (null buffer)
|
|
|
81 (setq buffer (current-buffer))
|
|
|
82 (check-argument-type 'bufferp buffer))
|
|
|
83 (when (> beg end)
|
|
|
84 (setq beg (prog1 end (setq end beg))))
|
|
22
|
85
|
|
163
|
86 (let ((overlay (make-extent beg end buffer)))
|
|
22
|
87 (set-extent-property overlay 'overlay t)
|
|
|
88 (if front-advance
|
|
|
89 (set-extent-property overlay 'start-open t)
|
|
|
90 (set-extent-property overlay 'start-closed t))
|
|
|
91 (if rear-advance
|
|
|
92 (set-extent-property overlay 'end-closed t)
|
|
|
93 (set-extent-property overlay 'end-open t))
|
|
|
94
|
|
|
95 overlay))
|
|
|
96
|
|
|
97 (defun move-overlay (overlay beg end &optional buffer)
|
|
|
98 "Set the endpoints of OVERLAY to BEG and END in BUFFER.
|
|
|
99 If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.
|
|
|
100 If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current
|
|
|
101 buffer."
|
|
163
|
102 (check-argument-type 'overlayp overlay)
|
|
|
103 (if (null buffer)
|
|
|
104 (setq buffer (extent-object overlay)))
|
|
|
105 (if (null buffer)
|
|
|
106 (setq buffer (current-buffer)))
|
|
|
107 (check-argument-type 'bufferp buffer)
|
|
|
108 (and (= beg end)
|
|
|
109 (extent-property overlay 'evaporate)
|
|
|
110 (delete-overlay overlay))
|
|
|
111 (when (> beg end)
|
|
|
112 (setq beg (prog1 end (setq end beg))))
|
|
|
113 (set-extent-endpoints overlay beg end buffer)
|
|
|
114 overlay)
|
|
22
|
115
|
|
|
116 (defun delete-overlay (overlay)
|
|
|
117 "Delete the overlay OVERLAY from its buffer."
|
|
|
118 (check-argument-type 'overlayp overlay)
|
|
|
119 (detach-extent overlay)
|
|
|
120 nil)
|
|
|
121
|
|
|
122 (defun overlay-start (overlay)
|
|
|
123 "Return the position at which OVERLAY starts."
|
|
|
124 (check-argument-type 'overlayp overlay)
|
|
|
125 (extent-start-position overlay))
|
|
|
126
|
|
|
127 (defun overlay-end (overlay)
|
|
|
128 "Return the position at which OVERLAY ends."
|
|
|
129 (check-argument-type 'overlayp overlay)
|
|
|
130 (extent-end-position overlay))
|
|
|
131
|
|
|
132 (defun overlay-buffer (overlay)
|
|
|
133 "Return the buffer OVERLAY belongs to."
|
|
|
134 (check-argument-type 'overlayp overlay)
|
|
|
135 (extent-object overlay))
|
|
|
136
|
|
|
137 (defun overlay-properties (overlay)
|
|
|
138 "Return a list of the properties on OVERLAY.
|
|
|
139 This is a copy of OVERLAY's plist; modifying its conses has no effect on
|
|
|
140 OVERLAY."
|
|
|
141 (check-argument-type 'overlayp overlay)
|
|
|
142 (extent-properties overlay))
|
|
|
143
|
|
|
144 (defun overlays-at (pos)
|
|
|
145 "Return a list of the overlays that contain position POS."
|
|
|
146 (overlays-in pos pos))
|
|
|
147
|
|
|
148 (defun overlays-in (beg end)
|
|
|
149 "Return a list of the overlays that overlap the region BEG ... END.
|
|
|
150 Overlap means that at least one character is contained within the overlay
|
|
|
151 and also contained within the specified region.
|
|
|
152 Empty overlays are included in the result if they are located at BEG
|
|
|
153 or between BEG and END."
|
|
163
|
154 (mapcar-extents #'identity nil nil beg end nil 'overlay))
|
|
22
|
155
|
|
|
156 (defun next-overlay-change (pos)
|
|
|
157 "Return the next position after POS where an overlay starts or ends.
|
|
|
158 If there are no more overlay boundaries after POS, return (point-max)."
|
|
|
159 (let ((next (point-max))
|
|
163
|
160 tmp)
|
|
|
161 (map-extents
|
|
|
162 (lambda (overlay ignore)
|
|
|
163 (when (or (and (< (setq tmp (extent-start-position overlay)) next)
|
|
|
164 (> tmp pos))
|
|
|
165 (and (< (setq tmp (extent-end-position overlay)) next)
|
|
|
166 (> tmp pos)))
|
|
|
167 (setq next tmp))
|
|
|
168 nil)
|
|
|
169 nil pos nil nil nil 'overlay)
|
|
22
|
170 next))
|
|
|
171
|
|
|
172 (defun previous-overlay-change (pos)
|
|
|
173 "Return the previous position before POS where an overlay starts or ends.
|
|
|
174 If there are no more overlay boundaries before POS, return (point-min)."
|
|
|
175 (let ((prev (point-min))
|
|
163
|
176 tmp)
|
|
|
177 (map-extents
|
|
|
178 (lambda (overlay ignore)
|
|
|
179 (when (or (and (> (setq tmp (extent-end-position overlay)) prev)
|
|
|
180 (< tmp pos))
|
|
|
181 (and (> (setq tmp (extent-start-position overlay)) prev)
|
|
|
182 (< tmp pos)))
|
|
|
183 (setq prev tmp))
|
|
|
184 nil)
|
|
|
185 nil nil pos nil nil 'overlay)
|
|
22
|
186 prev))
|
|
|
187
|
|
|
188 (defun overlay-lists ()
|
|
|
189 "Return a pair of lists giving all the overlays of the current buffer.
|
|
|
190 The car has all the overlays before the overlay center;
|
|
|
191 the cdr has all the overlays after the overlay center.
|
|
|
192 Recentering overlays moves overlays between these lists.
|
|
|
193 The lists you get are copies, so that changing them has no effect.
|
|
|
194 However, the overlays you get are the real objects that the buffer uses."
|
|
163
|
195 (or (boundp 'xemacs-internal-overlay-center-pos)
|
|
|
196 (overlay-recenter (1+ (/ (- (point-max) (point-min)) 2))))
|
|
22
|
197 (let ((pos xemacs-internal-overlay-center-pos)
|
|
|
198 before after)
|
|
163
|
199 (map-extents (lambda (overlay ignore)
|
|
|
200 (if (> pos (extent-end-position overlay))
|
|
|
201 (push overlay before)
|
|
|
202 (push overlay after))
|
|
|
203 nil)
|
|
|
204 nil nil nil nil nil 'overlay)
|
|
|
205 (cons (nreverse before) (nreverse after))))
|
|
22
|
206
|
|
|
207 (defun overlay-recenter (pos)
|
|
|
208 "Recenter the overlays of the current buffer around position POS."
|
|
|
209 (set (make-local-variable 'xemacs-internal-overlay-center-pos) pos))
|
|
|
210
|
|
|
211 (defun overlay-get (overlay prop)
|
|
|
212 "Get the property of overlay OVERLAY with property name PROP."
|
|
|
213 (check-argument-type 'overlayp overlay)
|
|
163
|
214 (let ((value (extent-property overlay prop))
|
|
|
215 category)
|
|
|
216 (if (and (null value)
|
|
|
217 (setq category (extent-property overlay 'category)))
|
|
|
218 (get category prop)
|
|
|
219 value)))
|
|
22
|
220
|
|
|
221 (defun overlay-put (overlay prop value)
|
|
|
222 "Set one property of overlay OVERLAY: give property PROP value VALUE."
|
|
|
223 (check-argument-type 'overlayp overlay)
|
|
|
224 (cond ((eq prop 'evaporate)
|
|
|
225 (set-extent-property overlay 'detachable value))
|
|
|
226 ((eq prop 'before-string)
|
|
|
227 (set-extent-property overlay 'begin-glyph
|
|
|
228 (make-glyph (vector 'string :data value))))
|
|
|
229 ((eq prop 'after-string)
|
|
|
230 (set-extent-property overlay 'end-glyph
|
|
|
231 (make-glyph (vector 'string :data value))))
|
|
163
|
232 ((eq prop 'local-map)
|
|
|
233 (set-extent-property overlay 'keymap value))
|
|
22
|
234 ((memq prop '(window insert-in-front-hooks insert-behind-hooks
|
|
|
235 modification-hooks))
|
|
|
236 (error "cannot support overlay '%s property under XEmacs"
|
|
|
237 prop)))
|
|
|
238 (set-extent-property overlay prop value))
|
|
|
239
|
|
|
240 (provide 'overlay)
|
|
|
241
|
|
|
242 ;;; overlay.el ends here
|
