New upstream version 3b5upstream/3b5upstream

1 files changed, 26 insertions, 14 deletions

diff --git a/html4each.scm b/html4each.scm
index f115616..bfb1972 100644..100755
--- 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))))))))