Merge branch 'master' of git://github.com/bogiebro/factor

basis/ui/gadgets/alerts/alerts.factor

@@ -0,0 +1,4 @@
+USING: accessors ui ui.gadgets ui.gadgets.labels ui.gadgets.buttons ui.gadgets.packs locals sequences io.styles ;
+IN: ui.gadgets.alerts
+:: alert ( quot string -- ) <pile> { 10 10 } >>gap 1 >>align string <label> { "sans-serif" plain 18 } >>font { 200 100 } >>pref-dim add-gadget 
+   "okay" [ close-window ] quot append <bevel-button> add-gadget "" open-window ;

basis/ui/gadgets/book-extras/book-extras.factor

@@ -0,0 +1,11 @@
+USING: accessors kernel fry math models ui.gadgets ui.gadgets.books ui.gadgets.buttons ;
+IN: ui.gadgets.book-extras
+: <book*> ( pages -- book ) 0 <model> <book> ;
+: |<< ( book -- ) 0 swap set-control-value ;
+: next ( book -- ) model>> [ 1 + ] change-model ;
+: prev ( book -- ) model>> [ 1 - ] change-model ;
+: (book-t) ( quot -- quot ) '[ : owner ( gadget -- book ) parent>> dup book? [ owner ] unless ; owner @ ] ;
+: <book-btn> ( label quot -- button ) (book-t) <button> ;
+: <book-bevel-btn> ( label quot -- button ) (book-t) <bevel-button> ;
+: >>> ( label -- button ) [ next ] <book-btn> ;
+: <<< ( label -- button ) [ prev ] <book-btn> ;

basis/ui/utils/utils.factor

@@ -0,0 +1,6 @@
+USING: accessors sequences namespaces ui.render opengl fry ;
+IN: ui.utils
+SYMBOLS: width height ;
+: store-dim ( gadget -- ) dim>> [ first width set ] [ second height set ] bi ;
+: with-dim ( gadget quot -- ) '[ _ store-dim @ ] with-scope ;
+: with-w/h ( gadget quot -- ) '[ origin get _ with-translation ] with-dim ;

extra/drills/drills.factor

@@ -0,0 +1,41 @@
+USING: accessors arrays cocoa.dialogs combinators continuations
+fry grouping io.encodings.utf8 io.files io.styles kernel math
+math.parser models models.filter models.history namespaces random
+sequences splitting ui ui.gadgets.alerts ui.gadgets.book-extras
+ui.gadgets.books ui.gadgets.buttons ui.gadgets.frames
+ui.gadgets.grids ui.gadgets.labels ui.gadgets.tracks ui.gestures ;
+
+IN: drills
+SYMBOLS: it startLength ;
+: big ( gadget -- gadget ) { "sans-serif" plain 30 } >>font ;
+: card ( model quot -- button ) <filter> <label-control> big [ next ] <book-btn> ;
+: op ( quot str -- gadget ) <label> big swap <book-bevel-btn> ;
+
+: show ( model -- gadget ) dup it set-global [ random ] <filter>
+   { [ [ first ] card ]
+   [ [ [ second ] [ drop [ "malformed input" throw ] "Malformed Input" alert ] recover ] card ]
+   [ '[ |<< [ it get [
+      _ value>> swap remove
+      [ [ it get go-back ] "Drill Complete" alert return ] when-empty
+   ] change-model ] with-return ] "Yes" op ]
+   [ '[ |<< it get _ model-changed ] "No" op ] } cleave
+2array { 1 0 } <track> swap [ 0.5 track-add ] each
+3array <book*> <frame> { 450 175 } >>pref-dim swap @center grid-add
+it get [ length startLength get swap - number>string "/" startLength get number>string 3append ] <filter> <label-control> @bottom grid-add ;
+
+: drill ( -- ) [ 
+   open-panel [
+      [ utf8 file-lines [ "\t" split
+         [ " " split 4 group [ " " join ] map ] map ] map ] map concat dup [ [ first ] [ second ] bi swap 2array ] map append
+         [ length startLength set-global ] keep <history> [ add-history ] [ show ] bi
+      "Got it?" open-window
+   ] when*
+] with-ui ;
+
+
+MAIN: drill
+
+    
+! FIXME: command-line opening
+! TODO: Menu bar
+! TODO: Pious hot-buttons

extra/peg-lexer/authors.txt

@@ -0,0 +1 @@
+Sam Anklesaria

extra/peg-lexer/peg-lexer-docs.factor

@@ -0,0 +1,14 @@
+USING: peg.ebnf help.syntax help.markup strings ;
+IN: peg-lexer
+ABOUT: "peg-lexer"
+
+HELP: ON-BNF:
+{ $syntax "ON-BNF: word ... ;ON-BNF" }
+{ $description "Creates a parsing word using a parser for lexer control, adding the resulting ast to the stack.  Parser syntax is as in " { $link POSTPONE: EBNF: } } ;
+
+HELP: create-bnf
+{ $values { "word" string } { "parser" parser } }
+{ $description "Runtime equivalent of " { $link POSTPONE: ON-BNF: } " also useful with manually constructed parsers." } ;
+
+HELP: factor
+{ $description "Tokenizer that acts like standard factor lexer, separating tokens by whitespace." } ;

extra/peg-lexer/peg-lexer-tests.factor

@@ -0,0 +1,14 @@
+USING: tools.test peg-lexer.test-parsers ;
+IN: peg-lexer.tests
+
+{ V{ "1234" "-end" } } [
+   test1 1234-end
+] unit-test
+
+{ V{ 1234 53 } } [
+   test2 12345
+] unit-test
+
+{ V{ "heavy" "duty" "testing" } } [
+   test3 heavy duty testing
+] unit-test

extra/peg-lexer/peg-lexer.factor

@@ -0,0 +1,52 @@
+USING: hashtables assocs sequences locals math accessors multiline delegate strings
+delegate.protocols kernel peg peg.ebnf lexer namespaces combinators parser words ;
+IN: peg-lexer
+
+TUPLE: lex-hash hash ;
+CONSULT: assoc-protocol lex-hash hash>> ;
+: <lex-hash> ( a -- lex-hash ) lex-hash boa ;
+
+: pos-or-0 ( neg? -- pos/0 ) dup 0 < [ drop 0 ] when ;
+
+:: prepare-pos ( v i -- c l )
+ [let | n [ i v head-slice ] |
+      v CHAR: \n n last-index -1 or 1+ -
+      n [ CHAR: \n = ] count 1+ ] ;
+      
+: store-pos ( v a -- ) input swap at prepare-pos
+   lexer get [ (>>line) ] keep (>>column) ;
+
+M: lex-hash set-at swap {
+   { pos [ store-pos ] }
+   [ swap hash>> set-at ] } case ;
+
+:: at-pos ( t l c -- p ) t l head-slice [ length ] map sum l 1- + c + ;
+
+M: lex-hash at* swap {
+      { input [ drop lexer get text>> "\n" join t ] }
+      { pos [ drop lexer get [ text>> ] [ line>> 1- ] [ column>> 1+ ] tri at-pos t ] }
+      [ swap hash>> at* ] } case ;
+
+: with-global-lexer ( quot -- result )
+   [ f lrstack set
+        V{ } clone error-stack set H{ } clone \ heads set
+        H{ } clone \ packrat set ] f make-assoc <lex-hash>
+   swap bind ; inline
+
+: parse* ( parser -- ast ) compile
+   [ execute [ error-stack get first throw ] unless* ] with-global-lexer
+   ast>> ;
+
+: create-bnf ( name parser -- ) reset-tokenizer [ lexer get skip-blank parse* parsed ] curry
+    define word make-parsing ;
+    
+: ON-BNF: CREATE-WORD reset-tokenizer ";ON-BNF" parse-multiline-string parse-ebnf
+    main swap at create-bnf ; parsing
+
+! Tokenizer like standard factor lexer
+EBNF: factor
+space = " " | "\n" | "\t"
+spaces = space* => [[ drop ignore ]]
+chunk = (!(space) .)+ => [[ >string ]]
+expr = spaces chunk
+;EBNF

extra/peg-lexer/summary.txt

@@ -0,0 +1 @@
+Use peg to write parsing words

extra/peg-lexer/tags.txt

@@ -0,0 +1 @@
+reflection

extra/peg-lexer/test-parsers/test-parsers.factor

@@ -0,0 +1,17 @@
+USING: peg-lexer math.parser strings ;
+IN: peg-lexer.test-parsers
+
+ON-BNF: test1
+      num = [1-4]* => [[ >string ]]
+      expr = num ( "-end" | "-done" )
+;ON-BNF
+
+ON-BNF: test2
+      num = [1-4]* => [[ >string string>number ]]
+      expr= num [5-9]
+;ON-BNF
+
+ON-BNF: test3
+      tokenizer = <foreign factor>
+      expr= "heavy" "duty" "testing"
+;ON-BNF