Merge commit 'erg/master'
Slava Pestov
commit
5c9b5b9159
|
|
@ -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
|
||||||
|
|
@ -43,7 +43,6 @@ TUPLE: thread timeout continuation continued? ;
|
||||||
: (mailbox-block-if-empty) ( mailbox timeout -- mailbox2 )
|
: (mailbox-block-if-empty) ( mailbox timeout -- mailbox2 )
|
||||||
over mailbox-empty? [
|
over mailbox-empty? [
|
||||||
[ <thread> swap mailbox-threads push stop ] callcc0
|
[ <thread> swap mailbox-threads push stop ] callcc0
|
||||||
"(mailbox-block-if-empty)" print flush
|
|
||||||
(mailbox-block-if-empty)
|
(mailbox-block-if-empty)
|
||||||
] [
|
] [
|
||||||
drop
|
drop
|
||||||
|
|
|
||||||
|
|
@ -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>
|
||||||
|
|
@ -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>
|
||||||
|
|
@ -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>
|
||||||
|
|
@ -0,0 +1,7 @@
|
||||||
|
<% USING: namespaces furnace sequences ; %>
|
||||||
|
|
||||||
|
<table width="100%">
|
||||||
|
<% "new-paste-quot" get "New paste" render-link %>
|
||||||
|
<tr align="left"><th> </th><th>Summary:</th><th>Paste by:</th><th>Link</th><th>Date</th></tr>
|
||||||
|
<% "pastes" get <reversed> [ "paste-summary" render-template ] each %></table>
|
||||||
|
|
||||||
|
|
@ -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>
|
||||||
|
|
@ -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
|
||||||
|
|
@ -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 %>
|
||||||
|
|
@ -112,7 +112,7 @@ check_ret wget
|
||||||
if [[ $OS == windows-nt ]] ; then
|
if [[ $OS == windows-nt ]] ; then
|
||||||
wget http://factorcode.org/dlls/freetype6.dll
|
wget http://factorcode.org/dlls/freetype6.dll
|
||||||
check_ret
|
check_ret
|
||||||
wget http://factorcode.org/dlls/zlib1.dla
|
wget http://factorcode.org/dlls/zlib1.dll
|
||||||
check_ret
|
check_ret
|
||||||
fi
|
fi
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue