add find-hrefs word
parent
f98729eb91
commit
805cb650bd
|
@ -140,6 +140,12 @@ TUPLE: link attributes clickable ;
|
||||||
: href-contains? ( str tag -- ? )
|
: href-contains? ( str tag -- ? )
|
||||||
attributes>> "href" swap at* [ subseq? ] [ 2drop f ] if ;
|
attributes>> "href" swap at* [ subseq? ] [ 2drop f ] if ;
|
||||||
|
|
||||||
|
: find-hrefs ( vector -- vector' )
|
||||||
|
find-links
|
||||||
|
[ [
|
||||||
|
[ name>> "a" = ]
|
||||||
|
[ attributes>> "href" swap key? ] bi and ] filter
|
||||||
|
] map sift [ [ attributes>> "href" swap at ] map ] map concat ;
|
||||||
|
|
||||||
: find-forms ( vector -- vector' )
|
: find-forms ( vector -- vector' )
|
||||||
"form" over find-opening-tags-by-name
|
"form" over find-opening-tags-by-name
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
USING: arrays html.parser.utils hashtables io kernel
|
USING: accessors arrays html.parser.utils hashtables io kernel
|
||||||
namespaces prettyprint quotations
|
namespaces prettyprint quotations
|
||||||
sequences splitting state-parser strings unicode.categories unicode.case ;
|
sequences splitting state-parser strings unicode.categories unicode.case ;
|
||||||
IN: html.parser
|
IN: html.parser
|
||||||
|
@ -23,8 +23,10 @@ SYMBOL: tagstack
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: <tag> ( name attributes closing? -- tag )
|
: <tag> ( name attributes closing? -- tag )
|
||||||
{ set-tag-name set-tag-attributes set-tag-closing? }
|
tag new
|
||||||
tag construct ;
|
swap >>closing?
|
||||||
|
swap >>attributes
|
||||||
|
swap >>name ;
|
||||||
|
|
||||||
: make-tag ( str attribs -- tag )
|
: make-tag ( str attribs -- tag )
|
||||||
>r [ closing-tag? ] keep "/" trim1 r> rot <tag> ;
|
>r [ closing-tag? ] keep "/" trim1 r> rot <tag> ;
|
||||||
|
@ -75,7 +77,7 @@ SYMBOL: tagstack
|
||||||
read-quote
|
read-quote
|
||||||
] [
|
] [
|
||||||
read-token
|
read-token
|
||||||
] if ;
|
] if [ blank? ] trim ;
|
||||||
|
|
||||||
: read-comment ( -- )
|
: read-comment ( -- )
|
||||||
"-->" take-string* make-comment-tag push-tag ;
|
"-->" take-string* make-comment-tag push-tag ;
|
||||||
|
|
Loading…
Reference in New Issue