From 6120f5f3876e1b6d5c9caeb544622aa5099bf133 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 6 Dec 2007 00:06:34 -0500
Subject: [PATCH] Furnace improvements

---
 extra/furnace/furnace.factor                  | 65 ++++++++++---------
 extra/webapps/pastebin/annotate-paste.furnace |  7 +-
 extra/webapps/pastebin/modes.furnace          |  7 ++
 extra/webapps/pastebin/new-paste.furnace      |  7 ++
 extra/webapps/pastebin/paste-list.furnace     | 30 +++++++--
 extra/webapps/pastebin/paste-summary.furnace  | 14 ++--
 extra/webapps/pastebin/pastebin.factor        | 37 +++++------
 extra/webapps/pastebin/show-paste.furnace     | 18 ++++-
 extra/webapps/pastebin/syntax.furnace         |  7 ++
 extra/webapps/planet/planet.factor            |  2 +-
 10 files changed, 128 insertions(+), 66 deletions(-)
 create mode 100644 extra/webapps/pastebin/modes.furnace
 create mode 100644 extra/webapps/pastebin/syntax.furnace

diff --git a/extra/furnace/furnace.factor b/extra/furnace/furnace.factor
index f2ce0ddf18..076b506112 100644
--- a/extra/furnace/furnace.factor
+++ b/extra/furnace/furnace.factor
@@ -101,36 +101,10 @@ SYMBOL: request-params
 
 : service-post ( url -- ) "response" get swap service-request ;
 
-: explode-tuple ( tuple -- )
-    dup tuple-slots swap class "slot-names" word-prop
-    [ set ] 2each ;
-
-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 ;
+: render-template ( template -- )
+    template-path get swap path+
+    ".furnace" append resource-path
+    run-template-file ;
 
 : web-app ( name default path -- )
     [
@@ -141,3 +115,34 @@ SYMBOL: model
         [ service-post ] "post" set
         ! [ service-head ] "head" set
     ] 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 ;
diff --git a/extra/webapps/pastebin/annotate-paste.furnace b/extra/webapps/pastebin/annotate-paste.furnace
index c963e2f88f..301726209b 100644
--- a/extra/webapps/pastebin/annotate-paste.furnace
+++ b/extra/webapps/pastebin/annotate-paste.furnace
@@ -1,4 +1,4 @@
-<% USING: io math math.parser namespaces ; %>
+<% USING: io math math.parser namespaces furnace ; %>
 
 <h1>Annotate</h1>
 
@@ -18,6 +18,11 @@
 <td><input type="TEXT" name="summary" value="" /></td>
 </tr>
 
+<tr>
+<th>File type:</th>
+<td><% "modes" render-template %></td>
+</tr>
+
 <tr>
 <th valign="top">Contents:</th>
 <td><textarea rows="24" cols="60" name="contents"></textarea></td>
diff --git a/extra/webapps/pastebin/modes.furnace b/extra/webapps/pastebin/modes.furnace
new file mode 100644
index 0000000000..cc09ae90ed
--- /dev/null
+++ b/extra/webapps/pastebin/modes.furnace
@@ -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>
diff --git a/extra/webapps/pastebin/new-paste.furnace b/extra/webapps/pastebin/new-paste.furnace
index 8a2544e801..98b9bae8b7 100644
--- a/extra/webapps/pastebin/new-paste.furnace
+++ b/extra/webapps/pastebin/new-paste.furnace
@@ -1,3 +1,5 @@
+<% USING: furnace ; %>
+
 <form method="POST" action="/responder/pastebin/submit-paste">
 
 <table>
@@ -12,6 +14,11 @@
 <td><input type="TEXT" name="summary" value="" /></td>
 </tr>
 
+<tr>
+<th>File type:</th>
+<td><% "modes" render-template %></td>
+</tr>
+
 <tr>
 <th>Channel:</th>
 <td><input type="TEXT" name="channel" value="#concatenative" /></td>
diff --git a/extra/webapps/pastebin/paste-list.furnace b/extra/webapps/pastebin/paste-list.furnace
index 7a25ae2f50..1edc312f54 100644
--- a/extra/webapps/pastebin/paste-list.furnace
+++ b/extra/webapps/pastebin/paste-list.furnace
@@ -1,7 +1,29 @@
 <% USING: namespaces furnace sequences ; %>
 
-<table  width="100%">
-<% "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>
-<% "pastes" get <reversed> [ "paste-summary" render-template ] each %></table>
+<!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%">
+        <% "new-paste-quot" get "New paste" render-link %>
+        <tr align="left" class="pastebin-headings">
+            <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>
diff --git a/extra/webapps/pastebin/paste-summary.furnace b/extra/webapps/pastebin/paste-summary.furnace
index f5c156a27e..87c01b646d 100644
--- a/extra/webapps/pastebin/paste-summary.furnace
+++ b/extra/webapps/pastebin/paste-summary.furnace
@@ -1,9 +1,13 @@
 <% USING: continuations namespaces io kernel math math.parser furnace ; %>
 
 <tr>
-<td><% "n" get number>string write %></td>
-<td><% "summary" 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><% "n" get number>string write %></td>
+    <td><%
+        "n" get number>string
+        "show-paste-quot" get curry
+        "summary" get
+        render-link
+    %></td>
+    <td><% "author" get write %></td>
+    <td><% "date" get print %></td>
 </tr>
diff --git a/extra/webapps/pastebin/pastebin.factor b/extra/webapps/pastebin/pastebin.factor
index f592f96448..382b7fbb85 100644
--- a/extra/webapps/pastebin/pastebin.factor
+++ b/extra/webapps/pastebin/pastebin.factor
@@ -1,5 +1,5 @@
-USING: calendar furnace furnace.validator io.files kernel namespaces
-sequences store ;
+USING: calendar furnace furnace.validator io.files kernel
+namespaces sequences store ;
 IN: webapps.pastebin
 
 TUPLE: pastebin pastes ;
@@ -7,23 +7,17 @@ TUPLE: pastebin pastes ;
 : <pastebin> ( -- pastebin )
     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 )
-    V{ } clone
-    {
-        set-paste-summary
-        set-paste-author
-        set-paste-channel
-        set-paste-contents
-        set-paste-annotations
-    } paste construct ;
+: <paste> ( summary author channel mode contents -- paste )
+    f V{ } clone f paste construct-boa ;
 
-TUPLE: annotation summary author contents ;
+TUPLE: annotation summary author mode contents ;
 
 C: <annotation> annotation
 
-
 SYMBOL: store
 
 "pastebin.store" resource-path load-store store set-global
@@ -34,12 +28,12 @@ SYMBOL: store
     pastebin get pastebin-pastes nth ;
 
 : show-paste ( n -- )
-    get-paste "show-paste" "Paste" render-page ;
+    get-paste "show-paste" render-component ;
 
 \ show-paste { { "n" v-number } } define-action
 
 : new-paste ( -- )
-    f "new-paste" "New paste" render-page ;
+    "new-paste" render-template ;
 
 \ new-paste { } define-action
 
@@ -47,22 +41,19 @@ SYMBOL: store
     [
         [ show-paste ] "show-paste-quot" set
         [ new-paste ] "new-paste-quot" set
-        pastebin get "paste-list" "Pastebin" render-page
+        pastebin get "paste-list" render-component
     ] with-scope ;
 
 \ paste-list { } define-action
 
-
-
 : save-pastebin-store ( -- )
     store get-global save-store ;
 
 : add-paste ( paste pastebin -- )
     >r now timestamp>http-string over set-paste-date r>
-    pastebin-pastes
-    [ length over set-paste-n ] keep push ;
+    pastebin-pastes 2dup length swap set-paste-n push ;
 
-: submit-paste ( summary author channel contents -- )
+: submit-paste ( summary author channel mode contents -- )
     <paste>
     \ pastebin get-global add-paste
     save-pastebin-store ;
@@ -71,6 +62,7 @@ SYMBOL: store
     { "summary" v-required }
     { "author" v-required }
     { "channel" "#concatenative" v-default }
+    { "mode" "factor" v-default }
     { "contents" v-required }
 } define-action
 
@@ -85,6 +77,7 @@ SYMBOL: store
     { "n" v-required v-number }
     { "summary" v-required }
     { "author" v-required }
+    { "mode" "factor" v-default }
     { "contents" v-required }
 } define-action
 
diff --git a/extra/webapps/pastebin/show-paste.furnace b/extra/webapps/pastebin/show-paste.furnace
index b3b4e99b6e..8213857687 100644
--- a/extra/webapps/pastebin/show-paste.furnace
+++ b/extra/webapps/pastebin/show-paste.furnace
@@ -1,15 +1,27 @@
 <% 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>
 <tr><th>Paste by:</th><td><% "author" 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>File type:</th><td><% "mode" get write %></td></tr>
 </table>
 
 <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 %>
diff --git a/extra/webapps/pastebin/syntax.furnace b/extra/webapps/pastebin/syntax.furnace
new file mode 100644
index 0000000000..cc09ae90ed
--- /dev/null
+++ b/extra/webapps/pastebin/syntax.furnace
@@ -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>
diff --git a/extra/webapps/planet/planet.factor b/extra/webapps/planet/planet.factor
index 92da085128..0ddd48e36e 100644
--- a/extra/webapps/planet/planet.factor
+++ b/extra/webapps/planet/planet.factor
@@ -121,7 +121,7 @@ SYMBOL: last-update
 
 {
     { "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/" }
     { "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/" }