Mercurial > hg > xemacs-beta
annotate tests/automated/extent-tests.el @ 5189:b65692aa90d8
Cosmetic XFT-code fixes, some variable renamings
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-04-04 Ben Wing <ben@xemacs.org>
* font-mgr.c:
* font-mgr.c (fc_standard_properties):
* font-mgr.c (Ffc_pattern_p):
* font-mgr.c (Ffc_pattern_create):
* font-mgr.c (Ffc_name_parse):
* font-mgr.c (Ffc_name_unparse):
* font-mgr.c (Ffc_pattern_duplicate):
* font-mgr.c (Ffc_pattern_add):
* font-mgr.c (Ffc_pattern_del):
* font-mgr.c (Ffc_pattern_get):
* font-mgr.c (fc_config_create_using):
* font-mgr.c (fc_strlist_to_lisp_using):
* font-mgr.c (fontset_to_list):
* font-mgr.c (Ffc_config_p):
* font-mgr.c (Ffc_config_create):
* font-mgr.c (Ffc_config_destroy):
* font-mgr.c (Ffc_config_up_to_date):
* font-mgr.c (Ffc_config_build_fonts):
* font-mgr.c (Ffc_config_get_config_dirs):
* font-mgr.c (Ffc_config_get_font_dirs):
* font-mgr.c (Ffc_config_get_config_files):
* font-mgr.c (Ffc_config_get_cache):
* font-mgr.c (Ffc_config_get_fonts):
* font-mgr.c (Ffc_config_set_current):
* font-mgr.c (Ffc_config_get_blanks):
* font-mgr.c (Ffc_config_get_rescan_interval):
* font-mgr.c (Ffc_config_set_rescan_interval):
* font-mgr.c (Ffc_config_app_font_add_file):
* font-mgr.c (Ffc_config_app_font_add_dir):
* font-mgr.c (Ffc_config_app_font_clear):
* font-mgr.c (Ffc_init_load_config):
* font-mgr.c (Ffc_init_load_config_and_fonts):
* font-mgr.c (Ffc_config_get_current):
* font-mgr.c (size):
* font-mgr.c (Ffc_font_render_prepare):
* font-mgr.c (Ffc_font_match):
* font-mgr.c (Ffc_font_sort):
* font-mgr.c (Ffc_init):
* font-mgr.c (Ffc_get_version):
* font-mgr.c (Ffc_init_reinitialize):
* font-mgr.c (Ffc_init_bring_up_to_date):
* font-mgr.c (Fxlfd_font_name_p):
* font-mgr.c (make_xlfd_font_regexp):
* font-mgr.c (syms_of_font_mgr):
* font-mgr.c (vars_of_font_mgr):
* font-mgr.c (complex_vars_of_font_mgr):
Fix the code to conform to GNU style standards.
Rename xft-debug-level to debug-xft.
* fontcolor-x.c:
* fontcolor-x.c (vars_of_fontcolor_x):
Rename debug-x-objects to debug-x-fonts.
* fontcolor-xlike-inc.c:
* fontcolor-xlike-inc.c (DEBUG_FONTS1):
* fontcolor-xlike-inc.c (DEBUG_FONTS2):
* fontcolor-xlike-inc.c (DEBUG_FONTS3):
* fontcolor-xlike-inc.c (DEBUG_FONTS4):
* fontcolor-xlike-inc.c (DEBUG_FONTS_LISP1):
* fontcolor-xlike-inc.c (count_hyphens):
* fontcolor-xlike-inc.c (XFUN):
* fontcolor-xlike-inc.c (xlistfonts_checking_charset):
* fontcolor-xlike-inc.c (xft_find_charset_font):
Misc. code fixes, mostly cosmetic. Get rid of some warnings.
Fix the code to conform to GNU style standards.
* lisp.h:
* print.c:
* print.c (debug_out_lisp):
New function for doing printf-like formatting involving Lisp objects
and outputting to the debug output.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Sun, 04 Apr 2010 23:46:50 -0500 |
| parents | 0f66906b6e37 |
| children | 308d34e9f07d |
| 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 | |
| 10 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 11 ;; under the terms of the GNU General Public License as published by | |
| 12 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 13 ;; any later version. | |
| 14 | |
| 15 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 18 ;; General Public License for more details. | |
| 19 | |
| 20 ;; You should have received a copy of the GNU General Public License | |
| 21 ;; along with XEmacs; see the file COPYING. If not, write to the Free | |
| 22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA | |
| 23 ;; 02111-1307, USA. | |
| 24 | |
| 25 ;;; Synched up with: Not in FSF. | |
| 26 | |
| 27 ;;; Commentary: | |
| 28 | |
| 29 ;; Test extents operations. | |
| 30 ;; See test-harness.el for instructions on how to run these tests. | |
| 31 | |
| 32 (eval-when-compile | |
| 33 (condition-case nil | |
| 34 (require 'test-harness) | |
| 35 (file-error | |
| 36 (push "." load-path) | |
| 37 (when (and (boundp 'load-file-name) (stringp load-file-name)) | |
| 38 (push (file-name-directory load-file-name) load-path)) | |
| 39 (require 'test-harness)))) | |
| 40 | |
| 41 | |
| 42 ;;----------------------------------------------------- | |
| 43 ;; Creating and attaching. | |
| 44 ;;----------------------------------------------------- | |
| 45 | |
| 46 (with-temp-buffer | |
| 47 (let ((extent (make-extent nil nil)) | |
| 48 (string "somecoolstring")) | |
| 49 | |
| 50 ;; Detached extent. | |
| 51 (Assert (extent-detached-p extent)) | |
| 52 | |
| 53 ;; Put it in a buffer. | |
| 54 (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
|
55 (Assert (eq (extent-object extent) (current-buffer))) |
| 468 | 56 |
| 57 ;; And then into another buffer. | |
| 58 (with-temp-buffer | |
| 59 (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
|
60 (Assert (eq (extent-object extent) (current-buffer)))) |
| 468 | 61 |
| 62 ;; Now that the buffer doesn't exist, extent should be detached | |
| 63 ;; again. | |
| 64 (Assert (extent-detached-p extent)) | |
| 65 | |
| 66 ;; This line crashes XEmacs 21.2.46 and prior. | |
| 67 (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
|
68 (Assert (eq (extent-object extent) string)) |
| 468 | 69 ) |
| 70 | |
| 71 (let ((extent (make-extent 1 1))) | |
| 72 ;; 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
|
73 (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
|
74 (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
|
75 (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
|
76 (Assert (eq (get extent 'end-closed) nil)) |
| 468 | 77 |
| 78 ;; Make it closed-closed. | |
| 79 (set-extent-property extent 'end-closed t) | |
| 80 | |
|
5136
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 'start-closed) t)) |
|
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 'start-open) nil)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
83 (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
|
84 (Assert (eq (get extent 'end-closed) t)) |
| 468 | 85 |
| 86 ;; open-closed | |
| 87 (set-extent-property extent 'start-open t) | |
| 88 | |
|
5136
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 'start-closed) 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 'start-open) t)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
91 (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
|
92 (Assert (eq (get extent 'end-closed) t)) |
| 468 | 93 |
| 94 ;; open-open | |
| 95 (set-extent-property extent 'end-open t) | |
| 96 | |
|
5136
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 'start-closed) nil)) |
|
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 'start-open) t)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
99 (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
|
100 (Assert (eq (get extent 'end-closed) nil))) |
| 468 | 101 |
| 102 ) | |
| 103 | |
| 104 ;;----------------------------------------------------- | |
| 105 ;; Insertion behavior. | |
| 106 ;;----------------------------------------------------- | |
| 107 | |
| 108 (defun et-range (extent) | |
| 109 "List (START-POSITION END-POSITION) of EXTENT." | |
| 110 (list (extent-start-position extent) | |
| 111 (extent-end-position extent))) | |
| 112 | |
| 113 (defun et-insert-at (string position) | |
| 114 "Insert STRING at POSITION in the current buffer." | |
| 115 (save-excursion | |
| 116 (goto-char position) | |
| 117 (insert string))) | |
| 118 | |
| 119 ;; Test insertion at the beginning, middle, and end of the extent. | |
| 120 | |
| 121 ;; closed-open | |
| 122 | |
| 123 (with-temp-buffer | |
| 124 (insert "###eee###") | |
| 125 (let ((e (make-extent 4 7))) | |
| 126 ;; current state: "###[eee)###" | |
| 127 ;; 123 456 789 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
128 (Assert (equal (et-range e) '(4 7))) |
| 468 | 129 |
| 130 (et-insert-at "xxx" 4) | |
| 131 | |
| 132 ;; current state: "###[xxxeee)###" | |
| 133 ;; 123 456789 012 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
134 (Assert (equal (et-range e) '(4 10))) |
| 468 | 135 |
| 136 (et-insert-at "yyy" 7) | |
| 137 | |
| 138 ;; current state: "###[xxxyyyeee)###" | |
| 139 ;; 123 456789012 345 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
140 (Assert (equal (et-range e) '(4 13))) |
| 468 | 141 |
| 142 (et-insert-at "zzz" 13) | |
| 143 | |
| 144 ;; current state: "###[xxxyyyeee)zzz###" | |
| 145 ;; 123 456789012 345678 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
146 (Assert (equal (et-range e) '(4 13))) |
| 468 | 147 )) |
| 148 | |
| 149 ;; closed-closed | |
| 150 | |
| 151 (with-temp-buffer | |
| 152 (insert "###eee###") | |
| 153 (let ((e (make-extent 4 7))) | |
| 154 (put e 'end-closed t) | |
| 155 | |
| 156 ;; current state: "###[eee]###" | |
| 157 ;; 123 456 789 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
158 (Assert (equal (et-range e) '(4 7))) |
| 468 | 159 |
| 160 (et-insert-at "xxx" 4) | |
| 161 | |
| 162 ;; current state: "###[xxxeee]###" | |
| 163 ;; 123 456789 012 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
164 (Assert (equal (et-range e) '(4 10))) |
| 468 | 165 |
| 166 (et-insert-at "yyy" 7) | |
| 167 | |
| 168 ;; current state: "###[xxxyyyeee]###" | |
| 169 ;; 123 456789012 345 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
170 (Assert (equal (et-range e) '(4 13))) |
| 468 | 171 |
| 172 (et-insert-at "zzz" 13) | |
| 173 | |
| 174 ;; current state: "###[xxxyyyeeezzz]###" | |
| 175 ;; 123 456789012345 678 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
176 (Assert (equal (et-range e) '(4 16))) |
| 468 | 177 )) |
| 178 | |
| 179 ;; open-closed | |
| 180 | |
| 181 (with-temp-buffer | |
| 182 (insert "###eee###") | |
| 183 (let ((e (make-extent 4 7))) | |
| 184 (put e 'start-open t) | |
| 185 (put e 'end-closed t) | |
| 186 | |
| 187 ;; current state: "###(eee]###" | |
| 188 ;; 123 456 789 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
189 (Assert (equal (et-range e) '(4 7))) |
| 468 | 190 |
| 191 (et-insert-at "xxx" 4) | |
| 192 | |
| 193 ;; current state: "###xxx(eee]###" | |
| 194 ;; 123456 789 012 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
195 (Assert (equal (et-range e) '(7 10))) |
| 468 | 196 |
| 197 (et-insert-at "yyy" 8) | |
| 198 | |
| 199 ;; current state: "###xxx(eyyyee]###" | |
| 200 ;; 123456 789012 345 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
201 (Assert (equal (et-range e) '(7 13))) |
| 468 | 202 |
| 203 (et-insert-at "zzz" 13) | |
| 204 | |
| 205 ;; current state: "###xxx(eyyyeezzz]###" | |
| 206 ;; 123456 789012345 678 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
207 (Assert (equal (et-range e) '(7 16))) |
| 468 | 208 )) |
| 209 | |
| 210 ;; open-open | |
| 211 | |
| 212 (with-temp-buffer | |
| 213 (insert "###eee###") | |
| 214 (let ((e (make-extent 4 7))) | |
| 215 (put e 'start-open t) | |
| 216 | |
| 217 ;; current state: "###(eee)###" | |
| 218 ;; 123 456 789 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
219 (Assert (equal (et-range e) '(4 7))) |
| 468 | 220 |
| 221 (et-insert-at "xxx" 4) | |
| 222 | |
| 223 ;; current state: "###xxx(eee)###" | |
| 224 ;; 123456 789 012 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
225 (Assert (equal (et-range e) '(7 10))) |
| 468 | 226 |
| 227 (et-insert-at "yyy" 8) | |
| 228 | |
| 229 ;; current state: "###xxx(eyyyee)###" | |
| 230 ;; 123456 789012 345 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
231 (Assert (equal (et-range e) '(7 13))) |
| 468 | 232 |
| 233 (et-insert-at "zzz" 13) | |
| 234 | |
| 235 ;; current state: "###xxx(eyyyee)zzz###" | |
| 236 ;; 123456 789012 345678 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
237 (Assert (equal (et-range e) '(7 13))) |
| 468 | 238 )) |
| 239 | |
| 240 | |
| 241 ;;----------------------------------------------------- | |
| 242 ;; Deletion behavior. | |
| 243 ;;----------------------------------------------------- | |
| 244 | |
| 245 (dolist (props '((start-closed t end-open t) | |
| 246 (start-closed t end-open nil) | |
| 247 (start-closed nil end-open nil) | |
| 248 (start-closed nil end-open t))) | |
| 249 ;; Deletion needs to behave the same regardless of the open-ness of | |
| 250 ;; the boundaries. | |
| 251 | |
| 252 (with-temp-buffer | |
| 253 (insert "xxxxxxxxxx") | |
| 254 (let ((e (make-extent 3 9))) | |
| 255 (set-extent-properties e props) | |
| 256 | |
| 257 ;; current state: xx[xxxxxx]xx | |
| 258 ;; 12 345678 90 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
259 (Assert (equal (et-range e) '(3 9))) |
| 468 | 260 |
| 261 (delete-region 1 2) | |
| 262 | |
| 263 ;; current state: x[xxxxxx]xx | |
| 264 ;; 1 234567 89 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
265 (Assert (equal (et-range e) '(2 8))) |
| 468 | 266 |
| 267 (delete-region 2 4) | |
| 268 | |
| 269 ;; current state: x[xxxx]xx | |
| 270 ;; 1 2345 67 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
271 (Assert (equal (et-range e) '(2 6))) |
| 468 | 272 |
| 273 (delete-region 1 3) | |
| 274 | |
| 275 ;; current state: [xxx]xx | |
| 276 ;; 123 45 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
277 (Assert (equal (et-range e) '(1 4))) |
| 468 | 278 |
| 279 (delete-region 3 5) | |
| 280 | |
| 281 ;; current state: [xx]x | |
| 282 ;; 12 3 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
283 (Assert (equal (et-range e) '(1 3))) |
| 468 | 284 |
| 285 ))) | |
| 286 | |
| 287 ;;; #### Should have a test for read-only-ness and insertion and | |
| 288 ;;; deletion! | |
| 289 | |
| 290 ;;----------------------------------------------------- | |
| 291 ;; `detachable' property | |
| 292 ;;----------------------------------------------------- | |
| 293 | |
| 294 (dolist (props '((start-closed t end-open t) | |
| 295 (start-closed t end-open nil) | |
| 296 (start-closed nil end-open nil) | |
| 297 (start-closed nil end-open t))) | |
| 298 ;; `detachable' shouldn't relate to region properties, hence the | |
| 299 ;; loop. | |
| 300 (with-temp-buffer | |
| 301 (insert "###eee###") | |
| 302 (let ((e (make-extent 4 7))) | |
| 303 (set-extent-properties e props) | |
| 304 (Assert (get e 'detachable)) | |
| 305 | |
| 306 (Assert (not (extent-detached-p e))) | |
| 307 | |
| 308 (delete-region 4 5) | |
| 309 ;; ###ee### (not detached yet) | |
| 310 (Assert (not (extent-detached-p e))) | |
| 311 | |
| 312 (delete-region 4 6) | |
| 313 ;; ###### (should be detached now) | |
| 314 (Assert (extent-detached-p e)))) | |
| 315 | |
| 316 (with-temp-buffer | |
| 317 (insert "###eee###") | |
| 318 (let ((e (make-extent 4 7))) | |
| 319 (set-extent-properties e props) | |
| 320 (put e 'detachable nil) | |
| 321 (Assert (not (get e 'detachable))) | |
| 322 | |
| 323 (Assert (not (extent-detached-p e))) | |
| 324 | |
| 325 (delete-region 4 5) | |
| 326 ;; ###ee### | |
| 327 (Assert (not (extent-detached-p e))) | |
| 328 | |
| 329 (delete-region 4 6) | |
| 330 ;; ###[]### | |
| 331 (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
|
332 (Assert (equal (et-range e) '(4 4))) |
| 468 | 333 )) |
| 334 ) | |
| 335 | |
| 336 | |
| 337 ;;----------------------------------------------------- | |
| 338 ;; Zero-length extents. | |
| 339 ;;----------------------------------------------------- | |
| 340 | |
| 341 ;; closed-open (should stay put) | |
| 342 (with-temp-buffer | |
| 343 (insert "######") | |
| 344 (let ((e (make-extent 4 4))) | |
| 345 (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
|
346 (Assert (equal (et-range e) '(4 4))))) |
| 468 | 347 |
| 348 ;; open-closed (should move) | |
| 349 (with-temp-buffer | |
| 350 (insert "######") | |
| 351 (let ((e (make-extent 4 4))) | |
| 352 (put e 'start-open t) | |
| 353 (put e 'end-closed t) | |
| 354 (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
|
355 (Assert (equal (et-range e) '(7 7))))) |
| 468 | 356 |
| 357 ;; closed-closed (should extend) | |
| 358 (with-temp-buffer | |
| 359 (insert "######") | |
| 360 (let ((e (make-extent 4 4))) | |
| 361 (put e 'end-closed t) | |
| 362 (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
|
363 (Assert (equal (et-range e) '(4 7))))) |
| 468 | 364 |
| 365 ;; open-open (illegal; forced to behave like closed-open) | |
| 366 (with-temp-buffer | |
| 367 (insert "######") | |
| 368 (let ((e (make-extent 4 4))) | |
| 369 (put e 'start-open t) | |
| 370 (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
|
371 (Assert (equal (et-range e) '(4 4))))) |