Update wiki, pastebin, planet for new furnace.rss code

db4
Slava Pestov 2008-06-05 01:50:59 -05:00
parent 89feb17f32
commit 1074bdb330
12 changed files with 153 additions and 137 deletions

View File

@ -2,7 +2,9 @@
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
<t:atom t:title="This paste" t:href="$pastebin/paste.atom" t:query="id" />
<t:atom t:href="$pastebin/paste.atom" t:query="id">
Paste: <t:label t:name="summary" />
</t:atom>
<t:title>Paste: <t:label t:name="summary" /></t:title>

View File

@ -2,7 +2,7 @@
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
<t:atom t:title="Pastebin" t:href="$pastebin/list.atom" />
<t:atom t:href="$pastebin/list.atom">Pastebin</t:atom>
<t:style t:include="resource:extra/webapps/pastebin/pastebin.css" />

View File

@ -35,6 +35,14 @@ entity f
{ "contents" "CONTENTS" TEXT +not-null+ }
} define-persistent
GENERIC: entity-url ( entity -- url )
M: entity feed-entry-title summary>> ;
M: entity feed-entry-date date>> ;
M: entity feed-entry-url entity-url ;
TUPLE: paste < entity annotations ;
\ paste "PASTES" { } define-persistent
@ -58,39 +66,31 @@ annotation "ANNOTATIONS"
swap >>id
swap >>parent ;
: fetch-annotations ( paste -- paste )
dup annotations>> [
dup id>> f <annotation> select-tuples >>annotations
] unless ;
: paste ( id -- paste )
<paste> select-tuple fetch-annotations ;
[ <paste> select-tuple ]
[ f <annotation> select-tuples ]
bi >>annotations ;
! ! !
! LINKS, ETC
! ! !
: pastebin-link ( -- url )
: pastebin-url ( -- url )
URL" $pastebin/list" ;
GENERIC: entity-link ( entity -- url )
: paste-url ( id -- url )
"$pastebin/paste" >url swap "id" set-query-param ;
: paste-link ( id -- url )
<url>
"$pastebin/paste" >>path
swap "id" set-query-param ;
M: paste entity-url
id>> paste-url ;
M: paste entity-link
id>> paste-link ;
: annotation-link ( parent id -- url )
<url>
"$pastebin/paste" >>path
: annotation-url ( parent id -- url )
"$pastebin/paste" >url
swap number>string >>anchor
swap "id" set-query-param ;
M: annotation entity-link
[ parent>> ] [ id>> ] bi annotation-link ;
M: annotation entity-url
[ parent>> ] [ id>> ] bi annotation-url ;
! ! !
! PASTE LIST
@ -101,24 +101,11 @@ M: annotation entity-link
[ pastes "pastes" set-value ] >>init
{ pastebin "pastebin" } >>template ;
: pastebin-feed-entries ( seq -- entries )
<reversed> 20 short head [
entry new
swap
[ summary>> >>title ]
[ date>> >>pub-date ]
[ entity-link adjust-url relative-to-request >>link ]
tri
] map ;
: pastebin-feed ( -- feed )
feed new
"Factor Pastebin" >>title
pastebin-link >>link
pastes pastebin-feed-entries >>entries ;
: <pastebin-feed-action> ( -- action )
<feed-action> [ pastebin-feed ] >>feed ;
<feed-action>
[ pastebin-url ] >>url
[ "Factor Pastebin" ] >>title
[ pastes <reversed> ] >>entries ;
! ! !
! PASTES
@ -140,21 +127,12 @@ M: annotation entity-link
{ pastebin "paste" } >>template ;
: paste-feed-entries ( paste -- entries )
fetch-annotations annotations>> pastebin-feed-entries ;
: paste-feed ( paste -- feed )
feed new
swap
[ "Paste " swap id>> number>string append >>title ]
[ entity-link adjust-url relative-to-request >>link ]
[ paste-feed-entries >>entries ]
tri ;
: <paste-feed-action> ( -- action )
<feed-action>
[ validate-integer-id ] >>init
[ "id" value paste paste-feed ] >>feed ;
[ "id" value paste-url ] >>url
[ "Paste " "id" value number>string append ] >>title
[ "id" value f <annotation> select-tuples ] >>entries ;
: validate-entity ( -- )
{
@ -186,7 +164,7 @@ M: annotation entity-link
f <paste>
[ deposit-entity-slots ]
[ insert-tuple ]
[ id>> paste-link <redirect> ]
[ id>> paste-url <redirect> ]
tri
] >>submit ;
@ -206,11 +184,6 @@ M: annotation entity-link
: <new-annotation-action> ( -- action )
<action>
[
{ { "id" [ v-integer ] } } validate-params
"id" value paste-link <redirect>
] >>display
[
{ { "parent" [ v-integer ] } } validate-params
validate-entity
@ -220,7 +193,7 @@ M: annotation entity-link
"parent" value f <annotation>
[ deposit-entity-slots ]
[ insert-tuple ]
[ entity-link <redirect> ]
[ entity-url <redirect> ]
tri
] >>submit ;
@ -231,7 +204,7 @@ M: annotation entity-link
[
f "id" value <annotation> select-tuple
[ delete-tuples ]
[ parent>> paste-link <redirect> ]
[ parent>> paste-url <redirect> ]
bi
] >>submit ;

View File

@ -14,9 +14,9 @@
</t:bind-each>
</ul>
<p>
<div>
<t:a t:href="$planet-factor/admin/new-blog">Add Blog</t:a>
| <t:button t:action="$planet-factor/admin/update" class="link-button link">Update</t:button>
</p>
</div>
</t:chloe>

View File

@ -5,7 +5,7 @@
<t:bind-each t:name="postings">
<p class="news">
<strong><t:view t:component="title" /></strong> <br/>
<strong><t:label t:name="title" /></strong> <br/>
<t:a value="link" class="more">Read More...</t:a>
</p>

View File

@ -34,16 +34,15 @@ blog "BLOGS"
{ "feed-url" "FEEDURL" { VARCHAR 256 } +not-null+ }
} define-persistent
! TUPLE: posting < entry id ;
TUPLE: posting id title link description pub-date ;
TUPLE: posting < entry id ;
posting "POSTINGS"
{
{ "id" "ID" INTEGER +db-assigned-id+ }
{ "title" "TITLE" { VARCHAR 256 } +not-null+ }
{ "link" "LINK" { VARCHAR 256 } +not-null+ }
{ "url" "LINK" { VARCHAR 256 } +not-null+ }
{ "description" "DESCRIPTION" TEXT +not-null+ }
{ "pub-date" "DATE" TIMESTAMP +not-null+ }
{ "date" "DATE" TIMESTAMP +not-null+ }
} define-persistent
: init-blog-table blog ensure-table ;
@ -60,7 +59,7 @@ posting "POSTINGS"
: postings ( -- seq )
posting new select-tuples
[ [ pub-date>> ] compare invert-comparison ] sort ;
[ [ date>> ] compare invert-comparison ] sort ;
: <edit-blogroll-action> ( -- action )
<page-action>
@ -76,21 +75,18 @@ posting "POSTINGS"
{ planet-factor "planet" } >>template ;
: planet-feed ( -- feed )
feed new
"Planet Factor" >>title
"http://planet.factorcode.org" >>link
postings >>entries ;
: <planet-feed-action> ( -- action )
<feed-action> [ planet-feed ] >>feed ;
<feed-action>
[ "Planet Factor" ] >>title
[ URL" $planet-factor" ] >>url
[ postings ] >>entries ;
:: <posting> ( entry name -- entry' )
posting new
name ": " entry title>> 3append >>title
entry link>> >>link
entry url>> >>url
entry description>> >>description
entry pub-date>> >>pub-date ;
entry date>> >>date ;
: fetch-feed ( url -- feed )
download-feed entries>> ;
@ -102,7 +98,7 @@ posting "POSTINGS"
[ '[ , <posting> ] map ] 2map concat ;
: sort-entries ( entries -- entries' )
[ [ pub-date>> ] compare invert-comparison ] sort ;
[ [ date>> ] compare invert-comparison ] sort ;
: update-cached-postings ( -- )
blogroll fetch-blogroll sort-entries 8 short head [
@ -197,7 +193,7 @@ can-administer-planet-factor? define-capability
: <planet-factor> ( -- responder )
planet-factor new-dispatcher
<planet-action> "list" add-main-responder
<feed-action> "feed.xml" add-responder
<planet-feed-action> "feed.xml" add-responder
<planet-factor-admin> <protected>
"administer Planet Factor" >>description
{ can-administer-planet-factor? } >>capabilities

View File

@ -11,7 +11,7 @@
<t:bind-each t:name="postings">
<h2 class="posting-title">
<t:a t:value="link"><t:label t:name="title" /></t:a>
<t:a t:value="url"><t:label t:name="title" /></t:a>
</h2>
<p class="posting-body">
@ -19,7 +19,7 @@
</p>
<p class="posting-date">
<t:a t:value="link"><t:label t:name="pub-date" /></t:a>
<t:a t:value="url"><t:label t:name="pub-date" /></t:a>
</p>
</t:bind-each>

View File

@ -83,7 +83,7 @@ TUPLE: user-admin < dispatcher ;
[ from-object ]
[ capabilities>> [ "true" swap word>string set-value ] each ] bi
capabilities get words>strings "capabilities" set-value
init-capabilities
] >>init
{ user-admin "edit-user" } >>template

View File

@ -2,6 +2,10 @@
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
<t:atom t:href="$wiki/revisions.atom" t:query="title">
Revisions of <t:label t:name="title" />
</t:atom>
<t:call-next-template />
<div class="navbar">

View File

@ -2,6 +2,10 @@
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
<t:atom t:href="$wiki/user-edits.atom" t:query="author">
Edits by <t:label t:name="author" />
</t:atom>
<t:title>Edits by <t:label t:name="author" /></t:title>
<ul>

View File

@ -2,6 +2,10 @@
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
<t:atom t:href="$wiki/changes.atom">
Recent Changes
</t:atom>
<t:style t:include="resource:extra/webapps/wiki/wiki.css" />
<div class="navbar">

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel hashtables calendar
namespaces splitting sequences sorting math.order
html.components
html.components rss
http.server
http.server.dispatchers
furnace
@ -10,10 +10,26 @@ furnace.actions
furnace.auth
furnace.auth.login
furnace.boilerplate
furnace.rss
validators
db.types db.tuples lcs farkup urls ;
IN: webapps.wiki
: title-url ( title action -- url )
"$wiki/" prepend >url swap "title" set-query-param ;
: view-url ( title -- url ) "view" title-url ;
: edit-url ( title -- url ) "edit" title-url ;
: revisions-url ( title -- url ) "revisions" title-url ;
: revision-url ( id -- url )
"$wiki/revision" >url swap "id" set-query-param ;
: user-edits-url ( author -- url )
"$wiki/user-edits" >url swap "author" set-query-param ;
TUPLE: wiki < dispatcher ;
TUPLE: article title revision ;
@ -39,6 +55,16 @@ revision "REVISIONS" {
{ "content" "CONTENT" TEXT +not-null+ }
} define-persistent
M: revision feed-entry-title
[ title>> ] [ drop " by " ] [ author>> ] tri 3append ;
M: revision feed-entry-date date>> ;
M: revision feed-entry-url id>> revision-url ;
: reverse-chronological-order ( seq -- sorted )
[ [ date>> ] compare invert-comparison ] sort ;
: <revision> ( id -- revision )
revision new swap >>id ;
@ -47,18 +73,16 @@ revision "REVISIONS" {
: validate-title ( -- )
{ { "title" [ v-one-line ] } } validate-params ;
: validate-author ( -- )
{ { "author" [ v-username ] } } validate-params ;
: <main-article-action> ( -- action )
<action>
[
<url>
"$wiki/view" >>path
"Front Page" "title" set-query-param
<redirect>
] >>display ;
[ "Front Page" view-url <redirect> ] >>display ;
: <view-article-action> ( -- action )
<action>
"title" >>rest-param
"title" >>rest
[
validate-title
@ -70,17 +94,14 @@ revision "REVISIONS" {
revision>> <revision> select-tuple from-object
{ wiki "view" } <chloe-content>
] [
<url>
"$wiki/edit" >>path
swap "title" set-query-param
<redirect>
edit-url <redirect>
] ?if
] >>display ;
: <view-revision-action> ( -- action )
<page-action>
[
{ { "id" [ v-integer ] } } validate-params
validate-integer-id
"id" value <revision>
select-tuple from-object
] >>init
@ -117,53 +138,53 @@ revision "REVISIONS" {
now >>date
logged-in-user get username>> >>author
"content" value >>content
[ add-revision ]
[
<url>
"$wiki/view" >>path
swap title>> "title" set-query-param
<redirect>
] bi
[ add-revision ] [ title>> view-url <redirect> ] bi
] >>submit ;
: list-revisions ( -- seq )
f <revision> "title" value >>title select-tuples
reverse-chronological-order ;
: <list-revisions-action> ( -- action )
<page-action>
[
validate-title
f <revision> "title" value >>title select-tuples
[ [ date>> ] compare invert-comparison ] sort
"revisions" set-value
list-revisions "revisions" set-value
] >>init
{ wiki "revisions" } >>template ;
: <list-revisions-feed-action> ( -- action )
<feed-action>
[ validate-title ] >>init
[ "Revisions of " "title" value append ] >>title
[ "title" value revisions-url ] >>url
[ list-revisions ] >>entries ;
: <rollback-action> ( -- action )
<action>
[
{ { "id" [ v-integer ] } } validate-params
] >>validate
[ validate-integer-id ] >>validate
[
"id" value <revision> select-tuple clone f >>id
[ add-revision ]
[
<url>
"$wiki/view" >>path
swap title>> "title" set-query-param
<redirect>
] bi
[ add-revision ] [ title>> view-url <redirect> ] bi
] >>submit ;
: list-changes ( -- seq )
"id" value <revision> select-tuples
reverse-chronological-order ;
: <list-changes-action> ( -- action )
<page-action>
[
f <revision> select-tuples
[ [ date>> ] compare invert-comparison ] sort
"changes" set-value
] >>init
[ list-changes "changes" set-value ] >>init
{ wiki "changes" } >>template ;
: <list-changes-feed-action> ( -- action )
<feed-action>
[ URL" $wiki/changes" ] >>url
[ "All changes" ] >>title
[ list-changes ] >>entries ;
: <delete-action> ( -- action )
<action>
[ validate-title ] >>validate
@ -204,38 +225,50 @@ revision "REVISIONS" {
{ wiki "articles" } >>template ;
: list-user-edits ( -- seq )
f <revision> "author" value >>author select-tuples
reverse-chronological-order ;
: <user-edits-action> ( -- action )
<page-action>
[
{ { "author" [ v-username ] } } validate-params
f <revision> "author" value >>author
select-tuples "user-edits" set-value
validate-author
list-user-edits "user-edits" set-value
] >>init
{ wiki "user-edits" } >>template ;
: <user-edits-feed-action> ( -- action )
<feed-action>
[ validate-author ] >>init
[ "Edits by " "author" value append ] >>title
[ "author" value user-edits-url ] >>url
[ list-user-edits ] >>entries ;
SYMBOL: can-delete-wiki-articles?
can-delete-wiki-articles? define-capability
: <article-boilerplate> ( responder -- responder' )
<boilerplate>
{ wiki "page-common" } >>template ;
: <wiki> ( -- dispatcher )
wiki new-dispatcher
<dispatcher>
<main-article-action> "" add-responder
<view-article-action> "view" add-responder
<view-revision-action> "revision" add-responder
<list-revisions-action> "revisions" add-responder
<diff-action> "diff" add-responder
<edit-article-action> <protected>
<main-article-action> <article-boilerplate> "" add-responder
<view-article-action> <article-boilerplate> "view" add-responder
<view-revision-action> <article-boilerplate> "revision" add-responder
<list-revisions-action> <article-boilerplate> "revisions" add-responder
<list-revisions-feed-action> "revisions.atom" add-responder
<diff-action> <article-boilerplate> "diff" add-responder
<edit-article-action> <article-boilerplate> <protected>
"edit wiki articles" >>description
"edit" add-responder
<boilerplate>
{ wiki "page-common" } >>template
>>default
<rollback-action> "rollback" add-responder
<user-edits-action> "user-edits" add-responder
<list-articles-action> "articles" add-responder
<list-changes-action> "changes" add-responder
<user-edits-feed-action> "user-edits.atom" add-responder
<list-changes-feed-action> "changes.atom" add-responder
<delete-action> <protected>
"delete wiki articles" >>description
{ can-delete-wiki-articles? } >>capabilities