From a69c9fb665459e2bfdbda1bf80741a0af31a7faf Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:06:40 -0800
Subject: New upstream version 3b5

---
 html4each.scm | 40 ++++++++++++++++++++++++++--------------
 1 file changed, 26 insertions(+), 14 deletions(-)
 mode change 100644 => 100755 html4each.scm

(limited to 'html4each.scm')

diff --git a/html4each.scm b/html4each.scm
old mode 100644
new mode 100755
index f115616..bfb1972
--- a/html4each.scm
+++ b/html4each.scm
@@ -201,15 +201,17 @@
 ;;@body
 ;;@1 is a hypertext markup string.
 ;;
-;;If @1 is a (hypertext) comment, then @0 returns #f.
-;;Otherwise @0 returns the hypertext element symbol (created by
-;;@code{string-ci->symbol}) consed onto an association list of the
-;;attribute name-symbols and values.  Each value is a number or
-;;string; or #t if the name had no value assigned within the markup.
+;;If @1 is a (hypertext) comment or DTD, then @0 returns #f.
+;;Otherwise @0 returns the hypertext element string consed onto an
+;;association list of the attribute name-symbols and values.  If the
+;;tag ends with "/>", then "/" is appended to the hypertext element
+;;string.  The name-symbols are created by @code{string-ci->symbol}.
+;;Each value is a string; or #t if the name had no value
+;;assigned within the markup.
 (define (htm-fields htm)
   (require 'string-case)
   (and
-   (not (and (> (string-length htm) 4) (equal? "<!--" (substring htm 0 4))))
+   (not (and (> (string-length htm) 3) (equal? "<!" (substring htm 0 2))))
    (call-with-input-string htm
      (lambda (port)
        (define element #f)
@@ -221,11 +223,24 @@
 	 (define junk #f)
 	 (define value #t)
 	 (cond
-	  ((eof-object? chr) (slib:warn 'htm-fields 'missing '> htm)
-	   (reverse fields))
+	  ((eof-object? chr)
+	   (cond ((and element
+		       (eqv? (string-ref element
+					 (+ -1 (string-length element)))
+			     #\>))
+		  (cons (substring element 0 (+ -1 (string-length element)))
+			fields))
+		 (else
+		  (slib:warn 'htm-fields 'missing '> htm)
+		  (if element
+		      (cons element (reverse fields))
+		      (reverse fields)))))
 	  ((eqv? #\> chr) (cons element (reverse fields)))
+	  ((eqv? #\/ chr)
+	   (set! element (string-append element (string (read-char port))))
+	   (loop (peek-char port)))
 	  ((char-whitespace? chr) (read-char port) (loop (peek-char port)))
-	  ((case (fscanf port "%[a-zA-Z0-9]%[=]%[-.a-zA-Z0-9]"
+	  ((case (fscanf port "%[-a-zA-Z0-9:] %[=] %[-.a-zA-Z0-9]"
 			 name junk value)
 	     ((3 1) #t)
 	     ((2)
@@ -242,11 +257,8 @@
 			     (else #f)))
 		(else #f)))
 	     (else #f))
-	   (set! fields (cons (cons (string-ci->symbol name)
-				    (if (string? value)
-					(or (string->number value) value)
-					value))
-			      fields))
+	   (set! fields (cons (cons (string-ci->symbol name) value)
+                              fields))
 	   (loop (peek-char port)))
 	  (else (slib:warn 'htm-fields 'bad 'field htm)
 		(reverse fields))))))))
-- 
cgit v1.2.3