diff options
Diffstat (limited to 'html4each.scm')
-rwxr-xr-x[-rw-r--r--] | html4each.scm | 40 |
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)))))))) |