add find-hrefs word

db4
Doug Coleman 2008-08-13 23:09:43 -05:00
parent f98729eb91
commit 805cb650bd
2 changed files with 12 additions and 4 deletions

View File

@ -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

View File

@ -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 ;