-;;; xmltok.el --- XML tokenization
+;;; xmltok.el --- XML tokenization -*- lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML
+;; Keywords: wp, hypermedia, languages, XML
;; This file is part of GNU Emacs.
meaning the replacement text included a <, or a string which is the
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
"List of errors detected by `xmltok-forward' and `xmltok-forward-prolog'.
indicating the position of the error.")
(defmacro xmltok-save (&rest body)
+ (declare (indent 0) (debug t))
`(let (xmltok-type
xmltok-start
xmltok-name-colon
xmltok-replacement
xmltok-attributes
xmltok-namespace-attributes
- xmltok-dependent-regions
xmltok-errors)
,@body))
-(put 'xmltok-save 'lisp-indent-function 0)
-(def-edebug-spec xmltok-save t)
-
(defsubst xmltok-attribute-name-start (att)
(aref att 0))
(or end (point)))
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 ()
(setq xmltok-start (point))
(let* ((case-fold-search nil)
(eval-when-compile
(let* ((or "\\|")
(open "\\(?:")
- (gopen "\\(")
(close "\\)")
(name-start-char "[_[:alpha:]]")
(name-continue-not-start-char "[-.[:digit:]]")
(setq xmltok-type 'empty-element))
((xmltok-after-lt start cdata-section-open)
(setq xmltok-type
- (if (search-forward "]]>" nil t)
- 'cdata-section
- (xmltok-add-error "No closing ]]>")
- (xmltok-add-dependent 'xmltok-unclosed-reparse-p
- nil
- nil
- "]]>")
- 'not-well-formed)))
+ (progn (search-forward "]]>" nil 'move)
+ 'cdata-section)))
((xmltok-after-lt start processing-instruction-question)
(xmltok-scan-after-processing-instruction-open))
((xmltok-after-lt start comment-open)
;; xmltok-scan-prolog-after-processing-instruction-open
;; XXX maybe should include rest of line (up to any <,>) in unclosed PI
(defun xmltok-scan-after-processing-instruction-open ()
- (cond ((not (search-forward "?>" nil t))
- (xmltok-add-error "No closing ?>"
- xmltok-start
- (+ xmltok-start 2))
- (xmltok-add-dependent 'xmltok-unclosed-reparse-p
- nil
- nil
- "?>")
- (setq xmltok-type 'not-well-formed))
- (t
- (cond ((not (save-excursion
- (goto-char (+ 2 xmltok-start))
- (and (looking-at (xmltok-ncname regexp))
- (setq xmltok-name-end (match-end 0)))))
- (setq xmltok-name-end (+ xmltok-start 2))
- (xmltok-add-error "<? not followed by name"
- (+ xmltok-start 2)
- (+ xmltok-start 3)))
- ((not (or (memq (char-after xmltok-name-end)
- '(?\n ?\t ?\r ? ))
- (= xmltok-name-end (- (point) 2))))
- (xmltok-add-error "Target not followed by whitespace"
- xmltok-name-end
- (1+ xmltok-name-end)))
- ((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))))
+ (search-forward "?>" nil 'move)
+ (cond ((not (save-excursion
+ (goto-char (+ 2 xmltok-start))
+ (and (looking-at (xmltok-ncname regexp))
+ (setq xmltok-name-end (match-end 0)))))
+ (setq xmltok-name-end (+ xmltok-start 2))
+ (xmltok-add-error "<? not followed by name"
+ (+ xmltok-start 2)
+ (+ xmltok-start 3)))
+ ((not (or (memq (char-after xmltok-name-end)
+ '(?\n ?\t ?\r ? ))
+ (= xmltok-name-end (- (point) 2))))
+ (xmltok-add-error "Target not followed by whitespace"
+ xmltok-name-end
+ (1+ xmltok-name-end)))
+ ((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 ()
- (setq xmltok-type
- (cond ((not (search-forward "--" nil t))
- (xmltok-add-error "No closing -->")
- (xmltok-add-dependent 'xmltok-unclosed-reparse-p
- nil
- nil
- ;; not --> because
- ;; -- is not allowed
- ;; in comments in XML
- "--")
- 'not-well-formed)
- ((eq (char-after) ?>)
- (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))))
+ (let ((found-- (search-forward "--" nil 'move)))
+ (setq xmltok-type
+ (cond ((or (eq (char-after) ?>) (not found--))
+ (goto-char (1+ (point)))
+ 'comment)
+ (t
+ ;; 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 `>'")
+ (goto-char (point-max))
+ 'comment)))))
(defun xmltok-scan-attributes ()
(let ((recovering nil)
(xmltok-valid-char-p n)
n)))
-(defun xmltok-unclosed-reparse-p (change-start
- change-end
- pre-change-length
- start
- end
- delimiter)
- (let ((len-1 (1- (length delimiter))))
- (goto-char (max start (- change-start len-1)))
- (search-forward delimiter (min end (+ change-end len-1)) t)))
-
-;; Handles a <!-- with the next -- not followed by >
-
-(defun xmltok-semi-closed-reparse-p (change-start
- change-end
- pre-change-length
- start
- end
- delimiter
- delimiter-length)
- (or (<= (- end delimiter-length) change-end)
- (xmltok-unclosed-reparse-p change-start
- change-end
- pre-change-length
- start
- end
- delimiter)))
-
(defun xmltok-valid-char-p (n)
"Return non-nil if N is the Unicode code of a valid XML character."
(cond ((< n #x20) (memq n '(#xA #xD #x9)))
markup-declaration-open, markup-declaration-close,
internal-subset-open, internal-subset-close, hash-name, keyword,
literal, encoding-name.
-Adds to `xmltok-errors' and `xmltok-dependent-regions' as appropriate."
+Adds to `xmltok-errors' as appropriate."
(let ((case-fold-search nil)
xmltok-start
xmltok-type
(setq xmltok-dtd xmltok-predefined-entity-alist)
(xmltok-scan-xml-declaration)
(xmltok-next-prolog-token)
- (while (condition-case err
+ (while (condition-case nil
(when (xmltok-parse-prolog-item)
(xmltok-next-prolog-token))
(xmltok-markup-declaration-parse-error
(1- xmltok-internal-subset-start)
xmltok-internal-subset-start))
(xmltok-parse-entities)
- ;; XXX prune dependent-regions for those entirely in prolog
(nreverse xmltok-prolog-regions)))
(defconst xmltok-bad-xml-decl-regexp
(t
(let ((xmltok-start (1- (point)))
xmltok-type xmltok-replacement)
- (xmltok-scan-after-amp (lambda (start end)))
+ (xmltok-scan-after-amp (lambda (_start _end)))
(cond ((eq xmltok-type 'char-ref)
(setq value-parts
(cons (buffer-substring-no-properties
(defun xmltok-current-token-string ()
(buffer-substring-no-properties xmltok-start (point)))
-(put 'xmltok-markup-declaration-parse-error
- 'error-conditions
- '(error xmltok-markup-declaration-parse-error))
-
-(put 'xmltok-markup-declaration-parse-error
- 'error-message
- "Syntax error in markup declaration")
+(define-error 'xmltok-markup-declaration-parse-error
+ "Syntax error in markup declaration")
(defun xmltok-markup-declaration-parse-error ()
(signal 'xmltok-markup-declaration-parse-error nil))
(end (save-excursion
(goto-char safe-end)
(search-forward delim nil t))))
- (or (cond ((not end)
- (xmltok-add-dependent 'xmltok-unclosed-reparse-p
- nil
- nil
- delim)
- nil)
- ((save-excursion
- (goto-char end)
- (looking-at "[ \t\r\n>%[]"))
- (goto-char end)
- (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)))))
+ (cond ((or (not end)
+ (save-excursion
+ (goto-char end)
+ (looking-at "[ \t\r\n>%[]")))
+ (goto-char end))
+ ((eq (1+ safe-end) end)
+ (goto-char end)
+ (xmltok-add-error (format "Missing space after %s" delim)
+ safe-end)))
+ (setq xmltok-type 'literal)))
(defun xmltok-scan-prolog-after-processing-instruction-open ()
- (cond ((not (search-forward "?>" nil t))
- (xmltok-add-error "No closing ?>"
- xmltok-start
- (+ xmltok-start 2))
- (xmltok-add-dependent 'xmltok-unclosed-reparse-p
- nil
- nil
- "?>")
- (setq xmltok-type 'not-well-formed))
- (t
- (let* ((end (point))
- (target
- (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 "\
+ (search-forward "?>" nil 'move)
+ (let* ((end (point))
+ (target
+ (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"
- (+ xmltok-start 2)
- (+ xmltok-start 3)))
- ((not (and (= (length target) 3)
- (let ((case-fold-search t))
- (string-match "xml" target)))))
- ((= xmltok-start 1)
- (xmltok-add-error "Invalid XML declaration"
- xmltok-start
- (point)))
- ((save-excursion
- (goto-char xmltok-start)
- (looking-at (xmltok-xml-declaration regexp)))
- (xmltok-add-error "XML declaration not at beginning of file"
- xmltok-start
- (point)))
- (t
- (xmltok-add-error "Processing instruction has target of xml"
- (+ xmltok-start 2)
- (+ xmltok-start 5))))
- (xmltok-add-prolog-region 'processing-instruction-left
- xmltok-start
- (+ xmltok-start
- 2
- (if target
- (length target)
- 0)))
- (xmltok-add-prolog-region 'processing-instruction-right
- (if target
- (save-excursion
- (goto-char (+ xmltok-start
- (length target)
- 2))
- (skip-chars-forward " \t\r\n")
- (point))
- (+ xmltok-start 2))
- (point)))
- (setq xmltok-type 'processing-instruction))))
+ (+ xmltok-start 2)
+ (+ xmltok-start 3)))
+ ((not (and (= (length target) 3)
+ (let ((case-fold-search t))
+ (string-match "xml" target)))))
+ ((= xmltok-start 1)
+ (xmltok-add-error "Invalid XML declaration"
+ xmltok-start
+ (point)))
+ ((save-excursion
+ (goto-char xmltok-start)
+ (looking-at (xmltok-xml-declaration regexp)))
+ (xmltok-add-error "XML declaration not at beginning of file"
+ xmltok-start
+ (point)))
+ (t
+ (xmltok-add-error "Processing instruction has target of xml"
+ (+ xmltok-start 2)
+ (+ xmltok-start 5))))
+ (xmltok-add-prolog-region 'processing-instruction-left
+ xmltok-start
+ (+ xmltok-start
+ 2
+ (if target
+ (length target)
+ 0)))
+ (xmltok-add-prolog-region 'processing-instruction-right
+ (if target
+ (save-excursion
+ (goto-char (+ xmltok-start
+ (length target)
+ 2))
+ (skip-chars-forward " \t\r\n")
+ (point))
+ (+ xmltok-start 2))
+ (point)))
+ (setq xmltok-type 'processing-instruction))
(defun xmltok-parse-entities ()
(let ((todo xmltok-dtd))