steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
Eduardo Cavazos 2007-12-05 22:28:17 -06:00
parent 6efd5260ad 4eb4982e60
commit b6a0e2fea1
3 changed files with 77 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
extra/rss/rss.factor
View File

@ -74,7 +74,7 @@ C: <entry> entry
: download-feed ( url -- feed ) : download-feed ( url -- feed )
#! Retrieve an news syndication file, return as a feed tuple. #! Retrieve an news syndication file, return as a feed tuple.
http-get rot 200 = [ http-get-stream rot 200 = [
nip read-feed nip read-feed
] [ ] [
2drop "Error retrieving newsfeed file" throw 2drop "Error retrieving newsfeed file" throw
@ -84,12 +84,15 @@ C: <entry> entry
: simple-tag, ( content name -- ) : simple-tag, ( content name -- )
[ , ] tag, ; [ , ] tag, ;
: simple-tag*, ( content name attrs -- )
[ , ] tag*, ;
: entry, ( entry -- ) : entry, ( entry -- )
"entry" [ "entry" [
dup entry-title "title" simple-tag, dup entry-title "title" { { "type" "html" } } simple-tag*,
"link" over entry-link "href" associate contained*, "link" over entry-link "href" associate contained*,
dup entry-pub-date "published" simple-tag, dup entry-pub-date "published" simple-tag,
entry-description "content" simple-tag, entry-description "content" { { "type" "html" } } simple-tag*,
] tag, ; ] tag, ;
: feed>xml ( feed -- xml ) : feed>xml ( feed -- xml )

135
extra/webapps/planet/planet.factor
View File

@ -1,41 +1,14 @@
USING: sequences rss arrays concurrency kernel sorting USING: sequences rss arrays concurrency kernel sorting
html.elements io assocs namespaces math threads vocabs html html.elements io assocs namespaces math threads vocabs html
furnace http.server.templating calendar math.parser splitting furnace http.server.templating calendar math.parser splitting
continuations debugger system http.server.responders ; continuations debugger system http.server.responders
xml.writer ;
IN: webapps.planet IN: webapps.planet
TUPLE: posting author title date link body ;
: diagnostic write print flush ;
: fetch-feed ( pair -- feed )
second
dup "Fetching " diagnostic
dup download-feed feed-entries
swap "Done fetching " diagnostic ;
: fetch-blogroll ( blogroll -- entries )
#! entries is an array of { author entries } pairs.
dup [
[ fetch-feed ] [ error. drop f ] recover
] parallel-map
[ [ >r first r> 2array ] curry* map ] 2map concat ;
: sort-entries ( entries -- entries' )
[ [ second entry-pub-date ] compare ] sort <reversed> ;
: <posting> ( pair -- posting )
#! pair has shape { author entry }
first2
{ entry-title entry-pub-date entry-link entry-description }
get-slots posting construct-boa ;
: print-posting-summary ( posting -- ) : print-posting-summary ( posting -- )
<p "news" =class p> <p "news" =class p>
<b> dup posting-title write </b> <br/> <b> dup entry-title write </b> <br/>
"- " write <a entry-link =href "more" =class a>
dup posting-author write bl
<a posting-link =href "more" =class a>
"Read More..." write "Read More..." write
</a> </a>
</p> ; </p> ;
@ -63,14 +36,16 @@ TUPLE: posting author title date link body ;
: print-posting ( posting -- ) : print-posting ( posting -- )
<h2 "posting-title" =class h2> <h2 "posting-title" =class h2>
<a dup posting-link =href a> <a dup entry-link =href a>
dup posting-title write-html dup entry-title write-html
" - " write
dup posting-author write
</a> </a>
</h2> </h2>
<p "posting-body" =class p> dup posting-body write-html </p> <p "posting-body" =class p>
<p "posting-date" =class p> posting-date format-date write </p> ; dup entry-description write-html
</p>
<p "posting-date" =class p>
entry-pub-date format-date write
</p> ;
: print-postings ( postings -- ) : print-postings ( postings -- )
[ print-posting ] each ; [ print-posting ] each ;
@ -83,38 +58,56 @@ TUPLE: posting author title date link body ;
SYMBOL: default-blogroll SYMBOL: default-blogroll
SYMBOL: cached-postings SYMBOL: cached-postings
: update-cached-postings ( -- )
default-blogroll get fetch-blogroll sort-entries
[ <posting> ] map
cached-postings set-global ;
: mini-planet-factor ( -- ) : mini-planet-factor ( -- )
cached-postings get 4 head print-posting-summaries ; cached-postings get 4 head print-posting-summaries ;
: planet-factor ( -- ) : planet-factor ( -- )
serving-html [ serving-html [ "planet" render-template ] with-html-stream ;
"resource:extra/webapps/planet/planet.fhtml"
run-template-file
] with-html-stream ;
\ planet-factor { } define-action \ planet-factor { } define-action
{ : planet-feed ( -- feed )
{ "Berlin Brown" "http://factorlang-fornovices.blogspot.com/feeds/posts/default" "http://factorlang-fornovices.blogspot.com" } "[ planet-factor ]"
{ "Chris Double" "http://www.bluishcoder.co.nz/atom.xml" "http://www.bluishcoder.co.nz/" } "http://planet.factorcode.org"
{ "Elie Chaftari" "http://fun-factor.blogspot.com/feeds/posts/default" "http://fun-factor.blogspot.com/" } cached-postings get 30 head <feed> ;
{ "Doug Coleman" "http://code-factor.blogspot.com/feeds/posts/default" "http://code-factor.blogspot.com/" }
{ "Daniel Ehrenberg" "http://useless-factor.blogspot.com/feeds/posts/default" "http://useless-factor.blogspot.com/" } : feed.xml
{ "Kio M. Smallwood" "text/xml" serving-content
"http://sekenre.wordpress.com/feed/atom/" planet-feed feed>xml write-xml ;
"http://sekenre.wordpress.com/" }
{ "Phil Dawes" "http://www.phildawes.net/blog/category/factor/feed/atom" "http://www.phildawes.net/blog/" } \ feed.xml { } define-action
{ "Samuel Tardieu" "http://www.rfc1149.net/blog/tag/factor/feed/atom/" "http://www.rfc1149.net/blog/tag/factor/" }
{ "Slava Pestov" "http://factor-language.blogspot.com/atom.xml" "http://factor-language.blogspot.com/" }
} default-blogroll set-global
SYMBOL: last-update SYMBOL: last-update
: diagnostic write print flush ;
: fetch-feed ( triple -- feed )
second
dup "Fetching " diagnostic
dup download-feed feed-entries
swap "Done fetching " diagnostic ;
: <posting> ( author entry -- entry' )
clone
[ ": " swap entry-title 3append ] keep
[ set-entry-title ] keep ;
: ?fetch-feed ( triple -- feed/f )
[ fetch-feed ] [ error. drop f ] recover ;
: fetch-blogroll ( blogroll -- entries )
dup 0 <column>
swap [ ?fetch-feed ] parallel-map
[ [ <posting> ] curry* map ] 2map concat ;
: sort-entries ( entries -- entries' )
[ [ entry-pub-date ] compare ] sort <reversed> ;
: update-cached-postings ( -- )
default-blogroll get
fetch-blogroll sort-entries
cached-postings set-global ;
: update-thread ( -- ) : update-thread ( -- )
millis last-update set-global millis last-update set-global
[ update-cached-postings ] in-thread [ update-cached-postings ] in-thread
@ -126,14 +119,16 @@ SYMBOL: last-update
"planet" "planet-factor" "extra/webapps/planet" web-app "planet" "planet-factor" "extra/webapps/planet" web-app
: merge-feeds ( feeds -- feed ) {
[ feed-entries ] map concat sort-entries ; { "Berlin Brown" "http://factorlang-fornovices.blogspot.com/feeds/posts/default" "http://factorlang-fornovices.blogspot.com" }
{ "Chris Double" "http://www.bluishcoder.co.nz/atom.xml" "http://www.bluishcoder.co.nz/" }
: planet-feed ( -- feed ) { "Elie Chaftari" "http://fun-factor.blogspot.com/feeds/posts/default" "http://fun-factor.blogspot.com/" }
default-blogroll get [ second download-feed ] map merge-feeds { "Doug Coleman" "http://code-factor.blogspot.com/feeds/posts/default" "http://code-factor.blogspot.com/" }
>r "[ planet-factor ]" "http://planet.factorcode.org" r> <entry> { "Daniel Ehrenberg" "http://useless-factor.blogspot.com/feeds/posts/default" "http://useless-factor.blogspot.com/" }
feed>xml ; { "Kio M. Smallwood"
"http://sekenre.wordpress.com/feed/atom/"
: feed.xml planet-feed ; "http://sekenre.wordpress.com/" }
! { "Phil Dawes" "http://www.phildawes.net/blog/category/factor/feed/atom" "http://www.phildawes.net/blog/" }
\ feed.xml { } define-action { "Samuel Tardieu" "http://www.rfc1149.net/blog/tag/factor/feed/atom/" "http://www.rfc1149.net/blog/tag/factor/" }
{ "Slava Pestov" "http://factor-language.blogspot.com/atom.xml" "http://factor-language.blogspot.com/" }
} default-blogroll set-global

7
extra/webapps/planet/planet.fhtml → extra/webapps/planet/planet.furnace
View File

@ -9,6 +9,7 @@
<title>planet-factor</title> <title>planet-factor</title>
<link rel="stylesheet" href="/responder/file/css/news.css" type="text/css" media="screen" title="no title" charset="utf-8" /> <link rel="stylesheet" href="/responder/file/css/news.css" type="text/css" media="screen" title="no title" charset="utf-8" />
<link rel="alternate" type="application/atom+xml" title="Planet Factor - Atom" href="feed.xml" />
</head> </head>
<body id="index"> <body id="index">
@ -23,7 +24,11 @@
<a href="http://planet.lisp.org">Planet Lisp</a>. <a href="http://planet.lisp.org">Planet Lisp</a>.
</p> </p>
<p> <p>
This webapp is written in <a href="http://factorcode.org/">Factor</a>. <img src="http://planet.lisp.org/feed-icon-14x14.png" />
<a href="feed.xml"> Syndicate </a>
</p>
<p>
This webapp is written in <a href="http://factorcode.org/">Factor</a>.<br>
<% "webapps.planet" browse-webapp-source %> <% "webapps.planet" browse-webapp-source %>
</p> </p>
<h2 class="blogroll-title">Blogroll</h2> <h2 class="blogroll-title">Blogroll</h2>