Merge branch 'master' of git://factorcode.org/git/factor

Makefile

@@ -166,7 +166,7 @@ factor-ffi-test: vm/ffi_test.o
 
 clean:
 	rm -f vm/*.o
-	rm -f factor*.dll libfactor.{a,so,dylib} libfactor-ffi-test.{a,so,dylib}
+	rm -f factor*.dll libfactor.{a,so,dylib} libfactor-ffi-test.{a,so,dylib} Factor.app/Contents/Frameworks/libfactor.dylib
 
 vm/resources.o:
 	$(WINDRES) vm/factor.rs vm/resources.o

basis/colors/colors-docs.factor

@@ -23,7 +23,7 @@ $nl
 ARTICLE: "colors" "Colors"
 "The " { $vocab-link "colors" } " vocabulary defines a protocol for colors, with a concrete implementation for RGBA colors. This vocabulary is used by " { $vocab-link "io.styles" } ", " { $vocab-link "ui" } " and other vocabularies, but it is independent of them."
 $nl
-"RGBA colors:"
+"RGBA colors with floating point components in the range " { $snippet "[0,1]" } ":"
 { $subsection rgba }
 { $subsection <rgba> }
 "Converting a color to RGBA:"

basis/compiler/cfg/linear-scan/allocation/allocation.factor

@@ -99,7 +99,7 @@ SYMBOL: spill-counts
 : interval-to-spill ( active-intervals current -- live-interval )
     #! We spill the interval with the most distant use location.
     start>> '[ dup _ [ >= ] find-use nip ] { } map>assoc
-    unclip-slice [ [ [ second ] bi@ > ] most ] reduce first ;
+    [ ] [ [ [ second ] bi@ > ] most ] map-reduce first ;
 
 : assign-spill ( before after -- before after )
     #! If it has been spilled already, reuse spill location.

basis/compiler/tree/propagation/info/info.factor

@@ -238,7 +238,7 @@ DEFER: (value-info-union)
 
 : value-infos-union ( infos -- info )
     [ null-info ]
-    [ unclip-slice [ value-info-union ] reduce ] if-empty ;
+    [ [ ] [ value-info-union ] map-reduce ] if-empty ;
 
 : literals<= ( info1 info2 -- ? )
     {

basis/db/errors/sqlite/sqlite.factor

@@ -4,7 +4,8 @@ USING: accessors combinators db kernel sequences peg.ebnf
 strings db.errors ;
 IN: db.errors.sqlite
 
-ERROR: unparsed-sqlite-error error ;
+TUPLE: unparsed-sqlite-error error ;
+C: <unparsed-sqlite-error> unparsed-sqlite-error
 
 SINGLETONS: table-exists table-missing ;
 
@@ -22,4 +23,6 @@ SqliteError =
       => [[ table >string message sqlite-table-error ]]
     | "no such table: " .+:table
       => [[ table >string <sql-table-missing> ]]
+    | .*:error
+      => [[ error >string <unparsed-sqlite-error> ]]
 ;EBNF

basis/delegate/protocols/protocols.factor

@@ -1,7 +1,6 @@
 ! Copyright (C) 2007 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: delegate sequences.private sequences assocs
-io definitions kernel continuations ;
+USING: delegate sequences.private sequences assocs io ;
 IN: delegate.protocols
 
 PROTOCOL: sequence-protocol
@@ -19,7 +18,3 @@ stream-read-until ;
 
 PROTOCOL: output-stream-protocol
 stream-flush stream-write1 stream-write stream-nl ;
-
-PROTOCOL: definition-protocol
-where set-where forget uses
-synopsis* definer definition ;

basis/furnace/actions/actions.factor

@@ -9,6 +9,7 @@ http.server.responses
 furnace.utilities
 furnace.redirection
 furnace.conversations
+furnace.chloe-tags
 html.forms
 html.components
 html.components

basis/furnace/furnace.factor

@@ -17,7 +17,6 @@ USE: vocabs.loader
 "furnace.auth.providers.db" require
 "furnace.auth.providers.null" require
 "furnace.boilerplate" require
-"furnace.chloe-tags" require
 "furnace.conversations" require
 "furnace.db" require
 "furnace.json" require

basis/furnace/redirection/redirection.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors combinators namespaces fry urls http
-http.server http.server.redirection http.server.responses
+USING: kernel accessors combinators namespaces fry urls urls.secure
+http http.server http.server.redirection http.server.responses
 http.server.remapping http.server.filters furnace.utilities ;
 IN: furnace.redirection
 

basis/help/home/home.factor

@@ -21,7 +21,7 @@ M: apropos add-recent-where recent-searches ;
 M: object add-recent-where f ;
 
 : $recent ( element -- )
-    first get [ nl ] [ 1array $pretty-link ] interleave ;
+    first get reverse [ nl ] [ 1array $pretty-link ] interleave ;
 
 : $recent-searches ( element -- )
     drop recent-searches get [ <$link> ] map $list ;

basis/hints/hints.factor

@@ -25,7 +25,7 @@ M: object specializer-declaration class ;
     [ drop object eq? not ] assoc-filter
     [ [ t ] ] [
         [ swap specializer-predicate append ] { } assoc>map
-        unclip [ swap [ f ] \ if 3array append [ ] like ] reduce
+        [ ] [ swap [ f ] \ if 3array append [ ] like ] map-reduce
     ] if-empty ;
 
 : specializer-cases ( quot word -- default alist )

basis/regexp/dfa/dfa.factor

@@ -51,10 +51,13 @@ IN: regexp.dfa
     [ condition-states ] 2dip
     '[ _ _ add-todo-state ] each ;
 
+: ensure-state ( key table -- )
+    2dup key? [ 2drop ] [ [ H{ } clone ] 2dip set-at ] if ; inline
+
 :: new-transitions ( nfa dfa new-states visited-states -- nfa dfa )
     new-states [ nfa dfa ] [
         pop :> state
-        state dfa transitions>> maybe-initialize-key
+        state dfa transitions>> ensure-state
         state nfa find-transitions
         [| trans |
             state trans nfa find-closure :> new-state

core/classes/builtin/builtin.factor

@@ -55,7 +55,7 @@ M: anonymous-intersection (flatten-class)
     [
         builtins get sift [ (flatten-class) ] each
     ] [
-        unclip [ assoc-intersect ] reduce [ swap set ] assoc-each
+        [ ] [ assoc-intersect ] map-reduce [ swap set ] assoc-each
     ] if-empty ;
 
 M: anonymous-complement (flatten-class)

extra/id3/id3.factor

@@ -163,17 +163,13 @@ TUPLE: id3v1-info title artist album year comment genre ;
         } cond
     ] with-mapped-uchar-file ;
 
-: (find-id3-frame) ( id3 name quot: ( obj -- obj' ) -- obj' )
-    [ swap frames>> at* ] dip
-    [ data>> ] prepose [ drop f ] if ; inline
-
 PRIVATE>
 
 : mp3>id3 ( path -- id3v2-info/f )
     dup file-info size>> 0 <= [ drop f ] [ (mp3>id3) ] if ; inline
 
 : find-id3-frame ( id3 name -- obj/f )
-    [ ] (find-id3-frame) ; inline
+    swap frames>> at* [ data>> ] when ; inline
 
 : title ( id3 -- title/f ) "TIT2" find-id3-frame ; inline
 
@@ -186,7 +182,7 @@ PRIVATE>
 : comment ( id3 -- comment/f ) "COMM" find-id3-frame ; inline
 
 : genre ( id3 -- genre/f )
-    "TCON" [ parse-genre ] (find-id3-frame) ; inline
+    "TCON" find-id3-frame parse-genre ; inline
 
 : find-mp3s ( path -- seq )
     [ >lower ".mp3" tail? ] find-all-files ; inline

extra/site-watcher/db/db.factor

@@ -2,10 +2,10 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors continuations db db.sqlite db.tuples db.types
 io.directories io.files.temp kernel io.streams.string calendar
-debugger combinators.smart sequences ;
+debugger combinators.smart sequences arrays ;
 IN: site-watcher.db
 
-TUPLE: account account-id account-name email twitter sms ;
+TUPLE: account account-name email twitter sms ;
 
 : <account> ( account-name email -- account )
     account new
@@ -25,6 +25,12 @@ TUPLE: site site-id url up? changed? last-up error last-error ;
     site new
         swap >>url ;
 
+: site-with-url ( url -- site )
+    <site> select-tuple ;
+
+: site-with-id ( id -- site )
+    site new swap >>site-id select-tuple ;
+
 site "SITE" {
     { "site-id" "SITE_ID" INTEGER +db-assigned-id+ }
     { "url" "URL" VARCHAR }
@@ -49,10 +55,12 @@ watching-site "WATCHING_SITE" {
 
 TUPLE: spidering-site < watching-site max-depth max-count ;
 
+C: <spidering-site> spidering-site
+
 SLOT: site
 
 M: watching-site site>>
-    site-id>> site new swap >>site-id select-tuple ;
+    site-id>> site-with-id ;
 
 SLOT: account
 
@@ -60,12 +68,25 @@ M: watching-site account>>
     account-name>> account new swap >>account-name select-tuple ;
 
 spidering-site "SPIDERING_SITE" {
-    { "account-name" "ACCOUNT_NAME" VARCHAR +user-assigned-id+ }
-    { "site-id" "SITE_ID" INTEGER +user-assigned-id+ }
     { "max-depth" "MAX_DEPTH" INTEGER }
     { "max-count" "MAX_COUNT" INTEGER }
 } define-persistent
 
+: spidering-sites ( username -- sites )
+    spidering-site new swap >>account-name select-tuples ;
+
+: insert-site ( url -- site )
+    <site> dup select-tuple [ ] [ dup t >>up? insert-tuple ] ?if ;
+
+: select-account/site ( username url -- account site )
+    insert-site site-id>> ;
+
+: add-spidered-site ( username url -- )
+    select-account/site 10 10 <spidering-site> insert-tuple ;
+
+: remove-spidered-site ( username url -- )
+    select-account/site 10 10 <spidering-site> delete-tuples ;
+
 TUPLE: reporting-site site-id email url up? changed? last-up? error last-error ;
 
 : set-notify-site-watchers ( site new-up? -- site )
@@ -89,16 +110,10 @@ TUPLE: reporting-site site-id email url up? changed? last-up? error last-error ;
     [ [ reporting-site boa ] input<sequence ] map
     "update site set changed = 0;" sql-command ;
 
-: insert-site ( url -- site )
-    <site> dup select-tuple [ ] [ dup t >>up? insert-tuple ] ?if ;
-
 : insert-account ( account-name email -- ) <account> insert-tuple ;
 
 : find-sites ( -- seq ) f <site> select-tuples ;
 
-: select-account/site ( username url -- account site )
-    insert-site site-id>> ;
-
 : watch-site ( username url -- )
     select-account/site <watching-site> insert-tuple ;
 

extra/site-watcher/site-watcher.factor

@@ -38,12 +38,12 @@ SYMBOL: running-site-watcher
 
 PRIVATE>
 
-: watch-sites ( db -- )
-    [ find-sites check-sites sites-to-report send-reports ] with-db ;
+: watch-sites ( -- )
+    find-sites check-sites sites-to-report send-reports ;
 
 : run-site-watcher ( db -- )
     [ running-site-watcher get ] dip '[ 
-        [ _ watch-sites ] site-watcher-frequency get every
+        [ _ [ watch-sites ] with-db ] site-watcher-frequency get every
         running-site-watcher set
     ] unless ;
 

extra/site-watcher/spider/spider.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: site-watcher.db site-watcher.email
+USING: site-watcher.db site-watcher.email site-watcher.spider
 spider spider.report
 accessors kernel sequences
-xml.writer ;
+xml.writer concurrency.combinators ;
 IN: site-watcher.spider
 
 : <site-spider> ( spidering-site -- spider )
@@ -20,3 +20,6 @@ IN: site-watcher.spider
     [ <site-spider> run-spider spider-report xml>string ]
     [ site>> url>> "Spidered " prefix ] tri
     send-site-email ;
+
+: spider-sites ( -- )
+    f spidering-sites [ spider-and-email ] parallel-each ;

extra/spider/report/report.factor

@@ -39,10 +39,11 @@ SYMBOL: time-std
     timings get sort-values
     [ slowest short tail* reverse slowest-pages set ]
     [
-        values
+        values [
             [ mean 1000000 /f mean-time set ]
             [ median 1000000 /f median-time set ]
             [ std 1000000 /f time-std set ] tri
+        ] unless-empty
     ] bi ;
 
 : process-results ( results -- )

extra/spider/spider.factor

@@ -5,12 +5,12 @@ http.client kernel tools.time sets assocs sequences
 concurrency.combinators io threads namespaces math multiline
 math.parser inspector urls logging combinators.short-circuit
 continuations calendar prettyprint dlists deques locals
-spider.unique-deque ;
+spider.unique-deque combinators concurrency.semaphores ;
 IN: spider
 
 TUPLE: spider base count max-count sleep max-depth initial-links
 filters spidered todo nonmatching quiet currently-spidering
-#threads follow-robots? robots ;
+#threads semaphore follow-robots? robots ;
 
 TUPLE: spider-result url depth headers
 fetched-in parsed-html links processed-in fetched-at ;
@@ -26,7 +26,12 @@ fetched-in parsed-html links processed-in fetched-at ;
         0 >>count
         1/0. >>max-count
         H{ } clone >>spidered
-        1 >>#threads ;
+        1 [ >>#threads ] [ <semaphore> >>semaphore ] bi ;
+
+: <spider-result> ( url depth -- spider-result )
+    spider-result new
+        swap >>depth
+        swap >>url ;
 
 <PRIVATE
 
@@ -57,26 +62,32 @@ fetched-in parsed-html links processed-in fetched-at ;
 : normalize-hrefs ( base links -- links' )
     [ derive-url ] with map ;
 
-: print-spidering ( url depth -- )
+: print-spidering ( spider-result -- )
+    [ url>> ] [ depth>> ] bi
     "depth: " write number>string write
     ", spidering: " write . yield ;
 
-:: new-spidered-result ( spider url depth -- spider-result )
-    f url spider spidered>> set-at
-    [ url http-get ] benchmark :> fetched-at :> html :> headers
+:: fill-spidered-result ( spider spider-result -- )
+    f spider-result url>> spider spidered>> set-at
+    [ spider-result url>> http-get ] benchmark :> fetched-in :> html :> headers
     [
         html parse-html
         spider currently-spidering>>
         over find-all-links normalize-hrefs
-    ] benchmark :> processing-time :> links :> parsed-html
-    url depth headers fetched-at parsed-html links processing-time
-    now spider-result boa ;
+    ] benchmark :> processed-in :> links :> parsed-html
+    spider-result
+        headers >>headers
+        fetched-in >>fetched-in
+        parsed-html >>parsed-html
+        links >>links
+        processed-in >>processed-in
+        now >>fetched-at drop ;
 
-:: spider-page ( spider url depth -- )
-    spider quiet>> [ url depth print-spidering ] unless
-    spider url depth new-spidered-result :> spidered-result
-    spider quiet>> [ spidered-result describe ] unless
-    spider spidered-result add-spidered ;
+:: spider-page ( spider spider-result -- )
+    spider quiet>> [ spider-result print-spidering ] unless
+    spider spider-result fill-spidered-result
+    spider quiet>> [ spider-result describe ] unless
+    spider spider-result add-spidered ;
 
 \ spider-page ERROR add-error-logging
 
@@ -94,9 +105,9 @@ fetched-in parsed-html links processed-in fetched-at ;
         [ [ count>> ] [ max-count>> ] bi < ]
     } 1&& ;
 
-: setup-next-url ( spider -- spider url depth )
+: setup-next-url ( spider -- spider spider-result )
     dup todo>> peek-url url>> >>currently-spidering
-    dup todo>> pop-url [ url>> ] [ depth>> ] bi ;
+    dup todo>> pop-url [ url>> ] [ depth>> ] bi <spider-result> ;
 
 : spider-next-page ( spider -- )
     setup-next-url spider-page ;

extra/webapps/site-watcher/common/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

extra/webapps/site-watcher/common/common.factor

@@ -0,0 +1,6 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: http.server.dispatchers ;
+IN: webapps.site-watcher.common
+
+TUPLE: site-watcher-app < dispatcher ;

extra/webapps/site-watcher/common/main.xml

@@ -0,0 +1,13 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+<p>SiteWatcher is a free service for web masters. It periodically tries fetching your web site via HTTP, and sends you an e-mail, SMS or Tweet if this fails. <t:a t:href="$site-watcher-app/login">Sign up now!</t:a></p>
+
+<ul>
+  <li><t:a t:href="$site-watcher-app/update-notify">Your contact info</t:a></li>
+  <li><t:a t:href="$site-watcher-app/watch-list">Watched sites</t:a></li>
+  <li><t:a t:href="$site-watcher-app/spider-list">Spidered sites</t:a></li>
+</ul>
+
+</t:chloe>

extra/webapps/site-watcher/common/site-list.xml

@@ -0,0 +1,28 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+<h1>Add some sites to watch</h1>
+
+<t:form t:action="$site-watcher-app/add-watch">
+<table>
+  <tr><th>URL:</th><td> <t:field t:name="url" t:size="80" /> <button type="submit">Done</button> </td></tr>
+</table>
+</t:form>
+
+<h1>Keep track of your sites</h1>
+
+<table border="2">
+  <tr> <th>URL</th><th></th> </tr>
+  <t:bind-each t:name="sites">
+    <tr>
+      <td> <t:label t:name="url" /> </td>
+      <td> <t:button t:action="$site-watcher-app/remove-watch" t:for="url">Remove</t:button> </td>
+    </tr>
+  </t:bind-each>
+</table>
+<p>
+  <t:button t:action="$site-watcher-app/check">Check now</t:button>
+</p>
+
+</t:chloe>

extra/webapps/site-watcher/common/spider-list.xml

@@ -0,0 +1,28 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+<h1>Add a site to spider</h1>
+
+<t:form t:action="$site-watcher-app/add-spider">
+<table>
+  <tr><th>URL:</th><td> <t:field t:name="url" t:size="80" /> <button type="submit">Done</button> </td></tr>
+</table>
+</t:form>
+
+<h1>Spidered sites</h1>
+
+<table border="2">
+  <tr> <th>URL</th><th></th> </tr>
+  <t:bind-each t:name="sites">
+    <tr>
+      <td> <t:label t:name="url" /> </td>
+      <td> <t:button t:action="$site-watcher-app/remove-spider" t:for="url">Remove</t:button> </td>
+    </tr>
+  </t:bind-each>
+</table>
+<p>
+  <t:button t:action="$site-watcher-app/spider">Spider now</t:button>
+</p>
+
+</t:chloe>

extra/webapps/site-watcher/main.xml

@@ -1,7 +0,0 @@
-<?xml version='1.0' ?>
-
-<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
-
-<p>SiteWatcher is a free service for web masters. It periodically tries fetching your web site via HTTP, and sends you an e-mail, SMS or Tweet if this fails. <t:a t:href="$site-watcher-app/list">Sign up now!</t:a></p>
-
-</t:chloe>

extra/webapps/site-watcher/site-list.xml

@@ -1,32 +0,0 @@
-<?xml version='1.0' ?>
-
-<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
-
-<p> Don't you hate it when your web site goes down, and all your users go buy that <a href="http://en.wikipedia.org/wiki/Slanket">slanket</a> from your competitor instead. Now using SiteWatcher, you can ensure this will never happen again! </p>
-
-<t:a t:href="$site-watcher-app/update-notify">Contact info</t:a>
-
-<h3>Step 2: add some sites to watch</h3>
-
-<t:form t:action="$site-watcher-app/add">
-<table>
-  <tr><th>URL:</th><td> <t:field t:name="url" t:size="80" /> <button type="submit">Done</button> </td></tr>
-</table>
-</t:form>
-
-<h3>Step 3: keep track of your sites</h3>
-
-<table border="2">
-  <tr> <th>URL</th><th></th> </tr>
-  <t:bind-each t:name="sites">
-    <tr>
-      <td> <t:label t:name="url" /> </td>
-      <td> <t:button t:action="$site-watcher-app/remove" t:for="url">Remove</t:button> </td>
-    </tr>
-  </t:bind-each>
-</table>
-<p>
-  <t:button t:action="$site-watcher-app/check">Check now</t:button>
-</p>
-
-</t:chloe>

extra/webapps/site-watcher/site-watcher.factor

@@ -8,65 +8,14 @@ furnace.auth.features.registration furnace.auth.login
 furnace.boilerplate furnace.redirection html.forms http.server
 http.server.dispatchers kernel namespaces site-watcher site-watcher.db
 site-watcher.private urls validators io.sockets.secure.unix.debug
-io.servers.connection db db.tuples sequences ;
+io.servers.connection db db.tuples sequences webapps.site-watcher.common
+webapps.site-watcher.watching webapps.site-watcher.spidering ;
 QUALIFIED: assocs
 IN: webapps.site-watcher
 
-TUPLE: site-watcher-app < dispatcher ;
-
-CONSTANT: site-list-url URL" $site-watcher-app/"
-
 : <main-action> ( -- action )
     <page-action>
-        [
-            logged-in?
-            [ URL" $site-watcher-app/list" <redirect> ]
-            [ { site-watcher-app "main" } <chloe-content> ] if
-        ] >>display ;
-
-: <site-list-action> ( -- action )
-    <page-action>
-        { site-watcher-app "site-list" } >>template
-        [
-            ! Silly query
-            username watching-sites
-            "sites" set-value
-        ] >>init
-    <protected>
-        "list watched sites" >>description ;
-
-: <add-site-action> ( -- action )
-    <action>
-        [
-            { { "url" [ v-url ] } } validate-params
-        ] >>validate
-        [
-            username "url" value watch-site
-            site-list-url <redirect>
-        ] >>submit
-    <protected>
-        "add a watched site" >>description ;
-
-: <remove-site-action> ( -- action )
-    <action>
-        [
-            { { "url" [ v-url ] } } validate-params
-        ] >>validate
-        [
-            username "url" value unwatch-site
-            site-list-url <redirect>
-        ] >>submit
-    <protected>
-        "remove a watched site" >>description ;
-
-: <check-sites-action> ( -- action )
-    <action>
-        [
-            watch-sites
-            site-list-url <redirect>
-        ] >>submit
-    <protected>
-        "check watched sites" >>description ;
+        { site-watcher-app "main" } >>template ;
 
 : <update-notify-action> ( -- action )
     <page-action>
@@ -95,10 +44,14 @@ CONSTANT: site-list-url URL" $site-watcher-app/"
 : <site-watcher-app> ( -- dispatcher )
     site-watcher-app new-dispatcher
         <main-action> "" add-responder
-        <site-list-action> "list" add-responder
-        <add-site-action> "add" add-responder
-        <remove-site-action> "remove" add-responder
+        <watch-list-action> "watch-list" add-responder
+        <add-watched-site-action> "add-watch" add-responder
+        <remove-watched-site-action> "remove-watch" add-responder
         <check-sites-action> "check" add-responder
+        <spider-list-action> "spider-list" add-responder
+        <add-spidered-site-action> "add-spider" add-responder
+        <remove-spidered-site-action> "remove-spider" add-responder
+        <spider-sites-action> "spider" add-responder
         <update-notify-action> "update-notify" add-responder ;
 
 : <login-config> ( responder -- responder' )
@@ -125,12 +78,13 @@ site-watcher-db <alloy>
 main-responder set-global
 
 M: site-watcher-app init-user-profile
-    drop
+    drop B
     "username" value "email" value <account> insert-tuple ;
 
 : init-db ( -- )
     site-watcher-db [
-        { site account watching-site } [ ensure-table ] each
+        { site account watching-site spidering-site }
+        [ ensure-table ] each
     ] with-db ;
 
 : start-site-watcher ( -- )

extra/webapps/site-watcher/spidering/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

extra/webapps/site-watcher/spidering/spidering.factor

@@ -0,0 +1,52 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors furnace.actions furnace.auth
+furnace.redirection html.forms validators webapps.site-watcher.common
+site-watcher.db site-watcher.spider kernel urls sequences ;
+IN: webapps.site-watcher.spidering
+
+CONSTANT: site-list-url URL" $site-watcher-app/spider-list"
+
+: <spider-list-action> ( -- action )
+    <page-action>
+        { site-watcher-app "spider-list" } >>template
+        [
+            ! Silly query
+            username B spidering-sites [ site>> ] map
+            "sites" set-value
+        ] >>init
+    <protected>
+        "list spidered sites" >>description ;
+
+: <add-spidered-site-action> ( -- action )
+    <action>
+        [
+            { { "url" [ v-url ] } } validate-params
+        ] >>validate
+        [
+            username "url" value add-spidered-site
+            site-list-url <redirect>
+        ] >>submit
+    <protected>
+        "add a spidered site" >>description ;
+
+: <remove-spidered-site-action> ( -- action )
+    <action>
+        [
+            { { "url" [ v-url ] } } validate-params
+        ] >>validate
+        [
+            username "url" value remove-spidered-site
+            site-list-url <redirect>
+        ] >>submit
+    <protected>
+        "remove a spidered site" >>description ;
+
+: <spider-sites-action> ( -- action )
+    <action>
+        [
+            spider-sites
+            site-list-url <redirect>
+        ] >>submit
+    <protected>
+        "spider sites" >>description ;

extra/webapps/site-watcher/watching/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

extra/webapps/site-watcher/watching/watching.factor

@@ -0,0 +1,52 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors furnace.actions furnace.auth
+furnace.redirection html.forms site-watcher site-watcher.db
+validators webapps.site-watcher.common urls ;
+IN: webapps.site-watcher.watching
+
+CONSTANT: site-list-url URL" $site-watcher-app/watch-list"
+
+: <watch-list-action> ( -- action )
+    <page-action>
+        { site-watcher-app "site-list" } >>template
+        [
+            ! Silly query
+            username watching-sites
+            "sites" set-value
+        ] >>init
+    <protected>
+        "list watched sites" >>description ;
+
+: <add-watched-site-action> ( -- action )
+    <action>
+        [
+            { { "url" [ v-url ] } } validate-params
+        ] >>validate
+        [
+            username "url" value watch-site
+            site-list-url <redirect>
+        ] >>submit
+    <protected>
+        "add a watched site" >>description ;
+
+: <remove-watched-site-action> ( -- action )
+    <action>
+        [
+            { { "url" [ v-url ] } } validate-params
+        ] >>validate
+        [
+            username "url" value unwatch-site
+            site-list-url <redirect>
+        ] >>submit
+    <protected>
+        "remove a watched site" >>description ;
+
+: <check-sites-action> ( -- action )
+    <action>
+        [
+            watch-sites
+            site-list-url <redirect>
+        ] >>submit
+    <protected>
+        "check watched sites" >>description ;