From edc7aa3908bd7cd76a636f45a851d1a13bbd627a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 29 Sep 2008 04:10:20 -0500
Subject: [PATCH] Working on help webapp

---
 basis/help/html/html-tests.factor |   5 ++
 basis/help/html/html.factor       | 101 ++++++++++++++++++++++++++++++
 basis/help/html/stylesheet.css    |   4 ++
 extra/webapps/help/help.factor    |  38 +++++++++++
 extra/webapps/help/help.xml       |  20 ++++++
 extra/webapps/help/search.xml     |  53 ++++++++++++++++
 6 files changed, 221 insertions(+)
 create mode 100644 basis/help/html/html-tests.factor
 create mode 100644 basis/help/html/stylesheet.css
 create mode 100644 extra/webapps/help/help.factor
 create mode 100644 extra/webapps/help/help.xml
 create mode 100644 extra/webapps/help/search.xml

diff --git a/basis/help/html/html-tests.factor b/basis/help/html/html-tests.factor
new file mode 100644
index 0000000000..475b2114b3
--- /dev/null
+++ b/basis/help/html/html-tests.factor
@@ -0,0 +1,5 @@
+IN: help.html.tests
+USING: html.streams classes.predicate help.topics help.markup
+io.streams.string accessors prettyprint kernel tools.test ;
+
+[ ] [ [ [ \ predicate-instance? def>> . ] with-html-writer ] with-string-writer drop ] unit-test
diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor
index b1bf8958a8..1e5d672658 100644
--- a/basis/help/html/html.factor
+++ b/basis/help/html/html.factor
@@ -1,5 +1,106 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.utf8 io.encodings.ascii io.encodings.binary
+io.files html.streams html.elements html.components help kernel
+assocs sequences make words accessors arrays help.topics vocabs
+tools.vocabs tools.vocabs.browser namespaces prettyprint io
+vocabs.loader serialize fry memoize unicode.case ;
 IN: help.html
 
+: escape-char ( ch -- )
+    dup H{
+        { CHAR: " "__quote__" }
+        { CHAR: * "__star__" }
+        { CHAR: : "__colon__" }
+        { CHAR: < "__lt__" }
+        { CHAR: > "__gt__" }
+        { CHAR: ? "__question__" }
+        { CHAR: \\ "__backslash__" }
+        { CHAR: | "__pipe__" }
+        { CHAR: _ "__underscore__" }
+        { CHAR: / "__slash__" }
+        { CHAR: \\ "__backslash__" }
+        { CHAR: , "__comma__" }
+    } at [ % ] [ , ] ?if ;
 
+: escape-filename ( string -- filename )
+    [ [ escape-char ] each ] "" make ;
+
+GENERIC: topic>filename* ( topic -- name prefix )
+
+M: word topic>filename* [ name>> ] [ vocabulary>> ] bi 2array "word" ;
+M: link topic>filename* name>> "article" ;
+M: word-link topic>filename* name>> topic>filename* ;
+M: vocab-spec topic>filename* vocab-name "vocab" ;
+M: vocab-tag topic>filename* name>> "tag" ;
+M: vocab-author topic>filename* name>> "author" ;
+
+: topic>filename ( topic -- filename )
+    [
+        topic>filename* % "-" %
+        dup array?
+        [ [ escape-filename ] map "," join ]
+        [ escape-filename ]
+        if % ".html" %
+    ] "" make ;
+
+M: topic browser-link-href topic>filename ;
+
+: help-stylesheet ( -- )
+    "resource:basis/help/html/stylesheet.css" ascii file-contents write ;
+
+: help>html ( topic -- )
+    dup topic>filename utf8 [
+        dup article-title
+        [ <style> help-stylesheet </style> ]
+        [ [ help ] with-html-writer ] simple-page
+    ] with-file-writer ;
+
+: all-vocabs-really ( -- seq )
+    #! Hack.
+    all-vocabs values concat
+    vocabs [ find-vocab-root not ] filter [ vocab ] map append ;
+
+: all-topics ( -- topics )
+    [
+        ! articles get keys [ >link ] map %
+        ! all-words [ >link ] map %
+        ! all-authors [ <vocab-author> ] map %
+        all-tags [ <vocab-tag> ] map %
+        ! all-vocabs-really %
+    ] { } make ;
+
+: serialize-index ( index file -- )
+    [ [ [ topic>filename ] dip ] { } assoc-map-as object>bytes ] dip
+    binary set-file-contents ;
+
+: generate-indices ( -- )
+    articles get keys [ [ >link ] [ article-title ] bi ] { } map>assoc "articles.idx" serialize-index
+    all-words [ dup name>> ] { } map>assoc "words.idx" serialize-index
+    all-vocabs-really [ dup vocab-name ] { } map>assoc "vocabs.idx" serialize-index ;
+
+: generate-help ( -- )
+    all-topics [ help>html ] each ;
+
+MEMO: load-index ( name -- index )
+    binary file-contents bytes>object ;
+
+TUPLE: result title href ;
+
+M: result link-title title>> ;
+
+M: result link-href href>> ;
+
+: offline-apropos ( string index -- results )
+    load-index swap >lower
+    '[ [ drop _ ] dip >lower subseq? ] assoc-filter
+    [ swap result boa ] { } assoc>map ;
+
+: article-apropos ( string -- results )
+    "articles.idx" offline-apropos ;
+
+: word-apropos ( string -- results )
+    "words.idx" offline-apropos ;
+
+: vocab-apropos ( string -- results )
+    "vocabs.idx" offline-apropos ;
diff --git a/basis/help/html/stylesheet.css b/basis/help/html/stylesheet.css
new file mode 100644
index 0000000000..ff657d634e
--- /dev/null
+++ b/basis/help/html/stylesheet.css
@@ -0,0 +1,4 @@
+a:link { text-decoration: none; color: #00004c; }
+a:visited { text-decoration: none; color: #00004c; }
+a:active { text-decoration: none; color: #00004c; }
+a:hover { text-decoration: underline; color: #00004c; }
diff --git a/extra/webapps/help/help.factor b/extra/webapps/help/help.factor
new file mode 100644
index 0000000000..e9b6a48634
--- /dev/null
+++ b/extra/webapps/help/help.factor
@@ -0,0 +1,38 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors http.server.dispatchers
+http.server.static furnace.actions furnace.redirection urls
+validators locals io.files html.forms help.html ;
+IN: webapps.help
+
+TUPLE: help-webapp < dispatcher ;
+
+:: <search-action> ( help-dir -- action )
+    <page-action>
+        { help-webapp "search" } >>template
+
+        [
+            {
+                { "search" [ 2 v-min-length 50 v-max-length v-one-line ] }
+            } validate-params
+
+            help-dir set-current-directory
+
+            "search" value article-apropos "articles" set-value
+            "search" value word-apropos "words" set-value
+            "search" value vocab-apropos "vocabs" set-value
+
+            { help-webapp "search" } <chloe-content>
+        ] >>submit ;
+
+: <main-action> ( -- action )
+    <page-action>
+        { help-webapp "help" } >>template ;
+
+: <help-webapp> ( help-dir -- webapp )
+    help-webapp new-dispatcher
+        <main-action> "" add-responder
+        over <search-action> "search" add-responder
+        swap <static> "content" add-responder ;
+
+
diff --git a/extra/webapps/help/help.xml b/extra/webapps/help/help.xml
new file mode 100644
index 0000000000..f71db15e19
--- /dev/null
+++ b/extra/webapps/help/help.xml
@@ -0,0 +1,20 @@
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html 
+     PUBLIC "-//W3C//DTD XHTML 1.0 Frameset//EN"
+     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd">
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<html xmlns="http://www.w3.org/1999/xhtml">
+		<head>
+			<title>Factor Documentation</title>
+			<t:base t:href="$help-webapp" />
+		</head>
+
+		<frameset cols="25%, 75%">
+			<frame src="search" name="search" />
+			<frame src="content/article-handbook.html" name="content" />
+		</frameset>
+	</html>
+
+</t:chloe>
diff --git a/extra/webapps/help/search.xml b/extra/webapps/help/search.xml
new file mode 100644
index 0000000000..b763f11f88
--- /dev/null
+++ b/extra/webapps/help/search.xml
@@ -0,0 +1,53 @@
+<?xml version='1.0' ?>
+
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+<html xmlns="http://www.w3.org/1999/xhtml">
+	<head>
+		<t:base t:href="$help-webapp/content/" />
+	</head>
+
+	<body>
+		<h1>Factor documentation</h1>
+
+		<t:form t:action="$help-webapp/search">
+			<t:field t:name="search" />
+			<button>Search</button>
+		</t:form>
+		
+		<t:if t:value="articles">
+			<h1>Articles</h1>
+			
+			<ul>
+				<t:each t:name="articles">
+					<li> <t:link t:name="value" t:target="content" /> </li>
+				</t:each>
+			</ul>
+		</t:if>
+		
+		<t:if t:value="vocabs">
+			<h1>Vocabularies</h1>
+			
+			<ul>
+				<t:each t:name="vocabs">
+					<li> <t:link t:name="value" t:target="content" /> </li>
+				</t:each>
+			</ul>
+		</t:if>
+		
+		<t:if t:value="words">
+			<h1>Words</h1>
+			
+			<ul>
+				<t:each t:name="words">
+					<li> <t:link t:name="value" t:target="content" /> </li>
+				</t:each>
+			</ul>
+		</t:if>
+
+	</body>
+</html>
+
+</t:chloe>
-- 
2.34.1