Mercurial > hg > xemacs-beta
comparison tests/automated/syntax-tests.el @ 1024:ccaf90c5a53a
[xemacs-hg @ 2002-10-02 09:29:37 by stephent]
21.4 -> R21.5 stuff
manual improvements <87k7l1p6su.fsf@tleepslib.sk.tsukuba.ac.jp>
regexp tests <87fzvpp6mf.fsf@tleepslib.sk.tsukuba.ac.jp>
add-to-list doc Ville Skyttä <87bs6dp6io.fsf@tleepslib.sk.tsukuba.ac.jp>
Move filename associations Ville Skyttä <877kh1p6ee.fsf@tleepslib.sk.tsukuba.ac.jp>
lookup-syntax-properties <87admil2e0.fsf_-_@tleepslib.sk.tsukuba.ac.jp>
fix stale submatches <873crpp50v.fsf_-_@tleepslib.sk.tsukuba.ac.jp>
info for developers <87y99hnqc4.fsf@tleepslib.sk.tsukuba.ac.jp>
author | stephent |
---|---|
date | Wed, 02 Oct 2002 09:31:40 +0000 |
parents | ea6a06f7bf2c |
children | 0d33547d9ed3 |
comparison
equal
deleted
inserted
replaced
1023:ce9bdd48654f | 1024:ccaf90c5a53a |
---|---|
105 ;; after <string> is inserted, the syntax-table <apply-syntax> | 105 ;; after <string> is inserted, the syntax-table <apply-syntax> |
106 ;; is applied to position <apply-pos>. | 106 ;; is applied to position <apply-pos>. |
107 ;; <apply-pos> can be in the form (start . end), or can be a | 107 ;; <apply-pos> can be in the form (start . end), or can be a |
108 ;; character position. | 108 ;; character position. |
109 (defun test-syntax-table (string apply-pos apply-syntax stop) | 109 (defun test-syntax-table (string apply-pos apply-syntax stop) |
110 (goto-char (point-max)) | 110 ;; We don't necessarily have syntax-table properties ... |
111 (unless (consp apply-pos) | 111 (when (fboundp 'lookup-syntax-properties) ; backwards compatible kludge |
112 (setq apply-pos `(,apply-pos . ,(+ 1 apply-pos)))) | 112 ;; ... and they may not be enabled by default if we do. |
113 (let ((point (point))) | 113 (setq lookup-syntax-properties t) |
114 (insert string) | 114 (goto-char (point-max)) |
115 (put-text-property (+ point (car apply-pos)) (+ point (cdr apply-pos)) | 115 (unless (consp apply-pos) |
116 'syntax-table apply-syntax) | 116 (setq apply-pos `(,apply-pos . ,(+ 1 apply-pos)))) |
117 (goto-char point) | 117 (let ((point (point))) |
118 (forward-word 1) | 118 (insert string) |
119 (Assert (eq (point) (+ point stop))))) | 119 (put-text-property (+ point (car apply-pos)) (+ point (cdr apply-pos)) |
120 'syntax-table apply-syntax) | |
121 (goto-char point) | |
122 (forward-word 1) | |
123 (Assert (eq (point) (+ point stop)))))) | |
120 | 124 |
121 ;; test syntax-table extents | 125 ;; test syntax-table extents |
122 (with-temp-buffer | 126 (with-temp-buffer |
123 ;; Apply punctuation to word | 127 ;; Apply punctuation to word |
124 (test-syntax-table "WO" 1 `(,(syntax-string-to-code ".")) 1) | 128 (test-syntax-table "WO" 1 `(,(syntax-string-to-code ".")) 1) |
125 ;; Apply word to punctuation | 129 ;; Apply word to punctuation |
126 (test-syntax-table "W." 1 `(,(syntax-string-to-code "w")) 2)) | 130 (test-syntax-table "W." 1 `(,(syntax-string-to-code "w")) 2)) |
127 | 131 |
128 ;; Test forward-comment at buffer boundaries | 132 ;; Test forward-comment at buffer boundaries |
133 ;; #### The second Assert fails (once interpreted, once compiled) on 21.4.9 | |
134 ;; with sjt's version of Andy's syntax-text-property-killer patch. | |
129 (with-temp-buffer | 135 (with-temp-buffer |
130 (if (not (fboundp 'c-mode)) | 136 (if (not (fboundp 'c-mode)) |
131 ;; #### This whole thing should go inside a macro Skip-Test | 137 ;; #### This whole thing should go inside a macro Skip-Test |
132 (let* ((reason "c-mode unavailable") | 138 (let* ((reason "c-mode unavailable") |
133 (count (gethash reason skipped-test-reasons))) | 139 (count (gethash reason skipped-test-reasons))) |