andros/emacs-gpu
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* lisp/nxml/nxml-mode.el: Treat unclosed <[[, <?, comment, and other

Browse source 
literals as extending to EOB.
(nxml-last-fontify-end): Remove unused variable.
(nxml-after-change1): Use with-silent-modifications.
(nxml-extend-after-change-region): Simplify.
(nxml-extend-after-change-region1): Remove function.
(nxml-after-change1): Don't adjust for dependent regions.
(nxml-fontify-matcher): Simplify.
* lisp/nxml/xmltok.el (xmltok-dependent-regions): Remove variable.
(xmltok-add-dependent): Remove function.
(xmltok-scan-after-lt, xmltok-scan-after-processing-instruction-open)
(xmltok-scan-after-comment-open, xmltok-scan-prolog-literal)
(xmltok-scan-prolog-after-processing-instruction-open): Treat
unclosed <[[, <?, comment, and other literals as extending to EOB.
* lisp/nxml/rng-valid.el (rng-mark-xmltok-dependent-regions)
(rng-mark-xmltok-dependent-region, rng-dependent-region-changed):
Remove functions.
(rng-do-some-validation-1): Don't mark dependent regions.
* lisp/nxml/nxml-rap.el (nxml-adjust-start-for-dependent-regions)
(nxml-mark-parse-dependent-regions, nxml-mark-parse-dependent-region)
(nxml-clear-dependent-regions): Remove functions.
(nxml-scan-after-change, nxml-scan-prolog, nxml-tokenize-forward)
(nxml-ensure-scan-up-to-date):
Don't clear&mark dependent regions.
This commit is contained in:
Stefan Monnier 2013-05-15 14:31:51 -04:00
parent e3772e9833
commit c99904740e
5 changed files with 154 additions and 364 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
lisp/ChangeLog
View file

@ -1,7 +1,34 @@
2013-05-15 Stefan Monnier <monnier@iro.umontreal.ca>
* nxml/nxml-mode.el: Treat unclosed <[[, <?, comment, and other
literals as extending to EOB.
(nxml-last-fontify-end): Remove unused variable.
(nxml-after-change1): Use with-silent-modifications.
(nxml-extend-after-change-region): Simplify.
(nxml-extend-after-change-region1): Remove function.
(nxml-after-change1): Don't adjust for dependent regions.
(nxml-fontify-matcher): Simplify.
* nxml/xmltok.el (xmltok-dependent-regions): Remove variable.
(xmltok-add-dependent): Remove function.
(xmltok-scan-after-lt, xmltok-scan-after-processing-instruction-open)
(xmltok-scan-after-comment-open, xmltok-scan-prolog-literal)
(xmltok-scan-prolog-after-processing-instruction-open): Treat
unclosed <[[, <?, comment, and other literals as extending to EOB.
* nxml/rng-valid.el (rng-mark-xmltok-dependent-regions)
(rng-mark-xmltok-dependent-region, rng-dependent-region-changed):
Remove functions.
(rng-do-some-validation-1): Don't mark dependent regions.
* nxml/nxml-rap.el (nxml-adjust-start-for-dependent-regions)
(nxml-mark-parse-dependent-regions, nxml-mark-parse-dependent-region)
(nxml-clear-dependent-regions): Remove functions.
(nxml-scan-after-change, nxml-scan-prolog, nxml-tokenize-forward)
(nxml-ensure-scan-up-to-date):
Don't clear&mark dependent regions.
2013-05-15 Leo Liu <sdl.web@gmail.com> 2013-05-15 Leo Liu <sdl.web@gmail.com>
* progmodes/octave.el (octave-goto-function-definition): Improve * progmodes/octave.el (octave-goto-function-definition):
and fix callers. Improve and fix callers.
2013-05-15 Stefan Monnier <monnier@iro.umontreal.ca> 2013-05-15 Stefan Monnier <monnier@iro.umontreal.ca>
@ -277,7 +304,8 @@
their declaration. their declaration.
(vhdl-mode-syntax-table-init): Remove. (vhdl-mode-syntax-table-init): Remove.
* progmodes/m4-mode.el (m4-mode-syntax-table): Add comment on last change. * progmodes/m4-mode.el (m4-mode-syntax-table): Add comment on
last change.
* progmodes/ld-script.el (ld-script-mode-syntax-table): Use symbol * progmodes/ld-script.el (ld-script-mode-syntax-table): Use symbol
syntax for "_". syntax for "_".
@ -292,7 +320,8 @@
Handle a _ with symbol syntax. Handle a _ with symbol syntax.
(autoconf-mode): Don't change the syntax-table for imenu and font-lock. (autoconf-mode): Don't change the syntax-table for imenu and font-lock.
* progmodes/ada-mode.el (ada-mode-abbrev-table): Consolidate declaration. * progmodes/ada-mode.el (ada-mode-abbrev-table):
Consolidate declaration.
(ada-mode-syntax-table, ada-mode-symbol-syntax-table): Initialize in (ada-mode-syntax-table, ada-mode-symbol-syntax-table): Initialize in
the declaration. the declaration.
(ada-create-syntax-table): Remove. (ada-create-syntax-table): Remove.

52
lisp/nxml/nxml-mode.el
View file

@ -352,11 +352,6 @@ Use `nxml-parent-document-set' to set it.")
See the function `xmltok-forward-prolog' for more information.") See the function `xmltok-forward-prolog' for more information.")
(make-variable-buffer-local 'nxml-prolog-regions) (make-variable-buffer-local 'nxml-prolog-regions)
(defvar nxml-last-fontify-end nil
"Position where fontification last ended.
It is nil if the buffer changed since the last fontification.")
(make-variable-buffer-local 'nxml-last-fontify-end)
(defvar nxml-degraded nil (defvar nxml-degraded nil
"Non-nil if currently operating in degraded mode. "Non-nil if currently operating in degraded mode.
Degraded mode is enabled when an internal error is encountered in the Degraded mode is enabled when an internal error is encountered in the
@ -538,7 +533,6 @@ Many aspects this mode can be customized using
(save-excursion (save-excursion
(save-restriction (save-restriction
(widen) (widen)
(nxml-clear-dependent-regions (point-min) (point-max))
(setq nxml-scan-end (copy-marker (point-min) nil)) (setq nxml-scan-end (copy-marker (point-min) nil))
(with-silent-modifications (with-silent-modifications
(nxml-clear-inside (point-min) (point-max)) (nxml-clear-inside (point-min) (point-max))
@ -583,12 +577,9 @@ Many aspects this mode can be customized using
;; Clean up fontification. ;; Clean up fontification.
(save-excursion (save-excursion
(widen) (widen)
(let ((inhibit-read-only t) (with-silent-modifications
(buffer-undo-list t)
(modified (buffer-modified-p)))
(nxml-with-invisible-motion (nxml-with-invisible-motion
(remove-text-properties (point-min) (point-max) '(face))) (remove-text-properties (point-min) (point-max) '(face)))))
(set-buffer-modified-p modified)))
(remove-hook 'change-major-mode-hook 'nxml-cleanup t)) (remove-hook 'change-major-mode-hook 'nxml-cleanup t))
(defun nxml-degrade (context err) (defun nxml-degrade (context err)
@ -638,10 +629,6 @@ the full extent of the area needing refontification.
For bookkeeping, call this function even when fontification is For bookkeeping, call this function even when fontification is
disabled." disabled."
(let ((pre-change-end (+ start pre-change-length))) (let ((pre-change-end (+ start pre-change-length)))
(setq start
(nxml-adjust-start-for-dependent-regions start
end
pre-change-length))
;; If the prolog might have changed, rescan the prolog ;; If the prolog might have changed, rescan the prolog
(when (<= start (when (<= start
;; Add 2 so as to include the < and following char that ;; Add 2 so as to include the < and following char that
@ -902,26 +889,16 @@ Called with `font-lock-beg' and `font-lock-end' dynamically bound."
(defun nxml-extend-after-change-region (start end pre-change-length) (defun nxml-extend-after-change-region (start end pre-change-length)
(unless nxml-degraded (unless nxml-degraded
(setq nxml-last-fontify-end nil) (nxml-with-degradation-on-error
(let ((region (nxml-with-degradation-on-error 'nxml-extend-after-change-region
'nxml-extend-after-change-region (save-excursion
(save-excursion (save-restriction
(save-restriction (widen)
(widen) (save-match-data
(save-match-data (nxml-with-invisible-motion
(nxml-with-invisible-motion (with-silent-modifications
(with-silent-modifications (nxml-after-change1
(nxml-extend-after-change-region1 start end pre-change-length)))))))))
start end pre-change-length)))))))))
(if (consp region) region))))
(defun nxml-extend-after-change-region1 (start end pre-change-length)
(let* ((region (nxml-after-change1 start end pre-change-length))
(font-lock-beg (car region))
(font-lock-end (cdr region)))
(nxml-extend-region)
(cons font-lock-beg font-lock-end)))
(defun nxml-fontify-matcher (bound) (defun nxml-fontify-matcher (bound)
"Called as font-lock keyword matcher." "Called as font-lock keyword matcher."
@ -936,13 +913,12 @@ Called with `font-lock-beg' and `font-lock-end' dynamically bound."
(nxml-fontify-prolog) (nxml-fontify-prolog)
(goto-char nxml-prolog-end)) (goto-char nxml-prolog-end))
(let (xmltok-dependent-regions (let (xmltok-errors)
xmltok-errors)
(while (and (nxml-tokenize-forward) (while (and (nxml-tokenize-forward)
(<= (point) bound)) ; Intervals are open-ended. (<= (point) bound)) ; Intervals are open-ended.
(nxml-apply-fontify-rule))) (nxml-apply-fontify-rule)))
(setq nxml-last-fontify-end (point))) )
;; Since we did the fontification internally, tell font-lock to not ;; Since we did the fontification internally, tell font-lock to not
;; do anything itself. ;; do anything itself.

86
lisp/nxml/nxml-rap.el
View file

@ -69,18 +69,6 @@
;; typical proportion of comments, CDATA sections and processing ;; typical proportion of comments, CDATA sections and processing
;; instructions is small relative to other things. Secondly, to scan ;; instructions is small relative to other things. Secondly, to scan
;; we just search for the regexp <[!?]. ;; we just search for the regexp <[!?].
;;
;; One problem is unclosed comments, processing instructions and CDATA
;; sections. Suppose, for example, we encounter a <!-- but there's no
;; matching -->. This is not an unexpected situation if the user is
;; creating a comment. It is not helpful to treat the whole of the
;; file starting from the <!-- onwards as a single unclosed comment
;; token. Instead we treat just the <!-- as a piece of not well-formed
;; markup and continue. The problem is that if at some later stage a
;; --> gets added to the buffer after the unclosed <!--, we will need
;; to reparse the buffer starting from the <!--. We need to keep
;; track of these reparse dependencies; they are called dependent
;; regions in the code.
;;; Code: ;;; Code:
@ -144,8 +132,7 @@ any 'inside' regions and at the beginning of a token."
(if (>= start nxml-scan-end) (if (>= start nxml-scan-end)
nxml-scan-end nxml-scan-end
(let ((inside-remove-start start) (let ((inside-remove-start start)
xmltok-errors xmltok-errors)
xmltok-dependent-regions)
(while (or (when (xmltok-forward-special (min end nxml-scan-end)) (while (or (when (xmltok-forward-special (min end nxml-scan-end))
(when (memq xmltok-type (when (memq xmltok-type
'(comment '(comment
@ -169,9 +156,7 @@ any 'inside' regions and at the beginning of a token."
(when inside-end (when inside-end
(setq end inside-end) (setq end inside-end)
t)))) t))))
(nxml-clear-inside inside-remove-start end) (nxml-clear-inside inside-remove-start end))
(nxml-clear-dependent-regions start end)
(nxml-mark-parse-dependent-regions))
(when (> end nxml-scan-end) (when (> end nxml-scan-end)
(set-marker nxml-scan-end end)) (set-marker nxml-scan-end end))
end)) end))
@ -182,63 +167,14 @@ any 'inside' regions and at the beginning of a token."
(defun nxml-scan-prolog () (defun nxml-scan-prolog ()
(goto-char (point-min)) (goto-char (point-min))
(let (xmltok-dtd (let (xmltok-dtd
xmltok-errors xmltok-errors)
xmltok-dependent-regions)
(setq nxml-prolog-regions (xmltok-forward-prolog)) (setq nxml-prolog-regions (xmltok-forward-prolog))
(setq nxml-prolog-end (point)) (setq nxml-prolog-end (point))
(nxml-clear-inside (point-min) nxml-prolog-end) (nxml-clear-inside (point-min) nxml-prolog-end))
(nxml-clear-dependent-regions (point-min) nxml-prolog-end)
(nxml-mark-parse-dependent-regions))
(when (< nxml-scan-end nxml-prolog-end) (when (< nxml-scan-end nxml-prolog-end)
(set-marker nxml-scan-end nxml-prolog-end))) (set-marker nxml-scan-end nxml-prolog-end)))
;;; Dependent regions
(defun nxml-adjust-start-for-dependent-regions (start end pre-change-length)
(let ((overlays (overlays-in (1- start) start))
(adjusted-start start))
(while overlays
(let* ((overlay (car overlays))
(ostart (overlay-start overlay)))
(when (and (eq (overlay-get overlay 'category) 'nxml-dependent)
(< ostart adjusted-start))
(let ((funargs (overlay-get overlay 'nxml-funargs)))
(when (apply (car funargs)
(append (list start
end
pre-change-length
ostart
(overlay-end overlay))
(cdr funargs)))
(setq adjusted-start ostart)))))
(setq overlays (cdr overlays)))
adjusted-start))
(defun nxml-mark-parse-dependent-regions ()
(while xmltok-dependent-regions
(apply 'nxml-mark-parse-dependent-region
(car xmltok-dependent-regions))
(setq xmltok-dependent-regions
(cdr xmltok-dependent-regions))))
(defun nxml-mark-parse-dependent-region (fun start end &rest args)
(let ((overlay (make-overlay start end nil t t)))
(overlay-put overlay 'category 'nxml-dependent)
(overlay-put overlay 'nxml-funargs (cons fun args))))
(put 'nxml-dependent 'evaporate t)
(defun nxml-clear-dependent-regions (start end)
(let ((overlays (overlays-in start end)))
(while overlays
(let* ((overlay (car overlays))
(category (overlay-get overlay 'category)))
(when (and (eq category 'nxml-dependent)
(<= start (overlay-start overlay)))
(delete-overlay overlay)))
(setq overlays (cdr overlays)))))
;;; Random access parsing ;;; Random access parsing
(defun nxml-token-after () (defun nxml-token-after ()
@ -286,17 +222,14 @@ Sets variables like `nxml-token-after'."
(point))) (point)))
(defun nxml-tokenize-forward () (defun nxml-tokenize-forward ()
(let (xmltok-dependent-regions (let (xmltok-errors)
xmltok-errors)
(when (and (xmltok-forward) (when (and (xmltok-forward)
(> (point) nxml-scan-end)) (> (point) nxml-scan-end))
(cond ((memq xmltok-type '(comment (cond ((memq xmltok-type '(comment
cdata-section cdata-section
processing-instruction)) processing-instruction))
(with-silent-modifications (with-silent-modifications
(nxml-set-inside (1+ xmltok-start) (point) xmltok-type))) (nxml-set-inside (1+ xmltok-start) (point) xmltok-type))))
(xmltok-dependent-regions
(nxml-mark-parse-dependent-regions)))
(set-marker nxml-scan-end (point))) (set-marker nxml-scan-end (point)))
xmltok-type)) xmltok-type))
@ -304,7 +237,7 @@ Sets variables like `nxml-token-after'."
"Move point backwards outside any 'inside' regions or tags. "Move point backwards outside any 'inside' regions or tags.
Point will not move past `nxml-prolog-end'. Point will not move past `nxml-prolog-end'.
Point will either be at BOUND or a '<' character starting a tag Point will either be at BOUND or a '<' character starting a tag
outside any 'inside' regions. Ignores dependent regions. outside any 'inside' regions.
As a precondition, point must be >= BOUND." As a precondition, point must be >= BOUND."
(nxml-move-outside-backwards) (nxml-move-outside-backwards)
(when (not (equal (char-after) ?<)) (when (not (equal (char-after) ?<))
@ -331,8 +264,7 @@ Leave point unmoved if it is not inside anything special."
(when (< nxml-scan-end pos) (when (< nxml-scan-end pos)
(save-excursion (save-excursion
(goto-char nxml-scan-end) (goto-char nxml-scan-end)
(let (xmltok-errors (let (xmltok-errors)
xmltok-dependent-regions)
(while (when (xmltok-forward-special pos) (while (when (xmltok-forward-special pos)
(when (memq xmltok-type (when (memq xmltok-type
'(comment '(comment
@ -346,8 +278,6 @@ Leave point unmoved if it is not inside anything special."
t t
(setq pos (point)) (setq pos (point))
nil))) nil)))
(nxml-clear-dependent-regions nxml-scan-end pos)
(nxml-mark-parse-dependent-regions)
(set-marker nxml-scan-end pos)))))) (set-marker nxml-scan-end pos))))))
;;; Element scanning ;;; Element scanning

53
lisp/nxml/rng-valid.el
View file

@ -530,7 +530,6 @@ Return t if there is work to do, nil otherwise."
xmltok-replacement xmltok-replacement
xmltok-attributes xmltok-attributes
xmltok-namespace-attributes xmltok-namespace-attributes
xmltok-dependent-regions
xmltok-errors) xmltok-errors)
(when (= (point) 1) (when (= (point) 1)
(let ((regions (xmltok-forward-prolog))) (let ((regions (xmltok-forward-prolog)))
@ -566,7 +565,6 @@ Return t if there is work to do, nil otherwise."
;; do this before setting rng-validate-up-to-date-end ;; do this before setting rng-validate-up-to-date-end
;; in case we get a quit ;; in case we get a quit
(rng-mark-xmltok-errors) (rng-mark-xmltok-errors)
(rng-mark-xmltok-dependent-regions)
(setq rng-validate-up-to-date-end (setq rng-validate-up-to-date-end
(marker-position rng-conditional-up-to-date-end)) (marker-position rng-conditional-up-to-date-end))
(rng-clear-conditional-region) (rng-clear-conditional-region)
@ -591,7 +589,6 @@ Return t if there is work to do, nil otherwise."
(when (not have-remaining-chars) (when (not have-remaining-chars)
(rng-process-end-document)) (rng-process-end-document))
(rng-mark-xmltok-errors) (rng-mark-xmltok-errors)
(rng-mark-xmltok-dependent-regions)
(setq rng-validate-up-to-date-end pos) (setq rng-validate-up-to-date-end pos)
(when rng-conditional-up-to-date-end (when rng-conditional-up-to-date-end
(cond ((<= rng-conditional-up-to-date-end pos) (cond ((<= rng-conditional-up-to-date-end pos)
@ -661,57 +658,9 @@ Return t if there is work to do, nil otherwise."
;; if overlays left over from a previous use ;; if overlays left over from a previous use
;; of rng-validate-mode that ended with a change of mode ;; of rng-validate-mode that ended with a change of mode
(when rng-error-count (when rng-error-count
(setq rng-error-count (1- rng-error-count))))) (setq rng-error-count (1- rng-error-count)))))))
((and (eq category 'rng-dependent)
(<= beg (overlay-start overlay)))
(delete-overlay overlay))))
(setq overlays (cdr overlays)))))) (setq overlays (cdr overlays))))))
;;; Dependent regions
(defun rng-mark-xmltok-dependent-regions ()
(while xmltok-dependent-regions
(apply 'rng-mark-xmltok-dependent-region
(car xmltok-dependent-regions))
(setq xmltok-dependent-regions
(cdr xmltok-dependent-regions))))
(defun rng-mark-xmltok-dependent-region (fun start end &rest args)
(let ((overlay (make-overlay start end nil t t)))
(overlay-put overlay 'category 'rng-dependent)
(overlay-put overlay 'rng-funargs (cons fun args))))
(put 'rng-dependent 'evaporate t)
(put 'rng-dependent 'modification-hooks '(rng-dependent-region-changed))
(put 'rng-dependent 'insert-behind-hooks '(rng-dependent-region-changed))
(defun rng-dependent-region-changed (overlay
after-p
change-start
change-end
&optional pre-change-length)
(when (and after-p
;; Emacs sometimes appears to call deleted overlays
(overlay-start overlay)
(let ((funargs (overlay-get overlay 'rng-funargs)))
(save-match-data
(save-excursion
(save-restriction
(widen)
(apply (car funargs)
(append (list change-start
change-end
pre-change-length
(overlay-start overlay)
(overlay-end overlay))
(cdr funargs))))))))
(rng-after-change-function (overlay-start overlay)
change-end
(+ pre-change-length
(- (overlay-start overlay)
change-start)))
(delete-overlay overlay)))
;;; Error state ;;; Error state
(defun rng-mark-xmltok-errors () (defun rng-mark-xmltok-errors ()

290
lisp/nxml/xmltok.el
View file

@ -132,33 +132,6 @@ from referencing the entity in element content and AR is either nil,
meaning the replacement text included a <, or a string which is the meaning the replacement text included a <, or a string which is the
normalized attribute value.") normalized attribute value.")
(defvar xmltok-dependent-regions nil
"List of descriptors of regions that a parsed token depends on.
A token depends on a region if the region occurs after the token and a
change in the region may require the token to be reparsed. This only
happens with markup that is not well-formed. For example, if a <?
occurs without a matching ?>, then the <? is returned as a
not-well-formed token. However, this token is dependent on region
from the end of the token to the end of the buffer: if this ever
contains ?> then the buffer must be reparsed from the <?.
A region descriptor is a list (FUN START END ARG ...), where FUN is a
function to be called when the region changes, START and END are
integers giving the start and end of the region, and ARG... are
additional arguments to be passed to FUN. FUN will be called with 5
arguments followed by the additional arguments if any: the position of
the start of the changed area in the region, the position of the end
of the changed area in the region, the length of the changed area
before the change, the position of the start of the region, the
position of the end of the region. FUN must return non-nil if the
region needs reparsing. FUN will be called in a `save-excursion'
with match-data saved.
`xmltok-forward', `xmltok-forward-special' and `xmltok-forward-prolog'
may add entries to the beginning of this list, but will not clear it.
`xmltok-forward' and `xmltok-forward-special' will only add entries
when returning tokens of type not-well-formed.")
(defvar xmltok-errors nil (defvar xmltok-errors nil
"List of errors detected by `xmltok-forward' and `xmltok-forward-prolog'. "List of errors detected by `xmltok-forward' and `xmltok-forward-prolog'.
@ -176,7 +149,6 @@ indicating the position of the error.")
xmltok-replacement xmltok-replacement
xmltok-attributes xmltok-attributes
xmltok-namespace-attributes xmltok-namespace-attributes
xmltok-dependent-regions
xmltok-errors) xmltok-errors)
,@body)) ,@body))
@ -298,14 +270,6 @@ and VALUE-END, otherwise a STRING giving the value."
(or end (point))) (or end (point)))
xmltok-errors))) xmltok-errors)))
(defun xmltok-add-dependent (fun &optional start end &rest args)
(setq xmltok-dependent-regions
(cons (cons fun
(cons (or start xmltok-start)
(cons (or end (point-max))
args)))
xmltok-dependent-regions)))
(defun xmltok-forward () (defun xmltok-forward ()
(setq xmltok-start (point)) (setq xmltok-start (point))
(let* ((case-fold-search nil) (let* ((case-fold-search nil)
@ -684,14 +648,8 @@ Return the type of the token."
(setq xmltok-type 'empty-element)) (setq xmltok-type 'empty-element))
((xmltok-after-lt start cdata-section-open) ((xmltok-after-lt start cdata-section-open)
(setq xmltok-type (setq xmltok-type
(if (search-forward "]]>" nil t) (progn (search-forward "]]>" nil 'move)
'cdata-section 'cdata-section)))
(xmltok-add-error "No closing ]]>")
(xmltok-add-dependent 'xmltok-unclosed-reparse-p
nil
nil
"]]>")
'not-well-formed)))
((xmltok-after-lt start processing-instruction-question) ((xmltok-after-lt start processing-instruction-question)
(xmltok-scan-after-processing-instruction-open)) (xmltok-scan-after-processing-instruction-open))
((xmltok-after-lt start comment-open) ((xmltok-after-lt start comment-open)
@ -758,68 +716,44 @@ Return the type of the token."
;; xmltok-scan-prolog-after-processing-instruction-open ;; xmltok-scan-prolog-after-processing-instruction-open
;; XXX maybe should include rest of line (up to any <,>) in unclosed PI ;; XXX maybe should include rest of line (up to any <,>) in unclosed PI
(defun xmltok-scan-after-processing-instruction-open () (defun xmltok-scan-after-processing-instruction-open ()
(cond ((not (search-forward "?>" nil t)) (search-forward "?>" nil 'move)
(xmltok-add-error "No closing ?>" (cond ((not (save-excursion
xmltok-start (goto-char (+ 2 xmltok-start))
(+ xmltok-start 2)) (and (looking-at (xmltok-ncname regexp))
(xmltok-add-dependent 'xmltok-unclosed-reparse-p (setq xmltok-name-end (match-end 0)))))
nil (setq xmltok-name-end (+ xmltok-start 2))
nil (xmltok-add-error "<? not followed by name"
"?>") (+ xmltok-start 2)
(setq xmltok-type 'not-well-formed)) (+ xmltok-start 3)))
(t ((not (or (memq (char-after xmltok-name-end)
(cond ((not (save-excursion '(?\n ?\t ?\r ? ))
(goto-char (+ 2 xmltok-start)) (= xmltok-name-end (- (point) 2))))
(and (looking-at (xmltok-ncname regexp)) (xmltok-add-error "Target not followed by whitespace"
(setq xmltok-name-end (match-end 0))))) xmltok-name-end
(setq xmltok-name-end (+ xmltok-start 2)) (1+ xmltok-name-end)))
(xmltok-add-error "<? not followed by name" ((and (= xmltok-name-end (+ xmltok-start 5))
(+ xmltok-start 2) (save-excursion
(+ xmltok-start 3))) (goto-char (+ xmltok-start 2))
((not (or (memq (char-after xmltok-name-end) (let ((case-fold-search t))
'(?\n ?\t ?\r ? )) (looking-at "xml"))))
(= xmltok-name-end (- (point) 2)))) (xmltok-add-error "Processing instruction target is xml"
(xmltok-add-error "Target not followed by whitespace" (+ xmltok-start 2)
xmltok-name-end (+ xmltok-start 5))))
(1+ xmltok-name-end))) (setq xmltok-type 'processing-instruction))
((and (= xmltok-name-end (+ xmltok-start 5))
(save-excursion
(goto-char (+ xmltok-start 2))
(let ((case-fold-search t))
(looking-at "xml"))))
(xmltok-add-error "Processing instruction target is xml"
(+ xmltok-start 2)
(+ xmltok-start 5))))
(setq xmltok-type 'processing-instruction))))
(defun xmltok-scan-after-comment-open () (defun xmltok-scan-after-comment-open ()
(setq xmltok-type (let ((found-- (search-forward "--" nil 'move)))
(cond ((not (search-forward "--" nil t)) (setq xmltok-type
(xmltok-add-error "No closing -->") (cond ((or (eq (char-after) ?>) (not found--))
(xmltok-add-dependent 'xmltok-unclosed-reparse-p (goto-char (1+ (point)))
nil 'comment)
nil (t
;; not --> because ;; just include the <!-- in the token
;; -- is not allowed (goto-char (+ xmltok-start 4))
;; in comments in XML ;; Need do this after the goto-char because
"--") ;; marked error should just apply to <!--
'not-well-formed) (xmltok-add-error "First following `--' not followed by `>'")
((eq (char-after) ?>) 'not-well-formed)))))
(goto-char (1+ (point)))
'comment)
(t
(xmltok-add-dependent
'xmltok-semi-closed-reparse-p
nil
(point)
"--"
2)
;; just include the <!-- in the token
(goto-char (+ xmltok-start 4))
;; Need do this after the goto-char because
;; marked error should just apply to <!--
(xmltok-add-error "First following `--' not followed by `>'")
'not-well-formed))))
(defun xmltok-scan-attributes () (defun xmltok-scan-attributes ()
(let ((recovering nil) (let ((recovering nil)
@ -1124,7 +1058,7 @@ comment, processing-instruction-left, processing-instruction-right,
markup-declaration-open, markup-declaration-close, markup-declaration-open, markup-declaration-close,
internal-subset-open, internal-subset-close, hash-name, keyword, internal-subset-open, internal-subset-close, hash-name, keyword,
literal, encoding-name. literal, encoding-name.
Adds to `xmltok-errors' and `xmltok-dependent-regions' as appropriate." Adds to `xmltok-errors' as appropriate."
(let ((case-fold-search nil) (let ((case-fold-search nil)
xmltok-start xmltok-start
xmltok-type xmltok-type
@ -1148,7 +1082,6 @@ Adds to `xmltok-errors' and `xmltok-dependent-regions' as appropriate."
(1- xmltok-internal-subset-start) (1- xmltok-internal-subset-start)
xmltok-internal-subset-start)) xmltok-internal-subset-start))
(xmltok-parse-entities) (xmltok-parse-entities)
;; XXX prune dependent-regions for those entirely in prolog
(nreverse xmltok-prolog-regions))) (nreverse xmltok-prolog-regions)))
(defconst xmltok-bad-xml-decl-regexp (defconst xmltok-bad-xml-decl-regexp
@ -1648,95 +1581,68 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT."
(end (save-excursion (end (save-excursion
(goto-char safe-end) (goto-char safe-end)
(search-forward delim nil t)))) (search-forward delim nil t))))
(or (cond ((not end) (cond ((or (not end)
(xmltok-add-dependent 'xmltok-unclosed-reparse-p (save-excursion
nil (goto-char end)
nil (looking-at "[ \t\r\n>%[]")))
delim) (goto-char end))
nil) ((eq (1+ safe-end) end)
((save-excursion (goto-char end)
(goto-char end) (xmltok-add-error (format "Missing space after %s" delim)
(looking-at "[ \t\r\n>%[]")) safe-end)))
(goto-char end) (setq xmltok-type 'literal)))
(setq xmltok-type 'literal))
((eq (1+ safe-end) end)
(goto-char end)
(xmltok-add-error (format "Missing space after %s" delim)
safe-end)
(setq xmltok-type 'literal))
(t
(xmltok-add-dependent 'xmltok-semi-closed-reparse-p
xmltok-start
(1+ end)
delim
1)
nil))
(progn
(xmltok-add-error (format "Missing closing %s" delim))
(goto-char safe-end)
(skip-chars-backward " \t\r\n")
(setq xmltok-type 'not-well-formed)))))
(defun xmltok-scan-prolog-after-processing-instruction-open () (defun xmltok-scan-prolog-after-processing-instruction-open ()
(cond ((not (search-forward "?>" nil t)) (search-forward "?>" nil 'move)
(xmltok-add-error "No closing ?>" (let* ((end (point))
xmltok-start (target
(+ xmltok-start 2)) (save-excursion
(xmltok-add-dependent 'xmltok-unclosed-reparse-p (goto-char (+ xmltok-start 2))
nil (and (looking-at (xmltok-ncname regexp))
nil (or (memq (char-after (match-end 0))
"?>") '(?\n ?\t ?\r ? ))
(setq xmltok-type 'not-well-formed)) (= (match-end 0) (- end 2)))
(t (match-string-no-properties 0)))))
(let* ((end (point)) (cond ((not target)
(target (xmltok-add-error "\
(save-excursion
(goto-char (+ xmltok-start 2))
(and (looking-at (xmltok-ncname regexp))
(or (memq (char-after (match-end 0))
'(?\n ?\t ?\r ? ))
(= (match-end 0) (- end 2)))
(match-string-no-properties 0)))))
(cond ((not target)
(xmltok-add-error "\
Processing instruction does not start with a name" Processing instruction does not start with a name"
(+ xmltok-start 2) (+ xmltok-start 2)
(+ xmltok-start 3))) (+ xmltok-start 3)))
((not (and (= (length target) 3) ((not (and (= (length target) 3)
(let ((case-fold-search t)) (let ((case-fold-search t))
(string-match "xml" target))))) (string-match "xml" target)))))
((= xmltok-start 1) ((= xmltok-start 1)
(xmltok-add-error "Invalid XML declaration" (xmltok-add-error "Invalid XML declaration"
xmltok-start xmltok-start
(point))) (point)))
((save-excursion ((save-excursion
(goto-char xmltok-start) (goto-char xmltok-start)
(looking-at (xmltok-xml-declaration regexp))) (looking-at (xmltok-xml-declaration regexp)))
(xmltok-add-error "XML declaration not at beginning of file" (xmltok-add-error "XML declaration not at beginning of file"
xmltok-start xmltok-start
(point))) (point)))
(t (t
(xmltok-add-error "Processing instruction has target of xml" (xmltok-add-error "Processing instruction has target of xml"
(+ xmltok-start 2) (+ xmltok-start 2)
(+ xmltok-start 5)))) (+ xmltok-start 5))))
(xmltok-add-prolog-region 'processing-instruction-left (xmltok-add-prolog-region 'processing-instruction-left
xmltok-start xmltok-start
(+ xmltok-start (+ xmltok-start
2 2
(if target (if target
(length target) (length target)
0))) 0)))
(xmltok-add-prolog-region 'processing-instruction-right (xmltok-add-prolog-region 'processing-instruction-right
(if target (if target
(save-excursion (save-excursion
(goto-char (+ xmltok-start (goto-char (+ xmltok-start
(length target) (length target)
2)) 2))
(skip-chars-forward " \t\r\n") (skip-chars-forward " \t\r\n")
(point)) (point))
(+ xmltok-start 2)) (+ xmltok-start 2))
(point))) (point)))
(setq xmltok-type 'processing-instruction)))) (setq xmltok-type 'processing-instruction))
(defun xmltok-parse-entities () (defun xmltok-parse-entities ()
(let ((todo xmltok-dtd)) (let ((todo xmltok-dtd))