diff --git a/extra/tools/walker/walker.factor b/extra/tools/walker/walker.factor index ef6dac66f6..2417e7ac39 100755 --- a/extra/tools/walker/walker.factor +++ b/extra/tools/walker/walker.factor @@ -4,7 +4,7 @@ USING: threads kernel namespaces continuations combinators sequences math namespaces.private continuations.private concurrency.messaging quotations kernel.private words sequences.private assocs models arrays accessors -generic generic.standard ; +generic generic.standard definitions ; IN: tools.walker 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 standard-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 ] } [ word-def (step-into-quot) ] } cond ; @@ -89,7 +90,6 @@ SYMBOL: step-into SYMBOL: step-all SYMBOL: step-into-all SYMBOL: step-back -SYMBOL: detach SYMBOL: abandon SYMBOL: call-in @@ -137,7 +137,7 @@ SYMBOL: +stopped+ { >n ndrop >c c> continue continue-with - stop yield suspend sleep (spawn) + stop suspend (spawn) } [ dup [ execute break ] curry "step-into" set-word-prop @@ -168,10 +168,7 @@ SYMBOL: +stopped+ +running+ set-status ; : walker-stopped ( -- ) - +stopped+ set-status - [ status +stopped+ eq? ] - [ [ drop f ] handle-synchronous ] - [ ] while ; + +stopped+ set-status ; : step-into-all-loop ( -- ) +running+ set-status diff --git a/extra/webapps/pastebin/pastebin.factor b/extra/webapps/pastebin/pastebin.factor index 9852bf47cb..43cae74ec8 100644 --- a/extra/webapps/pastebin/pastebin.factor +++ b/extra/webapps/pastebin/pastebin.factor @@ -15,18 +15,22 @@ IN: webapps.pastebin ! 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+ } { "summary" "SUMMARY" { VARCHAR 256 } +not-null+ } { "author" "AUTHOR" { 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+ } } define-persistent +TUPLE: paste < entity annotations ; + +\ paste "PASTES" { } define-persistent + : ( id -- paste ) \ paste new swap >>id ; @@ -34,23 +38,17 @@ TUPLE: paste id summary author mode date contents annotations ; : pastes ( -- pastes ) f 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+ } - { "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+ } + { "parent" "PARENT" INTEGER +not-null+ } } define-persistent -: ( id aid -- annotation ) +: ( parent id -- annotation ) annotation new - swap >>aid - swap >>id ; + swap >>id + swap >>parent ; : fetch-annotations ( paste -- paste ) dup annotations>> [ @@ -76,8 +74,8 @@ M: paste entity-link id>> "id" associate "$pastebin/paste" swap link>string ; M: annotation entity-link - [ id>> "id" associate "$pastebin/paste" swap link>string ] - [ aid>> number>string "#" prepend ] bi + [ parent>> "parent" associate "$pastebin/paste" swap link>string ] + [ id>> number>string "#" prepend ] bi append ; : pastebin-template ( name -- template ) @@ -147,7 +145,7 @@ M: annotation entity-link [ validate-integer-id ] >>init [ "id" value paste annotations>> paste-feed ] >>feed ; -: validate-paste ( -- ) +: validate-entity ( -- ) { { "summary" [ v-one-line ] } { "author" [ v-one-line ] } @@ -156,7 +154,7 @@ M: annotation entity-link { "captcha" [ v-captcha ] } } validate-params ; -: deposit-paste-slots ( tuple -- ) +: deposit-entity-slots ( tuple -- ) now >>date { "summary" "author" "mode" "contents" } deposit-slots ; @@ -170,10 +168,10 @@ M: annotation entity-link "new-paste" pastebin-template >>template [ - validate-paste + validate-entity f - [ deposit-paste-slots ] + [ deposit-entity-slots ] [ insert-tuple ] [ id>> "$pastebin/paste" ] tri @@ -195,31 +193,35 @@ M: annotation entity-link : ( -- action ) - [ validate-paste ] >>validate - - [ "id" param "$pastebin/paste" ] >>display + [ + { { "id" [ v-integer ] } } validate-params + "id" value "$pastebin/paste" + ] >>display [ - f f - { - [ deposit-paste-slots ] - [ { "id" } deposit-slots ] - [ insert-tuple ] - [ - ! Add anchor here - id>> "$pastebin/paste" - ] - } cleave + { { "id" [ v-integer ] } } validate-params + validate-entity + ] >>validate + + [ + "id" value f + [ deposit-entity-slots ] + [ insert-tuple ] + [ + ! Add anchor here + parent>> "$pastebin/paste" + ] + tri ] >>submit ; : ( -- action ) - [ { { "aid" [ v-number ] } } validate-params ] >>validate + [ { { "id" [ v-number ] } } validate-params ] >>validate [ - f "aid" value select-tuple + f "id" value select-tuple [ delete-tuples ] - [ id>> "$pastebin/paste" ] + [ parent>> "$pastebin/paste" ] bi ] >>submit ;