From 56e1097584c13f2b6db85592769db1c6c36e9419 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 16 Jan 2016 15:03:42 -0500 Subject: [PATCH] lisp/nxml: Use syntax-tables for comments * lisp/nxml/nxml-mode.el (nxml-set-face): Prepend. (nxml-mode): Set syntax-ppss-table. Use sgml-syntax-propertize-function for syntax-propertize-function. Let font-lock highlight strings and comments. (nxml-degrade): Don't touch "nxml-inside" property any more. (nxml-after-change, nxml-after-change1): Remove functions. (comment): Don't set fontify rule any more. (nxml-fontify-attribute): Don't highlight the value any more. (nxml-namespace-attribute-value-delimiter, nxml-namespace-attribute-value) (nxml-comment-delimiter, nxml-comment-content): Remove faces. * lisp/nxml/nxml-rap.el (nxml-scan-end): Remove. (nxml-get-inside, nxml-inside-start, nxml-inside-end): Use syntax-ppss. (nxml-clear-inside, nxml-set-inside): Remove. (nxml-scan-after-change): Remove function. (nxml-scan-prolog, nxml-tokenize-forward): Simplify. (nxml-ensure-scan-up-to-date): Use syntax-propertize. (nxml-move-outside-backwards): * lisp/nxml/nxml-outln.el (nxml-section-tag-backward): Adjust to new nxml-inside-start behavior. * lisp/nxml/nxml-util.el (nxml-debug-set-inside) (nxml-debug-clear-inside): Remove macros. * lisp/nxml/xmltok.el (xmltok-forward-special): Remove function. (xmltok-scan-after-comment-open): Simplify. --- lisp/nxml/nxml-mode.el | 112 ++++++----------------------------- lisp/nxml/nxml-outln.el | 2 +- lisp/nxml/nxml-rap.el | 127 ++++++---------------------------------- lisp/nxml/nxml-util.el | 14 ----- lisp/nxml/xmltok.el | 26 ++------ 5 files changed, 43 insertions(+), 238 deletions(-) diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index c6600b185e6..edc7414bfbf 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el @@ -37,6 +37,7 @@ ;; So we might as well just require it and silence the compiler. (provide 'nxml-mode) ; avoid recursive require (require 'rng-nxml) +(require 'sgml-mode) ;;; Customization @@ -147,16 +148,6 @@ This is not used directly, but only via inheritance by other faces." "Face used to highlight text." :group 'nxml-faces) -(defface nxml-comment-content - '((t (:inherit font-lock-comment-face))) - "Face used to highlight the content of comments." - :group 'nxml-faces) - -(defface nxml-comment-delimiter - '((t (:inherit font-lock-comment-delimiter-face))) - "Face used for the delimiters of comments, i.e., ." - :group 'nxml-faces) - (defface nxml-processing-instruction-delimiter '((t (:inherit nxml-delimiter))) "Face used for the delimiters of processing instructions, i.e., ." @@ -274,15 +265,6 @@ This includes ths `x' in hex references." "Face used for the delimiters of attribute values." :group 'nxml-faces) -(defface nxml-namespace-attribute-value - '((t (:inherit nxml-attribute-value))) - "Face used for the value of namespace attributes." - :group 'nxml-faces) - -(defface nxml-namespace-attribute-value-delimiter - '((t (:inherit nxml-attribute-value-delimiter))) - "Face used for the delimiters of namespace attribute values." - :group 'nxml-faces) (defface nxml-prolog-literal-delimiter '((t (:inherit nxml-delimited-data))) @@ -405,7 +387,9 @@ reference.") (defsubst nxml-set-face (start end face) (when (and face (< start end)) - (font-lock-append-text-property start end 'face face))) + ;; Prepend, so the character reference highlighting takes precedence over + ;; the string highlighting applied syntactically. + (font-lock-prepend-text-property start end 'face face))) (defun nxml-parent-document-set (parent-document) "Set `nxml-parent-document' and inherit the DTD &c." @@ -530,12 +514,11 @@ Many aspects this mode can be customized using (save-excursion (save-restriction (widen) - (setq nxml-scan-end (copy-marker (point-min) nil)) (with-silent-modifications - (nxml-clear-inside (point-min) (point-max)) (nxml-with-invisible-motion (nxml-scan-prolog))))) - (setq-local syntax-propertize-function #'nxml-after-change) + (setq-local syntax-ppss-table sgml-tag-syntax-table) + (setq-local syntax-propertize-function sgml-syntax-propertize-function) (add-hook 'change-major-mode-hook #'nxml-cleanup nil t) ;; Emacs 23 handles the encoding attribute on the xml declaration @@ -552,7 +535,7 @@ Many aspects this mode can be customized using (setq font-lock-defaults '(nxml-font-lock-keywords - t ; keywords-only; we highlight comments and strings here + nil ; highlight comments and strings based on syntax-tables nil ; font-lock-keywords-case-fold-search. XML is case sensitive nil ; no special syntax table (font-lock-extend-region-functions . (nxml-extend-region)) @@ -579,12 +562,7 @@ Many aspects this mode can be customized using (error-message-string err)) (ding) (setq nxml-degraded t) - (setq nxml-prolog-end 1) - (save-excursion - (save-restriction - (widen) - (with-silent-modifications - (nxml-clear-inside (point-min) (point-max)))))) + (setq nxml-prolog-end 1)) ;;; Change management @@ -597,41 +575,6 @@ Many aspects this mode can be customized using (goto-char font-lock-beg) (set-mark font-lock-end))) -(defun nxml-after-change (start end) - ;; Called via syntax-propertize-function. - (unless nxml-degraded - (nxml-with-degradation-on-error 'nxml-after-change - (save-restriction - (widen) - (nxml-with-invisible-motion - (nxml-after-change1 start end)))))) - -(defun nxml-after-change1 (start end) - "After-change bookkeeping. -Returns a cons cell containing a possibly-enlarged change region. -You must call `nxml-extend-region' on this expanded region to obtain -the full extent of the area needing refontification. - -For bookkeeping, call this function even when fontification is -disabled." - ;; If the prolog might have changed, rescan the prolog. - (when (<= start - ;; Add 2 so as to include the < and following char that - ;; start the instance (document element), since changing - ;; these can change where the prolog ends. - (+ nxml-prolog-end 2)) - (nxml-scan-prolog) - (setq start (point-min))) - - (when (> end nxml-prolog-end) - (goto-char start) - (nxml-move-tag-backwards (point-min)) - (setq start (point)) - (setq end (max (nxml-scan-after-change start end) - end))) - - (nxml-debug-change "nxml-after-change1" start end)) - ;;; Encodings (defun nxml-insert-xml-declaration () @@ -957,11 +900,11 @@ faces appropriately." [1 -1 nxml-entity-ref-name] [-1 nil nxml-entity-ref-delimiter])) -(put 'comment - 'nxml-fontify-rule - '([nil 4 nxml-comment-delimiter] - [4 -3 nxml-comment-content] - [-3 nil nxml-comment-delimiter])) +;; (put 'comment +;; 'nxml-fontify-rule +;; '([nil 4 nxml-comment-delimiter] +;; [4 -3 nxml-comment-content] +;; [-3 nil nxml-comment-delimiter])) (put 'processing-instruction 'nxml-fontify-rule @@ -993,7 +936,7 @@ faces appropriately." 'nxml-fontify-rule '([nil nil nxml-attribute-local-name])) -(put 'xml-declaration-attribute-value +(put 'xml-declaration-attribute-value ;FIXME: What is this for? 'nxml-fontify-rule '([nil 1 nxml-attribute-value-delimiter] [1 -1 nxml-attribute-value] @@ -1112,28 +1055,11 @@ faces appropriately." 'nxml-attribute-prefix 'nxml-attribute-colon 'nxml-attribute-local-name)) - (let ((start (xmltok-attribute-value-start att)) - (end (xmltok-attribute-value-end att)) - (refs (xmltok-attribute-refs att)) - (delimiter-face (if namespace-declaration - 'nxml-namespace-attribute-value-delimiter - 'nxml-attribute-value-delimiter)) - (value-face (if namespace-declaration - 'nxml-namespace-attribute-value - 'nxml-attribute-value))) - (when start - (nxml-set-face (1- start) start delimiter-face) - (nxml-set-face end (1+ end) delimiter-face) - (while refs - (let* ((ref (car refs)) - (ref-type (aref ref 0)) - (ref-start (aref ref 1)) - (ref-end (aref ref 2))) - (nxml-set-face start ref-start value-face) - (nxml-apply-fontify-rule ref-type ref-start ref-end) - (setq start ref-end)) - (setq refs (cdr refs))) - (nxml-set-face start end value-face)))) + (dolist (ref (xmltok-attribute-refs att)) + (let* ((ref-type (aref ref 0)) + (ref-start (aref ref 1)) + (ref-end (aref ref 2))) + (nxml-apply-fontify-rule ref-type ref-start ref-end)))) (defun nxml-fontify-qname (start colon diff --git a/lisp/nxml/nxml-outln.el b/lisp/nxml/nxml-outln.el index 79e6406f553..289816a1bba 100644 --- a/lisp/nxml/nxml-outln.el +++ b/lisp/nxml/nxml-outln.el @@ -888,7 +888,7 @@ Point is at the end of the tag. `xmltok-start' is the start." (nxml-ensure-scan-up-to-date) (let ((pos (nxml-inside-start (point)))) (when pos - (goto-char (1- pos)) + (goto-char pos) t)))) ((progn (xmltok-forward) diff --git a/lisp/nxml/nxml-rap.el b/lisp/nxml/nxml-rap.el index e68c8a427fd..e66289d042a 100644 --- a/lisp/nxml/nxml-rap.el +++ b/lisp/nxml/nxml-rap.el @@ -46,8 +46,7 @@ ;; look like it scales to large numbers of overlays in a buffer. ;; ;; We don't in fact track all these constructs, but only track them in -;; some initial part of the instance. The variable `nxml-scan-end' -;; contains the limit of where we have scanned up to for them. +;; some initial part of the instance. ;; ;; Thus to parse some random point in the file we first ensure that we ;; have scanned up to that point. Then we search backwards for a @@ -74,93 +73,33 @@ (require 'xmltok) (require 'nxml-util) +(require 'sgml-mode) -(defvar nxml-prolog-end nil +(defvar-local nxml-prolog-end nil "Integer giving position following end of the prolog.") -(make-variable-buffer-local 'nxml-prolog-end) - -(defvar nxml-scan-end nil - "Marker giving position up to which we have scanned. -nxml-scan-end must be >= nxml-prolog-end. Furthermore, nxml-scan-end -must not be an inside position in the following sense. A position is -inside if the following character is a part of, but not the first -character of, a CDATA section, comment or processing instruction. -Furthermore all positions >= nxml-prolog-end and < nxml-scan-end that -are inside positions must have a non-nil `nxml-inside' property whose -value is a symbol specifying what it is inside. Any characters with a -non-nil `fontified' property must have position < nxml-scan-end and -the correct face. Dependent regions must also be established for any -unclosed constructs starting before nxml-scan-end. -There must be no `nxml-inside' properties after nxml-scan-end.") -(make-variable-buffer-local 'nxml-scan-end) (defsubst nxml-get-inside (pos) - (get-text-property pos 'nxml-inside)) - -(defsubst nxml-clear-inside (start end) - (nxml-debug-clear-inside start end) - (remove-text-properties start end '(nxml-inside nil))) - -(defsubst nxml-set-inside (start end type) - (nxml-debug-set-inside start end) - (put-text-property start end 'nxml-inside type)) + (save-excursion (nth 8 (syntax-ppss pos)))) (defun nxml-inside-end (pos) "Return the end of the inside region containing POS. Return nil if the character at POS is not inside." - (if (nxml-get-inside pos) - (or (next-single-property-change pos 'nxml-inside) - (point-max)) - nil)) + (save-excursion + (let ((ppss (syntax-ppss pos))) + (when (nth 8 ppss) + (goto-char (nth 8 ppss)) + (with-syntax-table sgml-tag-syntax-table + (if (nth 3 ppss) + (progn (forward-comment 1) (point)) + (or (scan-sexps (point) 1) (point-max)))))))) (defun nxml-inside-start (pos) "Return the start of the inside region containing POS. Return nil if the character at POS is not inside." - (if (nxml-get-inside pos) - (or (previous-single-property-change (1+ pos) 'nxml-inside) - (point-min)) - nil)) + (save-excursion (nth 8 (syntax-ppss pos)))) ;;; Change management -(defun nxml-scan-after-change (start end) - "Restore `nxml-scan-end' invariants after a change. -The change happened between START and END. -Return position after which lexical state is unchanged. -END must be > `nxml-prolog-end'. START must be outside -any “inside” regions and at the beginning of a token." - (if (>= start nxml-scan-end) - nxml-scan-end - (let ((inside-remove-start start) - xmltok-errors) - (while (or (when (xmltok-forward-special (min end nxml-scan-end)) - (when (memq xmltok-type - '(comment - cdata-section - processing-instruction)) - (nxml-clear-inside inside-remove-start - (1+ xmltok-start)) - (nxml-set-inside (1+ xmltok-start) - (point) - xmltok-type) - (setq inside-remove-start (point))) - (if (< (point) (min end nxml-scan-end)) - t - (setq end (point)) - nil)) - ;; The end of the change was inside but is now outside. - ;; Imagine something really weird like - ;; - ;; and suppose we deleted " end nxml-scan-end) - (set-marker nxml-scan-end end)) - end)) - ;; n-s-p only called from nxml-mode.el, where this variable is defined. (defvar nxml-prolog-regions) @@ -169,10 +108,7 @@ any “inside” regions and at the beginning of a token." (let (xmltok-dtd xmltok-errors) (setq nxml-prolog-regions (xmltok-forward-prolog)) - (setq nxml-prolog-end (point)) - (nxml-clear-inside (point-min) nxml-prolog-end)) - (when (< nxml-scan-end nxml-prolog-end) - (set-marker nxml-scan-end nxml-prolog-end))) + (setq nxml-prolog-end (point)))) ;;; Random access parsing @@ -223,14 +159,7 @@ Sets variables like `nxml-token-after'." (defun nxml-tokenize-forward () (let (xmltok-errors) - (when (and (xmltok-forward) - (> (point) nxml-scan-end)) - (cond ((memq xmltok-type '(comment - cdata-section - processing-instruction)) - (with-silent-modifications - (nxml-set-inside (1+ xmltok-start) (point) xmltok-type)))) - (set-marker nxml-scan-end (point))) + (xmltok-forward) xmltok-type)) (defun nxml-move-tag-backwards (bound) @@ -253,32 +182,12 @@ As a precondition, point must be >= BOUND." Leave point unmoved if it is not inside anything special." (let ((start (nxml-inside-start (point)))) (when start - (goto-char (1- start)) + (goto-char start) (when (nxml-get-inside (point)) - (error "Char before inside-start at %s had nxml-inside property %s" - (point) - (nxml-get-inside (point))))))) + (error "Char before inside-start at %s is still \"inside\"" (point)))))) (defun nxml-ensure-scan-up-to-date () - (let ((pos (point))) - (when (< nxml-scan-end pos) - (save-excursion - (goto-char nxml-scan-end) - (let (xmltok-errors) - (while (when (xmltok-forward-special pos) - (when (memq xmltok-type - '(comment - processing-instruction - cdata-section)) - (with-silent-modifications - (nxml-set-inside (1+ xmltok-start) - (point) - xmltok-type))) - (if (< (point) pos) - t - (setq pos (point)) - nil))) - (set-marker nxml-scan-end pos)))))) + (syntax-propertize (point))) ;;; Element scanning diff --git a/lisp/nxml/nxml-util.el b/lisp/nxml/nxml-util.el index 14b887ea085..282d4952bf7 100644 --- a/lisp/nxml/nxml-util.el +++ b/lisp/nxml/nxml-util.el @@ -36,20 +36,6 @@ `(nxml-debug "%s: %S" ,name (buffer-substring-no-properties ,start ,end)))) -(defmacro nxml-debug-set-inside (start end) - (when nxml-debug - `(let ((overlay (make-overlay ,start ,end))) - (overlay-put overlay 'face '(:background "red")) - (overlay-put overlay 'nxml-inside-debug t) - (nxml-debug-change "nxml-set-inside" ,start ,end)))) - -(defmacro nxml-debug-clear-inside (start end) - (when nxml-debug - `(cl-loop for overlay in (overlays-in ,start ,end) - if (overlay-get overlay 'nxml-inside-debug) - do (delete-overlay overlay) - finally (nxml-debug-change "nxml-clear-inside" ,start ,end)))) - (defun nxml-make-namespace (str) "Return a symbol for the namespace URI STR. STR must be a string. If STR is the empty string, return nil. diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el index 93d47c195c0..f12905a86d0 100644 --- a/lisp/nxml/xmltok.el +++ b/lisp/nxml/xmltok.el @@ -34,10 +34,7 @@ ;; preceding part of the instance. This allows the instance to be ;; parsed incrementally. The main entry point is `xmltok-forward': ;; this can be called at any point in the instance provided it is -;; between tokens. The other entry point is `xmltok-forward-special' -;; which skips over tokens other comments, processing instructions or -;; CDATA sections (i.e. the constructs in an instance that can contain -;; less than signs that don't start a token). +;; between tokens. ;; ;; This is a non-validating XML 1.0 processor. It does not resolve ;; parameter entities (including the external DTD subset) and it does @@ -307,18 +304,6 @@ and VALUE-END, otherwise a STRING giving the value." (goto-char (point-max)) (setq xmltok-type 'data))))) -(defun xmltok-forward-special (bound) - "Scan forward past the first special token starting at or after point. -Return nil if there is no special token that starts before BOUND. -CDATA sections, processing instructions and comments (and indeed -anything starting with < following by ? or !) count as special. -Return the type of the token." - (when (re-search-forward "<[?!]" (1+ bound) t) - (setq xmltok-start (match-beginning 0)) - (goto-char (1+ xmltok-start)) - (let ((case-fold-search nil)) - (xmltok-scan-after-lt)))) - (eval-when-compile ;; A symbolic regexp is represented by a list whose CAR is the string @@ -738,11 +723,10 @@ Return the type of the token." (setq xmltok-type 'processing-instruction)) (defun xmltok-scan-after-comment-open () - (let (found--) - (while (and (setq found-- (re-search-forward "--\\(>\\)?" nil 'move)) - (not (match-end 1))) - (xmltok-add-error "`--' not followed by `>'" (match-beginning 0))) - (setq xmltok-type 'comment))) + (while (and (re-search-forward "--\\(>\\)?" nil 'move) + (not (match-end 1))) + (xmltok-add-error "`--' not followed by `>'" (match-beginning 0))) + (setq xmltok-type 'comment)) (defun xmltok-scan-attributes () (let ((recovering nil) -- 2.39.2