Furnace tools overhaul
parent
76f1b3bcfe
commit
7b05ede553
|
@ -1,6 +1,6 @@
|
|||
<% USING: namespaces io furnace ; %>
|
||||
|
||||
<html>
|
||||
<% xhtml-preamble %>
|
||||
|
||||
<head><title><% "title" get write %></title></head>
|
||||
|
||||
|
|
|
@ -109,13 +109,12 @@ C: page ( title model template -- page )
|
|||
: render-template ( model template -- )
|
||||
template-path get swap path+ call-template ;
|
||||
|
||||
: render-component
|
||||
dup component-model swap component-template
|
||||
render-template ;
|
||||
|
||||
: render-page ( title model template -- )
|
||||
serving-html
|
||||
<page> "contrib/furnace/page" call-template ;
|
||||
[
|
||||
rot [
|
||||
render-template
|
||||
] html-document
|
||||
] with-html-stream ;
|
||||
|
||||
: web-app ( name default path -- )
|
||||
over responder-vocab create-vocab drop
|
||||
|
|
|
@ -5,27 +5,10 @@ IN: furnace:browser
|
|||
USING: definitions hashtables help html httpd io kernel memory
|
||||
namespaces prettyprint sequences words xml furnace arrays ;
|
||||
|
||||
: option ( current text -- )
|
||||
#! Output the HTML option tag for the given text. If
|
||||
#! it is equal to the current string, make the option selected.
|
||||
<option tuck = [ "selected" =selected ] when option>
|
||||
write
|
||||
</option> ;
|
||||
TUPLE: list current options name ;
|
||||
|
||||
: options ( current seq -- ) [ option ] each-with ;
|
||||
|
||||
: list ( current seq name -- )
|
||||
<select =name "width: 200px;" =style "20" =size
|
||||
"JavaScript:document.getElementById('main').submit();" =onchange
|
||||
select>
|
||||
options
|
||||
</select> ;
|
||||
|
||||
: current-vocab ( -- string )
|
||||
"vocab" query-param [ "kernel" ] unless* ;
|
||||
|
||||
: current-word ( -- word )
|
||||
"word" query-param "vocab" query-param lookup ;
|
||||
: list ( current options name -- )
|
||||
<list> "list" render-template ;
|
||||
|
||||
: vocab-list ( vocab -- ) vocabs "vocab" list ;
|
||||
|
||||
|
@ -33,49 +16,23 @@ namespaces prettyprint sequences words xml furnace arrays ;
|
|||
[ lookup [ word-name ] [ f ] if* ] keep
|
||||
vocab hash-keys natural-sort "word" list ;
|
||||
|
||||
: word-source ( -- )
|
||||
#! Write the source for the given word from the vocab as HTML.
|
||||
current-word [ see-help ] when* ;
|
||||
|
||||
: browser-body ( word vocab -- )
|
||||
#! Write out the HTML for the body of the main browser page.
|
||||
<table "100%" =width table>
|
||||
<tr>
|
||||
<th> "Vocabularies" write </th>
|
||||
<th> "Words" write </th>
|
||||
<th> "Documentation" write </th>
|
||||
</tr>
|
||||
<tr>
|
||||
<td "top" =valign "width: 200px;" =style td>
|
||||
dup vocab-list
|
||||
</td>
|
||||
<td "top" =valign "width: 200px;" =style td>
|
||||
word-list
|
||||
</td>
|
||||
<td "top" =valign td> word-source </td>
|
||||
</tr>
|
||||
</table> ;
|
||||
|
||||
: browser-title ( word vocab -- str )
|
||||
2dup lookup dup
|
||||
[ 2nip summary ] [ drop nip "IN: " swap append ] if ;
|
||||
|
||||
TUPLE: browser word vocab ;
|
||||
|
||||
: browse ( word vocab -- )
|
||||
#! Display a Smalltalk like browser for exploring words.
|
||||
2dup browser-title [
|
||||
[
|
||||
<form "main" =id "browse" =action "get" =method form>
|
||||
browser-body
|
||||
</form>
|
||||
] with-html-stream
|
||||
] html-document ;
|
||||
2dup browser-title
|
||||
-rot <browser>
|
||||
"browser" render-page ;
|
||||
|
||||
\ browse {
|
||||
{ "word" }
|
||||
{ "vocab" "kernel" v-default }
|
||||
} define-action
|
||||
|
||||
"browser" "browse" "contrib/furnace" web-app
|
||||
"browser" "browse" "contrib/furnace/tools" web-app
|
||||
|
||||
M: word browser-link-href
|
||||
dup word-name swap word-vocabulary \ browse
|
||||
|
|
|
@ -0,0 +1,22 @@
|
|||
<% USING: namespaces furnace:browser words help kernel ; %>
|
||||
|
||||
<form id="main" action="browse" method="get">
|
||||
<table width="100%">
|
||||
<tr>
|
||||
<th>Vocabularies</th>
|
||||
<th>Words</th>
|
||||
<th>Documentation</th>
|
||||
</tr>
|
||||
<tr>
|
||||
<td valign="top" style="width: 200px;">
|
||||
<% "vocab" get vocab-list %>
|
||||
</td>
|
||||
<td valign="top" style="width: 200px;">
|
||||
<% "word" get "vocab" get word-list %>
|
||||
</td>
|
||||
<td valign="top">
|
||||
<% "word" get "vocab" get lookup [ see-help ] when* %>
|
||||
</td>
|
||||
</tr>
|
||||
</table>
|
||||
</form>
|
|
@ -15,7 +15,7 @@ USING: furnace help html kernel sequences words strings ;
|
|||
{ "topic" "handbook" v-default string>topic }
|
||||
} define-action
|
||||
|
||||
"help" "show-help" "contrib/furnace" web-app
|
||||
"help" "show-help" "contrib/furnace/tools" web-app
|
||||
|
||||
M: link browser-link-href
|
||||
link-name [ \ f ] unless* dup word? [
|
||||
|
|
|
@ -0,0 +1,14 @@
|
|||
<% USING: namespaces kernel html io sequences ; %>
|
||||
|
||||
<select name="<% "name" get write %>" style="width: 200px;" size="20"
|
||||
onchange="JavaScript:document.getElementById('main').submit();">
|
||||
|
||||
<%
|
||||
"options" get [
|
||||
<option dup "current" get = [ "selected" =selected ] when option>
|
||||
write
|
||||
</option>
|
||||
] each
|
||||
%>
|
||||
|
||||
</select>
|
|
@ -17,7 +17,7 @@ global [
|
|||
! Javascript source used by ajax libraries
|
||||
"resources" [
|
||||
[
|
||||
"" resource-path "doc-root" set
|
||||
"contrib/httpd/resources" resource-path "doc-root" set
|
||||
file-responder
|
||||
] with-scope
|
||||
] add-simple-responder
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
! Copyright (C) 2005 Alex Chapman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: embedded
|
||||
USING: sequences kernel parser math namespaces io ;
|
||||
USING: sequences kernel parser math namespaces io html test ;
|
||||
|
||||
! if example.fhtml contains:
|
||||
! <html>
|
||||
|
@ -38,7 +40,7 @@ USING: sequences kernel parser math namespaces io ;
|
|||
dup "<%" head? [
|
||||
get-embedded parse %
|
||||
] [
|
||||
get-text , \ write ,
|
||||
get-text , \ write-html ,
|
||||
] if ;
|
||||
|
||||
: embedded>factor ( string -- )
|
||||
|
@ -53,20 +55,14 @@ USING: sequences kernel parser math namespaces io ;
|
|||
|
||||
: eval-embedded ( string -- ) parse-embedded call ;
|
||||
|
||||
: with-embedded-file ( filename quot -- )
|
||||
[
|
||||
file-vocabs
|
||||
over file set ! so that reload works properly
|
||||
>r <file-reader> contents r> call
|
||||
] with-scope ;
|
||||
|
||||
: parse-embedded-file ( filename -- quot )
|
||||
[ parse-embedded ] with-embedded-file ;
|
||||
|
||||
: run-embedded-file ( filename -- )
|
||||
[ eval-embedded ] with-embedded-file ;
|
||||
[
|
||||
[
|
||||
file-vocabs
|
||||
dup file set ! so that reload works properly
|
||||
dup <file-reader> contents eval-embedded
|
||||
] with-scope
|
||||
] assert-depth drop ;
|
||||
|
||||
: embedded-convert ( infile outfile -- )
|
||||
<file-writer> [ run-embedded-file ] with-stream ;
|
||||
|
||||
PROVIDE: contrib/embedded ;
|
|
@ -188,21 +188,19 @@ M: html-stream with-stream-table ( grid quot style stream -- )
|
|||
M: html-stream stream-terpri [ <br/> ] with-stream* ;
|
||||
|
||||
: default-css ( -- )
|
||||
<style "text/css" =type style>
|
||||
"a:link { text-decoration: none; color: black; }" print
|
||||
"a:visited { text-decoration: none; color: black; }" print
|
||||
"a:active { text-decoration: none; color: black; }" print
|
||||
"a:hover, A:hover { text-decoration: underline; color: black; }" print
|
||||
</style> ;
|
||||
<link
|
||||
"stylesheet" =rel "text/css" =type
|
||||
"/responder/resources/stylesheet.css" =href
|
||||
link/> ;
|
||||
|
||||
: xhtml-preamble
|
||||
xml-preamble print
|
||||
"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">" print ;
|
||||
xml-preamble write-html
|
||||
"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">" write-html ;
|
||||
|
||||
: html-document ( title quot -- )
|
||||
xhtml-preamble
|
||||
swap chars>entities
|
||||
<html " xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\"" write html>
|
||||
<html " xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\"" write-html html>
|
||||
<head>
|
||||
<title> write </title>
|
||||
default-css
|
||||
|
|
|
@ -1,7 +1,6 @@
|
|||
USING: io ;
|
||||
|
||||
REQUIRES: contrib/calendar contrib/embedded contrib/http
|
||||
contrib/xml ;
|
||||
REQUIRES: contrib/calendar contrib/http contrib/xml ;
|
||||
|
||||
PROVIDE: contrib/httpd {
|
||||
"mime.factor"
|
||||
|
@ -12,6 +11,7 @@ PROVIDE: contrib/httpd {
|
|||
"cont-responder.factor"
|
||||
"prototype-js.factor"
|
||||
"html.factor"
|
||||
"embedded.factor"
|
||||
"file-responder.factor"
|
||||
"default-responders.factor"
|
||||
} {
|
||||
|
|
|
@ -11,7 +11,7 @@ strings ;
|
|||
: include-prototype-js ( -- )
|
||||
#! Write out the HTML script tag to include the prototype
|
||||
#! javascript library.
|
||||
<script "text/javascript" =type "/responder/resources/contrib/httpd/javascript/prototype.js"
|
||||
<script "text/javascript" =type "/responder/resources/prototype.js"
|
||||
=src script>
|
||||
</script> ;
|
||||
|
||||
|
|
|
@ -0,0 +1,4 @@
|
|||
a:link { text-decoration: none; color: black; }
|
||||
a:visited { text-decoration: none; color: black; }
|
||||
a:active { text-decoration: none; color: black; }
|
||||
a:hover { text-decoration: underline; color: black; }
|
Loading…
Reference in New Issue