[Emacs-diffs] master 56e1097: lisp/nxml: Use syntax-tables for comments

[Stefan Monnier]

branch: master
commit 56e1097584c13f2b6db85592769db1c6c36e9419
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    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 c6600b1..edc7414 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., <!-- and -->."
-  :group 'nxml-faces)
-
 (defface nxml-processing-instruction-delimiter
   '((t (:inherit nxml-delimiter)))
   "Face used for the delimiters of processing instructions, i.e., <? and ?>."
@@ -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 79e6406..289816a 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 e68c8a4..e66289d 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
-                ;; <![CDATA[foo <!-- bar ]]> <![CDATA[ stuff --> <!-- ]]> -->
-                ;; and suppose we deleted "<![CDATA[f"
-                (let ((inside-end (nxml-inside-end end)))
-                  (when inside-end
-                    (setq end inside-end)
-                    t))))
-      (nxml-clear-inside inside-remove-start end))
-    (when (> 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 14b887e..282d495 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 93d47c1..f12905a 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)