Mercurial > hg > xemacs-beta
annotate tests/automated/extent-tests.el @ 5940:c608d4b0b75e cygwin64 tip
rescue lost branch from 64bit.backup
| author | Henry Thompson <ht@markup.co.uk> |
|---|---|
| date | Thu, 16 Dec 2021 18:48:58 +0000 |
| parents | b79e1e02bf01 |
| children |
| 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))))) |
|
5803
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
370 |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
371 ;;----------------------------------------------------- |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
372 ;; Extents and the minibuffer. |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
373 ;;----------------------------------------------------- |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
374 |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
375 (let* ((string (copy-sequence "Der Hoelle Rache kocht in meinem Herzen")) |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
376 (e (make-extent (search "Rache" string) (search "kocht" string) |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
377 string)) |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
378 (ee (make-extent (search "meinem" string) (search "Herzen" string) |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
379 string)) |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
380 (property-name '#:secret-token) |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
381 event list) |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
382 (setf (extent-property e 'duplicable) t |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
383 (extent-property e property-name) t |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
384 (extent-property ee 'duplicable) nil) ;; Actually the default. |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
385 (block enough |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
386 (enqueue-eval-event #'(lambda (ignore) (return-from enough)) nil) |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
387 ;; Silence prompt on TTY. Maybe we shouldn't be doing this. |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
388 (flet ((send-string-to-terminal (&rest ignore))) |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
389 (while (setq event (next-event event string)) |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
390 (dispatch-event event)))) |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
391 (setq list (extent-list (get-buffer " *Echo Area*"))) |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
392 (Assert list "checking extent info was preserved in #'next-event") |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
393 (Assert (eql 1 (length list)) "checking only one extent was preserved") |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
394 (Assert (eql t (get (car list) property-name)) |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
395 "checking it was our duplicable extent that was preserved")) |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
396 |
|
b79e1e02bf01
Preserve extent information in the command builder code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
397 |