More web framework work

TODO.FACTOR.txt

@@ -1,5 +1,4 @@
 - live search: timer delay would be nice
-- httpd search tools
 - hashed generic method dispatch
 - fix this:
   [ 1 2 3 4 5 6 7 8 9 10 10 10 10 10 10 10 10 10 10 11 11 11 113 ] .

contrib/furnace-pastebin/pastebin.factor

@@ -29,14 +29,12 @@ C: pastebin ( -- pastebin )
     pastebin get pastebin-pastes nth ;
 
 : show-paste ( n -- )
-    "Paste"
-    swap get-paste
-    "show-paste" render-page ;
+    get-paste "show-paste" "Paste" render-page ;
 
 \ show-paste { { "n" v-number } } define-action
 
 : new-paste ( -- )
-    "New paste" f "new-paste" render-page ;
+    f "new-paste" "New paste" render-page ;
 
 \ new-paste { } define-action
 
@@ -55,9 +53,7 @@ C: pastebin ( -- pastebin )
         [ show-paste ] "show-paste-quot" set
         [ new-paste ] "new-paste-quot" set
 
-        "Pastebin"
-        pastebin get
-        "paste-list" render-page
+        pastebin get "paste-list" "Pastebin" render-page
     ] with-scope ;
 
 \ paste-list { } define-action

contrib/furnace/responder.factor

@@ -98,20 +98,12 @@ SYMBOL: model
         ".fhtml" append resource-path run-embedded-file
     ] with-scope ;
 
-TUPLE: component model template ;
-
-TUPLE: page title root ;
-
-C: page ( title model template -- page )
-    [ >r <component> r> set-page-root ] keep
-    [ set-page-title ] keep ;
-
 : render-template ( model template -- )
     template-path get swap path+ call-template ;
 
-: render-page ( title model template -- )
+: render-page ( model template title -- )
+    [
         [
-        rot [
             render-template
         ] html-document
     ] with-html-stream ;

contrib/furnace/tools/browser.factor

@@ -20,20 +20,19 @@ TUPLE: list current options name ;
     2dup lookup dup
     [ 2nip summary ] [ drop nip "IN: " swap append ] if ;
 
-TUPLE: browser word vocab ;
+TUPLE: browser word vocab apropos ;
 
-: browse ( word vocab -- )
-    2dup browser-title
-    -rot <browser>
-    "browser" render-page ;
+: browse ( word vocab apropos -- )
+    pick pick browser-title >r <browser> "browser" r> render-page ;
 
 \ browse {
     { "word" }
     { "vocab" "kernel" v-default }
+    { "apropos" }
 } define-action
 
 "browser" "browse" "contrib/furnace/tools" web-app
 
 M: word browser-link-href
-    dup word-name swap word-vocabulary \ browse
-    3array >quotation quot-link ;
+    dup word-name swap word-vocabulary f \ browse
+    4array >quotation quot-link ;

contrib/furnace/tools/browser.fhtml

@@ -1,11 +1,12 @@
-<% USING: namespaces furnace:browser words help kernel ; %>
+<% USING: namespaces furnace:browser words help kernel tools sequences io
+html ; %>
 
 <form id="main" action="browse" method="get">
     <table width="100%">
         <tr>
-            <th>Vocabularies</th>
-            <th>Words</th>
-            <th>Documentation</th>
+            <th align="left">Vocabularies</th>
+            <th align="left">Words</th>
+            <th align="left">Documentation</th>
         </tr>
         <tr>
             <td valign="top" style="width: 200px;">
@@ -19,4 +20,14 @@
             </td>
         </tr>
     </table>
+    <h2>Apropos</h2>
+    <input type="field" name="apropos" /><br/>
+    <%
+        "apropos" get dup empty? [
+            drop
+        ] [
+            <b> "Results for " write dup write ":" write </b> <br/>
+            apropos
+        ] if
+    %>
 </form>

contrib/furnace/tools/help.factor

@@ -1,22 +1,19 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: furnace:help
-USING: furnace help html kernel sequences words strings ;
-
-: string>topic ( string -- topic )
-    " " split dup length 1 = [ first ] when ;
+USING: furnace help html kernel sequences words strings io ;
 
 : show-help ( topic -- )
     dup article-title [
         [ help ] with-html-stream
+        <br/>
+        <a "search" =href a> "Search" write </a>
     ] html-document ;
 
 \ show-help {
     { "topic" "handbook" v-default string>topic }
 } define-action
 
-"help" "show-help" "contrib/furnace/tools" web-app
-
 M: link browser-link-href
     link-name [ \ f ] unless* dup word? [
         browser-link-href
@@ -24,3 +21,14 @@ M: link browser-link-href
         dup [ string? ] all? [ " " join ] when
         [ show-help ] curry quot-link
     ] if ;
+
+TUPLE: search terms ;
+
+: search ( terms -- )
+    <search> "search" "Search" render-page ;
+
+\ search {
+    { "terms" }
+} define-action
+
+"help" "show-help" "contrib/furnace/tools" web-app

contrib/furnace/tools/search.fhtml

@@ -0,0 +1,15 @@
+<% USING: help kernel sequences html namespaces io ; %>
+
+<form action="search" method="get">
+    <h1>Search help</h1>
+    <input type="field" name="terms" />
+    <%
+        "terms" get dup empty? [
+            drop
+        ] [
+            <b> "Results for " write dup write ":" write </b> <br/>
+            search-help.
+        ] if
+    %>
+    <input type="submit" />
+</form>