Update wiki, pastebin, planet for new furnace.rss code
							parent
							
								
									89feb17f32
								
							
						
					
					
						commit
						1074bdb330
					
				| 
						 | 
				
			
			@ -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>
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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" />
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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>
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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>
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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>
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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">
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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>
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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">
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue