Subject: bug#75928: 31.0.50; `dom-print' often fails to print an SVG DOM

From: David Ponce <[email-masked]>
Date: Sat, 8 Feb 2025 13:55:16 +0100

On 2025-02-08 10:41, Eli Zaretskii wrote:
>> Date: Wed, 5 Feb 2025 13:01:04 +0100
>> From:  David Ponce via "Bug reports for GNU Emacs,
>>   the Swiss army knife of text editors" <[email-masked]>
>>
>> I attached a new patch that also avoid printing attributes without a
>> value (value is nil in the DOM).
>>
>> I also refreshed the list of HTML boolean attributes from the current
>> standard, and put checking for a boolean attribute in a separate
>> inline function for clarity.
>>
>> The patch also slightly improve the code by computing the indentation
>> column outside of loop and delegating indentation to `indent-line-to'.
> 
> Thanks.
> 
> Using indent-line-to requires binding indent-tabs-mode to nil, to make
> sure we produce spaces and not TABs, right?
> 
> Also, please make sure the dom.el test suite still passes after this
> change, if you haven't already.  Bonus points for providing a new test
> for this feature.

Hello Eli,

Thank you very much for your feedback.

Please, find attached a new patch to force indent with spaces and to add
two new tests to dom-tests.el.

Here is the updated change log:

2025-02-08  David Ponce  <[email-masked]>

	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.

	* test/lisp/dom-tests.el (dom-tests-print-svg)
	(dom-tests-print-html-boolean): New tests.

All tests in dom-tests.el passed for me:

Running 28 tests (2025-02-08 13:45:37+0100, selector `(not (or (tag :unstable) (tag :nativecomp)))')
    passed   1/28  dom-test-search (0.000180 sec)
    passed   2/28  dom-tests-add-child-before (0.000199 sec)
    passed   3/28  dom-tests-append-child (0.000074 sec)
    passed   4/28  dom-tests-attr (0.000096 sec)
    passed   5/28  dom-tests-attributes (0.000054 sec)
    passed   6/28  dom-tests-by-class (0.000074 sec)
    passed   7/28  dom-tests-by-id (0.000091 sec)
    passed   8/28  dom-tests-by-style (0.000054 sec)
    passed   9/28  dom-tests-by-tag (0.000052 sec)
    passed  10/28  dom-tests-child-by-tag (0.000047 sec)
    passed  11/28  dom-tests-children (0.000066 sec)
    passed  12/28  dom-tests-elements (0.000057 sec)
    passed  13/28  dom-tests-ensure-node (0.000071 sec)
    passed  14/28  dom-tests-non-text-children (0.000057 sec)
    passed  15/28  dom-tests-parent (0.000052 sec)
    passed  16/28  dom-tests-pp (0.000102 sec)
    passed  17/28  dom-tests-previous-sibling (0.000049 sec)
    passed  18/28  dom-tests-print (0.009147 sec)
    passed  19/28  dom-tests-print-html-boolean (0.000200 sec)
    passed  20/28  dom-tests-print-svg (0.000166 sec)
    passed  21/28  dom-tests-remove-attribute (0.000083 sec)
    passed  22/28  dom-tests-remove-node (0.000088 sec)
    passed  23/28  dom-tests-set-attribute (0.000039 sec)
    passed  24/28  dom-tests-set-attributes (0.000074 sec)
    passed  25/28  dom-tests-strings (0.000077 sec)
    passed  26/28  dom-tests-tag (0.000087 sec)
    passed  27/28  dom-tests-text (0.000065 sec)
    passed  28/28  dom-tests-texts (0.000047 sec)

Ran 28 tests, 28 results as expected, 0 unexpected (2025-02-08 13:45:37+0100, 0.012721 sec)
diff --git a/lisp/dom.el b/lisp/dom.el
index fc032058e9f..4d904c92de9 100644
--- a/lisp/dom.el
+++ b/lisp/dom.el
@@ -258,31 +258,41 @@ dom-pp
 	      (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 @@ dom-print
 	      (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)
diff --git a/test/lisp/dom-tests.el b/test/lisp/dom-tests.el
index 47c2a7bb569..eecc4f39808 100644
--- a/test/lisp/dom-tests.el
+++ b/test/lisp/dom-tests.el
@@ -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 @@ dom-tests-print
                      "&lt;div class=&quot;default&quot;&gt; &lt;/div&gt;"
                      "</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)))