X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/d75ffb4ed0b2e72a9361a07d16a5c884a9459728..b1c23fb94072cca7f08ea5f50430916b9ea168e6:/lisp/xml.el

diff --git a/lisp/xml.el b/lisp/xml.el
index 179fdd6b5c..b3dce41ce1 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-2015 Free Software Foundation, Inc.
 
 ;; Author: Emmanuel Briot  <briot@gnat.com>
 ;; Maintainer: Mark A. Hershberger <mah@everybody.org>
@@ -200,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 ';'
@@ -479,7 +479,7 @@ Return one of:
 		 xml-default-ns))))
     (cond
      ;; Processing instructions, like <?xml version="1.0"?>.
-     ((looking-at "<\\?")
+     ((looking-at-p "<\\?")
       (search-forward "?>")
       (skip-syntax-forward " ")
       (xml-parse-tag-1 parse-dtd xml-ns))
@@ -492,14 +492,14 @@ Return one of:
 	 (buffer-substring-no-properties pos (match-beginning 0))
 	 (xml-parse-string))))
      ;; DTD for the document
-     ((looking-at "<!DOCTYPE[ \t\n\r]")
+     ((looking-at-p "<!DOCTYPE[ \t\n\r]")
       (let ((dtd (xml-parse-dtd parse-ns)))
 	(skip-syntax-forward " ")
 	(if xml-validating-parser
 	    (cons dtd (xml-parse-tag-1 nil xml-ns))
 	  (xml-parse-tag-1 nil xml-ns))))
      ;; skip comments
-     ((looking-at "<!--")
+     ((looking-at-p "<!--")
       (search-forward "-->")
       ;; FIXME: This loses the skipped-over spaces.
       (skip-syntax-forward " ")
@@ -507,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 "</")
       '())
      ;; opening tag
      ((looking-at (eval-when-compile (concat "<\\(" xml-name-re "\\)")))
@@ -530,7 +530,7 @@ Return one of:
 	(setq children (list attrs (xml-maybe-do-ns node-name "" xml-ns)))
 	(cond
 	 ;; is this an empty element ?
-	 ((looking-at "/>")
+	 ((looking-at-p "/>")
 	  (forward-char 2)
 	  (nreverse children))
 	 ;; is this a valid start tag ?
@@ -543,7 +543,7 @@ Return one of:
 	       ((eobp)
 		(error "XML: (Not Well-Formed) End of document while reading element `%s'"
 		       node-name))
-	       ((looking-at "</")
+	       ((looking-at-p "</")
 		(forward-char 2)
 		(error "XML: (Not Well-Formed) Invalid end tag `%s' (expecting `%s')"
 		       (let ((pos (point)))
@@ -591,7 +591,7 @@ references."
 	(old-remaining-size (- (buffer-size) (point)))
 	ref val)
     (while (and (not (eobp))
-		(not (looking-at "<")))
+		(not (looking-at-p "<")))
       ;; Find the next < or & character.
       (skip-chars-forward "^<&")
       (when (eq (char-after) ?&)
@@ -611,7 +611,7 @@ references."
 		   xml-validating-parser
 		   (error "XML: (Validity) Invalid character reference `%s'"
 			  (match-string 0)))
-	      (replace-match (or (string val) xml-undefined-entity) t t))
+	      (replace-match (if val (string val) xml-undefined-entity) t t))
 	  ;; For an entity reference, search again from the start of
 	  ;; the replaced text, since the replacement can contain
 	  ;; entity or character references, or markup.
@@ -620,7 +620,7 @@ references."
 	  (and (null val)
 	       xml-validating-parser
 	       (error "XML: (Validity) Undefined entity `%s'" ref))
-	  (replace-match (cdr val) t t)
+	  (replace-match (or (cdr val) xml-undefined-entity) t t)
 	  (goto-char (match-beginning 0)))
 	;; Check for XML bombs.
 	(and xml-entity-expansion-limit
@@ -690,11 +690,11 @@ This follows the rule [28] in the XML specifications."
   (let ((xml-validating-parser nil))
     (xml-parse-dtd)))
 
-(defun xml-parse-dtd (&optional parse-ns)
+(defun xml-parse-dtd (&optional _parse-ns)
   "Parse the DTD at point."
   (forward-char (eval-when-compile (length "<!DOCTYPE")))
   (skip-syntax-forward " ")
-  (if (and (looking-at ">")
+  (if (and (looking-at-p ">")
 	   xml-validating-parser)
       (error "XML: (Validity) Invalid DTD (expecting name of the document)"))
 
@@ -755,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)
@@ -771,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")))
@@ -803,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 "<!--")
+	 ((looking-at-p "<!--")
 	  (search-forward "-->")
 	  (and next-parameter-entity
 	       (> (point) next-parameter-entity)
@@ -856,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
@@ -916,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 ",")))))))
@@ -987,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))
@@ -1011,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 &amp;).
+
+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 '(("&" . "&amp;")
+			    ("<" . "&lt;")
+			    (">" . "&gt;")
+			    ("'" . "&apos;")
+			    ("\"" . "&quot;")))
+      (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.