Index: html-parser.scm
===================================================================
--- html-parser.scm	(revision 46460)
+++ html-parser.scm	(working copy)
@@ -1,8 +1,8 @@
 ;; html-parser.scm -- SSAX-like tree-folding html parser
-;; Copyright (c) 2003-2014 Alex Shinn.  All rights reserved.
+;; Copyright (c) 2003-2020 Alex Shinn.  All rights reserved.
 ;; BSD-style license: http://synthcode.com/license.txt
 
-;;> A permissive HTML parser supporting scalable streaming with a
+;;> A permissive HTML parser supporting scalable streaming with a tree
 ;;> folding interface.  This copies the interface of Oleg Kiselyov's
 ;;> SSAX parser, as well as providing simple convenience utilities.
 ;;> It correctly handles all invalid HTML, inserting "virtual"
@@ -307,9 +307,11 @@
           (if (string=? name "")
               (loop attrs)
               (let ((name (string->symbol (string-downcase name))))
+                (skip-whitespace in)
                 (cond
                  ((eqv? (peek-char in) #\=)
                   (read-char in)
+                  (skip-whitespace in)
                   (let ((value (if (memv (peek-char in) '(#\" #\'))
                                    (apply string-append
                                           (read-quoted in entities))
@@ -380,11 +382,16 @@
 (define *tag-levels*
   '(html (head body) table (thead tbody) tr (th td) p (b i u s)))
 
+(define *block*
+  '(div main section article header footer aside h1 h2 h3 h4 h5 h6 p
+        blockquote pre hr address ul ol li dl dt dd table tfoot form
+        fieldset figure figcaption video canvas noscript))
+
 (define *unnestables*
-  '(p li td tr))
+  '(p li td tr th dt dd rt rp optgroup option))
 
 (define *bodyless*
-  '(img hr br meta link))
+  '(img hr br area base col embed input link meta param source track wbr))
 
 (define *literals*
   '(script xmp))
@@ -571,6 +578,7 @@
               ((not (cdr tok)) ;; nameless closing tag
                (lp (read-html-token in entities) seed seeds tags))
               ((and (pair? tags) (eq? (cdr tok) (caar tags)))
+               ;; closing the currently open tag
                (lp (read-html-token in entities)
                    (end (cdr tok) (fix-attrs (cadar tags) seed)
                         (car seeds) seed #f)
@@ -583,8 +591,12 @@
                           (tag-level tag-levels (caar tags))
                           -1)))
                  (cond
-                  ((< this-level expected-level)
-                   ;; higher-level tag, forcefully close preceding tags
+                  ((or (< this-level expected-level)
+                       (and (memq (cdr tok) *block*)
+                            (pair? tags)
+                            (memq (caar tags) *block*)))
+                   ;; higher-level tag or both block tags,
+                   ;; forcefully close preceding tags
                    (lp tok
                        (end (caar tags) (fix-attrs (cadar tags) seed)
                             (car seeds) seed 'parent-closed)
@@ -637,14 +649,33 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; simple conversions
 
+;; concatenate adjacent top-level strings in ls
+(define (reverse-condensing-strings ls)
+  (let lp1 ((ls ls) (res '()))
+    (cond
+     ((null? ls) res)
+     ((null? (cdr ls)) (cons (car ls) res))
+     ((and (string? (car ls)) (string? (cadr ls)))
+      (let lp2 ((ls (cdr ls)) (strs (list (car ls))))
+        (cond
+         ((null? ls) (cons (apply string-append strs) res))
+         ((string? (car ls)) (lp2 (cdr ls) (cons (car ls) strs)))
+         (else (lp1 ls (cons (apply string-append strs) res))))))
+     (else (lp1 (cdr ls) (cons (car ls) res))))))
+
+;;> \procedure{(html->sxml [port])}
+;;> Returns the SXML representation of the document from \var{port},
+;;> using the default parsing options.
+
 (define html->sxml
   (let ((parse
          (make-html-parser
           'start: (lambda (tag attrs seed virtual?) '())
           'end:   (lambda (tag attrs parent-seed seed virtual?)
-                    `((,tag ,@(if (pair? attrs)
-                                  `((@ ,@attrs) ,@(reverse seed))
-                                  (reverse seed)))
+                    `((,tag
+                       ,@(if (pair? attrs)
+                             `((@ ,@attrs) ,@(reverse-condensing-strings seed))
+                             (reverse-condensing-strings seed)))
                       ,@parent-seed))
           'decl:    (lambda (tag attrs seed) `((*DECL* ,tag ,@attrs) ,@seed))
           'process: (lambda (attrs seed) `((*PI* ,@attrs) ,@seed))
Index: tests/run.scm
===================================================================
--- tests/run.scm	(revision 46460)
+++ tests/run.scm	(working copy)
@@ -71,6 +71,18 @@
 (test '(*TOP* (br) "\r\n" (br) "\r\n" (div (@ (data "(sxml (@ (attr \"12345\")) body)")) "div body"))
     (html->sxml "<br>\r\n<br>\r\n<div data=\"(sxml (@ (attr &quot;12345&quot;)) body)\">div body</div>"))
 
+(test '(*TOP* (p "foo'bar\"baz"))
+  (html->sxml "<p>foo&apos;bar&quot;baz</p>"))
+
+(test '(*TOP* (p "a") (p "b"))
+  (html->sxml "<p>a<p>b"))
+
+(test '(*TOP* (div "a" (p "b")))
+  (html->sxml "<div>a<p>b"))
+
+(test '(*TOP* (li "a") (li) (li (div (p "b"))) (li "c") (li))
+  (html->sxml "<li>a<li><li><div><p>b</div></li><li>c<li>"))
+
 (test
  '(*TOP*
    (meta (@ (charset "utf-8")))