diff options
| author | Stefan Monnier | 2019-05-22 18:36:37 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2019-05-22 18:36:37 -0400 |
| commit | 70839740214c5fac91536df8bd4cd7af23afa3b2 (patch) | |
| tree | f52973570958cf1b4005cd620409625b9d5c2496 | |
| parent | dfed333b312d06b3416ebfadff544eae38313391 (diff) | |
| download | emacs-70839740214c5fac91536df8bd4cd7af23afa3b2.tar.gz emacs-70839740214c5fac91536df8bd4cd7af23afa3b2.zip | |
* lisp/textmodes/sgml-mode.el: Fix lone `>` in sgml text
(sgml--syntax-propertize-ppss):New variable and function.
(sgml-syntax-propertize-rules): Use it.
Don't ignore quotes not followed by a matching quote or a '>' or '<'.
(sgml-syntax-propertize): Set up sgml--syntax-propertize-ppss.
* test/lisp/textmodes/sgml-mode-tests.el (sgml-tests--quotes-syntax):
Add test for lone '>'.
| -rw-r--r-- | lisp/textmodes/sgml-mode.el | 35 | ||||
| -rw-r--r-- | test/lisp/textmodes/sgml-mode-tests.el | 4 |
2 files changed, 33 insertions, 6 deletions
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 1826129f0b3..d0586fd9fce 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el | |||
| @@ -328,6 +328,24 @@ Any terminating `>' or `/' is not matched.") | |||
| 328 | (defvar sgml-font-lock-keywords sgml-font-lock-keywords-1 | 328 | (defvar sgml-font-lock-keywords sgml-font-lock-keywords-1 |
| 329 | "Rules for highlighting SGML code. See also `sgml-tag-face-alist'.") | 329 | "Rules for highlighting SGML code. See also `sgml-tag-face-alist'.") |
| 330 | 330 | ||
| 331 | (defvar-local sgml--syntax-propertize-ppss nil) | ||
| 332 | |||
| 333 | (defun sgml--syntax-propertize-ppss (pos) | ||
| 334 | "Return PPSS at POS, fixing the syntax of any lone `>' along the way." | ||
| 335 | (cl-assert (>= pos (car sgml--syntax-propertize-ppss))) | ||
| 336 | (let ((ppss (parse-partial-sexp (car sgml--syntax-propertize-ppss) pos -1 | ||
| 337 | nil (cdr sgml--syntax-propertize-ppss)))) | ||
| 338 | (while (eq -1 (car ppss)) | ||
| 339 | (put-text-property (1- (point)) (point) | ||
| 340 | 'syntax-table (string-to-syntax ".")) | ||
| 341 | ;; Hack attack: rather than recompute the ppss from | ||
| 342 | ;; (car sgml--syntax-propertize-ppss), we manually "fix it". | ||
| 343 | (setcar ppss 0) | ||
| 344 | (setq ppss (parse-partial-sexp (point) pos -1 nil ppss))) | ||
| 345 | (setcdr sgml--syntax-propertize-ppss ppss) | ||
| 346 | (setcar sgml--syntax-propertize-ppss pos) | ||
| 347 | ppss)) | ||
| 348 | |||
| 331 | (eval-and-compile | 349 | (eval-and-compile |
| 332 | (defconst sgml-syntax-propertize-rules | 350 | (defconst sgml-syntax-propertize-rules |
| 333 | (syntax-propertize-precompile-rules | 351 | (syntax-propertize-precompile-rules |
| @@ -344,23 +362,28 @@ Any terminating `>' or `/' is not matched.") | |||
| 344 | ;; the resulting number of calls to syntax-ppss made it too slow | 362 | ;; the resulting number of calls to syntax-ppss made it too slow |
| 345 | ;; (bug#33887), so we're now careful to leave alone any pair | 363 | ;; (bug#33887), so we're now careful to leave alone any pair |
| 346 | ;; of quotes that doesn't hold a < or > char, which is the vast majority. | 364 | ;; of quotes that doesn't hold a < or > char, which is the vast majority. |
| 347 | ("\\(?:\\(?1:\"\\)[^\"<>]*[<>\"]\\|\\(?1:'\\)[^'<>]*[<>']\\)" | 365 | ("\\(?:\\(?1:\"\\)[^\"<>]*\\|\\(?1:'\\)[^'\"<>]*\\)" |
| 348 | (1 (unless (memq (char-before) '(?\' ?\")) | 366 | (1 (if (eq (char-after) (char-after (match-beginning 0))) |
| 367 | (forward-char 1) | ||
| 349 | ;; Be careful to call `syntax-ppss' on a position before the one | 368 | ;; Be careful to call `syntax-ppss' on a position before the one |
| 350 | ;; we're going to change, so as not to need to flush the data we | 369 | ;; we're going to change, so as not to need to flush the data we |
| 351 | ;; just computed. | 370 | ;; just computed. |
| 352 | (if (prog1 (zerop (car (syntax-ppss (match-beginning 0)))) | 371 | (if (zerop (save-excursion |
| 353 | (goto-char (1- (match-end 0)))) | 372 | (car (sgml--syntax-propertize-ppss |
| 373 | (match-beginning 0))))) | ||
| 354 | (string-to-syntax "."))))) | 374 | (string-to-syntax "."))))) |
| 355 | ))) | 375 | ))) |
| 356 | 376 | ||
| 357 | (defun sgml-syntax-propertize (start end) | 377 | (defun sgml-syntax-propertize (start end) |
| 358 | "Syntactic keywords for `sgml-mode'." | 378 | "Syntactic keywords for `sgml-mode'." |
| 359 | (goto-char start) | 379 | (setq sgml--syntax-propertize-ppss (cons start (syntax-ppss start))) |
| 380 | (cl-assert (>= (cadr sgml--syntax-propertize-ppss) 0)) | ||
| 360 | (sgml-syntax-propertize-inside end) | 381 | (sgml-syntax-propertize-inside end) |
| 361 | (funcall | 382 | (funcall |
| 362 | (syntax-propertize-rules sgml-syntax-propertize-rules) | 383 | (syntax-propertize-rules sgml-syntax-propertize-rules) |
| 363 | start end)) | 384 | start end) |
| 385 | ;; Catch any '>' after the last quote. | ||
| 386 | (sgml--syntax-propertize-ppss end)) | ||
| 364 | 387 | ||
| 365 | (defun sgml-syntax-propertize-inside (end) | 388 | (defun sgml-syntax-propertize-inside (end) |
| 366 | (let ((ppss (syntax-ppss))) | 389 | (let ((ppss (syntax-ppss))) |
diff --git a/test/lisp/textmodes/sgml-mode-tests.el b/test/lisp/textmodes/sgml-mode-tests.el index a900e8dcf22..1b8965e3440 100644 --- a/test/lisp/textmodes/sgml-mode-tests.el +++ b/test/lisp/textmodes/sgml-mode-tests.el | |||
| @@ -165,6 +165,10 @@ The point is set to the beginning of the buffer." | |||
| 165 | (sgml-mode) | 165 | (sgml-mode) |
| 166 | (insert "a\"b <tag>c'd</tag>") | 166 | (insert "a\"b <tag>c'd</tag>") |
| 167 | (should (= 1 (car (syntax-ppss (1- (point-max)))))) | 167 | (should (= 1 (car (syntax-ppss (1- (point-max)))))) |
| 168 | (should (= 0 (car (syntax-ppss (point-max))))) | ||
| 169 | (erase-buffer) | ||
| 170 | (insert "<tag>c>d</tag>") | ||
| 171 | (should (= 1 (car (syntax-ppss (1- (point-max)))))) | ||
| 168 | (should (= 0 (car (syntax-ppss (point-max))))))) | 172 | (should (= 0 (car (syntax-ppss (point-max))))))) |
| 169 | 173 | ||
| 170 | (provide 'sgml-mode-tests) | 174 | (provide 'sgml-mode-tests) |