Fix DOM printing
Fix DOM printing when an attribute value is not a string, which is often the case in SVG DOM. Don't print attributes without a value. Refresh the list of HTML boolean attributes. * lisp/dom.el (dom--html-boolean-attribute-p): New function. (dom-print): Use it. Convert attribute value to string before to call `url-insert-entities-in-string'. Don't print attribute without a value. Compute indentation column outside of loop and call `indent-line-to' to indent line. (Bug#5928) * test/lisp/dom-tests.el (dom-tests-print-svg) (dom-tests-print-html-boolean): New tests.
This commit is contained in:
David Ponce
Eli Zaretskii
parent
a8a4c3a091
commit
7ad139d721
2 changed files with 88 additions and 26 deletions
60
lisp/dom.el
60
lisp/dom.el
|
|
@ -258,31 +258,41 @@ white-space."
|
|||
(insert ")")
|
||||
(insert "\n" (make-string (1+ column) ?\s))))))))
|
||||
|
||||
(define-inline dom--html-boolean-attribute-p (attr)
|
||||
"Return non-nil if ATTR is an HTML boolean attribute."
|
||||
(inline-quote
|
||||
(memq ,attr
|
||||
;; Extracted from the HTML Living Standard list of attributes
|
||||
;; at <https://html.spec.whatwg.org/#attributes-3>.
|
||||
'( allowfullscreen alpha async autofocus autoplay checked
|
||||
controls default defer disabled formnovalidate inert ismap
|
||||
itemscope loop multiple muted nomodule novalidate open
|
||||
playsinline readonly required reversed selected
|
||||
shadowrootclonable shadowrootdelegatesfocus
|
||||
shadowrootserializable))))
|
||||
|
||||
(defun dom-print (dom &optional pretty xml)
|
||||
"Print DOM at point as HTML/XML.
|
||||
If PRETTY, indent the HTML/XML logically.
|
||||
If XML, generate XML instead of HTML."
|
||||
(let ((column (current-column)))
|
||||
(let ((column (current-column))
|
||||
(indent-tabs-mode nil)) ;; Indent with spaces
|
||||
(insert (format "<%s" (dom-tag dom)))
|
||||
(let ((attr (dom-attributes dom)))
|
||||
(dolist (elem attr)
|
||||
;; In HTML, these are boolean attributes that should not have
|
||||
;; an = value.
|
||||
(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)))))))
|
||||
(pcase-dolist (`(,attr . ,value) (dom-attributes dom))
|
||||
;; Don't print attributes without a value.
|
||||
(when value
|
||||
(insert
|
||||
;; HTML boolean attributes should not have an = value. The
|
||||
;; presence of a boolean attribute on an element represents
|
||||
;; the true value, and the absence of the attribute
|
||||
;; represents the false value.
|
||||
(if (and (not xml) (dom--html-boolean-attribute-p attr))
|
||||
(format " %s" attr)
|
||||
(format " %s=%S" attr (url-insert-entities-in-string
|
||||
(format "%s" value)))))))
|
||||
(let* ((children (dom-children dom))
|
||||
(non-text nil))
|
||||
(non-text nil)
|
||||
(indent (+ column 2)))
|
||||
(if (null children)
|
||||
(insert " />")
|
||||
(insert ">")
|
||||
|
|
@ -291,16 +301,14 @@ If XML, generate XML instead of HTML."
|
|||
(insert (url-insert-entities-in-string child))
|
||||
(setq non-text t)
|
||||
(when pretty
|
||||
(insert "\n" (make-string (+ column 2) ?\s)))
|
||||
(insert "\n")
|
||||
(indent-line-to indent))
|
||||
(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.
|
||||
(when (and pretty
|
||||
(or (bolp)
|
||||
non-text))
|
||||
(unless (bolp)
|
||||
(insert "\n"))
|
||||
(insert (make-string column ?\s)))
|
||||
(when (and pretty (or (bolp) non-text))
|
||||
(or (bolp) (insert "\n"))
|
||||
(indent-line-to column))
|
||||
(insert (format "</%s>" (dom-tag dom)))))))
|
||||
|
||||
(provide 'dom)
|
||||
|
|
|
|||
|
|
@ -27,6 +27,7 @@
|
|||
;;; Code:
|
||||
|
||||
(require 'dom)
|
||||
(require 'svg)
|
||||
(require 'ert)
|
||||
|
||||
;; `defsubst's are not inlined inside `ert-deftest' (see Bug#24402),
|
||||
|
|
@ -219,6 +220,59 @@ child results in an error."
|
|||
"<div class="default"> </div>"
|
||||
"</samp>")))))
|
||||
|
||||
(ert-deftest dom-tests-print-svg ()
|
||||
"Test that `dom-print' correctly print a SVG DOM."
|
||||
(let ((svg (svg-create 100 100)))
|
||||
(svg-rectangle svg 0 0 "100%" "100%" :fill "blue")
|
||||
(svg-text svg "A text" :x 0 :y 55 :stroke "yellow" :fill "yellow")
|
||||
(with-temp-buffer
|
||||
(dom-print svg t t)
|
||||
(should
|
||||
(equal
|
||||
(buffer-string)
|
||||
(concat
|
||||
"<svg width=\"100\" height=\"100\" version=\"1.1\" "
|
||||
"xmlns=\"http://www.w3.org/2000/svg\" "
|
||||
"xmlns:xlink=\"http://www.w3.org/1999/xlink\">\n"
|
||||
" <rect width=\"100%\" height=\"100%\" x=\"0\" y=\"0\" fill=\"blue\" />\n"
|
||||
" <text fill=\"yellow\" stroke=\"yellow\" y=\"55\" x=\"0\">A text</text>\n"
|
||||
"</svg>"))))))
|
||||
|
||||
(ert-deftest dom-tests-print-html-boolean ()
|
||||
"Test that `dom-print' correctly print HTML boolean attributes."
|
||||
(let ((dom (dom-node
|
||||
"html" nil
|
||||
(dom-node "head" nil
|
||||
(dom-node "title" nil
|
||||
"Test boolean attributes"))
|
||||
(dom-node "body" nil
|
||||
;; The following checkboxes are checked
|
||||
(dom-node "input" '((type . "checkbox")
|
||||
(checked . "")))
|
||||
(dom-node "input" '((type . "checkbox")
|
||||
(checked . "checked")))
|
||||
(dom-node "input" '((type . "checkbox")
|
||||
(checked . "true")))
|
||||
(dom-node "input" '((type . "checkbox")
|
||||
(checked . "false")))
|
||||
;; The following checkbox is not checked
|
||||
(dom-node "input" '((type . "checkbox")
|
||||
(checked)))
|
||||
))))
|
||||
(with-temp-buffer
|
||||
(dom-print dom)
|
||||
(should
|
||||
(equal
|
||||
(buffer-string)
|
||||
(concat
|
||||
"<html><head><title>Test boolean attributes</title></head><body>"
|
||||
"<input type=\"checkbox\" checked />"
|
||||
"<input type=\"checkbox\" checked />"
|
||||
"<input type=\"checkbox\" checked />"
|
||||
"<input type=\"checkbox\" checked />"
|
||||
"<input type=\"checkbox\" />"
|
||||
"</body></html>"))))))
|
||||
|
||||
(ert-deftest dom-test-search ()
|
||||
(let ((dom '(a nil (b nil (c nil)))))
|
||||
(should (equal (dom-search dom (lambda (d) (eq (dom-tag d) 'a)))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue