mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-02-05 20:43:08 +00:00
Code Issues Releases Activity

lisp/nxml: Use syntax-tables for comments

Browse Source 
* 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.
This commit is contained in:
Stefan Monnier 2016-01-16 15:03:42 -05:00
parent 3dee7772f2
commit 56e1097584
5 changed files with 43 additions and 238 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

112
lisp/nxml/nxml-mode.el
View File

@ -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

2
lisp/nxml/nxml-outln.el
View File

@ -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)

127
lisp/nxml/nxml-rap.el
View File

@ -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

14
lisp/nxml/nxml-util.el
View File

@ -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.

26
lisp/nxml/xmltok.el
View File

@ -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)