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

Furnace improvements

release
Slava Pestov 2007-12-06 00:06:34 -05:00
parent 4eb4982e60
commit 6120f5f387
10 changed files with 128 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
extra/furnace/furnace.factor
View File

@ -101,36 +101,10 @@ SYMBOL: request-params
: service-post ( url -- ) "response" get swap service-request ; : service-post ( url -- ) "response" get swap service-request ;
: explode-tuple ( tuple -- ) : render-template ( template -- )
dup tuple-slots swap class "slot-names" word-prop template-path get swap path+
[ set ] 2each ; ".furnace" append resource-path
run-template-file ;
SYMBOL: model
: call-template ( model template -- )
[
>r [ dup model set explode-tuple ] when* r>
".furnace" append resource-path run-template-file
] with-scope ;
: render-template ( model template -- )
template-path get swap path+ call-template ;
: render-page* ( model body-template head-template -- )
[
[ render-template ] [ f rot render-template ] html-document
] serve-html ;
: render-titled-page* ( model body-template head-template title -- )
[
[ render-template ] swap [ <title> write </title> f rot render-template ] curry html-document
] serve-html ;
: render-page ( model template title -- )
[
[ render-template ] simple-html-document
] serve-html ;
: web-app ( name default path -- ) : web-app ( name default path -- )
[ [
@ -141,3 +115,34 @@ SYMBOL: model
[ service-post ] "post" set [ service-post ] "post" set
! [ service-head ] "head" set ! [ service-head ] "head" set
] make-responder ; ] make-responder ;
: explode-tuple ( tuple -- )
dup tuple-slots swap class "slot-names" word-prop
[ set ] 2each ;
SYMBOL: model
: with-slots ( model quot -- )
[
>r [ dup model set explode-tuple ] when* r> call
] with-scope ;
: render-component ( model template -- )
swap [ render-template ] with-slots ;
! Deprecated stuff
: render-page* ( model body-template head-template -- )
[
[ render-component ] [ f rot render-component ] html-document
] serve-html ;
: render-titled-page* ( model body-template head-template title -- )
[
[ render-component ] swap [ <title> write </title> f rot render-component ] curry html-document
] serve-html ;
: render-page ( model template title -- )
[
[ render-component ] simple-html-document
] serve-html ;

7
extra/webapps/pastebin/annotate-paste.furnace
View File

@ -1,4 +1,4 @@
<% USING: io math math.parser namespaces ; %> <% USING: io math math.parser namespaces furnace ; %>
<h1>Annotate</h1> <h1>Annotate</h1>
@ -18,6 +18,11 @@
<td><input type="TEXT" name="summary" value="" /></td> <td><input type="TEXT" name="summary" value="" /></td>
</tr> </tr>
<tr>
<th>File type:</th>
<td><% "modes" render-template %></td>
</tr>
<tr> <tr>
<th valign="top">Contents:</th> <th valign="top">Contents:</th>
<td><textarea rows="24" cols="60" name="contents"></textarea></td> <td><textarea rows="24" cols="60" name="contents"></textarea></td>

7
extra/webapps/pastebin/modes.furnace Normal file
View File

@ -0,0 +1,7 @@
<% USING: xmode.catalog sequences kernel html.elements assocs io ; %>
<select name="mode">
<% modes keys [
<option dup "factor" = [ "true" =selected ] when option> write </option>
] each %>
</select>

7
extra/webapps/pastebin/new-paste.furnace
View File

@ -1,3 +1,5 @@
<% USING: furnace ; %>
<form method="POST" action="/responder/pastebin/submit-paste"> <form method="POST" action="/responder/pastebin/submit-paste">
<table> <table>
@ -12,6 +14,11 @@
<td><input type="TEXT" name="summary" value="" /></td> <td><input type="TEXT" name="summary" value="" /></td>
</tr> </tr>
<tr>
<th>File type:</th>
<td><% "modes" render-template %></td>
</tr>
<tr> <tr>
<th>Channel:</th> <th>Channel:</th>
<td><input type="TEXT" name="channel" value="#concatenative" /></td> <td><input type="TEXT" name="channel" value="#concatenative" /></td>

28
extra/webapps/pastebin/paste-list.furnace
View File

@ -1,7 +1,29 @@
<% USING: namespaces furnace sequences ; %> <% USING: namespaces furnace sequences ; %>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-type" content="text/html; charset=utf-8" />
<title>Pastebin</title>
<link rel="stylesheet" href="/responder/file/css/pastebin.css" type="text/css" media="screen" title="no title" charset="utf-8" />
<link rel="alternate" type="application/atom+xml" title="Pastebin - Atom" href="feed.xml" />
</head>
<body id="index">
<h1 class="pastebin-title">[ "paste" bin ]</h1>
<table width="100%"> <table width="100%">
<% "new-paste-quot" get "New paste" render-link %> <% "new-paste-quot" get "New paste" render-link %>
<tr align="left"><th>&nbsp;</th><th>Summary:</th><th>Paste by:</th><th>Link</th><th>Date</th></tr> <tr align="left" class="pastebin-headings">
<% "pastes" get <reversed> [ "paste-summary" render-template ] each %></table> <th>&nbsp;</th>
<th>Summary:</th>
<th>Paste by:</th>
<th>Date:</th>
</tr>
<% "pastes" get <reversed> [ "paste-summary" render-component ] each %>
</table>
</body>
</html>

8
extra/webapps/pastebin/paste-summary.furnace
View File

@ -2,8 +2,12 @@
<tr> <tr>
<td><% "n" get number>string write %></td> <td><% "n" get number>string write %></td>
<td><% "summary" get write %></td> <td><%
"n" get number>string
"show-paste-quot" get curry
"summary" get
render-link
%></td>
<td><% "author" get write %></td> <td><% "author" get write %></td>
<td><% "n" get number>string "show-paste-quot" get curry "Show" render-link %></td>
<td><% "date" get print %></td> <td><% "date" get print %></td>
</tr> </tr>

37
extra/webapps/pastebin/pastebin.factor
View File

@ -1,5 +1,5 @@
USING: calendar furnace furnace.validator io.files kernel namespaces USING: calendar furnace furnace.validator io.files kernel
sequences store ; namespaces sequences store ;
IN: webapps.pastebin IN: webapps.pastebin
TUPLE: pastebin pastes ; TUPLE: pastebin pastes ;
@ -7,23 +7,17 @@ TUPLE: pastebin pastes ;
: <pastebin> ( -- pastebin ) : <pastebin> ( -- pastebin )
V{ } clone pastebin construct-boa ; V{ } clone pastebin construct-boa ;
TUPLE: paste n summary article author channel contents date annotations ; TUPLE: paste
summary author channel mode contents date
annotations n ;
: <paste> ( summary author channel contents -- paste ) : <paste> ( summary author channel mode contents -- paste )
V{ } clone f V{ } clone f paste construct-boa ;
{
set-paste-summary
set-paste-author
set-paste-channel
set-paste-contents
set-paste-annotations
} paste construct ;
TUPLE: annotation summary author contents ; TUPLE: annotation summary author mode contents ;
C: <annotation> annotation C: <annotation> annotation
SYMBOL: store SYMBOL: store
"pastebin.store" resource-path load-store store set-global "pastebin.store" resource-path load-store store set-global
@ -34,12 +28,12 @@ SYMBOL: store
pastebin get pastebin-pastes nth ; pastebin get pastebin-pastes nth ;
: show-paste ( n -- ) : show-paste ( n -- )
get-paste "show-paste" "Paste" render-page ; get-paste "show-paste" render-component ;
\ show-paste { { "n" v-number } } define-action \ show-paste { { "n" v-number } } define-action
: new-paste ( -- ) : new-paste ( -- )
f "new-paste" "New paste" render-page ; "new-paste" render-template ;
\ new-paste { } define-action \ new-paste { } define-action
@ -47,22 +41,19 @@ SYMBOL: store
[ [
[ show-paste ] "show-paste-quot" set [ show-paste ] "show-paste-quot" set
[ new-paste ] "new-paste-quot" set [ new-paste ] "new-paste-quot" set
pastebin get "paste-list" "Pastebin" render-page pastebin get "paste-list" render-component
] with-scope ; ] with-scope ;
\ paste-list { } define-action \ paste-list { } define-action
: save-pastebin-store ( -- ) : save-pastebin-store ( -- )
store get-global save-store ; store get-global save-store ;
: add-paste ( paste pastebin -- ) : add-paste ( paste pastebin -- )
>r now timestamp>http-string over set-paste-date r> >r now timestamp>http-string over set-paste-date r>
pastebin-pastes pastebin-pastes 2dup length swap set-paste-n push ;
[ length over set-paste-n ] keep push ;
: submit-paste ( summary author channel contents -- ) : submit-paste ( summary author channel mode contents -- )
<paste> <paste>
\ pastebin get-global add-paste \ pastebin get-global add-paste
save-pastebin-store ; save-pastebin-store ;
@ -71,6 +62,7 @@ SYMBOL: store
{ "summary" v-required } { "summary" v-required }
{ "author" v-required } { "author" v-required }
{ "channel" "#concatenative" v-default } { "channel" "#concatenative" v-default }
{ "mode" "factor" v-default }
{ "contents" v-required } { "contents" v-required }
} define-action } define-action
@ -85,6 +77,7 @@ SYMBOL: store
{ "n" v-required v-number } { "n" v-required v-number }
{ "summary" v-required } { "summary" v-required }
{ "author" v-required } { "author" v-required }
{ "mode" "factor" v-default }
{ "contents" v-required } { "contents" v-required }
} define-action } define-action

18
extra/webapps/pastebin/show-paste.furnace
View File

@ -1,15 +1,27 @@
<% USING: namespaces io furnace sequences ; %> <% USING: namespaces io furnace sequences ; %>
<h1>Paste: <% "summary" get write %></h1> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-type" content="text/html; charset=utf-8" />
<title>Paste: <% "summary" get write %></title>
<link rel="stylesheet" href="/responder/file/css/pastebin.css" type="text/css" media="screen" title="no title" charset="utf-8" />
</head>
<h1 class="pastebin-title">[ <% "summary" get write %> ]</h1>
<table> <table>
<tr><th>Paste by:</th><td><% "author" get write %></td></tr> <tr><th>Paste by:</th><td><% "author" get write %></td></tr>
<tr><th>Channel:</th><td><% "channel" get write %></td></tr> <tr><th>Channel:</th><td><% "channel" get write %></td></tr>
<tr><th>Created:</th><td><% "date" get write %></td></tr> <tr><th>Created:</th><td><% "date" get write %></td></tr>
<tr><th>File type:</th><td><% "mode" get write %></td></tr>
</table> </table>
<pre><% "contents" get write %></pre> <pre><% "contents" get write %></pre>
<% "annotations" get [ "annotation" render-template ] each %> <% "annotations" get [ "annotation" render-component ] each %>
<% model get "annotate-paste" render-template %> <% model get "annotate-paste" render-component %>

7
extra/webapps/pastebin/syntax.furnace Normal file
View File

@ -0,0 +1,7 @@
<% USING: xmode.catalog sequences kernel html.elements assocs io ; %>
<select name="mode">
<% modes keys [
<option dup "factor" = [ "true" =selected ] when option> write </option>
] each %>
</select>

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

@ -121,7 +121,7 @@ SYMBOL: last-update
{ {
{ "Berlin Brown" "http://factorlang-fornovices.blogspot.com/feeds/posts/default" "http://factorlang-fornovices.blogspot.com" } { "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/" } { "Chris Double" "http://www.blogger.com/feeds/18561009/posts/full/-/factor" "http://www.bluishcoder.co.nz/" }
{ "Elie Chaftari" "http://fun-factor.blogspot.com/feeds/posts/default" "http://fun-factor.blogspot.com/" } { "Elie Chaftari" "http://fun-factor.blogspot.com/feeds/posts/default" "http://fun-factor.blogspot.com/" }
{ "Doug Coleman" "http://code-factor.blogspot.com/feeds/posts/default" "http://code-factor.blogspot.com/" } { "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/" } { "Daniel Ehrenberg" "http://useless-factor.blogspot.com/feeds/posts/default" "http://useless-factor.blogspot.com/" }