Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2008-05-30 22:48:10 -05:00
commit 114fb0d83e
2 changed files with 43 additions and 44 deletions

View File

@ -4,7 +4,7 @@ USING: threads kernel namespaces continuations combinators
sequences math namespaces.private continuations.private sequences math namespaces.private continuations.private
concurrency.messaging quotations kernel.private words concurrency.messaging quotations kernel.private words
sequences.private assocs models arrays accessors sequences.private assocs models arrays accessors
generic generic.standard ; generic generic.standard definitions ;
IN: tools.walker IN: tools.walker
SYMBOL: show-walker-hook ! ( status continuation thread -- ) SYMBOL: show-walker-hook ! ( status continuation thread -- )
@ -73,6 +73,7 @@ M: object add-breakpoint ;
{ [ dup "step-into" word-prop ] [ "step-into" word-prop call ] } { [ dup "step-into" word-prop ] [ "step-into" word-prop call ] }
{ [ dup standard-generic? ] [ effective-method (step-into-execute) ] } { [ dup standard-generic? ] [ effective-method (step-into-execute) ] }
{ [ dup hook-generic? ] [ effective-method (step-into-execute) ] } { [ dup hook-generic? ] [ effective-method (step-into-execute) ] }
{ [ dup uses \ suspend swap member? ] [ execute break ] }
{ [ dup primitive? ] [ execute break ] } { [ dup primitive? ] [ execute break ] }
[ word-def (step-into-quot) ] [ word-def (step-into-quot) ]
} cond ; } cond ;
@ -89,7 +90,6 @@ SYMBOL: step-into
SYMBOL: step-all SYMBOL: step-all
SYMBOL: step-into-all SYMBOL: step-into-all
SYMBOL: step-back SYMBOL: step-back
SYMBOL: detach
SYMBOL: abandon SYMBOL: abandon
SYMBOL: call-in SYMBOL: call-in
@ -137,7 +137,7 @@ SYMBOL: +stopped+
{ {
>n ndrop >c c> >n ndrop >c c>
continue continue-with continue continue-with
stop yield suspend sleep (spawn) stop suspend (spawn)
} [ } [
dup [ execute break ] curry dup [ execute break ] curry
"step-into" set-word-prop "step-into" set-word-prop
@ -168,10 +168,7 @@ SYMBOL: +stopped+
+running+ set-status ; +running+ set-status ;
: walker-stopped ( -- ) : walker-stopped ( -- )
+stopped+ set-status +stopped+ set-status ;
[ status +stopped+ eq? ]
[ [ drop f ] handle-synchronous ]
[ ] while ;
: step-into-all-loop ( -- ) : step-into-all-loop ( -- )
+running+ set-status +running+ set-status

View File

@ -15,18 +15,22 @@ IN: webapps.pastebin
! DOMAIN MODEL ! DOMAIN MODEL
! ! ! ! ! !
TUPLE: paste id summary author mode date contents annotations ; TUPLE: entity id summary author mode date contents ;
\ paste "PASTE" entity f
{ {
{ "id" "ID" INTEGER +db-assigned-id+ } { "id" "ID" INTEGER +db-assigned-id+ }
{ "summary" "SUMMARY" { VARCHAR 256 } +not-null+ } { "summary" "SUMMARY" { VARCHAR 256 } +not-null+ }
{ "author" "AUTHOR" { VARCHAR 256 } +not-null+ } { "author" "AUTHOR" { VARCHAR 256 } +not-null+ }
{ "mode" "MODE" { VARCHAR 256 } +not-null+ } { "mode" "MODE" { VARCHAR 256 } +not-null+ }
{ "date" "DATE" DATETIME +not-null+ , } { "date" "DATE" DATETIME +not-null+ }
{ "contents" "CONTENTS" TEXT +not-null+ } { "contents" "CONTENTS" TEXT +not-null+ }
} define-persistent } define-persistent
TUPLE: paste < entity annotations ;
\ paste "PASTES" { } define-persistent
: <paste> ( id -- paste ) : <paste> ( id -- paste )
\ paste new \ paste new
swap >>id ; swap >>id ;
@ -34,23 +38,17 @@ TUPLE: paste id summary author mode date contents annotations ;
: pastes ( -- pastes ) : pastes ( -- pastes )
f <paste> select-tuples ; f <paste> select-tuples ;
TUPLE: annotation aid id summary author mode contents date ; TUPLE: annotation < entity parent ;
annotation "ANNOTATION" annotation "ANNOTATIONS"
{ {
{ "aid" "AID" INTEGER +db-assigned-id+ } { "parent" "PARENT" INTEGER +not-null+ }
{ "id" "ID" INTEGER +not-null+ }
{ "summary" "SUMMARY" { VARCHAR 256 } +not-null+ }
{ "author" "AUTHOR" { VARCHAR 256 } +not-null+ }
{ "mode" "MODE" { VARCHAR 256 } +not-null+ }
{ "date" "DATE" DATETIME +not-null+ }
{ "contents" "CONTENTS" TEXT +not-null+ }
} define-persistent } define-persistent
: <annotation> ( id aid -- annotation ) : <annotation> ( parent id -- annotation )
annotation new annotation new
swap >>aid swap >>id
swap >>id ; swap >>parent ;
: fetch-annotations ( paste -- paste ) : fetch-annotations ( paste -- paste )
dup annotations>> [ dup annotations>> [
@ -76,8 +74,8 @@ M: paste entity-link
id>> "id" associate "$pastebin/paste" swap link>string ; id>> "id" associate "$pastebin/paste" swap link>string ;
M: annotation entity-link M: annotation entity-link
[ id>> "id" associate "$pastebin/paste" swap link>string ] [ parent>> "parent" associate "$pastebin/paste" swap link>string ]
[ aid>> number>string "#" prepend ] bi [ id>> number>string "#" prepend ] bi
append ; append ;
: pastebin-template ( name -- template ) : pastebin-template ( name -- template )
@ -147,7 +145,7 @@ M: annotation entity-link
[ validate-integer-id ] >>init [ validate-integer-id ] >>init
[ "id" value paste annotations>> paste-feed ] >>feed ; [ "id" value paste annotations>> paste-feed ] >>feed ;
: validate-paste ( -- ) : validate-entity ( -- )
{ {
{ "summary" [ v-one-line ] } { "summary" [ v-one-line ] }
{ "author" [ v-one-line ] } { "author" [ v-one-line ] }
@ -156,7 +154,7 @@ M: annotation entity-link
{ "captcha" [ v-captcha ] } { "captcha" [ v-captcha ] }
} validate-params ; } validate-params ;
: deposit-paste-slots ( tuple -- ) : deposit-entity-slots ( tuple -- )
now >>date now >>date
{ "summary" "author" "mode" "contents" } deposit-slots ; { "summary" "author" "mode" "contents" } deposit-slots ;
@ -170,10 +168,10 @@ M: annotation entity-link
"new-paste" pastebin-template >>template "new-paste" pastebin-template >>template
[ [
validate-paste validate-entity
f <paste> f <paste>
[ deposit-paste-slots ] [ deposit-entity-slots ]
[ insert-tuple ] [ insert-tuple ]
[ id>> "$pastebin/paste" <id-redirect> ] [ id>> "$pastebin/paste" <id-redirect> ]
tri tri
@ -195,31 +193,35 @@ M: annotation entity-link
: <new-annotation-action> ( -- action ) : <new-annotation-action> ( -- action )
<page-action> <page-action>
[ validate-paste ] >>validate [
{ { "id" [ v-integer ] } } validate-params
[ "id" param "$pastebin/paste" <id-redirect> ] >>display "id" value "$pastebin/paste" <id-redirect>
] >>display
[ [
f f <annotation> { { "id" [ v-integer ] } } validate-params
{ validate-entity
[ deposit-paste-slots ] ] >>validate
[ { "id" } deposit-slots ]
[ insert-tuple ] [
[ "id" value f <annotation>
! Add anchor here [ deposit-entity-slots ]
id>> "$pastebin/paste" <id-redirect> [ insert-tuple ]
] [
} cleave ! Add anchor here
parent>> "$pastebin/paste" <id-redirect>
]
tri
] >>submit ; ] >>submit ;
: <delete-annotation-action> ( -- action ) : <delete-annotation-action> ( -- action )
<action> <action>
[ { { "aid" [ v-number ] } } validate-params ] >>validate [ { { "id" [ v-number ] } } validate-params ] >>validate
[ [
f "aid" value <annotation> select-tuple f "id" value <annotation> select-tuple
[ delete-tuples ] [ delete-tuples ]
[ id>> "$pastebin/paste" <id-redirect> ] [ parent>> "$pastebin/paste" <id-redirect> ]
bi bi
] >>submit ; ] >>submit ;