aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2019-05-22 18:36:37 -0400
committerStefan Monnier2019-05-22 18:36:37 -0400
commit70839740214c5fac91536df8bd4cd7af23afa3b2 (patch)
treef52973570958cf1b4005cd620409625b9d5c2496
parentdfed333b312d06b3416ebfadff544eae38313391 (diff)
downloademacs-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.el35
-rw-r--r--test/lisp/textmodes/sgml-mode-tests.el4
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)