summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2019-05-22 18:36:37 -0400
committerStefan Monnier <monnier@iro.umontreal.ca>2019-05-22 18:36:37 -0400
commit70839740214c5fac91536df8bd4cd7af23afa3b2 (patch)
treef52973570958cf1b4005cd620409625b9d5c2496
parentdfed333b312d06b3416ebfadff544eae38313391 (diff)
downloademacs-70839740214c5fac91536df8bd4cd7af23afa3b2.tar.gz
* 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.")
(defvar sgml-font-lock-keywords sgml-font-lock-keywords-1
"Rules for highlighting SGML code. See also `sgml-tag-face-alist'.")
+(defvar-local sgml--syntax-propertize-ppss nil)
+
+(defun sgml--syntax-propertize-ppss (pos)
+ "Return PPSS at POS, fixing the syntax of any lone `>' along the way."
+ (cl-assert (>= pos (car sgml--syntax-propertize-ppss)))
+ (let ((ppss (parse-partial-sexp (car sgml--syntax-propertize-ppss) pos -1
+ nil (cdr sgml--syntax-propertize-ppss))))
+ (while (eq -1 (car ppss))
+ (put-text-property (1- (point)) (point)
+ 'syntax-table (string-to-syntax "."))
+ ;; Hack attack: rather than recompute the ppss from
+ ;; (car sgml--syntax-propertize-ppss), we manually "fix it".
+ (setcar ppss 0)
+ (setq ppss (parse-partial-sexp (point) pos -1 nil ppss)))
+ (setcdr sgml--syntax-propertize-ppss ppss)
+ (setcar sgml--syntax-propertize-ppss pos)
+ ppss))
+
(eval-and-compile
(defconst sgml-syntax-propertize-rules
(syntax-propertize-precompile-rules
@@ -344,23 +362,28 @@ Any terminating `>' or `/' is not matched.")
;; the resulting number of calls to syntax-ppss made it too slow
;; (bug#33887), so we're now careful to leave alone any pair
;; of quotes that doesn't hold a < or > char, which is the vast majority.
- ("\\(?:\\(?1:\"\\)[^\"<>]*[<>\"]\\|\\(?1:'\\)[^'<>]*[<>']\\)"
- (1 (unless (memq (char-before) '(?\' ?\"))
+ ("\\(?:\\(?1:\"\\)[^\"<>]*\\|\\(?1:'\\)[^'\"<>]*\\)"
+ (1 (if (eq (char-after) (char-after (match-beginning 0)))
+ (forward-char 1)
;; Be careful to call `syntax-ppss' on a position before the one
;; we're going to change, so as not to need to flush the data we
;; just computed.
- (if (prog1 (zerop (car (syntax-ppss (match-beginning 0))))
- (goto-char (1- (match-end 0))))
+ (if (zerop (save-excursion
+ (car (sgml--syntax-propertize-ppss
+ (match-beginning 0)))))
(string-to-syntax ".")))))
)))
(defun sgml-syntax-propertize (start end)
"Syntactic keywords for `sgml-mode'."
- (goto-char start)
+ (setq sgml--syntax-propertize-ppss (cons start (syntax-ppss start)))
+ (cl-assert (>= (cadr sgml--syntax-propertize-ppss) 0))
(sgml-syntax-propertize-inside end)
(funcall
(syntax-propertize-rules sgml-syntax-propertize-rules)
- start end))
+ start end)
+ ;; Catch any '>' after the last quote.
+ (sgml--syntax-propertize-ppss end))
(defun sgml-syntax-propertize-inside (end)
(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."
(sgml-mode)
(insert "a\"b <tag>c'd</tag>")
(should (= 1 (car (syntax-ppss (1- (point-max))))))
+ (should (= 0 (car (syntax-ppss (point-max)))))
+ (erase-buffer)
+ (insert "<tag>c>d</tag>")
+ (should (= 1 (car (syntax-ppss (1- (point-max))))))
(should (= 0 (car (syntax-ppss (point-max)))))))
(provide 'sgml-mode-tests)