Merge branch 'clean-linux-x86-32' of git://factorcode.org/git/factor
Eduardo Cavazos
commit
14456e3a13
|
|
@ -1,9 +1,10 @@
|
|||
! Generate a new factor.vim file for syntax highlighting
|
||||
USING: http.server.templating.fhtml io.files ;
|
||||
USING: http.server.templating http.server.templating.fhtml
|
||||
io.files ;
|
||||
IN: editors.vim.generate-syntax
|
||||
|
||||
: generate-vim-syntax ( -- )
|
||||
"misc/factor.vim.fgen" resource-path
|
||||
"misc/factor.vim.fgen" resource-path <fhtml>
|
||||
"misc/factor.vim" resource-path
|
||||
template-convert ;
|
||||
|
||||
|
|
|
|||
|
|
@ -54,10 +54,12 @@ IN: farkup.tests
|
|||
[ "<p>=</p><h2>foo</h2>" ] [ "===foo==" convert-farkup ] unit-test
|
||||
[ "<h1>foo</h1><p>=</p>" ] [ "=foo==" convert-farkup ] unit-test
|
||||
|
||||
[ "<span class='KEYWORD3'>int</span> <span class='FUNCTION'>main</span><span class='OPERATOR'>(</span><span class='OPERATOR'>)</span><br/>" ]
|
||||
[ "<div style='white-space: pre; font-family: monospace; '><span class='KEYWORD3'>int</span> <span class='FUNCTION'>main</span><span class='OPERATOR'>(</span><span class='OPERATOR'>)</span><br/></div>" ]
|
||||
[ "[c{int main()}]" convert-farkup ] unit-test
|
||||
|
||||
[ "<p><img src=\"lol.jpg\"/></p>" ] [ "[[image:lol.jpg]]" convert-farkup ] unit-test
|
||||
[ "<p><img src=\"lol.jpg\" alt=\"teh lol\"/></p>" ] [ "[[image:lol.jpg|teh lol]]" convert-farkup ] unit-test
|
||||
[ "<p><a href=\"lol.com\"></a></p>" ] [ "[[lol.com]]" convert-farkup ] unit-test
|
||||
[ "<p><a href=\"lol.com\">haha</a></p>" ] [ "[[lol.com|haha]]" convert-farkup ] unit-test
|
||||
|
||||
[ ] [ "[{}]" convert-farkup drop ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays io kernel memoize namespaces peg sequences strings
|
||||
html.elements xml.entities xmode.code2html splitting
|
||||
io.streams.string html peg.parsers html.elements sequences.deep
|
||||
unicode.categories ;
|
||||
USING: arrays io io.styles kernel memoize namespaces peg
|
||||
sequences strings html.elements xml.entities xmode.code2html
|
||||
splitting io.streams.string html peg.parsers html.elements
|
||||
sequences.deep unicode.categories ;
|
||||
IN: farkup
|
||||
|
||||
<PRIVATE
|
||||
|
|
@ -55,7 +55,13 @@ MEMO: eq ( -- parser )
|
|||
|
||||
: render-code ( string mode -- string' )
|
||||
>r string-lines r>
|
||||
[ [ htmlize-lines ] with-html-stream ] with-string-writer ;
|
||||
[
|
||||
[
|
||||
H{ { wrap-margin f } } [
|
||||
htmlize-lines
|
||||
] with-nesting
|
||||
] with-html-stream
|
||||
] with-string-writer ;
|
||||
|
||||
: escape-link ( href text -- href-esc text-esc )
|
||||
>r escape-quoted-string r> escape-string ;
|
||||
|
|
|
|||
|
|
@ -394,13 +394,18 @@ body ;
|
|||
[ unparse-cookies "set-cookie" pick set-at ] when*
|
||||
write-header ;
|
||||
|
||||
GENERIC: write-response-body* ( body -- )
|
||||
|
||||
M: f write-response-body* drop ;
|
||||
|
||||
M: string write-response-body* write ;
|
||||
|
||||
M: callable write-response-body* call ;
|
||||
|
||||
M: object write-response-body* stdio get stream-copy ;
|
||||
|
||||
: write-response-body ( response -- response )
|
||||
dup body>> {
|
||||
{ [ dup not ] [ drop ] }
|
||||
{ [ dup string? ] [ write ] }
|
||||
{ [ dup callable? ] [ call ] }
|
||||
[ stdio get stream-copy ]
|
||||
} cond ;
|
||||
dup body>> write-response-body* ;
|
||||
|
||||
M: response write-response ( respose -- )
|
||||
write-response-version
|
||||
|
|
|
|||
|
|
@ -0,0 +1,9 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
|
||||
<h1><t:write-title /></h1>
|
||||
|
||||
<t:call-next-template />
|
||||
|
||||
</t:chloe>
|
||||
|
|
@ -1,77 +0,0 @@
|
|||
<% USING: http.server.components http.server.auth.login
|
||||
http.server namespaces kernel combinators ; %>
|
||||
<html>
|
||||
<body>
|
||||
<h1>Edit profile</h1>
|
||||
|
||||
<form method="POST" action="edit-profile">
|
||||
<% hidden-form-field %>
|
||||
|
||||
<table>
|
||||
|
||||
<tr>
|
||||
<td>User name:</td>
|
||||
<td><% "username" component render-view %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td>Real name:</td>
|
||||
<td><% "realname" component render-edit %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td></td>
|
||||
<td>Specifying a real name is optional.</td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td>Current password:</td>
|
||||
<td><% "password" component render-edit %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td></td>
|
||||
<td>If you don't want to change your current password, leave this field blank.</td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td>New password:</td>
|
||||
<td><% "new-password" component render-edit %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td>Verify:</td>
|
||||
<td><% "verify-password" component render-edit %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td></td>
|
||||
<td>If you are changing your password, enter it twice to ensure it is correct.</td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td>E-mail:</td>
|
||||
<td><% "email" component render-edit %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td></td>
|
||||
<td>Specifying an e-mail address is optional. It enables the "recover password" feature.</td>
|
||||
</tr>
|
||||
|
||||
</table>
|
||||
|
||||
<p><input type="submit" value="Update" />
|
||||
|
||||
<% {
|
||||
{ [ login-failed? get ] [ "invalid password" render-error ] }
|
||||
{ [ password-mismatch? get ] [ "passwords do not match" render-error ] }
|
||||
{ [ t ] [ ] }
|
||||
} cond %>
|
||||
|
||||
</p>
|
||||
|
||||
</form>
|
||||
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1,77 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
|
||||
<t:title>Edit Profile</t:title>
|
||||
|
||||
<t:form action="edit-profile">
|
||||
|
||||
<table>
|
||||
|
||||
<tr>
|
||||
<th class="field-label">User name:</th>
|
||||
<td><t:view component="username" /></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<th class="field-label">Real name:</th>
|
||||
<td><t:edit component="realname" /></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td></td>
|
||||
<td>Specifying a real name is optional.</td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<th class="field-label">Current password:</th>
|
||||
<td><t:edit component="password" /></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td></td>
|
||||
<td>If you don't want to change your current password, leave this field blank.</td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<th class="field-label">New password:</th>
|
||||
<td><t:edit component="new-password" /></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<th class="field-label">Verify:</th>
|
||||
<td><t:edit component="verify-password" /></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td></td>
|
||||
<td>If you are changing your password, enter it twice to ensure it is correct.</td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<th class="field-label">E-mail:</th>
|
||||
<td><t:edit component="email" /></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td></td>
|
||||
<td>Specifying an e-mail address is optional. It enables the "recover password" feature.</td>
|
||||
</tr>
|
||||
|
||||
</table>
|
||||
|
||||
<p>
|
||||
<input type="submit" value="Update" />
|
||||
|
||||
<t:if var="http.server.auth.login:login-failed?">
|
||||
<t:error>invalid password</t:error>
|
||||
</t:if>
|
||||
|
||||
<t:if var="http.server.auth.login:password-mismatch?">
|
||||
<t:error>passwords do not match</t:error>
|
||||
</t:if>
|
||||
</p>
|
||||
|
||||
</t:form>
|
||||
|
||||
</t:chloe>
|
||||
|
|
@ -15,7 +15,9 @@ http.server.actions
|
|||
http.server.components
|
||||
http.server.forms
|
||||
http.server.sessions
|
||||
http.server.templating.fhtml
|
||||
http.server.boilerplate
|
||||
http.server.templating
|
||||
http.server.templating.chloe
|
||||
http.server.validators ;
|
||||
IN: http.server.auth.login
|
||||
QUALIFIED: smtp
|
||||
|
|
@ -40,11 +42,15 @@ M: user-saver dispose
|
|||
: save-user-after ( user -- )
|
||||
<user-saver> add-always-destructor ;
|
||||
|
||||
: login-template ( name -- template )
|
||||
"resource:extra/http/server/auth/login/" swap ".xml"
|
||||
3append <chloe> ;
|
||||
|
||||
! ! ! Login
|
||||
|
||||
: <login-form>
|
||||
"login" <form>
|
||||
"resource:extra/http/server/auth/login/login.fhtml" >>edit-template
|
||||
"login" login-template >>edit-template
|
||||
"username" <username>
|
||||
t >>required
|
||||
add-field
|
||||
|
|
@ -62,10 +68,7 @@ M: user-saver dispose
|
|||
<action>
|
||||
[ blank-values ] >>init
|
||||
|
||||
[
|
||||
"text/html" <content>
|
||||
[ form edit-form ] >>body
|
||||
] >>display
|
||||
[ form edit-form ] >>display
|
||||
|
||||
[
|
||||
blank-values
|
||||
|
|
@ -86,7 +89,7 @@ M: user-saver dispose
|
|||
|
||||
: <register-form> ( -- form )
|
||||
"register" <form>
|
||||
"resource:extra/http/server/auth/login/register.fhtml" >>edit-template
|
||||
"register" login-template >>edit-template
|
||||
"username" <username>
|
||||
t >>required
|
||||
add-field
|
||||
|
|
@ -114,10 +117,7 @@ SYMBOL: user-exists?
|
|||
<action>
|
||||
[ blank-values ] >>init
|
||||
|
||||
[
|
||||
"text/html" <content>
|
||||
[ form edit-form ] >>body
|
||||
] >>display
|
||||
[ form edit-form ] >>display
|
||||
|
||||
[
|
||||
blank-values
|
||||
|
|
@ -147,7 +147,7 @@ SYMBOL: user-exists?
|
|||
|
||||
: <edit-profile-form> ( -- form )
|
||||
"edit-profile" <form>
|
||||
"resource:extra/http/server/auth/login/edit-profile.fhtml" >>edit-template
|
||||
"edit-profile" login-template >>edit-template
|
||||
"username" <username> add-field
|
||||
"realname" <string> add-field
|
||||
"password" <password> add-field
|
||||
|
|
@ -168,10 +168,7 @@ SYMBOL: previous-page
|
|||
dup email>> "email" set-value
|
||||
] >>init
|
||||
|
||||
[
|
||||
"text/html" <content>
|
||||
[ form edit-form ] >>body
|
||||
] >>display
|
||||
[ form edit-form ] >>display
|
||||
|
||||
[
|
||||
blank-values
|
||||
|
|
@ -242,7 +239,7 @@ SYMBOL: lost-password-from
|
|||
|
||||
: <recover-form-1> ( -- form )
|
||||
"register" <form>
|
||||
"resource:extra/http/server/auth/login/recover-1.fhtml" >>edit-template
|
||||
"recover-1" login-template >>edit-template
|
||||
"username" <username>
|
||||
t >>required
|
||||
add-field
|
||||
|
|
@ -256,10 +253,7 @@ SYMBOL: lost-password-from
|
|||
<action>
|
||||
[ blank-values ] >>init
|
||||
|
||||
[
|
||||
"text/html" <content>
|
||||
[ form edit-form ] >>body
|
||||
] >>display
|
||||
[ form edit-form ] >>display
|
||||
|
||||
[
|
||||
blank-values
|
||||
|
|
@ -271,13 +265,13 @@ SYMBOL: lost-password-from
|
|||
send-password-email
|
||||
] when*
|
||||
|
||||
"resource:extra/http/server/auth/login/recover-2.fhtml" serve-template
|
||||
"recover-2" login-template serve-template
|
||||
] >>submit
|
||||
] ;
|
||||
|
||||
: <recover-form-3>
|
||||
"new-password" <form>
|
||||
"resource:extra/http/server/auth/login/recover-3.fhtml" >>edit-template
|
||||
"recover-3" login-template >>edit-template
|
||||
"username" <username>
|
||||
hidden >>renderer
|
||||
t >>required
|
||||
|
|
@ -308,10 +302,7 @@ SYMBOL: lost-password-from
|
|||
] H{ } make-assoc values set
|
||||
] >>init
|
||||
|
||||
[
|
||||
"text/html" <content>
|
||||
[ <recover-form-3> edit-form ] >>body
|
||||
] >>display
|
||||
[ <recover-form-3> edit-form ] >>display
|
||||
|
||||
[
|
||||
blank-values
|
||||
|
|
@ -326,8 +317,7 @@ SYMBOL: lost-password-from
|
|||
"new-password" value >>password
|
||||
users update-user
|
||||
|
||||
"resource:extra/http/server/auth/login/recover-4.fhtml"
|
||||
serve-template
|
||||
"recover-4" login-template serve-template
|
||||
] [
|
||||
<400>
|
||||
] if*
|
||||
|
|
@ -367,24 +357,32 @@ M: login call-responder ( path responder -- response )
|
|||
dup login set
|
||||
call-next-method ;
|
||||
|
||||
: <login-boilerplate> ( responder -- responder' )
|
||||
<boilerplate>
|
||||
"boilerplate" login-template >>template ;
|
||||
|
||||
: <login> ( responder -- auth )
|
||||
login new-dispatcher
|
||||
swap <protected> >>default
|
||||
<login-action> "login" add-responder
|
||||
<logout-action> "logout" add-responder
|
||||
<login-action> <login-boilerplate> "login" add-responder
|
||||
<logout-action> <login-boilerplate> "logout" add-responder
|
||||
no-users >>users ;
|
||||
|
||||
! ! ! Configuration
|
||||
|
||||
: allow-edit-profile ( login -- login )
|
||||
<edit-profile-action> <protected> "edit-profile" add-responder ;
|
||||
<edit-profile-action> <protected> <login-boilerplate>
|
||||
"edit-profile" add-responder ;
|
||||
|
||||
: allow-registration ( login -- login )
|
||||
<register-action> "register" add-responder ;
|
||||
<register-action> <login-boilerplate>
|
||||
"register" add-responder ;
|
||||
|
||||
: allow-password-recovery ( login -- login )
|
||||
<recover-action-1> "recover-password" add-responder
|
||||
<recover-action-3> "new-password" add-responder ;
|
||||
<recover-action-1> <login-boilerplate>
|
||||
"recover-password" add-responder
|
||||
<recover-action-3> <login-boilerplate>
|
||||
"new-password" add-responder ;
|
||||
|
||||
: allow-edit-profile? ( -- ? )
|
||||
login get responders>> "edit-profile" swap key? ;
|
||||
|
|
|
|||
|
|
@ -1,46 +0,0 @@
|
|||
<% USING: http.server.auth.login http.server.components http.server
|
||||
kernel namespaces ; %>
|
||||
<html>
|
||||
<body>
|
||||
<h1>Login required</h1>
|
||||
|
||||
<form method="POST" action="login">
|
||||
|
||||
<% hidden-form-field %>
|
||||
|
||||
<table>
|
||||
|
||||
<tr>
|
||||
<td>User name:</td>
|
||||
<td><% "username" component render-edit %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td>Password:</td>
|
||||
<td><% "password" component render-edit %></td>
|
||||
</tr>
|
||||
|
||||
</table>
|
||||
|
||||
<p><input type="submit" value="Log in" />
|
||||
<%
|
||||
login-failed? get
|
||||
[ "Invalid username or password" render-error ] when
|
||||
%>
|
||||
</p>
|
||||
|
||||
</form>
|
||||
|
||||
<p>
|
||||
<% allow-registration? [ %>
|
||||
<a href="<% "register" f write-link %>">Register</a>
|
||||
<% ] when %>
|
||||
<% allow-password-recovery? [ %>
|
||||
<a href="<% "recover-password" f write-link %>">
|
||||
Recover Password
|
||||
</a>
|
||||
<% ] when %>
|
||||
</p>
|
||||
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1,44 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
|
||||
<t:title>Login</t:title>
|
||||
|
||||
<t:form action="login">
|
||||
|
||||
<table>
|
||||
|
||||
<tr>
|
||||
<th class="field-label">User name:</th>
|
||||
<td><t:edit component="username" /></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<th class="field-label">Password:</th>
|
||||
<td><t:edit component="password" /></td>
|
||||
</tr>
|
||||
|
||||
</table>
|
||||
|
||||
<p>
|
||||
|
||||
<input type="submit" value="Log in" />
|
||||
|
||||
<t:if var="http.server.auth.login:login-failed?">
|
||||
<t:error>invalid username or password</t:error>
|
||||
</t:if>
|
||||
</p>
|
||||
|
||||
</t:form>
|
||||
|
||||
<p>
|
||||
<t:if code="http.server.auth.login:login-failed?">
|
||||
<t:a href="register">Register</t:a>
|
||||
</t:if>
|
||||
|
|
||||
<t:if code="http.server.auth.login:allow-password-recovery?">
|
||||
<t:a href="recover-password">Recover Password</t:a>
|
||||
</t:if>
|
||||
</p>
|
||||
|
||||
</t:chloe>
|
||||
|
|
@ -1,41 +0,0 @@
|
|||
<% USING: http.server.components http.server ; %>
|
||||
<html>
|
||||
<body>
|
||||
<h1>Recover lost password: step 1 of 4</h1>
|
||||
|
||||
<p>Enter the username and e-mail address you used to register for this site, and you will receive a link for activating a new password.</p>
|
||||
|
||||
<form method="POST" action="recover-password">
|
||||
|
||||
<% hidden-form-field %>
|
||||
|
||||
<table>
|
||||
|
||||
<tr>
|
||||
<td>User name:</td>
|
||||
<td><% "username" component render-edit %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td>E-mail:</td>
|
||||
<td><% "email" component render-edit %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td>Captcha:</td>
|
||||
<td><% "captcha" component render-edit %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td></td>
|
||||
<td>Leave the captcha blank. Spam-bots will fill it indiscriminantly, so their attempts to e-mail you will be blocked.</td>
|
||||
</tr>
|
||||
|
||||
</table>
|
||||
|
||||
<input type="submit" value="Recover password" />
|
||||
|
||||
</form>
|
||||
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1,39 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
|
||||
<t:title>Recover lost password: step 1 of 4</t:title>
|
||||
|
||||
<p>Enter the username and e-mail address you used to register for this site, and you will receive a link for activating a new password.</p>
|
||||
|
||||
<t:form action="recover-password">
|
||||
|
||||
<table>
|
||||
|
||||
<tr>
|
||||
<th class="field-label">User name:</th>
|
||||
<td><t:edit component="username" /></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<th class="field-label">E-mail:</th>
|
||||
<td><t:edit component="email" /></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<th class="field-label">Captcha:</th>
|
||||
<td><t:edit component="captcha" /></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td></td>
|
||||
<td>Leave the captcha blank. Spam-bots will fill it indiscriminantly, so their attempts to e-mail you will be blocked.</td>
|
||||
</tr>
|
||||
|
||||
</table>
|
||||
|
||||
<input type="submit" value="Recover password" />
|
||||
|
||||
</t:form>
|
||||
|
||||
</t:chloe>
|
||||
|
|
@ -1,9 +0,0 @@
|
|||
<% USING: http.server.components ; %>
|
||||
<html>
|
||||
<body>
|
||||
<h1>Recover lost password: step 2 of 4</h1>
|
||||
|
||||
<p>If you entered the correct username and e-mail address, you should receive an e-mail shortly. Click the link in the e-mail for further instructions.</p>
|
||||
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
|
||||
<t:title>Recover lost password: step 2 of 4</t:title>
|
||||
|
||||
<p>If you entered the correct username and e-mail address, you should receive an e-mail shortly. Click the link in the e-mail for further instructions.</p>
|
||||
|
||||
</t:chloe>
|
||||
|
|
@ -1,46 +0,0 @@
|
|||
<% USING: http.server.components http.server.auth.login http.server
|
||||
namespaces kernel combinators ; %>
|
||||
<html>
|
||||
<body>
|
||||
<h1>Recover lost password: step 3 of 4</h1>
|
||||
|
||||
<p>Choose a new password for your account.</p>
|
||||
|
||||
<form method="POST" action="new-password">
|
||||
|
||||
<% hidden-form-field %>
|
||||
|
||||
<table>
|
||||
|
||||
<% "username" component render-edit %>
|
||||
<% "ticket" component render-edit %>
|
||||
|
||||
<tr>
|
||||
<td>Password:</td>
|
||||
<td><% "new-password" component render-edit %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td>Verify password:</td>
|
||||
<td><% "verify-password" component render-edit %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td></td>
|
||||
<td>Enter your password twice to ensure it is correct.</td>
|
||||
</tr>
|
||||
|
||||
</table>
|
||||
|
||||
<p><input type="submit" value="Set password" />
|
||||
|
||||
<% password-mismatch? get [
|
||||
"passwords do not match" render-error
|
||||
] when %>
|
||||
|
||||
</p>
|
||||
|
||||
</form>
|
||||
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1,43 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
|
||||
<t:title>Recover lost password: step 3 of 4</t:title>
|
||||
|
||||
<p>Choose a new password for your account.</p>
|
||||
|
||||
<t:form action="new-password">
|
||||
|
||||
<table>
|
||||
|
||||
<t:edit component="username" />
|
||||
<t:edit component="ticket" />
|
||||
|
||||
<tr>
|
||||
<th class="field-label">Password:</th>
|
||||
<td><t:edit component="new-password" /></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<th class="field-label">Verify password:</th>
|
||||
<td><t:edit component="verify-password" /></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td></td>
|
||||
<td>Enter your password twice to ensure it is correct.</td>
|
||||
</tr>
|
||||
|
||||
</table>
|
||||
|
||||
<p>
|
||||
<input type="submit" value="Set password" />
|
||||
|
||||
<t:if var="http.server.auth.login:password-mismatch?">
|
||||
<t:error>passwords do not match</t:error>
|
||||
</t:if>
|
||||
</p>
|
||||
|
||||
</t:form>
|
||||
|
||||
</t:chloe>
|
||||
|
|
@ -1,10 +0,0 @@
|
|||
<% USING: http.server ; %>
|
||||
<html>
|
||||
<body>
|
||||
<h1>Recover lost password: step 4 of 4</h1>
|
||||
|
||||
<p>Your password has been reset.
|
||||
You may now <a href="<% "login" f write-link %>">log in</a>.</p>
|
||||
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
|
||||
<t:title>Recover lost password: step 4 of 4</t:title>
|
||||
|
||||
<p>Your password has been reset. You may now <t:a href="login">log in</t:a>.</p>
|
||||
|
||||
</t:chloe>
|
||||
|
|
@ -1,77 +0,0 @@
|
|||
<% USING: http.server.components http.server.auth.login
|
||||
http.server namespaces kernel combinators ; %>
|
||||
<html>
|
||||
<body>
|
||||
<h1>New user registration</h1>
|
||||
|
||||
<form method="POST" action="register">
|
||||
<% hidden-form-field %>
|
||||
|
||||
<table>
|
||||
|
||||
<tr>
|
||||
<td>User name:</td>
|
||||
<td><% "username" component render-edit %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td>Real name:</td>
|
||||
<td><% "realname" component render-edit %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td></td>
|
||||
<td>Specifying a real name is optional.</td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td>Password:</td>
|
||||
<td><% "new-password" component render-edit %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td>Verify:</td>
|
||||
<td><% "verify-password" component render-edit %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td></td>
|
||||
<td>Enter your password twice to ensure it is correct.</td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td>E-mail:</td>
|
||||
<td><% "email" component render-edit %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td></td>
|
||||
<td>Specifying an e-mail address is optional. It enables the "recover password" feature.</td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td>Captcha:</td>
|
||||
<td><% "captcha" component render-edit %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td></td>
|
||||
<td>Leave the captcha blank. Spam-bots will fill it indiscriminantly, so their attempts to register will be blocked.</td>
|
||||
</tr>
|
||||
|
||||
</table>
|
||||
|
||||
<p><input type="submit" value="Register" />
|
||||
|
||||
<% {
|
||||
{ [ password-mismatch? get ] [ "passwords do not match" render-error ] }
|
||||
{ [ user-exists? get ] [ "username taken" render-error ] }
|
||||
{ [ t ] [ ] }
|
||||
} cond %>
|
||||
|
||||
</p>
|
||||
|
||||
</form>
|
||||
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1,79 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
|
||||
<t:title>New User Registration</t:title>
|
||||
|
||||
<t:form action="register">
|
||||
|
||||
<table>
|
||||
|
||||
<tr>
|
||||
<th class="field-label">User name:</th>
|
||||
<td><t:edit component="username" /></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<th class="field-label">Real name:</th>
|
||||
<td><t:edit component="realname" /></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td></td>
|
||||
<td>Specifying a real name is optional.</td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<th class="field-label">Password:</th>
|
||||
<td><t:edit component="new-password" /></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<th class="field-label">Verify:</th>
|
||||
<td><t:edit component="verify-password" /></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td></td>
|
||||
<td>Enter your password twice to ensure it is correct.</td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<th class="field-label">E-mail:</th>
|
||||
<td><t:edit component="email" /></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td></td>
|
||||
<td>Specifying an e-mail address is optional. It enables the "recover password" feature.</td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<th class="field-label">Captcha:</th>
|
||||
<td><t:edit component="captcha" /></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td></td>
|
||||
<td>Leave the captcha blank. Spam-bots will fill it indiscriminantly, so their attempts to register will be blocked.</td>
|
||||
</tr>
|
||||
|
||||
</table>
|
||||
|
||||
<p>
|
||||
|
||||
<input type="submit" value="Register" />
|
||||
|
||||
<t:if var="http.server.auth.login:user-exists?">
|
||||
<t:error>username taken</t:error>
|
||||
</t:if>
|
||||
|
||||
<t:if var="http.server.auth.login:password-mismatch?">
|
||||
<t:error>passwords do not match</t:error>
|
||||
</t:if>
|
||||
|
||||
</p>
|
||||
|
||||
</t:form>
|
||||
|
||||
</t:chloe>
|
||||
|
|
@ -0,0 +1,58 @@
|
|||
! Copyright (c) 2008 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel namespaces boxes sequences strings
|
||||
io io.streams.string
|
||||
http
|
||||
http.server
|
||||
http.server.templating ;
|
||||
IN: http.server.boilerplate
|
||||
|
||||
TUPLE: boilerplate responder template ;
|
||||
|
||||
: <boilerplate> f boilerplate boa ;
|
||||
|
||||
SYMBOL: title
|
||||
|
||||
: set-title ( string -- )
|
||||
title get >box ;
|
||||
|
||||
: write-title ( -- )
|
||||
title get value>> write ;
|
||||
|
||||
SYMBOL: style
|
||||
|
||||
: add-style ( string -- )
|
||||
"\n" style get push-all
|
||||
style get push-all ;
|
||||
|
||||
: write-style ( -- )
|
||||
style get >string write ;
|
||||
|
||||
SYMBOL: nested-template?
|
||||
|
||||
SYMBOL: next-template
|
||||
|
||||
: call-next-template ( -- )
|
||||
next-template get write ;
|
||||
|
||||
M: f call-template drop call-next-template ;
|
||||
|
||||
: with-boilerplate ( body template -- )
|
||||
[
|
||||
title get [ <box> title set ] unless
|
||||
style get [ SBUF" " clone style set ] unless
|
||||
|
||||
[
|
||||
[
|
||||
nested-template? on
|
||||
write-response-body*
|
||||
] with-string-writer
|
||||
next-template set
|
||||
]
|
||||
[ call-template ]
|
||||
bi*
|
||||
] with-scope ; inline
|
||||
|
||||
M: boilerplate call-responder
|
||||
[ responder>> call-responder clone ] [ template>> ] bi
|
||||
[ [ with-boilerplate ] 2curry ] curry change-body ;
|
||||
|
|
@ -1,11 +1,10 @@
|
|||
IN: http.server.components.tests
|
||||
USING: http.server.components http.server.forms
|
||||
http.server.validators namespaces tools.test kernel accessors
|
||||
tuple-syntax mirrors http.server.actions
|
||||
tuple-syntax mirrors
|
||||
http http.server.actions http.server.templating.fhtml
|
||||
io.streams.string io.streams.null ;
|
||||
|
||||
\ render-edit must-infer
|
||||
|
||||
validation-failed? off
|
||||
|
||||
[ 3 ] [ "3" "n" <number> validate ] unit-test
|
||||
|
|
@ -49,8 +48,8 @@ TUPLE: test-tuple text number more-text ;
|
|||
|
||||
: <test-form> ( -- form )
|
||||
"test" <form>
|
||||
"resource:extra/http/server/components/test/form.fhtml" >>view-template
|
||||
"resource:extra/http/server/components/test/form.fhtml" >>edit-template
|
||||
"resource:extra/http/server/components/test/form.fhtml" <fhtml> >>view-template
|
||||
"resource:extra/http/server/components/test/form.fhtml" <fhtml> >>edit-template
|
||||
"text" <string>
|
||||
t >>required
|
||||
add-field
|
||||
|
|
@ -64,9 +63,9 @@ TUPLE: test-tuple text number more-text ;
|
|||
"hi" >>default
|
||||
add-field ;
|
||||
|
||||
[ ] [ <test-tuple> <mirror> values set <test-form> view-form ] unit-test
|
||||
[ ] [ <test-tuple> <mirror> values set <test-form> view-form write-response-body drop ] unit-test
|
||||
|
||||
[ ] [ <test-tuple> <mirror> values set <test-form> edit-form ] unit-test
|
||||
[ ] [ <test-tuple> <mirror> values set <test-form> edit-form write-response-body drop ] unit-test
|
||||
|
||||
[ TUPLE{ test-tuple number: 123 more-text: "hi" } ] [
|
||||
<test-tuple> from-tuple
|
||||
|
|
|
|||
|
|
@ -7,9 +7,12 @@ continuations math ;
|
|||
IN: http.server.components
|
||||
|
||||
! Renderer protocol
|
||||
GENERIC: render-summary* ( value renderer -- )
|
||||
GENERIC: render-view* ( value renderer -- )
|
||||
GENERIC: render-edit* ( value id renderer -- )
|
||||
|
||||
M: object render-summary* render-view* ;
|
||||
|
||||
TUPLE: field type ;
|
||||
|
||||
C: <field> field
|
||||
|
|
@ -203,22 +206,67 @@ M: captcha validate*
|
|||
drop v-captcha ;
|
||||
|
||||
! Text areas
|
||||
TUPLE: textarea-renderer ;
|
||||
TUPLE: textarea-renderer rows cols ;
|
||||
|
||||
: textarea-renderer T{ textarea-renderer } ;
|
||||
: new-textarea-renderer ( class -- renderer )
|
||||
new
|
||||
60 >>cols
|
||||
20 >>rows ;
|
||||
|
||||
: <textarea-renderer> ( -- renderer )
|
||||
textarea-renderer new-textarea-renderer ;
|
||||
|
||||
M: textarea-renderer render-view*
|
||||
drop write ;
|
||||
|
||||
M: textarea-renderer render-edit*
|
||||
drop <textarea [ =id ] [ =name ] bi textarea> write </textarea> ;
|
||||
<textarea
|
||||
[ rows>> [ number>string =rows ] when* ]
|
||||
[ cols>> [ number>string =cols ] when* ] bi
|
||||
[ =id ]
|
||||
[ =name ] bi
|
||||
textarea>
|
||||
write
|
||||
</textarea> ;
|
||||
|
||||
TUPLE: text < string ;
|
||||
|
||||
: new-text ( id class -- component )
|
||||
new-string
|
||||
f >>one-line
|
||||
textarea-renderer >>renderer ;
|
||||
<textarea-renderer> >>renderer ;
|
||||
|
||||
: <text> ( id -- component )
|
||||
text new-text ;
|
||||
|
||||
! List components
|
||||
SYMBOL: +plain+
|
||||
SYMBOL: +ordered+
|
||||
SYMBOL: +unordered+
|
||||
|
||||
TUPLE: list-renderer component type ;
|
||||
|
||||
C: <list-renderer> list-renderer
|
||||
|
||||
: render-list ( value component -- )
|
||||
[ render-summary* ] curry each ;
|
||||
|
||||
: render-ordered-list ( value component -- )
|
||||
[ <li> render-summary* </li> ] curry each ;
|
||||
|
||||
: render-unordered-list ( value component -- )
|
||||
[ <li> render-summary* </li> ] curry each ;
|
||||
|
||||
M: list-renderer render-view*
|
||||
[ component>> ] [ type>> ] bi {
|
||||
{ +plain+ [ render-list ] }
|
||||
{ +ordered+ [ <ol> render-ordered-list </ol> ] }
|
||||
{ +unordered+ [ <ul> render-unordered-list </ul> ] }
|
||||
} case ;
|
||||
|
||||
TUPLE: list < component ;
|
||||
|
||||
: <list> ( id component type -- list )
|
||||
<list-renderer> list swap new-component ;
|
||||
|
||||
M: list component-string drop ;
|
||||
|
|
|
|||
|
|
@ -6,11 +6,12 @@ IN: http.server.components.farkup
|
|||
|
||||
TUPLE: farkup-renderer < textarea-renderer ;
|
||||
|
||||
: farkup-renderer T{ farkup-renderer } ;
|
||||
: <farkup-renderer>
|
||||
farkup-renderer new-textarea-renderer ;
|
||||
|
||||
M: farkup-renderer render-view*
|
||||
drop string-lines "\n" join convert-farkup write ;
|
||||
|
||||
: <farkup> ( id -- component )
|
||||
<text>
|
||||
farkup-renderer >>renderer ;
|
||||
<farkup-renderer> >>renderer ;
|
||||
|
|
|
|||
|
|
@ -15,49 +15,33 @@ IN: http.server.crud
|
|||
|
||||
[ "id" get ctor call select-tuple from-tuple ] >>init
|
||||
|
||||
[
|
||||
"text/html" <content>
|
||||
[ form view-form ] >>body
|
||||
] >>display ;
|
||||
[ form view-form ] >>display ;
|
||||
|
||||
: <id-redirect> ( id next -- response )
|
||||
swap number>string "id" associate <permanent-redirect> ;
|
||||
|
||||
:: <create-action> ( form ctor next -- action )
|
||||
<action>
|
||||
[ f ctor call from-tuple form set-defaults ] >>init
|
||||
|
||||
[
|
||||
"text/html" <content>
|
||||
[ form edit-form ] >>body
|
||||
] >>display
|
||||
|
||||
[
|
||||
f ctor call from-tuple
|
||||
|
||||
form validate-form
|
||||
|
||||
values-tuple insert-tuple
|
||||
|
||||
"id" value next <id-redirect>
|
||||
] >>submit ;
|
||||
|
||||
:: <edit-action> ( form ctor next -- action )
|
||||
<action>
|
||||
{ { "id" [ v-number ] } } >>get-params
|
||||
[ "id" get ctor call select-tuple from-tuple ] >>init
|
||||
{ { "id" [ [ v-number ] v-optional ] } } >>get-params
|
||||
|
||||
[
|
||||
"text/html" <content>
|
||||
[ form edit-form ] >>body
|
||||
] >>display
|
||||
"id" get ctor call
|
||||
|
||||
"id" get
|
||||
[ select-tuple from-tuple ]
|
||||
[ from-tuple form set-defaults ]
|
||||
if
|
||||
] >>init
|
||||
|
||||
[ form edit-form ] >>display
|
||||
|
||||
[
|
||||
f ctor call from-tuple
|
||||
|
||||
form validate-form
|
||||
|
||||
values-tuple update-tuple
|
||||
values-tuple
|
||||
"id" value [ update-tuple ] [ insert-tuple ] if
|
||||
|
||||
"id" value next <id-redirect>
|
||||
] >>submit ;
|
||||
|
|
@ -71,3 +55,13 @@ IN: http.server.crud
|
|||
|
||||
next f <permanent-redirect>
|
||||
] >>submit ;
|
||||
|
||||
:: <list-action> ( form ctor -- action )
|
||||
<action>
|
||||
[
|
||||
blank-values
|
||||
|
||||
f ctor call select-tuples "list" set-value
|
||||
|
||||
form view-form
|
||||
] >>display ;
|
||||
|
|
|
|||
|
|
@ -1,11 +1,16 @@
|
|||
USING: kernel accessors assocs namespaces io.files fry
|
||||
! Copyright (C) 2008 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel accessors assocs namespaces io.files sequences fry
|
||||
http.server
|
||||
http.server.actions
|
||||
http.server.components
|
||||
http.server.validators
|
||||
http.server.templating.fhtml ;
|
||||
http.server.templating ;
|
||||
IN: http.server.forms
|
||||
|
||||
TUPLE: form < component view-template edit-template components ;
|
||||
TUPLE: form < component
|
||||
view-template edit-template summary-template
|
||||
components ;
|
||||
|
||||
M: form init V{ } clone >>components ;
|
||||
|
||||
|
|
@ -15,8 +20,11 @@ M: form init V{ } clone >>components ;
|
|||
: add-field ( form component -- form )
|
||||
dup id>> pick components>> set-at ;
|
||||
|
||||
: set-components ( form -- )
|
||||
components>> components set ;
|
||||
|
||||
: with-form ( form quot -- )
|
||||
>r components>> components r> with-variable ; inline
|
||||
[ [ set-components ] [ call ] bi* ] with-scope ; inline
|
||||
|
||||
: set-defaults ( form -- )
|
||||
[
|
||||
|
|
@ -27,11 +35,16 @@ M: form init V{ } clone >>components ;
|
|||
] assoc-each
|
||||
] with-form ;
|
||||
|
||||
: view-form ( form -- )
|
||||
dup view-template>> '[ , run-template ] with-form ;
|
||||
: <form-response> ( form template -- response )
|
||||
[ components>> components set ]
|
||||
[ "text/html" <content> swap >>body ]
|
||||
bi* ;
|
||||
|
||||
: edit-form ( form -- )
|
||||
dup edit-template>> '[ , run-template ] with-form ;
|
||||
: view-form ( form -- response )
|
||||
dup view-template>> <form-response> ;
|
||||
|
||||
: edit-form ( form -- response )
|
||||
dup edit-template>> <form-response> ;
|
||||
|
||||
: validate-param ( id component -- )
|
||||
[ [ params get at ] [ validate ] bi* ]
|
||||
|
|
@ -46,3 +59,20 @@ M: form init V{ } clone >>components ;
|
|||
|
||||
: validate-form ( form -- )
|
||||
(validate-form) [ validation-failed ] when ;
|
||||
|
||||
: render-form ( value form template -- )
|
||||
[
|
||||
[ from-tuple ]
|
||||
[ set-components ]
|
||||
[ call-template ]
|
||||
tri*
|
||||
] with-scope ;
|
||||
|
||||
M: form render-summary*
|
||||
dup summary-template>> render-form ;
|
||||
|
||||
M: form render-view*
|
||||
dup view-template>> render-form ;
|
||||
|
||||
M: form render-edit*
|
||||
dup edit-template>> render-form ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,97 @@
|
|||
USING: http.server.templating http.server.templating.chloe
|
||||
http.server.components http.server.boilerplate tools.test
|
||||
io.streams.string kernel sequences ascii boxes namespaces xml
|
||||
splitting ;
|
||||
IN: http.server.templating.chloe.tests
|
||||
|
||||
[ "foo" ]
|
||||
[ "<a href=\"foo\">blah</a>" string>xml "href" required-attr ]
|
||||
unit-test
|
||||
|
||||
[ "<a name=\"foo\">blah</a>" string>xml "href" required-attr ]
|
||||
[ "href attribute is required" = ]
|
||||
must-fail-with
|
||||
|
||||
[ f ] [ f parse-query-attr ] unit-test
|
||||
|
||||
[ f ] [ "" parse-query-attr ] unit-test
|
||||
|
||||
[ H{ { "a" "b" } } ] [
|
||||
blank-values
|
||||
"b" "a" set-value
|
||||
"a" parse-query-attr
|
||||
] unit-test
|
||||
|
||||
[ H{ { "a" "b" } { "c" "d" } } ] [
|
||||
blank-values
|
||||
"b" "a" set-value
|
||||
"d" "c" set-value
|
||||
"a,c" parse-query-attr
|
||||
] unit-test
|
||||
|
||||
: run-template
|
||||
with-string-writer [ "\r\n\t" member? not ] subset
|
||||
"?>" split1 nip ; inline
|
||||
|
||||
: test-template ( name -- template )
|
||||
"resource:extra/http/server/templating/chloe/test/"
|
||||
swap
|
||||
".xml" 3append <chloe> ;
|
||||
|
||||
[ "Hello world" ] [
|
||||
[
|
||||
"test1" test-template call-template
|
||||
] run-template
|
||||
] unit-test
|
||||
|
||||
[ "Blah blah" "Hello world" ] [
|
||||
[
|
||||
<box> title set
|
||||
[
|
||||
"test2" test-template call-template
|
||||
] run-template
|
||||
title get box>
|
||||
] with-scope
|
||||
] unit-test
|
||||
|
||||
[ "<html><head><title>Hello world</title></head><body>Blah blah</body></html>" ] [
|
||||
[
|
||||
[
|
||||
"test2" test-template call-template
|
||||
] "test3" test-template with-boilerplate
|
||||
] run-template
|
||||
] unit-test
|
||||
|
||||
: test4-aux? t ;
|
||||
|
||||
[ "True" ] [
|
||||
[
|
||||
"test4" test-template call-template
|
||||
] run-template
|
||||
] unit-test
|
||||
|
||||
: test5-aux? f ;
|
||||
|
||||
[ "" ] [
|
||||
[
|
||||
"test5" test-template call-template
|
||||
] run-template
|
||||
] unit-test
|
||||
|
||||
SYMBOL: test6-aux?
|
||||
|
||||
[ "True" ] [
|
||||
[
|
||||
test6-aux? on
|
||||
"test6" test-template call-template
|
||||
] run-template
|
||||
] unit-test
|
||||
|
||||
SYMBOL: test7-aux?
|
||||
|
||||
[ "" ] [
|
||||
[
|
||||
test7-aux? off
|
||||
"test7" test-template call-template
|
||||
] run-template
|
||||
] unit-test
|
||||
|
|
@ -0,0 +1,174 @@
|
|||
USING: accessors kernel sequences combinators kernel namespaces
|
||||
classes.tuple assocs splitting words arrays
|
||||
io.files io.encodings.utf8 html.elements unicode.case
|
||||
tuple-syntax xml xml.data xml.writer xml.utilities
|
||||
http.server
|
||||
http.server.auth
|
||||
http.server.components
|
||||
http.server.sessions
|
||||
http.server.templating
|
||||
http.server.boilerplate ;
|
||||
IN: http.server.templating.chloe
|
||||
|
||||
! Chloe is Ed's favorite web designer
|
||||
|
||||
TUPLE: chloe path ;
|
||||
|
||||
C: <chloe> chloe
|
||||
|
||||
DEFER: process-template
|
||||
|
||||
: chloe-ns TUPLE{ name url: "http://factorcode.org/chloe/1.0" } ;
|
||||
|
||||
: chloe-tag? ( tag -- ? )
|
||||
{
|
||||
{ [ dup tag? not ] [ f ] }
|
||||
{ [ dup chloe-ns names-match? not ] [ f ] }
|
||||
[ t ]
|
||||
} cond nip ;
|
||||
|
||||
SYMBOL: tags
|
||||
|
||||
: required-attr ( tag name -- value )
|
||||
dup rot at*
|
||||
[ nip ] [ drop " attribute is required" append throw ] if ;
|
||||
|
||||
: optional-attr ( tag name -- value )
|
||||
swap at ;
|
||||
|
||||
: write-title-tag ( tag -- )
|
||||
drop
|
||||
"head" tags get member? "title" tags get member? not and
|
||||
[ <title> write-title </title> ] [ write-title ] if ;
|
||||
|
||||
: style-tag ( tag -- )
|
||||
dup "include" optional-attr dup [
|
||||
swap children>string empty? [
|
||||
"style tag cannot have both an include attribute and a body" throw
|
||||
] unless
|
||||
utf8 file-contents
|
||||
] [
|
||||
drop children>string
|
||||
] if add-style ;
|
||||
|
||||
: write-style-tag ( tag -- )
|
||||
drop <style> write-style </style> ;
|
||||
|
||||
: component-attr ( tag -- name )
|
||||
"component" required-attr ;
|
||||
|
||||
: view-tag ( tag -- )
|
||||
component-attr component render-view ;
|
||||
|
||||
: edit-tag ( tag -- )
|
||||
component-attr component render-edit ;
|
||||
|
||||
: parse-query-attr ( string -- assoc )
|
||||
dup empty?
|
||||
[ drop f ] [ "," split [ dup value ] H{ } map>assoc ] if ;
|
||||
|
||||
: a-start-tag ( tag -- )
|
||||
<a
|
||||
[ "href" required-attr ]
|
||||
[ "query" optional-attr parse-query-attr ]
|
||||
bi link>string =href
|
||||
a> ;
|
||||
|
||||
: process-tag-children ( tag -- )
|
||||
[ process-template ] each ;
|
||||
|
||||
: a-tag ( tag -- )
|
||||
[ a-start-tag ]
|
||||
[ process-tag-children ]
|
||||
[ drop </a> ]
|
||||
tri ;
|
||||
|
||||
: form-start-tag ( tag -- )
|
||||
<form
|
||||
"POST" =method
|
||||
tag-attrs print-attrs
|
||||
form>
|
||||
hidden-form-field ;
|
||||
|
||||
: form-tag ( tag -- )
|
||||
[ form-start-tag ]
|
||||
[ process-tag-children ]
|
||||
[ drop </form> ]
|
||||
tri ;
|
||||
|
||||
: attr>word ( value -- word/f )
|
||||
dup ":" split1 swap lookup
|
||||
[ ] [ "No such word: " swap append throw ] ?if ;
|
||||
|
||||
: attr>var ( value -- word/f )
|
||||
attr>word dup symbol? [
|
||||
"Must be a symbol: " swap append throw
|
||||
] unless ;
|
||||
|
||||
: if-satisfied? ( tag -- ? )
|
||||
{
|
||||
[ "code" optional-attr [ attr>word execute ] [ t ] if* ]
|
||||
[ "var" optional-attr [ attr>var get ] [ t ] if* ]
|
||||
[ "svar" optional-attr [ attr>var sget ] [ t ] if* ]
|
||||
[ "uvar" optional-attr [ attr>var uget ] [ t ] if* ]
|
||||
} cleave 4array [ ] all? ;
|
||||
|
||||
: if-tag ( tag -- )
|
||||
dup if-satisfied? [ process-tag-children ] [ drop ] if ;
|
||||
|
||||
: error-tag ( tag -- )
|
||||
children>string render-error ;
|
||||
|
||||
: process-chloe-tag ( tag -- )
|
||||
dup name-tag {
|
||||
{ "chloe" [ [ process-template ] each ] }
|
||||
{ "title" [ children>string set-title ] }
|
||||
{ "write-title" [ write-title-tag ] }
|
||||
{ "style" [ style-tag ] }
|
||||
{ "write-style" [ write-style-tag ] }
|
||||
{ "view" [ view-tag ] }
|
||||
{ "edit" [ edit-tag ] }
|
||||
{ "a" [ a-tag ] }
|
||||
{ "form" [ form-tag ] }
|
||||
{ "error" [ error-tag ] }
|
||||
{ "if" [ if-tag ] }
|
||||
{ "call-next-template" [ drop call-next-template ] }
|
||||
[ "Unknown chloe tag: " swap append throw ]
|
||||
} case ;
|
||||
|
||||
: process-tag ( tag -- )
|
||||
{
|
||||
[ name-tag >lower tags get push ]
|
||||
[ write-start-tag ]
|
||||
[ process-tag-children ]
|
||||
[ write-end-tag ]
|
||||
[ drop tags get pop* ]
|
||||
} cleave ;
|
||||
|
||||
: process-template ( xml -- )
|
||||
{
|
||||
{ [ dup [ chloe-tag? ] is? ] [ process-chloe-tag ] }
|
||||
{ [ dup [ tag? ] is? ] [ process-tag ] }
|
||||
{ [ t ] [ write-item ] }
|
||||
} cond ;
|
||||
|
||||
: process-chloe ( xml -- )
|
||||
[
|
||||
V{ } clone tags set
|
||||
|
||||
nested-template? get [
|
||||
process-template
|
||||
] [
|
||||
{
|
||||
[ xml-prolog write-prolog ]
|
||||
[ xml-before write-chunk ]
|
||||
[ process-template ]
|
||||
[ xml-after write-chunk ]
|
||||
} cleave
|
||||
] if
|
||||
] with-scope ;
|
||||
|
||||
M: chloe call-template
|
||||
path>> utf8 <file-reader> read-xml process-chloe ;
|
||||
|
||||
INSTANCE: chloe template
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
Hello world
|
||||
</t:chloe>
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
<t:title>Hello world</t:title>
|
||||
Blah blah
|
||||
</t:chloe>
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
<t:title>Hello world</t:title>
|
||||
</t:chloe>
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
<html>
|
||||
<head>
|
||||
<t:write-title />
|
||||
</head>
|
||||
<body>
|
||||
<t:call-next-template />
|
||||
</body>
|
||||
</html>
|
||||
</t:chloe>
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
|
||||
<t:if code="http.server.templating.chloe.tests:test4-aux?">
|
||||
True
|
||||
</t:if>
|
||||
|
||||
</t:chloe>
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
|
||||
<t:if code="http.server.templating.chloe.tests:test5-aux?">
|
||||
True
|
||||
</t:if>
|
||||
|
||||
</t:chloe>
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
|
||||
<t:if var="http.server.templating.chloe.tests:test6-aux?">
|
||||
True
|
||||
</t:if>
|
||||
|
||||
</t:chloe>
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
|
||||
<t:if var="http.server.templating.chloe.tests:test7-aux?">
|
||||
True
|
||||
</t:if>
|
||||
|
||||
</t:chloe>
|
||||
|
|
@ -1,13 +1,13 @@
|
|||
USING: io io.files io.streams.string io.encodings.utf8
|
||||
http.server.templating.fhtml kernel tools.test sequences
|
||||
parser ;
|
||||
http.server.templating http.server.templating.fhtml kernel
|
||||
tools.test sequences parser ;
|
||||
IN: http.server.templating.fhtml.tests
|
||||
|
||||
: test-template ( path -- ? )
|
||||
"resource:extra/http/server/templating/fhtml/test/"
|
||||
prepend
|
||||
[
|
||||
".fhtml" append [ run-template ] with-string-writer
|
||||
".fhtml" append <fhtml> [ call-template ] with-string-writer
|
||||
] keep
|
||||
".html" append utf8 file-contents = ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,12 +1,12 @@
|
|||
! Copyright (C) 2005 Alex Chapman
|
||||
! Copyright (C) 2006, 2008 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: continuations sequences kernel parser namespaces io
|
||||
io.files io.streams.string html html.elements source-files
|
||||
debugger combinators math quotations generic strings splitting
|
||||
accessors http.server.static http.server assocs
|
||||
io.encodings.utf8 fry accessors ;
|
||||
|
||||
USING: continuations sequences kernel namespaces debugger
|
||||
combinators math quotations generic strings splitting
|
||||
accessors assocs fry
|
||||
parser io io.files io.streams.string io.encodings.utf8 source-files
|
||||
html html.elements
|
||||
http.server.static http.server http.server.templating ;
|
||||
IN: http.server.templating.fhtml
|
||||
|
||||
: templating-vocab ( -- vocab-name ) "http.server.templating.fhtml" ;
|
||||
|
|
@ -72,9 +72,13 @@ DEFER: <% delimiter
|
|||
: html-error. ( error -- )
|
||||
<pre> error. </pre> ;
|
||||
|
||||
: run-template ( filename -- )
|
||||
TUPLE: fhtml path ;
|
||||
|
||||
C: <fhtml> fhtml
|
||||
|
||||
M: fhtml call-template ( filename -- )
|
||||
'[
|
||||
, [
|
||||
, path>> [
|
||||
"quiet" on
|
||||
parser-notes off
|
||||
templating-vocab use+
|
||||
|
|
@ -85,16 +89,10 @@ DEFER: <% delimiter
|
|||
] with-file-vocabs
|
||||
] assert-depth ;
|
||||
|
||||
: template-convert ( infile outfile -- )
|
||||
utf8 [ run-template ] with-file-writer ;
|
||||
|
||||
! responder integration
|
||||
: serve-template ( name -- response )
|
||||
"text/html" <content>
|
||||
swap '[ , run-template ] >>body ;
|
||||
|
||||
! file responder integration
|
||||
: enable-fhtml ( responder -- responder )
|
||||
[ serve-template ]
|
||||
[ <fhtml> serve-template ]
|
||||
"application/x-factor-server-page"
|
||||
pick special>> set-at ;
|
||||
|
||||
INSTANCE: fhtml template
|
||||
|
|
|
|||
|
|
@ -0,0 +1,17 @@
|
|||
USING: accessors kernel fry io.encodings.utf8 io.files
|
||||
http http.server ;
|
||||
IN: http.server.templating
|
||||
|
||||
MIXIN: template
|
||||
|
||||
GENERIC: call-template ( template -- )
|
||||
|
||||
M: template write-response-body* call-template ;
|
||||
|
||||
: template-convert ( template output -- )
|
||||
utf8 [ call-template ] with-file-writer ;
|
||||
|
||||
! responder integration
|
||||
: serve-template ( template -- response )
|
||||
"text/html" <content>
|
||||
swap '[ , call-template ] >>body ;
|
||||
|
|
@ -11,8 +11,7 @@ TUPLE: validation-error value reason ;
|
|||
C: <validation-error> validation-error
|
||||
|
||||
: with-validator ( value quot -- result )
|
||||
[ validation-failed? on <validation-error> ] recover ;
|
||||
inline
|
||||
[ validation-failed? on <validation-error> ] recover ; inline
|
||||
|
||||
: v-default ( str def -- str )
|
||||
over empty? spin ? ;
|
||||
|
|
@ -20,6 +19,9 @@ C: <validation-error> validation-error
|
|||
: v-required ( str -- str )
|
||||
dup empty? [ "required" throw ] when ;
|
||||
|
||||
: v-optional ( str quot -- str )
|
||||
over empty? [ 2drop f ] [ call ] if ; inline
|
||||
|
||||
: v-min-length ( str n -- str )
|
||||
over length over < [
|
||||
[ "must be at least " % # " characters" % ] "" make
|
||||
|
|
|
|||
|
|
@ -0,0 +1,33 @@
|
|||
! Copyright (c) 2008 Eric Mertens
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays assocs kernel math math.ranges sequences ;
|
||||
|
||||
IN: project-euler.164
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=164
|
||||
|
||||
! DESCRIPTION
|
||||
! -----------
|
||||
|
||||
! How many 20 digit numbers n (without any leading zero) exist such
|
||||
! that no three consecutive digits of n have a sum greater than 9?
|
||||
|
||||
! SOLUTION
|
||||
! --------
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: next-keys ( key -- keys )
|
||||
[ peek ] [ 10 swap sum - ] bi [ 2array ] with map ;
|
||||
|
||||
: next-table ( assoc -- assoc )
|
||||
H{ } clone swap
|
||||
[ swap next-keys [ pick at+ ] with each ] assoc-each ;
|
||||
|
||||
: init-table ( -- assoc )
|
||||
9 [1,b] [ 1array 1 ] H{ } map>assoc ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler164 ( -- n )
|
||||
init-table 19 [ next-table ] times values sum ;
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
|
||||
<t:title>Edit Item</t:title>
|
||||
|
||||
<t:form action="edit">
|
||||
<t:edit component="id" />
|
||||
|
||||
<table>
|
||||
<tr><th class="field-label">Summary: </th><td><t:edit component="summary" /></td></tr>
|
||||
<tr><th class="field-label">Priority: </th><td><t:edit component="priority" /></td></tr>
|
||||
<tr><th class="field-label big-field-label">Description:</th><td><t:edit component="description" /></td></tr>
|
||||
</table>
|
||||
|
||||
<input type="SUBMIT" value="Done" />
|
||||
</t:form>
|
||||
|
||||
<t:a href="view" query="id">View</t:a>
|
||||
|
|
||||
<t:form action="delete" class="inline">
|
||||
<t:edit component="id" />
|
||||
<button type="submit" class="link-button link">Delete</button>
|
||||
</t:form>
|
||||
|
||||
</t:chloe>
|
||||
|
|
@ -0,0 +1,45 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<!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">
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
|
||||
<head>
|
||||
<t:write-title />
|
||||
|
||||
<t:style>
|
||||
body, button {
|
||||
font:9pt "Lucida Grande", "Lucida Sans Unicode", verdana, geneva, sans-serif;
|
||||
color:#444;
|
||||
}
|
||||
|
||||
a, .link {
|
||||
color: #222;
|
||||
border-bottom:1px dotted #666;
|
||||
text-decoration:none;
|
||||
}
|
||||
|
||||
a:hover, .link:hover {
|
||||
border-bottom:1px solid #66a;
|
||||
}
|
||||
|
||||
.error { color: #a00; }
|
||||
|
||||
.field-label {
|
||||
text-align: right;
|
||||
}
|
||||
</t:style>
|
||||
|
||||
<t:write-style />
|
||||
</head>
|
||||
|
||||
<body>
|
||||
<t:call-next-template />
|
||||
</body>
|
||||
|
||||
</t:chloe>
|
||||
|
||||
</html>
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
|
||||
<t:title>My Todo List</t:title>
|
||||
|
||||
<table class="todo-list">
|
||||
<tr><th>Summary</th><th>Priority</th><th>View</th><th>Edit</th></tr>
|
||||
<t:view component="list" />
|
||||
</table>
|
||||
|
||||
</t:chloe>
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
|
||||
<tr>
|
||||
<td>
|
||||
<t:view component="summary" />
|
||||
</td>
|
||||
<td>
|
||||
<t:view component="priority" />
|
||||
</td>
|
||||
<td>
|
||||
<t:a href="view" query="id">View</t:a>
|
||||
</td>
|
||||
<td>
|
||||
<t:a href="edit" query="id">Edit</t:a>
|
||||
</td>
|
||||
</tr>
|
||||
|
||||
</t:chloe>
|
||||
|
|
@ -0,0 +1,41 @@
|
|||
.big-field-label {
|
||||
vertical-align: top;
|
||||
}
|
||||
|
||||
.description {
|
||||
border: 1px dashed #ccc;
|
||||
background-color: #f5f5f5;
|
||||
padding: 5px;
|
||||
font-size: 150%;
|
||||
color: #000000;
|
||||
}
|
||||
|
||||
.link-button {
|
||||
padding: 0px;
|
||||
background: none;
|
||||
border: none;
|
||||
}
|
||||
|
||||
.navbar {
|
||||
background-color: #eeeeee;
|
||||
padding: 5px;
|
||||
border: 1px solid #ccc;
|
||||
}
|
||||
|
||||
.inline {
|
||||
display: inline;
|
||||
}
|
||||
|
||||
pre {
|
||||
font-size: 75%;
|
||||
}
|
||||
|
||||
.todo-list {
|
||||
border-style: none;
|
||||
}
|
||||
|
||||
.todo-list td, .todo-list th {
|
||||
border-width: 1px;
|
||||
padding: 2px;
|
||||
border-style: solid;
|
||||
}
|
||||
|
|
@ -0,0 +1,113 @@
|
|||
! Copyright (c) 2008 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel locals sequences
|
||||
db db.types db.tuples
|
||||
http.server.components http.server.components.farkup
|
||||
http.server.forms http.server.templating.chloe
|
||||
http.server.boilerplate http.server.crud http.server.auth
|
||||
http.server.actions http.server.db
|
||||
http.server ;
|
||||
IN: webapps.todo
|
||||
|
||||
TUPLE: todo uid id priority summary description ;
|
||||
|
||||
todo "TODO"
|
||||
{
|
||||
{ "uid" "UID" { VARCHAR 256 } +not-null+ }
|
||||
{ "id" "ID" +native-id+ }
|
||||
{ "priority" "PRIORITY" INTEGER +not-null+ }
|
||||
{ "summary" "SUMMARY" { VARCHAR 256 } +not-null+ }
|
||||
{ "description" "DESCRIPTION" { VARCHAR 256 } }
|
||||
} define-persistent
|
||||
|
||||
: init-todo-table todo ensure-table ;
|
||||
|
||||
: <todo> ( id -- todo )
|
||||
todo new
|
||||
swap >>id
|
||||
uid >>uid ;
|
||||
|
||||
: todo-template ( name -- template )
|
||||
"resource:extra/webapps/todo/" swap ".xml" 3append <chloe> ;
|
||||
|
||||
: <todo-form> ( -- form )
|
||||
"todo" <form>
|
||||
"view-todo" todo-template >>view-template
|
||||
"edit-todo" todo-template >>edit-template
|
||||
"todo-summary" todo-template >>summary-template
|
||||
"id" <integer>
|
||||
hidden >>renderer
|
||||
add-field
|
||||
"summary" <string>
|
||||
t >>required
|
||||
add-field
|
||||
"priority" <integer>
|
||||
t >>required
|
||||
0 >>default
|
||||
0 >>min-value
|
||||
10 >>max-value
|
||||
add-field
|
||||
"description" <farkup>
|
||||
add-field ;
|
||||
|
||||
: <todo-list-form> ( -- form )
|
||||
"todo-list" <form>
|
||||
"todo-list" todo-template >>view-template
|
||||
"list" <todo-form> +plain+ <list>
|
||||
add-field ;
|
||||
|
||||
TUPLE: todo-responder < dispatcher ;
|
||||
|
||||
:: <todo-responder> ( -- responder )
|
||||
[let | todo-form [ <todo-form> ]
|
||||
list-form [ <todo-list-form> ]
|
||||
ctor [ [ <todo> ] ] |
|
||||
todo-responder new-dispatcher
|
||||
list-form ctor <list-action> "list" add-main-responder
|
||||
todo-form ctor <view-action> "view" add-responder
|
||||
todo-form ctor "view" <edit-action> "edit" add-responder
|
||||
ctor "list" <delete-action> "delete" add-responder
|
||||
<boilerplate>
|
||||
"todo" todo-template >>template
|
||||
] ;
|
||||
|
||||
! What follows below is somewhat akin to a 'deployment descriptor'
|
||||
! for the todo application. The <todo-responder> can be integrated
|
||||
! into an existing web app that provides session management and
|
||||
! login facilities, or <todo-app> can be used to run a
|
||||
! self-contained todo instance.
|
||||
USING: namespaces io.files io.sockets
|
||||
db.sqlite smtp
|
||||
http.server.sessions
|
||||
http.server.auth.login
|
||||
http.server.auth.providers.db
|
||||
http.server.sessions.storage.db ;
|
||||
|
||||
: test-db "todo.db" resource-path sqlite-db ;
|
||||
|
||||
: <todo-app> ( -- responder )
|
||||
<todo-responder>
|
||||
<login>
|
||||
users-in-db >>users
|
||||
allow-registration
|
||||
allow-password-recovery
|
||||
allow-edit-profile
|
||||
<boilerplate>
|
||||
"page" todo-template >>template
|
||||
<url-sessions>
|
||||
sessions-in-db >>sessions
|
||||
test-db <db-persistence> ;
|
||||
|
||||
: init-todo ( -- )
|
||||
"factorcode.org" 25 <inet> smtp-server set-global
|
||||
"todo@factorcode.org" lost-password-from set-global
|
||||
|
||||
test-db [
|
||||
init-todo-table
|
||||
init-users-table
|
||||
init-sessions-table
|
||||
] with-db
|
||||
|
||||
<dispatcher>
|
||||
<todo-app> "todo" add-responder
|
||||
main-responder set-global ;
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
|
||||
<t:style include="resource:extra/webapps/todo/todo.css" />
|
||||
|
||||
<t:style include="resource:extra/xmode/code2html/stylesheet.css" />
|
||||
|
||||
<div class="navbar">
|
||||
<t:a href="list">List Items</t:a>
|
||||
| <t:a href="edit">Add Item</t:a>
|
||||
|
||||
<t:if code="http.server.auth.login:allow-edit-profile?">
|
||||
| <t:a href="edit-profile">Edit Profile</t:a>
|
||||
</t:if>
|
||||
|
||||
<t:form action="logout" class="inline">
|
||||
| <button type="submit" class="link-button link">Logout</button>
|
||||
</t:form>
|
||||
</div>
|
||||
|
||||
<h1><t:write-title /></h1>
|
||||
|
||||
<t:call-next-template />
|
||||
|
||||
</t:chloe>
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
|
||||
<t:title>View Item</t:title>
|
||||
|
||||
<table>
|
||||
<tr><th class="field-label">Summary: </th><td><t:view component="summary" /></td></tr>
|
||||
<tr><th class="field-label">Priority: </th><td><t:view component="priority" /></td></tr>
|
||||
</table>
|
||||
|
||||
<div class="description">
|
||||
<t:view component="description" />
|
||||
</div>
|
||||
|
||||
<t:a href="edit" query="id">Edit</t:a>
|
||||
|
|
||||
<t:form action="delete" class="inline">
|
||||
<t:edit component="id" />
|
||||
<button class="link-button link">Delete</button>
|
||||
</t:form>
|
||||
|
||||
</t:chloe>
|
||||
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2005, 2006 Daniel Ehrenberg
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: hashtables kernel math namespaces sequences strings
|
||||
io io.streams.string xml.data assocs wrap xml.entities
|
||||
unicode.categories ;
|
||||
assocs combinators io io.streams.string
|
||||
xml.data wrap xml.entities unicode.categories ;
|
||||
IN: xml.writer
|
||||
|
||||
SYMBOL: xml-pprint?
|
||||
|
|
@ -61,6 +61,9 @@ M: string write-item
|
|||
?indent CHAR: < write1
|
||||
dup print-name tag-attrs print-attrs ;
|
||||
|
||||
: write-start-tag ( tag -- )
|
||||
write-tag ">" write ;
|
||||
|
||||
M: contained-tag write-item
|
||||
write-tag "/>" write ;
|
||||
|
||||
|
|
@ -72,11 +75,14 @@ M: contained-tag write-item
|
|||
?indent "</" write print-name CHAR: > write1 ;
|
||||
|
||||
M: open-tag write-item
|
||||
xml-pprint? [ [
|
||||
over sensitive? not and xml-pprint? set
|
||||
dup write-tag CHAR: > write1
|
||||
dup write-children write-end-tag
|
||||
] keep ] change ;
|
||||
xml-pprint? get >r
|
||||
{
|
||||
[ sensitive? not xml-pprint? get and xml-pprint? set ]
|
||||
[ write-start-tag ]
|
||||
[ write-children ]
|
||||
[ write-end-tag ]
|
||||
} cleave
|
||||
r> xml-pprint? set ;
|
||||
|
||||
M: comment write-item
|
||||
"<!--" write comment-text write "-->" write ;
|
||||
|
|
@ -97,10 +103,12 @@ M: instruction write-item
|
|||
[ write-item ] each ;
|
||||
|
||||
: write-xml ( xml -- )
|
||||
dup xml-prolog write-prolog
|
||||
dup xml-before write-chunk
|
||||
dup write-item
|
||||
xml-after write-chunk ;
|
||||
{
|
||||
[ xml-prolog write-prolog ]
|
||||
[ xml-before write-chunk ]
|
||||
[ write-item ]
|
||||
[ xml-after write-chunk ]
|
||||
} cleave ;
|
||||
|
||||
: print-xml ( xml -- )
|
||||
write-xml nl ;
|
||||
|
|
|
|||
|
|
@ -36,9 +36,13 @@ TAGS>
|
|||
f \ modes set-global ;
|
||||
|
||||
MEMO: (load-mode) ( name -- rule-sets )
|
||||
modes at mode-file
|
||||
"extra/xmode/modes/" prepend
|
||||
resource-path utf8 <file-reader> parse-mode ;
|
||||
modes at [
|
||||
mode-file
|
||||
"extra/xmode/modes/" prepend
|
||||
resource-path utf8 <file-reader> parse-mode
|
||||
] [
|
||||
"text" (load-mode)
|
||||
] if* ;
|
||||
|
||||
SYMBOL: rule-sets
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue