Merge branch 'master' of git://factorcode.org/git/factor
Doug Coleman
commit
7fea8f6381
|
|
@ -10,7 +10,7 @@ HELP: add-alarm
|
|||
|
||||
HELP: later
|
||||
{ $values { "quot" quotation } { "dt" duration } { "alarm" alarm } }
|
||||
{ $description "Creates and registers an alarm which calls the quotation once at " { $snippet "time" } { $link from-now } "." } ;
|
||||
{ $description "Creates and registers an alarm which calls the quotation once at " { $snippet "time" } " from now." } ;
|
||||
|
||||
HELP: cancel-alarm
|
||||
{ $values { "alarm" alarm } }
|
||||
|
|
|
|||
|
|
@ -82,10 +82,10 @@ PRIVATE>
|
|||
<alarm> [ register-alarm ] keep ;
|
||||
|
||||
: later ( quot dt -- alarm )
|
||||
from-now f add-alarm ;
|
||||
hence f add-alarm ;
|
||||
|
||||
: every ( quot dt -- alarm )
|
||||
[ from-now ] keep add-alarm ;
|
||||
[ hence ] keep add-alarm ;
|
||||
|
||||
: cancel-alarm ( alarm -- )
|
||||
alarm-entry [ alarms get-global heap-delete ] if-box? ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
|
||||
USING: kernel parser namespaces sequences quotations arrays vectors splitting
|
||||
words math
|
||||
macros generalizations combinators.lib combinators.conditional newfx ;
|
||||
strings words math generalizations
|
||||
macros combinators.lib combinators.conditional newfx ;
|
||||
|
||||
IN: bake
|
||||
|
||||
|
|
@ -20,7 +20,9 @@ DEFER: [bake]
|
|||
: broil-element ( obj -- quot )
|
||||
{
|
||||
{ [ comma? ] [ drop [ >r ] ] }
|
||||
{ [ f = ] [ [ >r ] prefix-on ] }
|
||||
{ [ integer? ] [ [ >r ] prefix-on ] }
|
||||
{ [ string? ] [ [ >r ] prefix-on ] }
|
||||
{ [ sequence? ] [ [bake] [ >r ] append ] }
|
||||
{ [ word? ] [ literalize [ >r ] prefix-on ] }
|
||||
{ [ drop t ] [ [ >r ] prefix-on ] }
|
||||
|
|
@ -90,5 +92,6 @@ MACRO: bake ( seq -- quot ) [bake] ;
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: `{ \ } [ >array ] parse-literal \ bake parsed ; parsing
|
||||
: `{ \ } [ >array ] parse-literal \ bake parsed ; parsing
|
||||
: `V{ \ } [ >vector ] parse-literal \ bake parsed ; parsing
|
||||
: `[ \ } [ >quotation ] parse-literal \ bake parsed ; parsing
|
||||
|
|
@ -13,74 +13,74 @@ IN: bake.fry.tests
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
[ [ 3 + ] ] [ 3 `[ , + ] ] unit-test
|
||||
[ [ 3 + ] ] [ 3 '[ , + ] ] unit-test
|
||||
|
||||
[ [ 1 3 + ] ] [ 1 3 `[ , , + ] ] unit-test
|
||||
[ [ 1 3 + ] ] [ 1 3 '[ , , + ] ] unit-test
|
||||
|
||||
[ [ 1 + ] ] [ 1 [ + ] `[ , @ ] ] unit-test
|
||||
[ [ 1 + ] ] [ 1 [ + ] '[ , @ ] ] unit-test
|
||||
|
||||
[ [ 1 + . ] ] [ 1 [ + ] `[ , @ . ] ] unit-test
|
||||
[ [ 1 + . ] ] [ 1 [ + ] '[ , @ . ] ] unit-test
|
||||
|
||||
[ [ + - ] ] [ [ + ] [ - ] `[ @ @ ] ] unit-test
|
||||
[ [ + - ] ] [ [ + ] [ - ] '[ @ @ ] ] unit-test
|
||||
|
||||
[ [ "a" write "b" print ] ]
|
||||
[ "a" "b" `[ , write , print ] ] unit-test
|
||||
[ "a" "b" '[ , write , print ] ] unit-test
|
||||
|
||||
[ [ 1 2 + 3 4 - ] ]
|
||||
[ [ + ] [ - ] `[ 1 2 @ 3 4 @ ] ] unit-test
|
||||
[ [ + ] [ - ] '[ 1 2 @ 3 4 @ ] ] unit-test
|
||||
|
||||
[ 1/2 ] [
|
||||
1 `[ , _ / ] 2 swap call
|
||||
1 '[ , _ / ] 2 swap call
|
||||
] unit-test
|
||||
|
||||
[ { { 1 "a" "A" } { 1 "b" "B" } { 1 "c" "C" } } ] [
|
||||
1 `[ , _ _ 3array ]
|
||||
1 '[ , _ _ 3array ]
|
||||
{ "a" "b" "c" } { "A" "B" "C" } rot 2map
|
||||
] unit-test
|
||||
|
||||
[ { { 1 "a" } { 1 "b" } { 1 "c" } } ] [
|
||||
`[ 1 _ 2array ]
|
||||
'[ 1 _ 2array ]
|
||||
{ "a" "b" "c" } swap map
|
||||
] unit-test
|
||||
|
||||
[ 1 2 ] [
|
||||
1 2 `[ _ , ] call
|
||||
1 2 '[ _ , ] call
|
||||
] unit-test
|
||||
|
||||
[ { { 1 "a" 2 } { 1 "b" 2 } { 1 "c" 2 } } ] [
|
||||
1 2 `[ , _ , 3array ]
|
||||
1 2 '[ , _ , 3array ]
|
||||
{ "a" "b" "c" } swap map
|
||||
] unit-test
|
||||
|
||||
: funny-dip `[ @ _ ] call ; inline
|
||||
: funny-dip '[ @ _ ] call ; inline
|
||||
|
||||
[ "hi" 3 ] [ "h" "i" 3 [ append ] funny-dip ] unit-test
|
||||
|
||||
[ { 1 2 3 } ] [
|
||||
3 1 `[ , [ , + ] map ] call
|
||||
3 1 '[ , [ , + ] map ] call
|
||||
] unit-test
|
||||
|
||||
[ { 1 { 2 { 3 } } } ] [
|
||||
1 2 3 `[ , [ , [ , 1array ] call 2array ] call 2array ] call
|
||||
1 2 3 '[ , [ , [ , 1array ] call 2array ] call 2array ] call
|
||||
] unit-test
|
||||
|
||||
{ 1 1 } [ `[ [ [ , ] ] ] ] must-infer-as
|
||||
{ 1 1 } [ '[ [ [ , ] ] ] ] must-infer-as
|
||||
|
||||
[ { { { 3 } } } ] [
|
||||
3 `[ [ [ , 1array ] call 1array ] call 1array ] call
|
||||
3 '[ [ [ , 1array ] call 1array ] call 1array ] call
|
||||
] unit-test
|
||||
|
||||
[ { { { 3 } } } ] [
|
||||
3 `[ [ [ , 1array ] call 1array ] call 1array ] call
|
||||
3 '[ [ [ , 1array ] call 1array ] call 1array ] call
|
||||
] unit-test
|
||||
|
||||
! [ 10 20 30 40 `[ , V{ , { , } } , ] ] [ [ 10 V{ 20 { 30 } } 40 ] ] unit-test*
|
||||
! [ 10 20 30 40 '[ , V{ , { , } } , ] ] [ [ 10 V{ 20 { 30 } } 40 ] ] unit-test*
|
||||
|
||||
[ 10 20 30 40 `[ , V{ , { , } } , ] ]
|
||||
[ 10 20 30 40 '[ , V{ , { , } } , ] ]
|
||||
[ [ 10 20 30 >r r> 1 narray >r >r r> r> 2 narray >vector 40 ] ]
|
||||
unit-test*
|
||||
|
||||
[ { 1 2 3 } { 4 5 6 } { 7 8 9 } `[ , { V{ @ } { , } } ] call ]
|
||||
[ { 1 2 3 } { 4 5 6 } { 7 8 9 } '[ , { V{ @ } { , } } ] call ]
|
||||
[
|
||||
{ 1 2 3 }
|
||||
{ V{ 4 5 6 } { { 7 8 9 } } }
|
||||
|
|
|
|||
|
|
@ -77,4 +77,4 @@ DEFER: shallow-fry
|
|||
|
||||
MACRO: fry ( seq -- quot ) [fry] ;
|
||||
|
||||
: `[ \ ] [ >quotation ] parse-literal \ fry parsed ; parsing
|
||||
: '[ \ ] [ >quotation ] parse-literal \ fry parsed ; parsing
|
||||
|
|
@ -284,7 +284,7 @@ MEMO: unix-1970 ( -- timestamp )
|
|||
|
||||
: now ( -- timestamp ) gmt >local-time ;
|
||||
|
||||
: from-now ( dt -- timestamp ) now swap time+ ;
|
||||
: hence ( dt -- timestamp ) now swap time+ ;
|
||||
: ago ( dt -- timestamp ) now swap time- ;
|
||||
|
||||
: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } ; inline
|
||||
|
|
@ -357,7 +357,7 @@ M: timestamp days-in-year ( timestamp -- n ) year>> days-in-year ;
|
|||
|
||||
M: timestamp sleep-until timestamp>millis sleep-until ;
|
||||
|
||||
M: duration sleep from-now sleep-until ;
|
||||
M: duration sleep hence sleep-until ;
|
||||
|
||||
{
|
||||
{ [ os unix? ] [ "calendar.unix" ] }
|
||||
|
|
|
|||
|
|
@ -12,9 +12,9 @@ HELP: ctags ( path -- )
|
|||
{ $values { "path" "a pathname string" } }
|
||||
{ $description "Generates a index file in ctags format and stores in " { $snippet "path" } "." }
|
||||
{ $examples
|
||||
{ $example
|
||||
{ $unchecked-example
|
||||
"USING: ctags ;"
|
||||
"\"tags\" ctags-write"
|
||||
"\"tags\" ctags"
|
||||
""
|
||||
}
|
||||
} ;
|
||||
|
|
@ -24,7 +24,7 @@ HELP: ctags-write ( seq path -- )
|
|||
{ "path" "a pathname string" } }
|
||||
{ $description "Stores a " { $snippet "alist" } " in " { $snippet "path" } ". " { $snippet "alist" } " must be an association list with ctags format: key must be a valid word and value a sequence whose first element is a resource name and second element is a line number" }
|
||||
{ $examples
|
||||
{ $example
|
||||
{ $unchecked-example
|
||||
"USING: kernel ctags ;"
|
||||
"{ { if { \"resource:extra/unix/unix.factor\" 91 } } } \"tags\" ctags-write"
|
||||
""
|
||||
|
|
@ -38,9 +38,9 @@ HELP: ctag-strings ( alist -- seq )
|
|||
{ "seq" sequence } }
|
||||
{ $description "Converts an " { $snippet "alist" } " with ctag format (a word as key and a sequence whose first element is a resource name and a second element is a line number as value) in a " { $snippet "seq" } " of ctag strings." }
|
||||
{ $examples
|
||||
{ $example
|
||||
"USING: kernel ctags ;"
|
||||
"{ { if { \"resource:extra/unix/unix.factor\" 91 } } } ctag-strings"
|
||||
{ $unchecked-example
|
||||
"USING: kernel ctags prettyprint ;"
|
||||
"{ { if { \"resource:extra/unix/unix.factor\" 91 } } } ctag-strings ."
|
||||
"{ \"if\\t/path/to/factor/extra/unix/unix.factor\\t91\" }"
|
||||
}
|
||||
} ;
|
||||
|
|
@ -50,8 +50,8 @@ HELP: ctag ( seq -- str )
|
|||
{ "str" string } }
|
||||
{ $description "Outputs a string " { $snippet "str" } " in ctag format for sequence with two elements, first one must be a valid word and second one a sequence whose first element is a resource name and second element is a line number" }
|
||||
{ $examples
|
||||
{ $example
|
||||
"USING: kernel ctags ;"
|
||||
{ $unchecked-example
|
||||
"USING: kernel ctags prettyprint ;"
|
||||
"{ if { \"resource:extra/unix/unix.factor\" 91 } } ctag ."
|
||||
"\"if\\t/path/to/factor/extra/unix/unix.factor\\t91\""
|
||||
}
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@ IN: ctags
|
|||
{ } swap [ ctag suffix ] each ;
|
||||
|
||||
: ctags-write ( seq path -- )
|
||||
>r ctag-strings r> ascii set-file-lines ;
|
||||
[ ctag-strings ] dip ascii set-file-lines ;
|
||||
|
||||
: (ctags) ( -- seq )
|
||||
{ } all-words [
|
||||
|
|
|
|||
|
|
@ -1,8 +1,22 @@
|
|||
IN: db.pools.tests
|
||||
USING: db.pools tools.test ;
|
||||
USING: db.pools tools.test continuations io.files namespaces
|
||||
accessors kernel math destructors ;
|
||||
|
||||
\ <db-pool> must-infer
|
||||
|
||||
{ 2 0 } [ [ ] with-db-pool ] must-infer-as
|
||||
|
||||
{ 1 0 } [ [ ] with-pooled-db ] must-infer-as
|
||||
|
||||
! Test behavior after image save/load
|
||||
USE: db.sqlite
|
||||
|
||||
[ "pool-test.db" temp-file delete-file ] ignore-errors
|
||||
|
||||
[ ] [ "pool-test.db" sqlite-db <db-pool> "pool" set ] unit-test
|
||||
|
||||
[ ] [ "pool" get expired>> t >>expired drop ] unit-test
|
||||
|
||||
[ ] [ 1000 [ "pool" get [ ] with-pooled-db ] times ] unit-test
|
||||
|
||||
[ ] [ "pool" get dispose ] unit-test
|
||||
|
|
|
|||
|
|
@ -15,11 +15,11 @@ IN: documents
|
|||
|
||||
: lines-equal? ( loc1 loc2 -- ? ) [ first ] bi@ number= ;
|
||||
|
||||
TUPLE: document locs ;
|
||||
TUPLE: document < model locs ;
|
||||
|
||||
: <document> ( -- document )
|
||||
V{ "" } clone <model> V{ } clone
|
||||
{ set-delegate set-document-locs } document construct ;
|
||||
V{ "" } clone document new-model
|
||||
V{ } clone >>locs ;
|
||||
|
||||
: add-loc ( loc document -- ) locs>> push ;
|
||||
|
||||
|
|
|
|||
|
|
@ -40,10 +40,9 @@ M: login-realm modify-form ( responder -- )
|
|||
permit-id get realm get name>> permit-id-key <cookie>
|
||||
"$login-realm" resolve-base-path >>path
|
||||
realm get
|
||||
[ timeout>> from-now >>expires ]
|
||||
[ domain>> >>domain ]
|
||||
[ secure>> >>secure ]
|
||||
tri ;
|
||||
bi ;
|
||||
|
||||
: put-permit-cookie ( response -- response' )
|
||||
<permit-cookie> put-cookie ;
|
||||
|
|
|
|||
|
|
@ -31,6 +31,6 @@ TUPLE: server-state-manager < filter-responder timeout ;
|
|||
new
|
||||
swap >>responder
|
||||
20 minutes >>timeout ; inline
|
||||
|
||||
|
||||
: touch-state ( state manager -- )
|
||||
timeout>> from-now >>expires drop ;
|
||||
timeout>> hence >>expires drop ;
|
||||
|
|
|
|||
|
|
@ -116,7 +116,6 @@ M: session-saver dispose
|
|||
: <session-cookie> ( -- cookie )
|
||||
session get id>> session-id-key <cookie>
|
||||
"$sessions" resolve-base-path >>path
|
||||
sessions get timeout>> from-now >>expires
|
||||
sessions get domain>> >>domain ;
|
||||
|
||||
: put-session-cookie ( response -- response' )
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ TUPLE: pool connections disposed expired ;
|
|||
: check-pool ( pool -- )
|
||||
dup check-disposed
|
||||
dup expired>> expired? [
|
||||
ALIEN: 31337 >>expired
|
||||
31337 <alien> >>expired
|
||||
connections>> delete-all
|
||||
] [ drop ] if ;
|
||||
|
||||
|
|
|
|||
|
|
@ -125,7 +125,8 @@ M: fd refill
|
|||
} cond ;
|
||||
|
||||
M: unix (wait-to-read) ( port -- )
|
||||
dup dup handle>> refill dup
|
||||
dup
|
||||
dup handle>> dup check-disposed refill dup
|
||||
[ dupd wait-for-port (wait-to-read) ] [ 2drop ] if ;
|
||||
|
||||
! Writers
|
||||
|
|
@ -144,7 +145,9 @@ M: fd drain
|
|||
} cond ;
|
||||
|
||||
M: unix (wait-to-write) ( port -- )
|
||||
dup dup handle>> drain dup [ wait-for-port ] [ 2drop ] if ;
|
||||
dup
|
||||
dup handle>> dup check-disposed drain
|
||||
dup [ wait-for-port ] [ 2drop ] if ;
|
||||
|
||||
M: unix io-multiplex ( ms/f -- )
|
||||
mx get-global wait-for-events ;
|
||||
|
|
|
|||
|
|
@ -61,6 +61,7 @@ C: <FileArgs> FileArgs
|
|||
|
||||
: make-FileArgs ( port -- <FileArgs> )
|
||||
{
|
||||
[ handle>> check-disposed ]
|
||||
[ handle>> handle>> ]
|
||||
[ buffer>> ]
|
||||
[ buffer>> buffer-length ]
|
||||
|
|
|
|||
|
|
@ -74,7 +74,7 @@ M: winnt add-completion ( win32-handle -- )
|
|||
] if ;
|
||||
|
||||
M: win32-handle cancel-operation
|
||||
handle>> CancelIo drop ;
|
||||
[ check-disposed ] [ handle>> CancelIo drop ] bi ;
|
||||
|
||||
M: winnt io-multiplex ( ms -- )
|
||||
handle-overlapped [ 0 io-multiplex ] when ;
|
||||
|
|
|
|||
|
|
@ -45,7 +45,7 @@ tetris-gadget H{
|
|||
dup tetris-gadget-tetris maybe-update relayout-1 ;
|
||||
|
||||
M: tetris-gadget graft* ( gadget -- )
|
||||
dup [ tick ] curry 100 milliseconds from-now 100 milliseconds add-alarm
|
||||
dup [ tick ] curry 100 milliseconds every
|
||||
swap set-tetris-gadget-alarm ;
|
||||
|
||||
M: tetris-gadget ungraft* ( gadget -- )
|
||||
|
|
|
|||
|
|
@ -121,7 +121,7 @@ SYMBOL: drag-timer
|
|||
: start-drag-timer ( -- )
|
||||
hand-buttons get-global empty? [
|
||||
[ drag-gesture ]
|
||||
300 milliseconds from-now
|
||||
300 milliseconds hence
|
||||
100 milliseconds
|
||||
add-alarm drag-timer get-global >box
|
||||
] when ;
|
||||
|
|
|
|||
|
|
@ -1,14 +0,0 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
|
||||
<t:bind-each t:name="postings">
|
||||
|
||||
<p class="news">
|
||||
<strong><t:label t:name="title" /></strong> <br/>
|
||||
<t:a value="link" class="more">Read More...</t:a>
|
||||
</p>
|
||||
|
||||
</t:bind-each>
|
||||
|
||||
</t:chloe>
|
||||
|
|
@ -0,0 +1,63 @@
|
|||
Look at the source to this page by clicking *Edit* to compare the farkup language with resulting output.
|
||||
|
||||
= level 1 heading =
|
||||
|
||||
== level 2 heading ==
|
||||
|
||||
=== level 3 heading ===
|
||||
|
||||
==== level 4 heading ====
|
||||
|
||||
Here is a paragraph of text, with _emphasized_ and *strong* text, together with an inline %code snippet%. Did you know that E=mc^2^, and L~2~ spaces are cool? Of course, if you want to include \_ special \* characters \^ you \~ can \% do that, too.
|
||||
|
||||
You can make [[Wiki Links]] just like that, as well as links to external sites: [[http://sbcl.sourceforge.net]]. [[Factor|Custom link text]] can be used [[http://www.apple.com|with both types of links]].
|
||||
|
||||
Images can be embedded in the text:
|
||||
|
||||
[[image:http://factorcode.org/graphics/logo.png]]
|
||||
|
||||
- a list
|
||||
- with three
|
||||
- items
|
||||
|
||||
|a table|with|four|columns|
|
||||
|and|two|rows|...|
|
||||
|
||||
Here is some code:
|
||||
|
||||
[{HAI
|
||||
CAN HAS STDIO?
|
||||
VISIBLE "HAI WORLD!"
|
||||
KTHXBYE}]
|
||||
|
||||
There is syntax highlighting various languages, too:
|
||||
|
||||
[factor{PEG: parse-request-line ( string -- triple )
|
||||
#! Triple is { method url version }
|
||||
[
|
||||
'space' ,
|
||||
'http-method' ,
|
||||
'space' ,
|
||||
'url' ,
|
||||
'space' ,
|
||||
'http-version' ,
|
||||
'space' ,
|
||||
] seq* just ;}]
|
||||
|
||||
Some Java:
|
||||
|
||||
[java{/**
|
||||
* Returns the extension of the specified filename, or an empty
|
||||
* string if there is none.
|
||||
* @param path The path
|
||||
*/
|
||||
public static String getFileExtension(String path)
|
||||
{
|
||||
int fsIndex = getLastSeparatorIndex(path);
|
||||
int index = path.lastIndexOf('.');
|
||||
// there could be a dot in the path and no file extension
|
||||
if(index == -1 || index < fsIndex )
|
||||
return "";
|
||||
else
|
||||
return path.substring(index);
|
||||
}}]
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
Congratulations, you are now running your very own Wiki.
|
||||
|
||||
You can now click *Edit* below and begin editing the content of the [[Front Page]]. This Wiki uses [[Farkup]] to mark up text.
|
||||
|
||||
Two special article names are recognized by the Wiki: [[Sidebar]] and [[Footer]]. They do not exist by default, but if you create them, they will be visible on every page.
|
||||
|
|
@ -13,6 +13,7 @@
|
|||
<t:a t:href="$wiki">Front Page</t:a>
|
||||
| <t:a t:href="$wiki/articles">All Articles</t:a>
|
||||
| <t:a t:href="$wiki/changes">Recent Changes</t:a>
|
||||
| <t:a t:href="$wiki/random">Random Article</t:a>
|
||||
|
||||
<t:if t:code="furnace.auth:logged-in?">
|
||||
|
||||
|
|
@ -45,6 +46,16 @@
|
|||
</td>
|
||||
</t:if>
|
||||
</tr>
|
||||
|
||||
<tr>
|
||||
<td>
|
||||
<t:bind t:name="footer">
|
||||
<small>
|
||||
<t:farkup t:name="content" />
|
||||
</small>
|
||||
</t:bind>
|
||||
</td>
|
||||
</tr>
|
||||
</table>
|
||||
|
||||
</t:chloe>
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (C) 2008 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel hashtables calendar
|
||||
USING: accessors kernel hashtables calendar random assocs
|
||||
namespaces splitting sequences sorting math.order present
|
||||
io.files io.encodings.ascii
|
||||
syndication
|
||||
html.components html.forms
|
||||
http.server
|
||||
|
|
@ -115,6 +116,14 @@ M: revision feed-entry-url id>> revision-url ;
|
|||
|
||||
{ wiki "view" } >>template ;
|
||||
|
||||
: <random-article-action> ( -- action )
|
||||
<action>
|
||||
[
|
||||
article new select-tuples random
|
||||
[ title>> ] [ "Front Page" ] if*
|
||||
view-url <redirect>
|
||||
] >>display ;
|
||||
|
||||
: amend-article ( revision article -- )
|
||||
swap id>> >>revision update-tuple ;
|
||||
|
||||
|
|
@ -286,15 +295,15 @@ M: revision feed-entry-url id>> revision-url ;
|
|||
{ wiki "page-common" } >>template ;
|
||||
|
||||
: init-sidebar ( -- )
|
||||
"Sidebar" latest-revision [
|
||||
"sidebar" [ from-object ] nest-form
|
||||
] when* ;
|
||||
"Sidebar" latest-revision [ "sidebar" [ from-object ] nest-form ] when*
|
||||
"Footer" latest-revision [ "footer" [ from-object ] nest-form ] when* ;
|
||||
|
||||
: <wiki> ( -- dispatcher )
|
||||
wiki new-dispatcher
|
||||
<main-article-action> <article-boilerplate> "" add-responder
|
||||
<view-article-action> <article-boilerplate> "view" add-responder
|
||||
<view-revision-action> <article-boilerplate> "revision" add-responder
|
||||
<random-article-action> "random" add-responder
|
||||
<list-revisions-action> <article-boilerplate> "revisions" add-responder
|
||||
<list-revisions-feed-action> "revisions.atom" add-responder
|
||||
<diff-action> <article-boilerplate> "diff" add-responder
|
||||
|
|
@ -309,3 +318,15 @@ M: revision feed-entry-url id>> revision-url ;
|
|||
<boilerplate>
|
||||
[ init-sidebar ] >>init
|
||||
{ wiki "wiki-common" } >>template ;
|
||||
|
||||
: init-wiki ( -- )
|
||||
"resource:extra/webapps/wiki/initial-content" directory* keys
|
||||
[
|
||||
[ ascii file-contents ] [ file-name "." split1 drop ] bi
|
||||
f <revision>
|
||||
swap >>title
|
||||
swap >>content
|
||||
"slava" >>author
|
||||
now >>date
|
||||
add-revision
|
||||
] each ;
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ webapps.wee-url
|
|||
webapps.user-admin ;
|
||||
IN: websites.concatenative
|
||||
|
||||
: test-db ( -- db params ) "resource:test.db" sqlite-db ;
|
||||
: test-db ( -- params db ) "resource:test.db" sqlite-db ;
|
||||
|
||||
: init-factor-db ( -- )
|
||||
test-db [
|
||||
|
|
|
|||
|
|
@ -1285,10 +1285,10 @@ FUNCTION: void SetLastErrorEx ( DWORD dwErrCode, DWORD dwType ) ;
|
|||
! FUNCTION: SetWindowPlacement
|
||||
FUNCTION: BOOL SetWindowPos ( HWND hWnd, HWND hWndInsertAfter, int X, int Y, int cx, int cy, UINT uFlags ) ;
|
||||
|
||||
: HWND_BOTTOM ALIEN: 1 ;
|
||||
: HWND_NOTOPMOST ALIEN: -2 ;
|
||||
: HWND_TOP ALIEN: 0 ;
|
||||
: HWND_TOPMOST ALIEN: -1 ;
|
||||
: HWND_BOTTOM ( -- alien ) 1 <alien> ;
|
||||
: HWND_NOTOPMOST ( -- alien ) -2 <alien> ;
|
||||
: HWND_TOP ( -- alien ) 0 <alien> ;
|
||||
: HWND_TOPMOST ( -- alien ) -1 <alien> ;
|
||||
|
||||
! FUNCTION: SetWindowRgn
|
||||
! FUNCTION: SetWindowsHookA
|
||||
|
|
|
|||
Loading…
Reference in New Issue