X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/69c41c4070c86baac11a627e9c3d366420aeb7cc..becf0483bf5ca42b0aab7533ed02ff21cc509c1a:/lisp/xml.el diff --git a/lisp/xml.el b/lisp/xml.el index e2788e5e75..ca8ddce586 100644 --- a/lisp/xml.el +++ b/lisp/xml.el @@ -1,6 +1,6 @@ ;;; xml.el --- XML parser -;; Copyright (C) 2000-2012 Free Software Foundation, Inc. +;; Copyright (C) 2000-2014 Free Software Foundation, Inc. ;; Author: Emmanuel Briot ;; Maintainer: Mark A. Hershberger @@ -126,7 +126,10 @@ tag. For example, would be represented by - '(\"\" . \"foo\")." + '(\"\" . \"foo\"). + +If you'd just like a plain symbol instead, use 'symbol-qnames in +the PARSE-NS argument." (car node)) @@ -197,7 +200,7 @@ See also `xml-get-attribute-or-nil'." ;; [68] EntityRef ::= '&' Name ';' (defconst xml-entity-ref (concat "&" xml-name-re ";")) -(defconst xml-entity-or-char-ref-re (concat "&\\(?:#\\(x\\)?\\([0-9]+\\)\\|\\(" +(defconst xml-entity-or-char-ref-re (concat "&\\(?:#\\(x\\)?\\([0-9a-fA-F]+\\)\\|\\(" xml-name-re "\\)\\);")) ;; [69] PEReference ::= '%' Name ';' @@ -313,7 +316,22 @@ only those characters, have whitespace syntax.") "Parse the well-formed XML file FILE. Return the top node with all its children. If PARSE-DTD is non-nil, the DTD is parsed rather than skipped. -If PARSE-NS is non-nil, then QNAMES are expanded." + +If PARSE-NS is non-nil, then QNAMES are expanded. By default, +the variable `xml-default-ns' is the mapping from namespaces to +URIs, and expanded names will be returned as a cons + + (\"namespace:\" . \"foo\"). + +If PARSE-NS is an alist, it will be used as the mapping from +namespace to URIs instead. + +If it is the symbol 'symbol-qnames, expanded names will be +returned as a plain symbol 'namespace:foo instead of a cons. + +Both features can be combined by providing a cons cell + + (symbol-qnames . ALIST)." (with-temp-buffer (insert-file-contents file) (xml--parse-buffer parse-dtd parse-ns))) @@ -329,7 +347,21 @@ If END is nil, it defaults to `point-max'. If BUFFER is nil, it defaults to the current buffer. If PARSE-DTD is non-nil, parse the DTD and return it as the first element of the list. -If PARSE-NS is non-nil, expand QNAMES." +If PARSE-NS is non-nil, then QNAMES are expanded. By default, +the variable `xml-default-ns' is the mapping from namespaces to +URIs, and expanded names will be returned as a cons + + (\"namespace:\" . \"foo\"). + +If PARSE-NS is an alist, it will be used as the mapping from +namespace to URIs instead. + +If it is the symbol 'symbol-qnames, expanded names will be +returned as a plain symbol 'namespace:foo instead of a cons. + +Both features can be combined by providing a cons cell + + (symbol-qnames . ALIST)." ;; Use fixed syntax table to ensure regexp char classes and syntax ;; specs DTRT. (unless buffer @@ -386,26 +418,36 @@ is nil. During namespace-aware parsing, any name without a namespace is put into the namespace identified by DEFAULT. nil is used to -specify that the name shouldn't be given a namespace." +specify that the name shouldn't be given a namespace. +Expanded names will by default be returned as a cons. If you +would like to get plain symbols instead, provide a cons cell + + (symbol-qnames . ALIST) + +in the XML-NS argument." (if (consp xml-ns) - (let* ((nsp (string-match ":" name)) + (let* ((symbol-qnames (eq (car-safe xml-ns) 'symbol-qnames)) + (nsp (string-match ":" name)) (lname (if nsp (substring name (match-end 0)) name)) (prefix (if nsp (substring name 0 (match-beginning 0)) default)) (special (and (string-equal lname "xmlns") (not prefix))) ;; Setting default to nil will insure that there is not ;; matching cons in xml-ns. In which case we (ns (or (cdr (assoc (if special "xmlns" prefix) - xml-ns)) + (if symbol-qnames (cdr xml-ns) xml-ns))) ""))) - (cons ns (if special "" lname))) + (if (and symbol-qnames + (not (string= prefix "xmlns"))) + (intern (concat ns lname)) + (cons ns (if special "" lname)))) (intern name))) (defun xml-parse-tag (&optional parse-dtd parse-ns) "Parse the tag at point. If PARSE-DTD is non-nil, the DTD of the document, if any, is parsed and returned as the first element in the list. -If PARSE-NS is non-nil, expand QNAMES; if the value of PARSE-NS -is a list, use it as an alist mapping namespaces to URIs. +If PARSE-NS is non-nil, expand QNAMES; for further details, see +`xml-parse-region'. Return one of: - a list : the matching node @@ -425,12 +467,19 @@ Return one of: (defun xml-parse-tag-1 (&optional parse-dtd parse-ns) "Like `xml-parse-tag', but possibly modify the buffer while working." - (let ((xml-validating-parser (or parse-dtd xml-validating-parser)) - (xml-ns (cond ((consp parse-ns) parse-ns) - (parse-ns xml-default-ns)))) + (let* ((xml-validating-parser (or parse-dtd xml-validating-parser)) + (xml-ns + (cond ((eq parse-ns 'symbol-qnames) + (cons 'symbol-qnames xml-default-ns)) + ((or (consp (car-safe parse-ns)) + (and (eq (car-safe parse-ns) 'symbol-qnames) + (listp (cdr parse-ns)))) + parse-ns) + (parse-ns + xml-default-ns)))) (cond ;; Processing instructions, like . - ((looking-at "<\\?") + ((looking-at-p "<\\?") (search-forward "?>") (skip-syntax-forward " ") (xml-parse-tag-1 parse-dtd xml-ns)) @@ -443,14 +492,14 @@ Return one of: (buffer-substring-no-properties pos (match-beginning 0)) (xml-parse-string)))) ;; DTD for the document - ((looking-at "") ;; FIXME: This loses the skipped-over spaces. (skip-syntax-forward " ") @@ -458,7 +507,7 @@ Return one of: (let ((xml-sub-parser t)) (xml-parse-tag-1 parse-dtd xml-ns)))) ;; end tag - ((looking-at "") + ((looking-at-p "/>") (forward-char 2) (nreverse children)) ;; is this a valid start tag ? @@ -492,7 +543,7 @@ Return one of: ((eobp) (error "XML: (Not Well-Formed) End of document while reading element `%s'" node-name)) - ((looking-at "") + (if (and (looking-at-p ">") xml-validating-parser) (error "XML: (Validity) Invalid DTD (expecting name of the document)")) @@ -704,7 +755,7 @@ This follows the rule [28] in the XML specifications." ;; Parse the rest of the DTD ;; Fixme: Deal with NOTATION, PIs. - (while (not (looking-at "\\s-*\\]")) + (while (not (looking-at-p "\\s-*\\]")) (skip-syntax-forward " ") (cond ((eobp) @@ -720,14 +771,14 @@ This follows the rule [28] in the XML specifications." (end-pos (match-end 0))) ;; Translation of rule [46] of XML specifications (cond - ((string-match "\\`EMPTY\\s-*\\'" type) ; empty declaration + ((string-match-p "\\`EMPTY\\s-*\\'" type) ; empty declaration (setq type 'empty)) - ((string-match "\\`ANY\\s-*$" type) ; any type of contents + ((string-match-p "\\`ANY\\s-*$" type) ; any type of contents (setq type 'any)) ((string-match "\\`(\\(.*\\))\\s-*\\'" type) ; children ([47]) (setq type (xml-parse-elem-type (match-string-no-properties 1 type)))) - ((string-match "^%[^;]+;[ \t\n\r]*\\'" type) ; substitution + ((string-match-p "^%[^;]+;[ \t\n\r]*\\'" type) ; substitution nil) (xml-validating-parser (error "XML: (Validity) Invalid element type in the DTD"))) @@ -752,7 +803,7 @@ This follows the rule [28] in the XML specifications." (goto-char (match-end 0))) ;; Comments (skip to end, ignoring parameter entity): - ((looking-at "") (and next-parameter-entity (> (point) next-parameter-entity) @@ -805,7 +856,6 @@ This follows the rule [28] in the XML specifications." (unless (looking-at xml-pe-reference-re) (error "XML: Internal error")) (let* ((entity (match-string 1)) - (beg (point-marker)) (elt (assoc entity xml-parameter-entity-alist))) (if elt (progn @@ -865,11 +915,11 @@ references and parameter-entity references." (progn (setq elem (match-string-no-properties 1 string) modifier (match-string-no-properties 2 string)) - (if (string-match "|" elem) + (if (string-match-p "|" elem) (setq elem (cons 'choice (mapcar 'xml-parse-elem-type (split-string elem "|")))) - (if (string-match "," elem) + (if (string-match-p "," elem) (setq elem (cons 'seq (mapcar 'xml-parse-elem-type (split-string elem ","))))))) @@ -936,13 +986,12 @@ by \"*\"." (if (and string (stringp string)) (let ((start 0)) (while (string-match "&#\\([0-9]+\\);" string start) - (condition-case nil - (setq string (replace-match - (string (read (substring string - (match-beginning 1) - (match-end 1)))) - nil nil string)) - (error nil)) + (ignore-errors + (setq string (replace-match + (string (read (substring string + (match-beginning 1) + (match-end 1)))) + nil nil string))) (setq start (1+ (match-beginning 0)))) string) nil)) @@ -960,13 +1009,25 @@ The first line is indented with the optional INDENT-STRING." (defalias 'xml-print 'xml-debug-print) (defun xml-escape-string (string) - "Return STRING with entity substitutions made from `xml-entity-alist'." - (mapconcat (lambda (byte) - (let ((char (char-to-string byte))) - (if (rassoc char xml-entity-alist) - (concat "&" (car (rassoc char xml-entity-alist)) ";") - char))) - string "")) + "Convert STRING into a string containing valid XML character data. +Replace occurrences of &<>'\" in STRING with their default XML +entity references (e.g. replace each & with &). + +XML character data must not contain & or < characters, nor the > +character under some circumstances. The XML spec does not impose +restriction on \" or ', but we just substitute for these too +\(as is permitted by the spec)." + (with-temp-buffer + (insert string) + (dolist (substitution '(("&" . "&") + ("<" . "<") + (">" . ">") + ("'" . "'") + ("\"" . """))) + (goto-char (point-min)) + (while (search-forward (car substitution) nil t) + (replace-match (cdr substitution) t t nil))) + (buffer-string))) (defun xml-debug-print-internal (xml indent-string) "Outputs the XML tree in the current buffer.