! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays hashtables sequence-parser
-html.parser.utils kernel namespaces sequences
-unicode.case unicode.categories combinators.short-circuit
-quoting fry ;
+USING: accessors combinators.short-circuit html.parser.utils
+kernel make math namespaces quoting sequences sequences.parser
+unicode ;
IN: html.parser
TUPLE: tag name attributes text closing? ;
: closing-tag? ( string -- ? )
[ f ]
- [ { [ first CHAR: / = ] [ peek CHAR: / = ] } 1|| ] if-empty ;
+ [ { [ first CHAR: / = ] [ last CHAR: / = ] } 1|| ] if-empty ;
: <tag> ( name attributes closing? -- tag )
tag new
CHAR: ' (read-quote) ;
: read-double-quote ( sequence-parser -- string )
- CHAR: " (read-quote) ;
+ CHAR: \" (read-quote) ;
: read-quote ( sequence-parser -- string )
dup get+increment CHAR: ' =
[ blank? ] trim ;
: read-comment ( sequence-parser -- )
- "-->" take-until-sequence comment new-tag push-tag ;
+ [ "-->" take-until-sequence comment new-tag push-tag ]
+ [ '[ _ advance drop ] 3 swap times ] bi ;
: read-dtd ( sequence-parser -- )
- ">" take-until-sequence dtd new-tag push-tag ;
+ [ ">" take-until-sequence dtd new-tag push-tag ]
+ [ advance drop ] bi ;
: read-bang ( sequence-parser -- )
advance dup { [ current CHAR: - = ] [ peek-next CHAR: - = ] } 1&&
[ advance advance read-comment ] [ read-dtd ] if ;
: read-tag ( sequence-parser -- string )
- [ [ current "><" member? ] take-until ]
- [ dup current CHAR: < = [ advance ] unless drop ] bi ;
+ [
+ [ current "><" member? ] take-until
+ [ CHAR: / = ] trim-tail
+ ] [ dup current CHAR: < = [ advance ] unless drop ] bi ;
: read-until-< ( sequence-parser -- string )
[ current CHAR: < = ] take-until ;
dup sequence-parse-end? [
drop
] [
- [ parse-key/value swap set ] [ (parse-attributes) ] bi
+ [ parse-key/value swap ,, ] [ (parse-attributes) ] bi
] if ;
: parse-attributes ( sequence-parser -- hashtable )
- [ (parse-attributes) ] H{ } make-assoc ;
+ [ (parse-attributes) ] H{ } make ;
: (parse-tag) ( string -- string' hashtable )
[