dom-print: Fix missing entities quoting

Also use `?\s` for the space character.

* lisp/dom.el (dom-print): Properly quote special characters to avoid
generating invalid HTML/XML.
(dom-tag, dom-attributes, dom-children, dom-node)
(dom-add-child-before): Simplify.
(dom-set-attribute): Add at beginning rather than at end (slightly
more efficient and less destructive).

diff --git a/lisp/dom.el b/lisp/dom.el
index f8c794a300508efa6c0f9dd6846bc55961a52662..01bdef3a07adf2cdf63173fa2302f1b8f017f051 100644 (file)
--- a/lisp/dom.el
+++ b/lisp/dom.el
@@ -30,23 +30,17 @@
 (defsubst dom-tag (node)
   "Return the NODE tag."
   ;; Called on a list of nodes.  Use the first.
-  (if (consp (car node))
-      (caar node)
-    (car node)))
+  (car (if (consp (car node)) (car node) node)))
 
 (defsubst dom-attributes (node)
   "Return the NODE attributes."
   ;; Called on a list of nodes.  Use the first.
-  (if (consp (car node))
-      (cadr (car node))
-    (cadr node)))
+  (cadr (if (consp (car node)) (car node) node)))
 
 (defsubst dom-children (node)
   "Return the NODE children."
   ;; Called on a list of nodes.  Use the first.
-  (if (consp (car node))
-      (cddr (car node))
-    (cddr node)))
+  (cddr (if (consp (car node)) (car node) node)))
 
 (defun dom-non-text-children (node)
   "Return all non-text-node children of NODE."
@@ -62,10 +56,11 @@
 (defun dom-set-attribute (node attribute value)
   "Set ATTRIBUTE in NODE to VALUE."
   (setq node (dom-ensure-node node))
-  (let ((old (assoc attribute (cadr node))))
+  (let* ((attributes (cadr node))
+         (old (assoc attribute attributes)))
     (if old
        (setcdr old value)
-      (setcar (cdr node) (nconc (cadr node) (list (cons attribute value)))))))
+      (setcar (cdr node) (cons (cons attribute value) attributes)))))
 
 (defun dom-remove-attribute (node attribute)
   "Remove ATTRIBUTE from NODE."
@@ -80,7 +75,7 @@ A typical attribute is `href'."
 
 (defun dom-text (node)
   "Return all the text bits in the current node concatenated."
-  (mapconcat 'identity (cl-remove-if-not 'stringp (dom-children node)) " "))
+  (mapconcat #'identity (cl-remove-if-not #'stringp (dom-children node)) " "))
 
 (defun dom-texts (node &optional separator)
   "Return all textual data under NODE concatenated with SEPARATOR in-between."
@@ -195,9 +190,7 @@ ATTRIBUTE would typically be `class', `id' or the like."
 
 (defun dom-node (tag &optional attributes &rest children)
   "Return a DOM node with TAG and ATTRIBUTES."
-  (if children
-      `(,tag ,attributes ,@children)
-    (list tag attributes)))
+  `(,tag ,attributes ,@children))
 
 (defun dom-append-child (node child)
   "Append CHILD to the end of NODE's children."
@@ -215,11 +208,7 @@ If BEFORE is nil, make CHILD NODE's first child."
     (let ((pos (if before
                   (cl-position before children)
                 0)))
-      (if (zerop pos)
-         ;; First child.
-         (setcdr (cdr node) (cons child (cddr node)))
-       (setcdr (nthcdr (1- pos) children)
-               (cons child (nthcdr pos children))))))
+      (push child (nthcdr (+ 2 pos) node))))
   node)
 
 (defun dom-ensure-node (node)
@@ -247,7 +236,7 @@ white-space."
          (insert (format "(%S . %S)" (car elem) (cdr elem)))
          (if (zerop (cl-decf times))
              (insert ")")
-           (insert "\n" (make-string column ? ))))))
+           (insert "\n" (make-string column ?\s))))))
     (let* ((children (if remove-empty
                         (cl-remove-if
                          (lambda (child)
@@ -258,16 +247,16 @@ white-space."
           (times (length children)))
       (if (null children)
          (insert ")")
-       (insert "\n" (make-string (1+ column) ? ))
+       (insert "\n" (make-string (1+ column) ?\s))
        (dolist (child children)
          (if (stringp child)
-             (if (or (not remove-empty)
-                     (not (string-match "\\`[\n\r\t  ]*\\'" child)))
+             (if (not (and remove-empty
+                           (string-match "\\`[\n\r\t  ]*\\'" child)))
                  (insert (format "%S" child)))
            (dom-pp child remove-empty))
          (if (zerop (cl-decf times))
              (insert ")")
-           (insert "\n" (make-string (1+ column) ? ))))))))
+           (insert "\n" (make-string (1+ column) ?\s))))))))
 
 (defun dom-print (dom &optional pretty xml)
   "Print DOM at point as HTML/XML.
@@ -279,18 +268,19 @@ If XML, generate XML instead of HTML."
       (dolist (elem attr)
        ;; In HTML, these are boolean attributes that should not have
        ;; an = value.
-       (if (and (memq (car elem)
-                      '(async autofocus autoplay checked
-                              contenteditable controls default
-                              defer disabled formNoValidate frameborder
-                              hidden ismap itemscope loop
-                              multiple muted nomodule novalidate open
-                              readonly required reversed
-                              scoped selected typemustmatch))
-                (cdr elem)
-                (not xml))
-           (insert (format " %s" (car elem)))
-         (insert (format " %s=%S" (car elem) (cdr elem))))))
+       (insert (if (and (memq (car elem)
+                              '(async autofocus autoplay checked
+                                contenteditable controls default
+                                defer disabled formNoValidate frameborder
+                                hidden ismap itemscope loop
+                                multiple muted nomodule novalidate open
+                                readonly required reversed
+                                scoped selected typemustmatch))
+                        (cdr elem)
+                        (not xml))
+                   (format " %s" (car elem))
+                 (format " %s=\"%s\"" (car elem)
+                         (url-insert-entities-in-string (cdr elem)))))))
     (let* ((children (dom-children dom))
           (non-text nil))
       (if (null children)
@@ -301,7 +291,7 @@ If XML, generate XML instead of HTML."
              (insert child)
            (setq non-text t)
            (when pretty
-              (insert "\n" (make-string (+ column 2) ? )))
+              (insert "\n" (make-string (+ column 2) ?\s)))
            (dom-print child pretty xml)))
        ;; If we inserted non-text child nodes, or a text node that
        ;; ends with a newline, then we indent the end tag.
@@ -310,7 +300,7 @@ If XML, generate XML instead of HTML."
                       non-text))
          (unless (bolp)
             (insert "\n"))
-         (insert (make-string column ? )))
+         (insert (make-string column ?\s)))
         (insert (format "</%s>" (dom-tag dom)))))))
 
 (provide 'dom)