Merge commit 'erg/master'

release
Slava Pestov 2007-11-14 16:49:27 -05:00
commit 5c9b5b9159
10 changed files with 278 additions and 2 deletions

View File

@ -0,0 +1,87 @@
! Copyright (C) 2007 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays calendar combinators concurrency generic
init kernel math namespaces sequences threads ;
IN: alarms
TUPLE: alarm time quot ;
C: <alarm> alarm
<PRIVATE
! for now a V{ }, eventually a min-heap to store alarms
SYMBOL: alarms
SYMBOL: alarm-receiver
SYMBOL: alarm-looper
: add-alarm ( alarm -- )
alarms get-global push ;
: remove-alarm ( alarm -- )
alarms get-global remove alarms set-global ;
: handle-alarm ( alarm -- )
dup delegate {
{ "register" [ add-alarm ] }
{ "unregister" [ remove-alarm ] }
} case ;
: expired-alarms ( -- seq )
now alarms get-global
[ alarm-time <=> 0 > ] curry* subset ;
: unexpired-alarms ( -- seq )
now alarms get-global
[ alarm-time <=> 0 <= ] curry* subset ;
: call-alarm ( alarm -- )
alarm-quot spawn drop ;
: do-alarms ( -- )
expired-alarms [ call-alarm ] each
unexpired-alarms alarms set-global ;
: alarm-receive-loop ( -- )
receive dup alarm? [ handle-alarm ] [ drop ] if
alarm-receive-loop ;
: start-alarm-receiver ( -- )
[
alarm-receive-loop
] spawn alarm-receiver set-global ;
: alarm-loop ( -- )
alarms get-global empty? [
do-alarms
] unless 100 sleep alarm-loop ;
: start-alarm-looper ( -- )
[
alarm-loop
] spawn alarm-looper set-global ;
: send-alarm ( str alarm -- )
over set-delegate
alarm-receiver get-global send ;
: start-alarm-daemon ( -- )
alarms get-global [ V{ } clone alarms set-global ] unless
start-alarm-looper
start-alarm-receiver ;
[ start-alarm-daemon ] "alarms" add-init-hook
PRIVATE>
: register-alarm ( alarm -- )
"register" send-alarm ;
: unregister-alarm ( alarm -- )
"unregister" send-alarm ;
: change-alarm ( alarm-old alarm-new -- )
"register" send-alarm
"unregister" send-alarm ;
! Example:
! 5 seconds from-now [ "hi" print flush ] <alarm> register-alarm

View File

@ -43,7 +43,6 @@ TUPLE: thread timeout continuation continued? ;
: (mailbox-block-if-empty) ( mailbox timeout -- mailbox2 )
over mailbox-empty? [
[ <thread> swap mailbox-threads push stop ] callcc0
"(mailbox-block-if-empty)" print flush
(mailbox-block-if-empty)
] [
drop

View File

@ -0,0 +1,28 @@
<% USING: io math math.parser namespaces ; %>
<h1>Annotate</h1>
<form method="POST" action="/responder/pastebin/annotate-paste">
<table>
<input type="hidden" name="n" value="<% "n" get number>string write %>" />
<tr>
<th>Your name:</th>
<td><input type="TEXT" name="author" value="" /></td>
</tr>
<tr>
<th>Summary:</th>
<td><input type="TEXT" name="summary" value="" /></td>
</tr>
<tr>
<th valign="top">Contents:</th>
<td><textarea rows="24" cols="60" name="contents"></textarea></td>
</tr>
</table>
<input type="SUBMIT" value="Annotate" />
</form>

View File

@ -0,0 +1,11 @@
<% USING: namespaces io ; %>
<h2>Annotation: <% "summary" get write %></h2>
<table>
<tr><th>Annotation by:</th><td><% "author" get write %></td></tr>
<tr><th>Channel:</th><td><% "channel" get write %></td></tr>
<tr><th>Created:</th><td><% "date" get write %></td></tr>
</table>
<pre><% "contents" get write %></pre>

View File

@ -0,0 +1,27 @@
<form method="POST" action="/responder/pastebin/submit-paste">
<table>
<tr>
<th>Your name:</th>
<td><input type="TEXT" name="author" value="" /></td>
</tr>
<tr>
<th>Summary:</th>
<td><input type="TEXT" name="summary" value="" /></td>
</tr>
<tr>
<th>Channel:</th>
<td><input type="TEXT" name="channel" value="#concatenative" /></td>
</tr>
<tr>
<th valign="top">Contents:</th>
<td><textarea rows="24" cols="60" name="contents"></textarea></td>
</tr>
</table>
<input type="SUBMIT" value="Submit paste" />
</form>

View File

@ -0,0 +1,7 @@
<% USING: namespaces furnace sequences ; %>
<table width="100%">
<% "new-paste-quot" get "New paste" render-link %>
<tr align="left"><th>&nbsp;</th><th>Summary:</th><th>Paste by:</th><th>Link</th><th>Date</th></tr>
<% "pastes" get <reversed> [ "paste-summary" render-template ] each %></table>

View File

@ -0,0 +1,9 @@
<% USING: continuations namespaces io kernel math math.parser furnace ; %>
<tr>
<td><% "n" get number>string write %></td>
<td><% "summary" get write %></td>
<td><% "author" get write %></td>
<td><% "n" get number>string "show-paste-quot" get curry "Show" render-link %></td>
<td><% "date" get print %></td>
</tr>

View File

@ -0,0 +1,93 @@
USING: calendar furnace furnace.validator io.files kernel namespaces
sequences store ;
IN: webapps.pastebin
TUPLE: pastebin pastes ;
: <pastebin> ( -- pastebin )
V{ } clone pastebin construct-boa ;
TUPLE: paste n summary article author channel contents date annotations ;
: <paste> ( summary author channel contents -- paste )
V{ } clone
{
set-paste-summary
set-paste-author
set-paste-channel
set-paste-contents
set-paste-annotations
} paste construct ;
TUPLE: annotation summary author contents ;
C: <annotation> annotation
SYMBOL: store
"pastebin.store" resource-path load-store store set-global
<pastebin> \ pastebin store get store-variable
: get-paste ( n -- paste )
pastebin get pastebin-pastes nth ;
: show-paste ( n -- )
get-paste "show-paste" "Paste" render-page ;
\ show-paste { { "n" v-number } } define-action
: new-paste ( -- )
f "new-paste" "New paste" render-page ;
\ new-paste { } define-action
: paste-list ( -- )
[
[ show-paste ] "show-paste-quot" set
[ new-paste ] "new-paste-quot" set
pastebin get "paste-list" "Pastebin" render-page
] with-scope ;
\ paste-list { } define-action
: save-pastebin-store ( -- )
store get-global save-store ;
: add-paste ( paste pastebin -- )
>r now timestamp>http-string over set-paste-date r>
pastebin-pastes
[ length over set-paste-n ] keep push ;
: submit-paste ( summary author channel contents -- )
<paste>
\ pastebin get-global add-paste
save-pastebin-store ;
\ submit-paste {
{ "summary" v-required }
{ "author" v-required }
{ "channel" "#concatenative" v-default }
{ "contents" v-required }
} define-action
\ submit-paste [ paste-list ] define-redirect
: annotate-paste ( n summary author contents -- )
<annotation> swap get-paste
paste-annotations push
save-pastebin-store ;
\ annotate-paste {
{ "n" v-required v-number }
{ "summary" v-required }
{ "author" v-required }
{ "contents" v-required }
} define-action
\ annotate-paste [ "n" show-paste ] define-redirect
"pastebin" "paste-list" "extra/webapps/pastebin" web-app

View File

@ -0,0 +1,15 @@
<% USING: namespaces io furnace sequences ; %>
<h1>Paste: <% "summary" get write %></h1>
<table>
<tr><th>Paste by:</th><td><% "author" get write %></td></tr>
<tr><th>Channel:</th><td><% "channel" get write %></td></tr>
<tr><th>Created:</th><td><% "date" get write %></td></tr>
</table>
<pre><% "contents" get write %></pre>
<% "annotations" get [ "annotation" render-template ] each %>
<% model get "annotate-paste" render-template %>

View File

@ -112,7 +112,7 @@ check_ret wget
if [[ $OS == windows-nt ]] ; then
wget http://factorcode.org/dlls/freetype6.dll
check_ret
wget http://factorcode.org/dlls/zlib1.dla
wget http://factorcode.org/dlls/zlib1.dll
check_ret
fi