Remove really obsolete stuff from unmaintained
Slava Pestov
parent
c19f2257f4
commit
d657b52eb1
|
|
@ -1,55 +0,0 @@
|
|||
USING: assocs assoc-heaps heaps heaps.private kernel tools.test ;
|
||||
IN: temporary
|
||||
|
||||
[
|
||||
T{
|
||||
assoc-heap
|
||||
f
|
||||
H{ { 2 1 } }
|
||||
T{ min-heap T{ heap f V{ { 1 2 } } } }
|
||||
}
|
||||
] [ H{ } clone <assoc-min-heap> 1 2 pick heap-push ] unit-test
|
||||
|
||||
[
|
||||
T{
|
||||
assoc-heap
|
||||
f
|
||||
H{ { 1 0 } { 2 1 } }
|
||||
T{ min-heap T{ heap f V{ { 0 1 } { 1 2 } } } }
|
||||
}
|
||||
] [ H{ } clone <assoc-min-heap> 1 2 pick heap-push 0 1 pick heap-push ] unit-test
|
||||
|
||||
[ T{ assoc-heap f H{ } T{ min-heap T{ heap f V{ } } } } ]
|
||||
[
|
||||
H{ } clone <assoc-min-heap>
|
||||
1 2 pick heap-push 0 1 pick heap-push
|
||||
dup heap-pop 2drop dup heap-pop 2drop
|
||||
] unit-test
|
||||
|
||||
|
||||
[ 0 1 ] [
|
||||
T{
|
||||
assoc-heap
|
||||
f
|
||||
H{ { 1 0 } { 2 1 } }
|
||||
T{ min-heap T{ heap f V{ { 0 1 } { 1 2 } } } }
|
||||
} heap-pop
|
||||
] unit-test
|
||||
|
||||
[ 1 2 ] [
|
||||
T{
|
||||
assoc-heap
|
||||
f
|
||||
H{ { 1 0 } { 2 1 } }
|
||||
T{ max-heap T{ heap f V{ { 1 2 } { 0 1 } } } }
|
||||
} heap-pop
|
||||
] unit-test
|
||||
|
||||
[
|
||||
T{
|
||||
assoc-heap
|
||||
f
|
||||
H{ { 1 2 } { 3 4 } }
|
||||
T{ min-heap T{ heap f V{ { 2 1 } { 4 3 } } } }
|
||||
}
|
||||
] [ H{ { 1 2 } { 3 4 } } H{ } clone <assoc-min-heap> [ heap-push-all ] keep ] unit-test
|
||||
|
|
@ -1,45 +0,0 @@
|
|||
USING: assocs heaps kernel sequences ;
|
||||
IN: assoc-heaps
|
||||
|
||||
TUPLE: assoc-heap assoc heap ;
|
||||
|
||||
INSTANCE: assoc-heap assoc
|
||||
INSTANCE: assoc-heap priority-queue
|
||||
|
||||
C: <assoc-heap> assoc-heap
|
||||
|
||||
: <assoc-min-heap> ( assoc -- obj ) <min-heap> <assoc-heap> ;
|
||||
: <assoc-max-heap> ( assoc -- obj ) <max-heap> <assoc-heap> ;
|
||||
|
||||
M: assoc-heap at* ( key assoc-heap -- value ? )
|
||||
assoc-heap-assoc at* ;
|
||||
|
||||
M: assoc-heap assoc-size ( assoc-heap -- n )
|
||||
assoc-heap-assoc assoc-size ;
|
||||
|
||||
TUPLE: assoc-heap-key-exists ;
|
||||
|
||||
: check-key-exists ( key assoc-heap -- )
|
||||
assoc-heap-assoc key?
|
||||
[ \ assoc-heap-key-exists construct-empty throw ] when ;
|
||||
|
||||
M: assoc-heap set-at ( value key assoc-heap -- )
|
||||
[ check-key-exists ] 2keep
|
||||
[ assoc-heap-assoc set-at ] 3keep
|
||||
assoc-heap-heap swapd heap-push ;
|
||||
|
||||
M: assoc-heap heap-empty? ( assoc-heap -- ? )
|
||||
assoc-heap-assoc assoc-empty? ;
|
||||
|
||||
M: assoc-heap heap-length ( assoc-heap -- n )
|
||||
assoc-heap-assoc assoc-size ;
|
||||
|
||||
M: assoc-heap heap-peek ( assoc-heap -- value key )
|
||||
assoc-heap-heap heap-peek ;
|
||||
|
||||
M: assoc-heap heap-push ( value key assoc-heap -- )
|
||||
set-at ;
|
||||
|
||||
M: assoc-heap heap-pop ( assoc-heap -- value key )
|
||||
dup assoc-heap-heap heap-pop swap
|
||||
rot dupd assoc-heap-assoc delete-at ;
|
||||
|
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
||||
|
|
@ -1 +0,0 @@
|
|||
Priority search queues
|
||||
|
|
@ -1 +0,0 @@
|
|||
Slava Pestov
|
||||
|
|
@ -1,89 +0,0 @@
|
|||
! Copyright (C) 2005, 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel furnace furnace.validator http.server.responders
|
||||
help help.topics html splitting sequences words strings
|
||||
quotations macros vocabs tools.browser combinators
|
||||
arrays io.files ;
|
||||
IN: webapps.help
|
||||
|
||||
! : string>topic ( string -- topic )
|
||||
! " " split dup length 1 = [ first ] when ;
|
||||
|
||||
: show-help ( topic -- )
|
||||
serving-html
|
||||
dup article-title [
|
||||
[ help ] with-html-stream
|
||||
] simple-html-document ;
|
||||
|
||||
\ show-help {
|
||||
{ "topic" }
|
||||
} define-action
|
||||
\ show-help { { "topic" "handbook" } } default-values
|
||||
|
||||
M: link browser-link-href
|
||||
link-name
|
||||
dup word? over f eq? or [
|
||||
browser-link-href
|
||||
] [
|
||||
dup array? [ " " join ] when
|
||||
[ show-help ] curry quot-link
|
||||
] if ;
|
||||
|
||||
: show-word ( word vocab -- )
|
||||
lookup show-help ;
|
||||
|
||||
\ show-word {
|
||||
{ "word" }
|
||||
{ "vocab" }
|
||||
} define-action
|
||||
\ show-word { { "word" "call" } { "vocab" "kernel" } } default-values
|
||||
|
||||
M: f browser-link-href
|
||||
drop \ f browser-link-href ;
|
||||
|
||||
M: word browser-link-href
|
||||
dup word-name swap word-vocabulary
|
||||
[ show-word ] 2curry quot-link ;
|
||||
|
||||
: show-vocab ( vocab -- )
|
||||
f >vocab-link show-help ;
|
||||
|
||||
\ show-vocab {
|
||||
{ "vocab" }
|
||||
} define-action
|
||||
|
||||
\ show-vocab { { "vocab" "kernel" } } default-values
|
||||
|
||||
M: vocab-spec browser-link-href
|
||||
vocab-name [ show-vocab ] curry quot-link ;
|
||||
|
||||
: show-vocabs-tagged ( tag -- )
|
||||
<vocab-tag> show-help ;
|
||||
|
||||
\ show-vocabs-tagged {
|
||||
{ "tag" }
|
||||
} define-action
|
||||
|
||||
M: vocab-tag browser-link-href
|
||||
vocab-tag-name [ show-vocabs-tagged ] curry quot-link ;
|
||||
|
||||
: show-vocabs-by ( author -- )
|
||||
<vocab-author> show-help ;
|
||||
|
||||
\ show-vocabs-by {
|
||||
{ "author" }
|
||||
} define-action
|
||||
|
||||
M: vocab-author browser-link-href
|
||||
vocab-author-name [ show-vocabs-by ] curry quot-link ;
|
||||
|
||||
"help" "show-help" "extra/webapps/help" web-app
|
||||
|
||||
! Hard-coding for factorcode.org
|
||||
PREDICATE: pathname resource-pathname
|
||||
pathname-string "resource:" head? ;
|
||||
|
||||
M: resource-pathname browser-link-href
|
||||
pathname-string
|
||||
"resource:" ?head drop
|
||||
"/responder/source/" swap append ;
|
||||
|
|
@ -1,47 +0,0 @@
|
|||
<% USING: io math math.parser namespaces furnace ; %>
|
||||
|
||||
<h1>Annotate</h1>
|
||||
|
||||
<form method="POST" action="/responder/pastebin/annotate-paste">
|
||||
|
||||
<table>
|
||||
|
||||
<tr>
|
||||
<th align="right">Summary:</th>
|
||||
<td><input type="TEXT" name="summary" value="<% "summary" render %>" /></td>
|
||||
<td align="left" class="error"><% "summary" "*Required" render-error %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<th align="right">Your name:</th>
|
||||
<td><input type="TEXT" name="author" value="<% "author" render %>" /></td>
|
||||
<td class="error"><% "author" "*Required" render-error %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<th align="right">File type:</th>
|
||||
<td><% "modes" render-template %></td>
|
||||
</tr>
|
||||
|
||||
<!--
|
||||
<tr>
|
||||
<th align="right">Channel:</th>
|
||||
<td><input type="TEXT" name="channel" value="#concatenative" /></td>
|
||||
</tr>
|
||||
-->
|
||||
|
||||
<tr>
|
||||
<td></td>
|
||||
<td colspan="2" class="error" align="left"><% "contents" "*Required" render-error %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<th align="right" valign="top">Content:</th>
|
||||
<td colspan="2"><textarea rows="24" cols="60" name="contents"><% "contents" render %></textarea></td>
|
||||
</tr>
|
||||
</table>
|
||||
|
||||
<input type="hidden" name="n" value="<% "n" get number>string write %>" />
|
||||
<input type="hidden" name="furnace-form-submitted" value="annotate-paste"/>
|
||||
<input type="SUBMIT" value="Annotate" />
|
||||
</form>
|
||||
|
|
@ -1,11 +0,0 @@
|
|||
<% USING: namespaces io furnace calendar ; %>
|
||||
|
||||
<h2>Annotation: <% "summary" get write %></h2>
|
||||
|
||||
<table>
|
||||
<tr><th align="right">Annotation by:</th><td><% "author" get write %></td></tr>
|
||||
<tr><th align="right">File type:</th><td><% "mode" get write %></td></tr>
|
||||
<tr><th align="right">Created:</th><td><% "date" get timestamp>string write %></td></tr>
|
||||
</table>
|
||||
|
||||
<% "syntax" render-template %>
|
||||
|
|
@ -1 +0,0 @@
|
|||
Slava Pestov
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
</body>
|
||||
|
||||
</html>
|
||||
|
|
@ -1,23 +0,0 @@
|
|||
<% USING: namespaces io furnace sequences xmode.code2html webapps.pastebin ; %>
|
||||
|
||||
<!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">
|
||||
<head>
|
||||
<meta http-equiv="Content-type" content="text/html; charset=utf-8" />
|
||||
|
||||
<title><% "title" get write %></title>
|
||||
<link rel="stylesheet" href="style.css" type="text/css" media="screen" title="no title" charset="utf-8" />
|
||||
<% default-stylesheet %>
|
||||
<link rel="alternate" type="application/atom+xml" title="Pastebin - Atom" href="feed.xml" />
|
||||
</head>
|
||||
|
||||
<body id="index">
|
||||
|
||||
<div class="navbar">
|
||||
<% [ paste-list ] "Paste list" render-link %> |
|
||||
<% [ new-paste ] "New paste" render-link %> |
|
||||
<% [ feed.xml ] "Syndicate" render-link %>
|
||||
</div>
|
||||
<h1 class="pastebin-title"><% "title" get write %></h1>
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
<% USING: furnace xmode.catalog sequences kernel html.elements assocs io sorting continuations ; %>
|
||||
|
||||
<select name="mode">
|
||||
<% modes keys natural-sort [
|
||||
<option dup "mode" session-var = [ "true" =selected ] when option> write </option>
|
||||
] each %>
|
||||
</select>
|
||||
|
|
@ -1,51 +0,0 @@
|
|||
<% USING: continuations furnace namespaces ; %>
|
||||
|
||||
<%
|
||||
"New paste" "title" set
|
||||
"header" render-template
|
||||
%>
|
||||
|
||||
<form method="POST" action="/responder/pastebin/submit-paste">
|
||||
|
||||
<table>
|
||||
|
||||
<tr>
|
||||
<th align="right">Summary:</th>
|
||||
<td><input type="TEXT" name="summary" value="<% "summary" render %>" /></td>
|
||||
<td align="left" class="error"><% "summary" "*Required" render-error %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<th align="right">Your name:</th>
|
||||
<td><input type="TEXT" name="author" value="<% "author" render %>" /></td>
|
||||
<td class="error"><% "author" "*Required" render-error %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<th align="right">File type:</th>
|
||||
<td><% "modes" render-template %></td>
|
||||
</tr>
|
||||
|
||||
<!--
|
||||
<tr>
|
||||
<th align="right">Channel:</th>
|
||||
<td><input type="TEXT" name="channel" value="#concatenative" /></td>
|
||||
</tr>
|
||||
-->
|
||||
|
||||
<tr>
|
||||
<td></td>
|
||||
<td colspan="2" class="error" align="left"><% "contents" "*Required" render-error %></td>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<th align="right" valign="top">Content:</th>
|
||||
<td colspan="2"><textarea rows="24" cols="60" name="contents"><% "contents" render %></textarea></td>
|
||||
</tr>
|
||||
</table>
|
||||
|
||||
<input type="hidden" name="furnace-form-submitted" value="new-paste"/>
|
||||
<input type="SUBMIT" value="Submit paste" />
|
||||
</form>
|
||||
|
||||
<% "footer" render-template %>
|
||||
|
|
@ -1,33 +0,0 @@
|
|||
<% USING: namespaces furnace sequences ; %>
|
||||
|
||||
<%
|
||||
"Pastebin" "title" set
|
||||
"header" render-template
|
||||
%>
|
||||
|
||||
<table width="100%" cellspacing="10">
|
||||
<tr>
|
||||
<td valign="top">
|
||||
<table width="100%">
|
||||
<tr align="left" class="pastebin-headings">
|
||||
<th width="50%">Summary:</th>
|
||||
<th width="100">Paste by:</th>
|
||||
<th width="200">Date:</th>
|
||||
</tr>
|
||||
<% "pastes" get <reversed> [ "paste-summary" render-component ] each %>
|
||||
</table>
|
||||
</td>
|
||||
<td valign="top" width="25%">
|
||||
<div class="infobox">
|
||||
<p>This pastebin is written in <a href="http://factorcode.org/">Factor</a>. It is inspired by <a href="http://paste.lisp.org">lisppaste</a>.
|
||||
</p>
|
||||
<p>It can be used for collaborative development over IRC. You can post code for review, and annotate other people's code. Syntax highlighting for over a hundred file types is supported.
|
||||
</p>
|
||||
<p>
|
||||
<% "webapps.pastebin" browse-webapp-source %></p>
|
||||
</div>
|
||||
</td>
|
||||
</tr>
|
||||
</table>
|
||||
|
||||
<% "footer" render-template %>
|
||||
|
|
@ -1,12 +0,0 @@
|
|||
<% USING: continuations namespaces io kernel math math.parser
|
||||
furnace webapps.pastebin calendar sequences ; %>
|
||||
|
||||
<tr>
|
||||
<td>
|
||||
<a href="<% model get paste-link write %>">
|
||||
<% "summary" get write %>
|
||||
</a>
|
||||
</td>
|
||||
<td><% "author" get write %></td>
|
||||
<td><% "date" get timestamp>string write %></td>
|
||||
</tr>
|
||||
|
|
@ -1,119 +0,0 @@
|
|||
USING: calendar furnace furnace.validator io.files kernel
|
||||
namespaces sequences http.server.responders html math.parser rss
|
||||
xml.writer xmode.code2html math calendar.format ;
|
||||
IN: webapps.pastebin
|
||||
|
||||
TUPLE: pastebin pastes ;
|
||||
|
||||
: <pastebin> ( -- pastebin )
|
||||
V{ } clone pastebin construct-boa ;
|
||||
|
||||
<pastebin> pastebin set-global
|
||||
|
||||
TUPLE: paste
|
||||
summary author channel mode contents date
|
||||
annotations n ;
|
||||
|
||||
: <paste> ( summary author channel mode contents -- paste )
|
||||
f V{ } clone f paste construct-boa ;
|
||||
|
||||
TUPLE: annotation summary author mode contents ;
|
||||
|
||||
C: <annotation> annotation
|
||||
|
||||
: get-paste ( n -- paste )
|
||||
pastebin get pastebin-pastes nth ;
|
||||
|
||||
: show-paste ( n -- )
|
||||
serving-html
|
||||
get-paste
|
||||
[ "show-paste" render-component ] with-html-stream ;
|
||||
|
||||
\ show-paste { { "n" v-number } } define-action
|
||||
|
||||
: new-paste ( -- )
|
||||
serving-html
|
||||
[ "new-paste" render-template ] with-html-stream ;
|
||||
|
||||
\ new-paste { } define-action
|
||||
|
||||
: paste-list ( -- )
|
||||
serving-html
|
||||
[
|
||||
[ show-paste ] "show-paste-quot" set
|
||||
[ new-paste ] "new-paste-quot" set
|
||||
pastebin get "paste-list" render-component
|
||||
] with-html-stream ;
|
||||
|
||||
\ paste-list { } define-action
|
||||
|
||||
: paste-link ( paste -- link )
|
||||
paste-n number>string [ show-paste ] curry quot-link ;
|
||||
|
||||
: safe-head ( seq n -- seq' )
|
||||
over length min head ;
|
||||
|
||||
: paste-feed ( -- entries )
|
||||
pastebin get pastebin-pastes <reversed> 20 safe-head [
|
||||
{
|
||||
paste-summary
|
||||
paste-link
|
||||
paste-date
|
||||
} get-slots timestamp>rfc3339 f swap <entry>
|
||||
] map ;
|
||||
|
||||
: feed.xml ( -- )
|
||||
"text/xml" serving-content
|
||||
"pastebin"
|
||||
"http://pastebin.factorcode.org"
|
||||
paste-feed <feed> feed>xml write-xml ;
|
||||
|
||||
\ feed.xml { } define-action
|
||||
|
||||
: add-paste ( paste pastebin -- )
|
||||
>r now over set-paste-date r>
|
||||
pastebin-pastes 2dup length swap set-paste-n push ;
|
||||
|
||||
: submit-paste ( summary author channel mode contents -- )
|
||||
<paste> [ pastebin get add-paste ] keep
|
||||
paste-link permanent-redirect ;
|
||||
|
||||
\ new-paste
|
||||
\ submit-paste {
|
||||
{ "summary" v-required }
|
||||
{ "author" v-required }
|
||||
{ "channel" }
|
||||
{ "mode" v-required }
|
||||
{ "contents" v-required }
|
||||
} define-form
|
||||
|
||||
\ new-paste {
|
||||
{ "channel" "#concatenative" }
|
||||
{ "mode" "factor" }
|
||||
} default-values
|
||||
|
||||
: annotate-paste ( n summary author mode contents -- )
|
||||
<annotation> swap get-paste
|
||||
[ paste-annotations push ] keep
|
||||
paste-link permanent-redirect ;
|
||||
|
||||
[ "n" show-paste ]
|
||||
\ annotate-paste {
|
||||
{ "n" v-required v-number }
|
||||
{ "summary" v-required }
|
||||
{ "author" v-required }
|
||||
{ "mode" v-required }
|
||||
{ "contents" v-required }
|
||||
} define-form
|
||||
|
||||
\ show-paste {
|
||||
{ "mode" "factor" }
|
||||
} default-values
|
||||
|
||||
: style.css ( -- )
|
||||
"text/css" serving-content
|
||||
"style.css" send-resource ;
|
||||
|
||||
\ style.css { } define-action
|
||||
|
||||
"pastebin" "paste-list" "extra/webapps/pastebin" web-app
|
||||
|
|
@ -1,21 +0,0 @@
|
|||
<% USING: namespaces io furnace sequences xmode.code2html calendar ; %>
|
||||
|
||||
<%
|
||||
"Paste: " "summary" get append "title" set
|
||||
"header" render-template
|
||||
%>
|
||||
|
||||
<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 timestamp>string write %></td></tr>
|
||||
<tr><th>File type:</th><td><% "mode" get write %></td></tr>
|
||||
</table>
|
||||
|
||||
<% "syntax" render-template %>
|
||||
|
||||
<% "annotations" get [ "annotation" render-component ] each %>
|
||||
|
||||
<% model get "annotate-paste" render-component %>
|
||||
|
||||
<% "footer" render-template %>
|
||||
|
|
@ -1,41 +0,0 @@
|
|||
body {
|
||||
font:75%/1.6em "Lucida Grande", "Lucida Sans Unicode", verdana, geneva, sans-serif;
|
||||
color:#888;
|
||||
}
|
||||
|
||||
h1.pastebin-title {
|
||||
font-size:300%;
|
||||
}
|
||||
|
||||
a {
|
||||
color:#222;
|
||||
border-bottom:1px dotted #ccc;
|
||||
text-decoration:none;
|
||||
}
|
||||
|
||||
a:hover {
|
||||
border-bottom:1px solid #ccc;
|
||||
}
|
||||
|
||||
pre.code {
|
||||
border:1px dashed #ccc;
|
||||
background-color:#f5f5f5;
|
||||
padding:5px;
|
||||
font-size:150%;
|
||||
color:#000000;
|
||||
}
|
||||
|
||||
.navbar {
|
||||
background-color:#eeeeee;
|
||||
padding:5px;
|
||||
border:1px solid #ccc;
|
||||
}
|
||||
|
||||
.infobox {
|
||||
border: 1px solid #C1DAD7;
|
||||
padding: 10px;
|
||||
}
|
||||
|
||||
.error {
|
||||
color: red;
|
||||
}
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
<% USING: xmode.code2html splitting namespaces ; %>
|
||||
|
||||
<pre class="code"><% "contents" get string-lines "mode" get htmlize-lines %></pre>
|
||||
|
|
@ -1 +0,0 @@
|
|||
Slava Pestov
|
||||
|
|
@ -1,129 +0,0 @@
|
|||
USING: sequences rss arrays concurrency.combinators kernel
|
||||
sorting html.elements io assocs namespaces math threads vocabs
|
||||
html furnace http.server.templating calendar math.parser
|
||||
splitting continuations debugger system http.server.responders
|
||||
xml.writer prettyprint logging calendar.format ;
|
||||
IN: webapps.planet
|
||||
|
||||
: print-posting-summary ( posting -- )
|
||||
<p "news" =class p>
|
||||
<b> dup entry-title write </b> <br/>
|
||||
<a entry-link =href "more" =class a>
|
||||
"Read More..." write
|
||||
</a>
|
||||
</p> ;
|
||||
|
||||
: print-posting-summaries ( postings -- )
|
||||
[ print-posting-summary ] each ;
|
||||
|
||||
: print-blogroll ( blogroll -- )
|
||||
<ul "description" =class ul>
|
||||
[
|
||||
<li> <a dup third =href a> first write </a> </li>
|
||||
] each
|
||||
</ul> ;
|
||||
|
||||
: format-date ( date -- string )
|
||||
rfc3339>timestamp timestamp>string ;
|
||||
|
||||
: print-posting ( posting -- )
|
||||
<h2 "posting-title" =class h2>
|
||||
<a dup entry-link =href a>
|
||||
dup entry-title write-html
|
||||
</a>
|
||||
</h2>
|
||||
<p "posting-body" =class p>
|
||||
dup entry-description write-html
|
||||
</p>
|
||||
<p "posting-date" =class p>
|
||||
entry-pub-date format-date write
|
||||
</p> ;
|
||||
|
||||
: print-postings ( postings -- )
|
||||
[ print-posting ] each ;
|
||||
|
||||
SYMBOL: default-blogroll
|
||||
SYMBOL: cached-postings
|
||||
|
||||
: safe-head ( seq n -- seq' )
|
||||
over length min head ;
|
||||
|
||||
: mini-planet-factor ( -- )
|
||||
cached-postings get 4 safe-head print-posting-summaries ;
|
||||
|
||||
: planet-factor ( -- )
|
||||
serving-html [ "planet" render-template ] with-html-stream ;
|
||||
|
||||
\ planet-factor { } define-action
|
||||
|
||||
: planet-feed ( -- feed )
|
||||
"[ planet-factor ]"
|
||||
"http://planet.factorcode.org"
|
||||
cached-postings get 30 safe-head <feed> ;
|
||||
|
||||
: feed.xml ( -- )
|
||||
"text/xml" serving-content
|
||||
planet-feed feed>xml write-xml ;
|
||||
|
||||
\ feed.xml { } define-action
|
||||
|
||||
: style.css ( -- )
|
||||
"text/css" serving-content
|
||||
"style.css" send-resource ;
|
||||
|
||||
\ style.css { } define-action
|
||||
|
||||
SYMBOL: last-update
|
||||
|
||||
: <posting> ( author entry -- entry' )
|
||||
clone
|
||||
[ ": " swap entry-title 3append ] keep
|
||||
[ set-entry-title ] keep ;
|
||||
|
||||
: fetch-feed ( url -- feed )
|
||||
download-feed feed-entries ;
|
||||
|
||||
\ fetch-feed DEBUG add-error-logging
|
||||
|
||||
: fetch-blogroll ( blogroll -- entries )
|
||||
dup 0 <column> swap 1 <column>
|
||||
[ fetch-feed ] parallel-map
|
||||
[ [ <posting> ] with map ] 2map concat ;
|
||||
|
||||
: sort-entries ( entries -- entries' )
|
||||
[ [ entry-pub-date ] compare ] sort <reversed> ;
|
||||
|
||||
: update-cached-postings ( -- )
|
||||
default-blogroll get
|
||||
fetch-blogroll sort-entries
|
||||
cached-postings set-global ;
|
||||
|
||||
: update-thread ( -- )
|
||||
millis last-update set-global
|
||||
[ update-cached-postings ] "RSS feed update slave" spawn drop
|
||||
10 60 * 1000 * sleep
|
||||
update-thread ;
|
||||
|
||||
: start-update-thread ( -- )
|
||||
[
|
||||
"webapps.planet" [
|
||||
update-thread
|
||||
] with-logging
|
||||
] "RSS feed update master" spawn drop ;
|
||||
|
||||
"planet" "planet-factor" "extra/webapps/planet" web-app
|
||||
|
||||
{
|
||||
{ "Berlin Brown" "http://factorlang-fornovices.blogspot.com/feeds/posts/default" "http://factorlang-fornovices.blogspot.com" }
|
||||
{ "Chris Double" "http://www.blogger.com/feeds/18561009/posts/full/-/factor" "http://www.bluishcoder.co.nz/" }
|
||||
{ "Elie Chaftari" "http://fun-factor.blogspot.com/feeds/posts/default" "http://fun-factor.blogspot.com/" }
|
||||
{ "Doug Coleman" "http://code-factor.blogspot.com/feeds/posts/default" "http://code-factor.blogspot.com/" }
|
||||
{ "Daniel Ehrenberg" "http://useless-factor.blogspot.com/feeds/posts/default" "http://useless-factor.blogspot.com/" }
|
||||
{ "Gavin Harrison" "http://gmh33.blogspot.com/feeds/posts/default" "http://gmh33.blogspot.com/" }
|
||||
{ "Kio M. Smallwood"
|
||||
"http://sekenre.wordpress.com/feed/atom/"
|
||||
"http://sekenre.wordpress.com/" }
|
||||
{ "Phil Dawes" "http://www.phildawes.net/blog/category/factor/feed/atom" "http://www.phildawes.net/blog/" }
|
||||
{ "Samuel Tardieu" "http://www.rfc1149.net/blog/tag/factor/feed/atom/" "http://www.rfc1149.net/blog/tag/factor/" }
|
||||
{ "Slava Pestov" "http://factor-language.blogspot.com/atom.xml" "http://factor-language.blogspot.com/" }
|
||||
} default-blogroll set-global
|
||||
|
|
@ -1,45 +0,0 @@
|
|||
<% USING: namespaces html.elements webapps.planet sequences
|
||||
furnace ; %>
|
||||
|
||||
<!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">
|
||||
<head>
|
||||
<meta http-equiv="Content-type" content="text/html; charset=utf-8" />
|
||||
|
||||
<title>planet-factor</title>
|
||||
<link rel="stylesheet" href="style.css" type="text/css" media="screen" title="no title" charset="utf-8" />
|
||||
<link rel="alternate" type="application/atom+xml" title="Planet Factor - Atom" href="feed.xml" />
|
||||
</head>
|
||||
|
||||
<body id="index">
|
||||
<h1 class="planet-title">[ planet-factor ]</h1>
|
||||
<table width="100%" cellpadding="10">
|
||||
<tr>
|
||||
<td> <% cached-postings get 20 safe-head print-postings %> </td>
|
||||
<td valign="top" width="25%" class="infobox">
|
||||
<p>
|
||||
<b>planet-factor</b> is an Atom/RSS aggregator that collects the
|
||||
contents of <a href="http://factorcode.org/">Factor</a>-related blogs. It is inspired by
|
||||
<a href="http://planet.lisp.org">Planet Lisp</a>.
|
||||
</p>
|
||||
<p>
|
||||
<img src="http://planet.lisp.org/feed-icon-14x14.png" />
|
||||
<a href="feed.xml"> Syndicate </a>
|
||||
</p>
|
||||
<p>
|
||||
This webapp is written in <a href="http://factorcode.org/">Factor</a>.<br/>
|
||||
<% "webapps.planet" browse-webapp-source %>
|
||||
</p>
|
||||
<h2 class="blogroll-title">Blogroll</h2>
|
||||
<% default-blogroll get print-blogroll %>
|
||||
<p>
|
||||
If you want your weblog added to the blogroll, <a href="http://factorcode.org/gethelp.fhtml">just ask</a>.
|
||||
</p>
|
||||
</td>
|
||||
</tr>
|
||||
</table>
|
||||
</body>
|
||||
|
||||
</html>
|
||||
|
|
@ -1,45 +0,0 @@
|
|||
body {
|
||||
font:75%/1.6em "Lucida Grande", "Lucida Sans Unicode", verdana, geneva, sans-serif;
|
||||
color:#888;
|
||||
}
|
||||
|
||||
h1.planet-title {
|
||||
font-size:300%;
|
||||
}
|
||||
|
||||
a {
|
||||
color:#222;
|
||||
border-bottom:1px dotted #ccc;
|
||||
text-decoration:none;
|
||||
}
|
||||
|
||||
a:hover {
|
||||
border-bottom:1px solid #ccc;
|
||||
}
|
||||
|
||||
.posting-title {
|
||||
background-color:#f5f5f5;
|
||||
}
|
||||
|
||||
pre, code {
|
||||
color:#000000;
|
||||
font-size:120%;
|
||||
}
|
||||
|
||||
.infobox {
|
||||
border-left: 1px solid #C1DAD7;
|
||||
}
|
||||
|
||||
.posting-date {
|
||||
text-align: right;
|
||||
font-size:90%;
|
||||
}
|
||||
|
||||
a.more {
|
||||
display:block;
|
||||
padding:0 0 5px 0;
|
||||
color:#333;
|
||||
text-decoration:none;
|
||||
text-align:right;
|
||||
border:none;
|
||||
}
|
||||
|
|
@ -1,4 +0,0 @@
|
|||
REQUIRES: apps/http-server libs/store ;
|
||||
|
||||
PROVIDE: apps/wee-url
|
||||
{ +files+ { "responder.factor" } } ;
|
||||
|
|
@ -1,91 +0,0 @@
|
|||
! Copyright (C) 2006 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: generic assocs help html httpd
|
||||
io kernel math namespaces prettyprint sequences store strings ;
|
||||
IN: wee-url-responder
|
||||
|
||||
SYMBOL: wee-shortcuts
|
||||
SYMBOL: wee-store
|
||||
|
||||
"wee-url.store" load-store wee-store set-global
|
||||
H{ } clone wee-shortcuts wee-store get store-variable
|
||||
|
||||
: responder-url "responder-url" get ;
|
||||
|
||||
: wee-url ( string -- url )
|
||||
[
|
||||
"http://" %
|
||||
host %
|
||||
responder-url %
|
||||
%
|
||||
] "" make ;
|
||||
|
||||
: letter-bank
|
||||
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890" ;
|
||||
|
||||
: random-letter letter-bank length random letter-bank nth ;
|
||||
|
||||
: random-url ( -- string )
|
||||
6 random 1+ [ drop random-letter ] map >string
|
||||
dup wee-shortcuts get key? [ drop random-url ] when ;
|
||||
|
||||
: prepare-wee-url ( url -- url )
|
||||
CHAR: : over member? [ "http://" swap append ] unless ;
|
||||
|
||||
: set-symmetric-hash ( obj1 obj2 hash -- )
|
||||
3dup set-at swapd set-at ;
|
||||
|
||||
: add-shortcut ( url-long -- url-short )
|
||||
dup wee-shortcuts get at* [
|
||||
nip
|
||||
] [
|
||||
drop
|
||||
random-url [ wee-shortcuts get set-symmetric-hash ] keep
|
||||
wee-store get save-store
|
||||
] if ;
|
||||
|
||||
: url-prompt ( -- )
|
||||
serving-html
|
||||
"wee-url.com - wee URLs since 2007" [
|
||||
<form "get" =method responder-url =action form>
|
||||
"URL: " write
|
||||
<input "text" =type "url" =name input/>
|
||||
<input "submit" =type "Submit" =value input/>
|
||||
</form>
|
||||
] simple-html-document ;
|
||||
|
||||
: url-submitted ( url-long url-short -- )
|
||||
"URL Submitted" [
|
||||
"URL: " write write nl
|
||||
"wee-url: " write
|
||||
<a dup wee-url =href a> wee-url write </a> nl
|
||||
"Back to " write
|
||||
<a responder-url =href a> "wee-url" write </a> nl
|
||||
] simple-html-document ;
|
||||
|
||||
: url-submit ( url -- )
|
||||
serving-html
|
||||
prepare-wee-url [ add-shortcut ] keep url-submitted ;
|
||||
|
||||
: url-error ( -- )
|
||||
serving-html
|
||||
"wee-url error" [
|
||||
"No such link." write
|
||||
] simple-html-document ;
|
||||
|
||||
: wee-url-responder ( url -- )
|
||||
"url" query-param [
|
||||
url-submit drop
|
||||
] [
|
||||
dup empty? [
|
||||
drop url-prompt
|
||||
] [
|
||||
wee-shortcuts get at*
|
||||
[ permanent-redirect ] [ drop url-error ] if
|
||||
] if
|
||||
] if* ;
|
||||
|
||||
[
|
||||
"wee-url" "responder" set
|
||||
[ wee-url-responder ] "get" set
|
||||
] make-responder
|
||||
|
|
@ -1,89 +0,0 @@
|
|||
! Copyright (C) 2007 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: assocs furnace html html.elements http.server
|
||||
http.server.responders io kernel math math.ranges
|
||||
namespaces random sequences store strings ;
|
||||
IN: webapps.wee-url
|
||||
|
||||
SYMBOL: shortcuts
|
||||
SYMBOL: store
|
||||
|
||||
! "wee-url.store" load-store store set-global
|
||||
! H{ } clone shortcuts store get store-variable
|
||||
|
||||
: set-at-once ( value key assoc -- ? )
|
||||
2dup key? [ 3drop f ] [ set-at t ] if ;
|
||||
|
||||
: responder-url "responder/wee-url" ;
|
||||
|
||||
: wee-url ( string -- url )
|
||||
[
|
||||
"http://" %
|
||||
host %
|
||||
responder-url %
|
||||
%
|
||||
] "" make ;
|
||||
|
||||
: letter-bank
|
||||
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890" ; inline
|
||||
|
||||
: random-url ( -- string )
|
||||
1 6 [a,b] random [ drop letter-bank random ] "" map-as
|
||||
dup shortcuts get key? [ drop random-url ] when ;
|
||||
|
||||
: add-shortcut ( url-long url-short -- url-short )
|
||||
shortcuts get set-at-once [
|
||||
store get save-store
|
||||
] [
|
||||
drop
|
||||
] if ;
|
||||
|
||||
: show-submit ( -- )
|
||||
serving-html
|
||||
"wee-url.com - wee URLs since 2007" [
|
||||
<form "get" =method "url-submit" =action form>
|
||||
"URL: " write
|
||||
<input "text" =type "url" =name input/>
|
||||
<input "submit" =type "Submit" =value input/>
|
||||
</form>
|
||||
] simple-html-document ;
|
||||
|
||||
\ show-submit { } define-action
|
||||
|
||||
: url-submitted ( url-long url-short -- )
|
||||
"URL Submitted" [
|
||||
"URL: " write write nl
|
||||
"wee-url: " write
|
||||
<a dup wee-url =href a> wee-url write </a> nl
|
||||
"Back to " write
|
||||
<a responder-url =href a> "wee-url" write </a> nl
|
||||
] simple-html-document ;
|
||||
|
||||
: url-submit ( url -- )
|
||||
[ add-shortcut ] keep
|
||||
url-submitted ;
|
||||
|
||||
\ url-submit {
|
||||
{ "url" }
|
||||
} define-action
|
||||
|
||||
: url-error ( -- )
|
||||
serving-html
|
||||
"wee-url error" [
|
||||
"No such link." write
|
||||
] simple-html-document ;
|
||||
|
||||
: wee-url-responder ( url -- )
|
||||
"url" query-param [
|
||||
url-submit drop
|
||||
] [
|
||||
dup empty? [
|
||||
drop show-submit
|
||||
] [
|
||||
shortcuts get at*
|
||||
[ permanent-redirect ] [ drop url-error ] if
|
||||
] if
|
||||
] if* ;
|
||||
|
||||
! "wee-url" "wee-url-responder" "extra/webapps/wee-url" web-app
|
||||
~
|
||||
Loading…
Reference in New Issue