summaryrefslogtreecommitdiffstats
path: root/html4each.scm
diff options
context:
space:
mode:
Diffstat (limited to 'html4each.scm')
-rwxr-xr-x[-rw-r--r--]html4each.scm40
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))))))))