1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
|
;; This file implements spans in terms of extents, for emacs19.
;;
;; Copyright (C) 1998 LFCS Edinburgh
;; Author: Healfdene Goguen
;; Maintainer: David Aspinall <David.Aspinall@ed.ac.uk>
;; License: GPL (GNU GENERAL PUBLIC LICENSE)
;;
;; $Id$
;; XEmacs-Emacs compatibility: define "spans" in terms of overlays.
(defalias 'span-start 'overlay-start)
(defalias 'span-end 'overlay-end)
(defalias 'set-span-property 'overlay-put)
(defalias 'span-property 'overlay-get)
(defalias 'make-span 'make-overlay)
(defalias 'detach-span 'delete-overlay)
(defalias 'set-span-endpoints 'move-overlay)
(defalias 'span-buffer 'overlay-buffer)
(defun span-read-only-hook (overlay after start end &optional len)
(unless inhibit-read-only
(error "Region is read-only")))
(defun span-read-only (span)
"Set SPAN to be read only."
;; This function may be called on spans which are detached from a
;; buffer, which gives an error here, since text-properties are
;; associated with text in a particular buffer position. So we use
;; our own read only hook.
;(add-text-properties (span-start span) (span-end span) '(read-only t)))
;; 30.8.02: tested using overlay-put as below with Emacs 21.2.1,
;; bit this seems to have no effect when the overlay is added to
;; the buffer. (Maybe read-only is only a text property, not an
;; overlay property?).
;; (overlay-put span 'read-only t))
(set-span-property span 'modification-hooks '(span-read-only-hook))
(set-span-property span 'insert-in-front-hooks '(span-read-only-hook)))
(defun span-read-write (span)
"Set SPAN to be writeable."
;; See comment above for text properties problem.
(set-span-property span 'modification-hooks nil)
(set-span-property span 'insert-in-front-hooks nil))
(defun span-give-warning (&rest args)
"Give a warning message."
(message "You should not edit here!"))
(defun span-write-warning (span)
"Give a warning message when SPAN is changed."
(set-span-property span 'modification-hooks '(span-give-warning))
(set-span-property span 'insert-in-front-hooks '(span-give-warning)))
;; We use end first because proof-locked-queue is often changed, and
;; its starting point is always 1
(defun span-lt (s u)
(or (< (span-end s) (span-end u))
(and (eq (span-end s) (span-end u))
(< (span-start s) (span-start u)))))
(defun spans-at-point-prop (pt prop)
(let ((ols ()))
(dolist (ol (overlays-at pt))
(if (or (null prop) (overlay-get ol prop)) (push ol ols)))
ols))
(defun spans-at-region-prop (start end prop &optional val)
(let ((ols ()))
(dolist (ol (overlays-in start end))
(if (or (null prop)
(if val (eq val (overlay-get ol prop)) (overlay-get ol prop)))
(push ol ols)))
ols))
(defun span-at (pt prop)
"Return the SPAN at point PT with property PROP.
For XEmacs, span-at gives smallest extent at pos.
For Emacs, we assume that spans don't overlap."
(car (spans-at-point-prop pt prop)))
(defsubst delete-span (span)
"Delete SPAN."
(let ((predelfn (span-property span 'span-delete-action)))
(and predelfn (funcall predelfn)))
(delete-overlay span))
;; The next two change ordering of list of spans:
(defsubst mapcar-spans (fn start end prop &optional val)
"Apply function FN to all spans between START and END with property PROP set"
(mapcar fn (spans-at-region-prop start end prop (or val nil))))
(defun span-at-before (pt prop)
"Return the smallest SPAN at before PT with property PROP.
A span is before PT if it begins before the character before PT."
(let ((ols (if (eq (point-min) pt)
nil ;; (overlays-at pt)
(overlays-in (1- pt) pt))))
;; Check the PROP is set.
(when prop
(dolist (ol (prog1 ols (setq ols nil)))
(if (overlay-get ol prop) (push ol ols))))
;; Eliminate the case of an empty overlay at (1- pt).
(dolist (ol (prog1 ols (setq ols nil)))
(if (>= (overlay-end ol) pt) (push ol ols)))
;; "Get the smallest". I have no idea what that means, so I just do
;; something somewhat random but vaguely meaningful. -Stef
(car (last (sort ols 'span-lt)))))
(defun prev-span (span prop)
"Return span before SPAN with property PROP."
(span-at-before (span-start span) prop))
; overlays are [start, end)
(defun next-span (span prop)
"Return span after SPAN with property PROP."
;; Presuming the span-extents.el is the reference, its code does the same
;; as the code below.
(span-at (span-end span) prop)
;; ;; 3.4 fix here: Now we do a proper search, so this should work with
;; ;; nested overlays, after a fashion. Use overlays-in to get a list
;; ;; for the entire buffer, this avoids repeatedly checking the same
;; ;; overlays in an ever expanding list (see v6.1). (However, this
;; ;; list may be huge: is it a bottleneck?)
;; ;; [Why has this function never used the before-list ?]
;; (let* ((start (overlay-start span))
;; ;; (pos start)
;; (nextos (overlays-in (overlay-end span)
;; (1+ start)
;; (point-max)))
;; (resstart (1+ (point-max)))
;; spanres)
;; ;; overlays are returned in an unspecified order; we
;; ;; must search whole list for a closest-next one.
;; (dolist (newres nextos spanres)
;; (if (and (span-property newres prop)
;; (< start (span-start newres))
;; (< (span-start newres) resstart))
;; (progn
;; (setq spanres newres)
;; (setq resstart (span-start spanres))))))
)
(defsubst span-live-p (span)
"Return non-nil if SPAN is in a live buffer."
(and span
(overlay-buffer span)
(buffer-live-p (overlay-buffer span))))
(defun span-raise (span)
"Set priority of span to make it appear above other spans.
FIXME: new hack added nov 99 because of disappearing overlays.
Behaviour is still worse than before." ;??? --Stef
(set-span-property span 'priority 100))
(defalias 'span-object 'overlay-buffer)
(defun span-string (span)
(with-current-buffer (overlay-buffer span)
(buffer-substring (overlay-start span) (overlay-end span))))
;Pierre: new utility functions for "holes"
(defun set-span-properties (span plist)
"Set SPAN's properties, plist is a plist."
(let ((pl plist))
(while pl
(let* ((name (car pl))
(value (car (cdr pl))))
(overlay-put span name value)
(setq pl (cdr (cdr pl))))
)
)
)
(defun span-find-span (overlay-list &optional prop)
"Returns the first overlay of overlay-list having property prop (default 'span), nil if no such overlay belong to the list."
(let ((l overlay-list))
(while (and l (not (overlay-get (car l) (or prop 'span))))
(setq l (cdr l)))
(car l)))
(defsubst span-at-event (event &optional prop)
(span-find-span (overlays-at (posn-point (event-start event))) prop)
)
(defun make-detached-span ()
(let ((ol (make-overlay 0 0)))
(delete-overlay ol)
ol))
(defun fold-spans (f &optional buffer from to maparg ignored-flags prop val)
(with-current-buffer (or buffer (current-buffer))
(let ((ols (overlays-in (or from (point-min)) (or to (point-max))))
res)
;; Check the PROP.
(when prop
(dolist (ol (prog1 ols (setq ols nil)))
(if (if val (eq val (overlay-get ol prop)) (overlay-get ol prop))
(push ol ols))))
;; Iterate in order.
(setq ols (sort ols 'span-lt))
(while (and ols (not (setq res (funcall f (pop ols) maparg)))))
res)))
(defsubst span-detached-p (span)
"is this span detached? nil for no, t for yes"
(null (overlay-buffer span)))
(defsubst set-span-face (span face)
"set the face of a span"
(overlay-put span 'face face))
(defun set-span-keymap (span map)
"Set the keymap of SPAN to MAP"
(overlay-put span 'keymap map)
(overlay-put span 'local-map map))
(provide 'span-overlay)
|
