Mercurial > hg > xemacs-beta
annotate tests/automated/extent-tests.el @ 5652:cc6f0266bc36
Avoid #'delq in core Lisp, for the sake of style, a very slightly smaller binary
lisp/ChangeLog addition:
2012-05-01 Aidan Kehoe <kehoea@parhasard.net>
Avoid #'delq in core code, for the sake of style and a (very
slightly) smaller binary.
* behavior.el (disable-behavior):
* behavior.el (compute-behavior-group-children):
* buff-menu.el (buffers-tab-items):
* byte-optimize.el (byte-optimize-delay-constants-math):
* byte-optimize.el (byte-optimize-logmumble):
* byte-optimize.el (byte-decompile-bytecode-1):
* byte-optimize.el (byte-optimize-lapcode):
* bytecomp.el:
* bytecomp.el (byte-compile-arglist-warn):
* bytecomp.el (byte-compile-warn-about-unresolved-functions):
* bytecomp.el (byte-compile-lambda):
* bytecomp.el (byte-compile-out-toplevel):
* bytecomp.el (byte-compile-insert):
* bytecomp.el (byte-compile-defalias-warn):
* cl-macs.el (cl-upcase-arg):
* cl-macs.el (cl-transform-lambda):
* cl-macs.el (cl-do-proclaim):
* cl-macs.el (defstruct):
* cl-macs.el (cl-make-type-test):
* cl-macs.el (define-compiler-macro):
* cl-macs.el (delete-duplicates):
* cus-edit.el (widget-face-value-delete):
* cus-edit.el (face-history):
* easymenu.el (easy-menu-remove):
* files.el (files-fetch-hook-value):
* files.el (file-expand-wildcards):
* font-lock.el (font-lock-update-removed-keyword-alist):
* font-lock.el (font-lock-remove-keywords):
* frame.el (frame-initialize):
* frame.el (frame-notice-user-settings):
* frame.el (set-frame-font):
* frame.el (delete-other-frames):
* frame.el (get-frame-for-buffer-noselect):
* gnuserv.el (gnuserv-kill-buffer-function):
* gnuserv.el (gnuserv-check-device):
* gnuserv.el (gnuserv-kill-client):
* gnuserv.el (gnuserv-buffer-done-1):
* gtk-font-menu.el (gtk-reset-device-font-menus):
* gutter-items.el (buffers-tab-items):
* gutter.el (set-gutter-element-visible-p):
* info.el (Info-find-file-node):
* info.el (Info-history-add):
* info.el (Info-build-annotation-completions):
* info.el (Info-index):
* info.el (Info-reannotate-node):
* itimer.el (delete-itimer):
* itimer.el (start-itimer):
* lib-complete.el (lib-complete:cache-completions):
* loadhist.el (unload-feature):
* menubar-items.el (build-buffers-menu-internal):
* menubar.el (delete-menu-item):
* menubar.el (relabel-menu-item):
* msw-font-menu.el (mswindows-reset-device-font-menus):
* mule/make-coding-system.el (fixed-width-generate-helper):
* next-error.el (next-error-find-buffer):
* obsolete.el:
* obsolete.el (find-non-ascii-charset-string):
* obsolete.el (find-non-ascii-charset-region):
* occur.el (multi-occur-by-filename-regexp):
* occur.el (occur-1):
* packages.el (packages-package-hierarchy-directory-names):
* packages.el (package-get-key-1):
* process.el (setenv):
* simple.el (undo):
* simple.el (handle-pre-motion-command-current-command-is-motion):
* sound.el (load-sound-file):
* wid-edit.el (widget-field-value-delete):
* wid-edit.el (widget-checklist-match-inline):
* wid-edit.el (widget-checklist-match-find):
* wid-edit.el (widget-editable-list-delete-at):
* wid-edit.el (widget-editable-list-entry-create):
* window.el (quit-window):
* x-font-menu.el (x-reset-device-font-menus-core):
1. Replace (delq nil (mapcar ....)) with analogous (mapcan ...)
forms; this is in non-dumped files, it was done previously in
dumped files.
2. Replace (delq FOO (copy-sequence BAR)) with (remove* FOO BAR),
where #'eq and #'eql are equivalent
3. Replace (delq FOO BAR) with (delete* FOO BAR), where FOO is not
a non-fixnum number. Saves a little space in the dumped file
(since the compiler macro adds :test #'eq to the delete* call if
it's not clear that FOO is not a non-fixnum number).
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Tue, 01 May 2012 16:17:42 +0100 |
parents | 308d34e9f07d |
children | b79e1e02bf01 |
rev | line source |
---|---|
468 | 1 ;; Copyright (C) 2001 Free Software Foundation, Inc. |
2 | |
3 ;; Author: Hrvoje Niksic <hniksic@xemacs.org> | |
4 ;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org> | |
5 ;; Created: 1999 | |
6 ;; Keywords: tests | |
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:
5136
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:
5136
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:
5136
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:
5136
diff
changeset
|
13 ;; option) any later version. |
468 | 14 |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
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:
5136
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:
5136
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:
5136
diff
changeset
|
18 ;; for more details. |
468 | 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:
5136
diff
changeset
|
21 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
468 | 22 |
23 ;;; Synched up with: Not in FSF. | |
24 | |
25 ;;; Commentary: | |
26 | |
27 ;; Test extents operations. | |
28 ;; See test-harness.el for instructions on how to run these tests. | |
29 | |
30 (eval-when-compile | |
31 (condition-case nil | |
32 (require 'test-harness) | |
33 (file-error | |
34 (push "." load-path) | |
35 (when (and (boundp 'load-file-name) (stringp load-file-name)) | |
36 (push (file-name-directory load-file-name) load-path)) | |
37 (require 'test-harness)))) | |
38 | |
39 | |
40 ;;----------------------------------------------------- | |
41 ;; Creating and attaching. | |
42 ;;----------------------------------------------------- | |
43 | |
44 (with-temp-buffer | |
45 (let ((extent (make-extent nil nil)) | |
46 (string "somecoolstring")) | |
47 | |
48 ;; Detached extent. | |
49 (Assert (extent-detached-p extent)) | |
50 | |
51 ;; Put it in a buffer. | |
52 (set-extent-endpoints extent 1 1 (current-buffer)) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
53 (Assert (eq (extent-object extent) (current-buffer))) |
468 | 54 |
55 ;; And then into another buffer. | |
56 (with-temp-buffer | |
57 (set-extent-endpoints extent 1 1 (current-buffer)) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
58 (Assert (eq (extent-object extent) (current-buffer)))) |
468 | 59 |
60 ;; Now that the buffer doesn't exist, extent should be detached | |
61 ;; again. | |
62 (Assert (extent-detached-p extent)) | |
63 | |
64 ;; This line crashes XEmacs 21.2.46 and prior. | |
65 (set-extent-endpoints extent 1 (length string) string) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
66 (Assert (eq (extent-object extent) string)) |
468 | 67 ) |
68 | |
69 (let ((extent (make-extent 1 1))) | |
70 ;; By default, extent should be closed-open | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
71 (Assert (eq (get extent 'start-closed) t)) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
72 (Assert (eq (get extent 'start-open) nil)) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
73 (Assert (eq (get extent 'end-open) t)) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
74 (Assert (eq (get extent 'end-closed) nil)) |
468 | 75 |
76 ;; Make it closed-closed. | |
77 (set-extent-property extent 'end-closed t) | |
78 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
79 (Assert (eq (get extent 'start-closed) t)) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
80 (Assert (eq (get extent 'start-open) nil)) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
81 (Assert (eq (get extent 'end-open) nil)) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
82 (Assert (eq (get extent 'end-closed) t)) |
468 | 83 |
84 ;; open-closed | |
85 (set-extent-property extent 'start-open t) | |
86 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
87 (Assert (eq (get extent 'start-closed) nil)) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
88 (Assert (eq (get extent 'start-open) t)) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
89 (Assert (eq (get extent 'end-open) nil)) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
90 (Assert (eq (get extent 'end-closed) t)) |
468 | 91 |
92 ;; open-open | |
93 (set-extent-property extent 'end-open t) | |
94 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
95 (Assert (eq (get extent 'start-closed) nil)) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
96 (Assert (eq (get extent 'start-open) t)) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
97 (Assert (eq (get extent 'end-open) t)) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
98 (Assert (eq (get extent 'end-closed) nil))) |
468 | 99 |
100 ) | |
101 | |
102 ;;----------------------------------------------------- | |
103 ;; Insertion behavior. | |
104 ;;----------------------------------------------------- | |
105 | |
106 (defun et-range (extent) | |
107 "List (START-POSITION END-POSITION) of EXTENT." | |
108 (list (extent-start-position extent) | |
109 (extent-end-position extent))) | |
110 | |
111 (defun et-insert-at (string position) | |
112 "Insert STRING at POSITION in the current buffer." | |
113 (save-excursion | |
114 (goto-char position) | |
115 (insert string))) | |
116 | |
117 ;; Test insertion at the beginning, middle, and end of the extent. | |
118 | |
119 ;; closed-open | |
120 | |
121 (with-temp-buffer | |
122 (insert "###eee###") | |
123 (let ((e (make-extent 4 7))) | |
124 ;; current state: "###[eee)###" | |
125 ;; 123 456 789 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
126 (Assert (equal (et-range e) '(4 7))) |
468 | 127 |
128 (et-insert-at "xxx" 4) | |
129 | |
130 ;; current state: "###[xxxeee)###" | |
131 ;; 123 456789 012 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
132 (Assert (equal (et-range e) '(4 10))) |
468 | 133 |
134 (et-insert-at "yyy" 7) | |
135 | |
136 ;; current state: "###[xxxyyyeee)###" | |
137 ;; 123 456789012 345 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
138 (Assert (equal (et-range e) '(4 13))) |
468 | 139 |
140 (et-insert-at "zzz" 13) | |
141 | |
142 ;; current state: "###[xxxyyyeee)zzz###" | |
143 ;; 123 456789012 345678 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
144 (Assert (equal (et-range e) '(4 13))) |
468 | 145 )) |
146 | |
147 ;; closed-closed | |
148 | |
149 (with-temp-buffer | |
150 (insert "###eee###") | |
151 (let ((e (make-extent 4 7))) | |
152 (put e 'end-closed t) | |
153 | |
154 ;; current state: "###[eee]###" | |
155 ;; 123 456 789 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
156 (Assert (equal (et-range e) '(4 7))) |
468 | 157 |
158 (et-insert-at "xxx" 4) | |
159 | |
160 ;; current state: "###[xxxeee]###" | |
161 ;; 123 456789 012 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
162 (Assert (equal (et-range e) '(4 10))) |
468 | 163 |
164 (et-insert-at "yyy" 7) | |
165 | |
166 ;; current state: "###[xxxyyyeee]###" | |
167 ;; 123 456789012 345 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
168 (Assert (equal (et-range e) '(4 13))) |
468 | 169 |
170 (et-insert-at "zzz" 13) | |
171 | |
172 ;; current state: "###[xxxyyyeeezzz]###" | |
173 ;; 123 456789012345 678 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
174 (Assert (equal (et-range e) '(4 16))) |
468 | 175 )) |
176 | |
177 ;; open-closed | |
178 | |
179 (with-temp-buffer | |
180 (insert "###eee###") | |
181 (let ((e (make-extent 4 7))) | |
182 (put e 'start-open t) | |
183 (put e 'end-closed t) | |
184 | |
185 ;; current state: "###(eee]###" | |
186 ;; 123 456 789 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
187 (Assert (equal (et-range e) '(4 7))) |
468 | 188 |
189 (et-insert-at "xxx" 4) | |
190 | |
191 ;; current state: "###xxx(eee]###" | |
192 ;; 123456 789 012 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
193 (Assert (equal (et-range e) '(7 10))) |
468 | 194 |
195 (et-insert-at "yyy" 8) | |
196 | |
197 ;; current state: "###xxx(eyyyee]###" | |
198 ;; 123456 789012 345 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
199 (Assert (equal (et-range e) '(7 13))) |
468 | 200 |
201 (et-insert-at "zzz" 13) | |
202 | |
203 ;; current state: "###xxx(eyyyeezzz]###" | |
204 ;; 123456 789012345 678 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
205 (Assert (equal (et-range e) '(7 16))) |
468 | 206 )) |
207 | |
208 ;; open-open | |
209 | |
210 (with-temp-buffer | |
211 (insert "###eee###") | |
212 (let ((e (make-extent 4 7))) | |
213 (put e 'start-open t) | |
214 | |
215 ;; current state: "###(eee)###" | |
216 ;; 123 456 789 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
217 (Assert (equal (et-range e) '(4 7))) |
468 | 218 |
219 (et-insert-at "xxx" 4) | |
220 | |
221 ;; current state: "###xxx(eee)###" | |
222 ;; 123456 789 012 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
223 (Assert (equal (et-range e) '(7 10))) |
468 | 224 |
225 (et-insert-at "yyy" 8) | |
226 | |
227 ;; current state: "###xxx(eyyyee)###" | |
228 ;; 123456 789012 345 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
229 (Assert (equal (et-range e) '(7 13))) |
468 | 230 |
231 (et-insert-at "zzz" 13) | |
232 | |
233 ;; current state: "###xxx(eyyyee)zzz###" | |
234 ;; 123456 789012 345678 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
235 (Assert (equal (et-range e) '(7 13))) |
468 | 236 )) |
237 | |
238 | |
239 ;;----------------------------------------------------- | |
240 ;; Deletion behavior. | |
241 ;;----------------------------------------------------- | |
242 | |
243 (dolist (props '((start-closed t end-open t) | |
244 (start-closed t end-open nil) | |
245 (start-closed nil end-open nil) | |
246 (start-closed nil end-open t))) | |
247 ;; Deletion needs to behave the same regardless of the open-ness of | |
248 ;; the boundaries. | |
249 | |
250 (with-temp-buffer | |
251 (insert "xxxxxxxxxx") | |
252 (let ((e (make-extent 3 9))) | |
253 (set-extent-properties e props) | |
254 | |
255 ;; current state: xx[xxxxxx]xx | |
256 ;; 12 345678 90 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
257 (Assert (equal (et-range e) '(3 9))) |
468 | 258 |
259 (delete-region 1 2) | |
260 | |
261 ;; current state: x[xxxxxx]xx | |
262 ;; 1 234567 89 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
263 (Assert (equal (et-range e) '(2 8))) |
468 | 264 |
265 (delete-region 2 4) | |
266 | |
267 ;; current state: x[xxxx]xx | |
268 ;; 1 2345 67 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
269 (Assert (equal (et-range e) '(2 6))) |
468 | 270 |
271 (delete-region 1 3) | |
272 | |
273 ;; current state: [xxx]xx | |
274 ;; 123 45 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
275 (Assert (equal (et-range e) '(1 4))) |
468 | 276 |
277 (delete-region 3 5) | |
278 | |
279 ;; current state: [xx]x | |
280 ;; 12 3 | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
281 (Assert (equal (et-range e) '(1 3))) |
468 | 282 |
283 ))) | |
284 | |
285 ;;; #### Should have a test for read-only-ness and insertion and | |
286 ;;; deletion! | |
287 | |
288 ;;----------------------------------------------------- | |
289 ;; `detachable' property | |
290 ;;----------------------------------------------------- | |
291 | |
292 (dolist (props '((start-closed t end-open t) | |
293 (start-closed t end-open nil) | |
294 (start-closed nil end-open nil) | |
295 (start-closed nil end-open t))) | |
296 ;; `detachable' shouldn't relate to region properties, hence the | |
297 ;; loop. | |
298 (with-temp-buffer | |
299 (insert "###eee###") | |
300 (let ((e (make-extent 4 7))) | |
301 (set-extent-properties e props) | |
302 (Assert (get e 'detachable)) | |
303 | |
304 (Assert (not (extent-detached-p e))) | |
305 | |
306 (delete-region 4 5) | |
307 ;; ###ee### (not detached yet) | |
308 (Assert (not (extent-detached-p e))) | |
309 | |
310 (delete-region 4 6) | |
311 ;; ###### (should be detached now) | |
312 (Assert (extent-detached-p e)))) | |
313 | |
314 (with-temp-buffer | |
315 (insert "###eee###") | |
316 (let ((e (make-extent 4 7))) | |
317 (set-extent-properties e props) | |
318 (put e 'detachable nil) | |
319 (Assert (not (get e 'detachable))) | |
320 | |
321 (Assert (not (extent-detached-p e))) | |
322 | |
323 (delete-region 4 5) | |
324 ;; ###ee### | |
325 (Assert (not (extent-detached-p e))) | |
326 | |
327 (delete-region 4 6) | |
328 ;; ###[]### | |
329 (Assert (not (extent-detached-p e))) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
330 (Assert (equal (et-range e) '(4 4))) |
468 | 331 )) |
332 ) | |
333 | |
334 | |
335 ;;----------------------------------------------------- | |
336 ;; Zero-length extents. | |
337 ;;----------------------------------------------------- | |
338 | |
339 ;; closed-open (should stay put) | |
340 (with-temp-buffer | |
341 (insert "######") | |
342 (let ((e (make-extent 4 4))) | |
343 (et-insert-at "foo" 4) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
344 (Assert (equal (et-range e) '(4 4))))) |
468 | 345 |
346 ;; open-closed (should move) | |
347 (with-temp-buffer | |
348 (insert "######") | |
349 (let ((e (make-extent 4 4))) | |
350 (put e 'start-open t) | |
351 (put e 'end-closed t) | |
352 (et-insert-at "foo" 4) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
353 (Assert (equal (et-range e) '(7 7))))) |
468 | 354 |
355 ;; closed-closed (should extend) | |
356 (with-temp-buffer | |
357 (insert "######") | |
358 (let ((e (make-extent 4 4))) | |
359 (put e 'end-closed t) | |
360 (et-insert-at "foo" 4) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
361 (Assert (equal (et-range e) '(4 7))))) |
468 | 362 |
363 ;; open-open (illegal; forced to behave like closed-open) | |
364 (with-temp-buffer | |
365 (insert "######") | |
366 (let ((e (make-extent 4 4))) | |
367 (put e 'start-open t) | |
368 (et-insert-at "foo" 4) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
369 (Assert (equal (et-range e) '(4 4))))) |