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

Furnace tools overhaul

darcs
slava 2006-10-19 21:28:58 +00:00
parent 76f1b3bcfe
commit 7b05ede553
13 changed files with 78 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
contrib/furnace/page.fhtml
View File

@ -1,6 +1,6 @@
<% USING: namespaces io furnace ; %> <% USING: namespaces io furnace ; %>
<html> <% xhtml-preamble %>
<head><title><% "title" get write %></title></head> <head><title><% "title" get write %></title></head>

11
contrib/furnace/responder.factor
View File

@ -109,13 +109,12 @@ C: page ( title model template -- page )
: render-template ( model template -- ) : render-template ( model template -- )
template-path get swap path+ call-template ; template-path get swap path+ call-template ;
: render-component
dup component-model swap component-template
render-template ;
: render-page ( title model 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 -- ) : web-app ( name default path -- )
over responder-vocab create-vocab drop over responder-vocab create-vocab drop

61
contrib/furnace/tools/browser.factor
View File

@ -5,27 +5,10 @@ IN: furnace:browser
USING: definitions hashtables help html httpd io kernel memory USING: definitions hashtables help html httpd io kernel memory
namespaces prettyprint sequences words xml furnace arrays ; namespaces prettyprint sequences words xml furnace arrays ;
: option ( current text -- ) TUPLE: list current options name ;
#! 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> ;
: options ( current seq -- ) [ option ] each-with ; : list ( current options name -- )
<list> "list" render-template ;
: 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 ;
: vocab-list ( vocab -- ) vocabs "vocab" list ; : vocab-list ( vocab -- ) vocabs "vocab" list ;
@ -33,49 +16,23 @@ namespaces prettyprint sequences words xml furnace arrays ;
[ lookup [ word-name ] [ f ] if* ] keep [ lookup [ word-name ] [ f ] if* ] keep
vocab hash-keys natural-sort "word" list ; 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 ) : browser-title ( word vocab -- str )
2dup lookup dup 2dup lookup dup
[ 2nip summary ] [ drop nip "IN: " swap append ] if ; [ 2nip summary ] [ drop nip "IN: " swap append ] if ;
TUPLE: browser word vocab ;
: browse ( word vocab -- ) : browse ( word vocab -- )
#! Display a Smalltalk like browser for exploring words. 2dup browser-title
2dup browser-title [ -rot <browser>
[ "browser" render-page ;
<form "main" =id "browse" =action "get" =method form>
browser-body
</form>
] with-html-stream
] html-document ;
\ browse { \ browse {
{ "word" } { "word" }
{ "vocab" "kernel" v-default } { "vocab" "kernel" v-default }
} define-action } define-action
"browser" "browse" "contrib/furnace" web-app "browser" "browse" "contrib/furnace/tools" web-app
M: word browser-link-href M: word browser-link-href
dup word-name swap word-vocabulary \ browse dup word-name swap word-vocabulary \ browse

22
contrib/furnace/tools/browser.fhtml Normal file
View File

@ -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>

2
contrib/furnace/tools/help.factor
View File

@ -15,7 +15,7 @@ USING: furnace help html kernel sequences words strings ;
{ "topic" "handbook" v-default string>topic } { "topic" "handbook" v-default string>topic }
} define-action } define-action
"help" "show-help" "contrib/furnace" web-app "help" "show-help" "contrib/furnace/tools" web-app
M: link browser-link-href M: link browser-link-href
link-name [ \ f ] unless* dup word? [ link-name [ \ f ] unless* dup word? [

14
contrib/furnace/tools/list.fhtml Normal file
View File

@ -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>

2
contrib/httpd/default-responders.factor
View File

@ -17,7 +17,7 @@ global [
! Javascript source used by ajax libraries ! Javascript source used by ajax libraries
"resources" [ "resources" [
[ [
"" resource-path "doc-root" set "contrib/httpd/resources" resource-path "doc-root" set
file-responder file-responder
] with-scope ] with-scope
] add-simple-responder ] add-simple-responder

26
contrib/embedded.factor → contrib/httpd/embedded.factor
View File

@ -1,5 +1,7 @@
! Copyright (C) 2005 Alex Chapman.
! See http://factorcode.org/license.txt for BSD license.
IN: embedded IN: embedded
USING: sequences kernel parser math namespaces io ; USING: sequences kernel parser math namespaces io html test ;
! if example.fhtml contains: ! if example.fhtml contains:
! <html> ! <html>
@ -38,7 +40,7 @@ USING: sequences kernel parser math namespaces io ;
dup "<%" head? [ dup "<%" head? [
get-embedded parse % get-embedded parse %
] [ ] [
get-text , \ write , get-text , \ write-html ,
] if ; ] if ;
: embedded>factor ( string -- ) : embedded>factor ( string -- )
@ -53,20 +55,14 @@ USING: sequences kernel parser math namespaces io ;
: eval-embedded ( string -- ) parse-embedded call ; : 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 -- ) : 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 -- ) : embedded-convert ( infile outfile -- )
<file-writer> [ run-embedded-file ] with-stream ; <file-writer> [ run-embedded-file ] with-stream ;
PROVIDE: contrib/embedded ;

16
contrib/httpd/html.factor
View File

@ -188,21 +188,19 @@ M: html-stream with-stream-table ( grid quot style stream -- )
M: html-stream stream-terpri [ <br/> ] with-stream* ; M: html-stream stream-terpri [ <br/> ] with-stream* ;
: default-css ( -- ) : default-css ( -- )
<style "text/css" =type style> <link
"a:link { text-decoration: none; color: black; }" print "stylesheet" =rel "text/css" =type
"a:visited { text-decoration: none; color: black; }" print "/responder/resources/stylesheet.css" =href
"a:active { text-decoration: none; color: black; }" print link/> ;
"a:hover, A:hover { text-decoration: underline; color: black; }" print
</style> ;
: xhtml-preamble : xhtml-preamble
xml-preamble 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\">" print ; "<!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 -- ) : html-document ( title quot -- )
xhtml-preamble xhtml-preamble
swap chars>entities 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> <head>
<title> write </title> <title> write </title>
default-css default-css

4
contrib/httpd/load.factor
View File

@ -1,7 +1,6 @@
USING: io ; USING: io ;
REQUIRES: contrib/calendar contrib/embedded contrib/http REQUIRES: contrib/calendar contrib/http contrib/xml ;
contrib/xml ;
PROVIDE: contrib/httpd { PROVIDE: contrib/httpd {
"mime.factor" "mime.factor"
@ -12,6 +11,7 @@ PROVIDE: contrib/httpd {
"cont-responder.factor" "cont-responder.factor"
"prototype-js.factor" "prototype-js.factor"
"html.factor" "html.factor"
"embedded.factor"
"file-responder.factor" "file-responder.factor"
"default-responders.factor" "default-responders.factor"
} { } {

2
contrib/httpd/prototype-js.factor
View File

@ -11,7 +11,7 @@ strings ;
: include-prototype-js ( -- ) : include-prototype-js ( -- )
#! Write out the HTML script tag to include the prototype #! Write out the HTML script tag to include the prototype
#! javascript library. #! javascript library.
<script "text/javascript" =type "/responder/resources/contrib/httpd/javascript/prototype.js" <script "text/javascript" =type "/responder/resources/prototype.js"
=src script> =src script>
</script> ; </script> ;

0
contrib/httpd/javascript/prototype.js → contrib/httpd/resources/prototype.js vendored
View File

4
contrib/httpd/resources/stylesheet.css Normal file
View File

@ -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; }