<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>
<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" />
{ "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
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-link ( id -- url )
- <url>
- "$pastebin/paste" >>path
- swap "id" set-query-param ;
+: paste-url ( id -- url )
+ "$pastebin/paste" >url swap "id" set-query-param ;
-M: paste entity-link
- id>> paste-link ;
+M: paste entity-url
+ id>> paste-url ;
-: 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
[ 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
{ 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 ( -- )
{
f <paste>
[ deposit-entity-slots ]
[ insert-tuple ]
- [ id>> paste-link <redirect> ]
+ [ id>> paste-url <redirect> ]
tri
] >>submit ;
: <new-annotation-action> ( -- action )
<action>
- [
- { { "id" [ v-integer ] } } validate-params
- "id" value paste-link <redirect>
- ] >>display
-
[
{ { "parent" [ v-integer ] } } validate-params
validate-entity
"parent" value f <annotation>
[ deposit-entity-slots ]
[ insert-tuple ]
- [ entity-link <redirect> ]
+ [ entity-url <redirect> ]
tri
] >>submit ;
[
f "id" value <annotation> select-tuple
[ delete-tuples ]
- [ parent>> paste-link <redirect> ]
+ [ parent>> paste-url <redirect> ]
bi
] >>submit ;
</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>
<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>
{ "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 ;
: postings ( -- seq )
posting new select-tuples
- [ [ pub-date>> ] compare invert-comparison ] sort ;
+ [ [ date>> ] compare invert-comparison ] sort ;
: <edit-blogroll-action> ( -- action )
<page-action>
{ 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>> ;
[ '[ , <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 [
: <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
<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">
</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>
[ 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
<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">
<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>
<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">
! 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
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 ;
{ "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 ;
: 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
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
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
{ 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>
- "edit wiki articles" >>description
- "edit" add-responder
- <boilerplate>
- { wiki "page-common" } >>template
- >>default
+ <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
<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