diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 545680fd5f..41f3dbace4 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,7 +1,6 @@ + 0.80: - zero-height gadgets mess up hit testing -- make-image leaks memory - does parsing cons excessive amounts of bignums with c-streams - -with combinators are awkward - cleanups: diff --git a/library/inference/dataflow.factor b/library/inference/dataflow.factor index 2a43b464f0..4f7823fd5b 100644 --- a/library/inference/dataflow.factor +++ b/library/inference/dataflow.factor @@ -130,18 +130,6 @@ SYMBOL: current-node dup dataflow-graph set current-node set ] if ; -: nest-node ( -- dataflow current ) - dataflow-graph get dataflow-graph off - current-node get current-node off ; - -: unnest-node ( new-node dataflow current -- new-node ) - >r >r dataflow-graph get 1array over set-node-children - r> dataflow-graph set - r> current-node set ; - -: with-nesting ( quot -- new-node | quot: -- new-node ) - nest-node 2slip unnest-node ; inline - : node-values ( node -- values ) [ dup node-in-d % dup node-out-d % diff --git a/library/inference/words.factor b/library/inference/words.factor index 3044ed19a4..7dbc19f095 100644 --- a/library/inference/words.factor +++ b/library/inference/words.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: inference -USING: errors generic interpreter kernel lists math -math-internals namespaces sequences strings vectors words -hashtables parser prettyprint ; +USING: arrays errors generic hashtables interpreter kernel lists +math math-internals namespaces parser prettyprint sequences +strings vectors words ; : consume-values ( n node -- ) over ensure-values @@ -27,21 +27,28 @@ hashtables parser prettyprint ; TUPLE: rstate label quot base-case? ; +: nest-node ( -- dataflow current ) + dataflow-graph get dataflow-graph off + current-node get current-node off ; + +: unnest-node ( new-node dataflow current -- new-node ) + >r >r dataflow-graph get 1array over set-node-children + r> dataflow-graph set + r> current-node set ; + : with-recursive-state ( word label base-case quot -- ) >r >r over word-def r> cons recursive-state [ cons ] change r> - call ; inline + nest-node 2slip unnest-node ; inline : inline-block ( word base-case -- node-block variables ) [ copy-inference >r gensym 2dup r> [ - [ - dup #label >r - #entry node, - swap word-def infer-quot - #return node, r> - ] with-nesting + dup #label >r + #entry node, + swap word-def infer-quot + #return node, r> ] with-recursive-state ] make-hash ; diff --git a/library/io/stdio.factor b/library/io/stdio.factor index 08f756bc91..b6af8b1ff7 100644 --- a/library/io/stdio.factor +++ b/library/io/stdio.factor @@ -19,7 +19,9 @@ SYMBOL: stdio : break ( -- ) stdio get stream-break ; : terpri ( -- ) stdio get stream-terpri ; : format ( string style -- ) stdio get stream-format ; -: with-nesting ( style quot -- ) stdio get with-nested-stream ; + +: with-nesting ( style quot -- ) + swap stdio get with-nested-stream ; : print ( string -- ) stdio get stream-print ; diff --git a/library/io/stream.factor b/library/io/stream.factor index 4225b8d272..51f86f52e2 100644 --- a/library/io/stream.factor +++ b/library/io/stream.factor @@ -22,7 +22,7 @@ GENERIC: stream-flush ( stream -- ) GENERIC: stream-break ( stream -- ) GENERIC: stream-terpri ( stream -- ) GENERIC: stream-format ( string style stream -- ) -GENERIC: with-nested-stream ( style stream quot -- ) +GENERIC: with-nested-stream ( quot style stream -- ) : stream-print ( string stream -- ) [ stream-write ] keep stream-terpri ; diff --git a/library/styles.factor b/library/styles.factor index 269fc5a958..447feacb9e 100644 --- a/library/styles.factor +++ b/library/styles.factor @@ -37,5 +37,4 @@ SYMBOL: outline ! Paragraph styles SYMBOL: border-color SYMBOL: border-width -SYMBOL: padding SYMBOL: word-wrap diff --git a/library/ui/panes.factor b/library/ui/panes.factor index 66138cf11b..d72985c81d 100644 --- a/library/ui/panes.factor +++ b/library/ui/panes.factor @@ -131,8 +131,8 @@ M: pane stream-readln ( pane -- line ) M: pane stream-write1 ( char pane -- ) [ pane-current stream-write1 ] keep scroll-pane ; -M: pane stream-write ( string style pane -- ) - [ rot "\n" split pane-write ] keep scroll-pane ; +M: pane stream-write ( string pane -- ) + [ swap "\n" split pane-write ] keep scroll-pane ; M: pane stream-format ( string style pane -- ) [ rot "\n" split pane-format ] keep scroll-pane ; @@ -154,6 +154,3 @@ M: pane stream-close ( pane -- ) drop ; #! Clear the pane and run the quotation in a scope with #! stdio set to the pane. >r dup pane-clear r> with-stream* ; inline - -M: pane with-nested-stream ( style stream quot -- ) - -rot >r >r make-pane r> drop r> pane-current add-gadget ; diff --git a/library/ui/presentations.factor b/library/ui/presentations.factor index 28e87d0891..55d28da6b7 100644 --- a/library/ui/presentations.factor +++ b/library/ui/presentations.factor @@ -1,11 +1,11 @@ ! Copyright (C) 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: gadgets-presentations -USING: arrays compiler gadgets gadgets-buttons gadgets-labels -gadgets-layouts gadgets-menus gadgets-outliner gadgets-panes -gadgets-theme generic hashtables inference inspector io jedit -kernel lists memory namespaces parser prettyprint sequences -strings styles words ; +USING: arrays compiler gadgets gadgets-borders gadgets-buttons +gadgets-labels gadgets-layouts gadgets-menus gadgets-outliner +gadgets-panes gadgets-theme generic hashtables inference +inspector io jedit kernel lists memory namespaces parser +prettyprint sequences strings styles words ; SYMBOL: commands @@ -83,6 +83,15 @@ M: gadget-stream stream-break ( stream -- ) M: gadget-stream stream-close ( stream -- ) drop ; +: paragraph-style ( pane style -- pane ) + border-width over hash [ >r r> ] when + border-color swap hash + [ over set-gadget-boundary ] when* ; + +M: pane with-nested-stream ( quot style stream -- ) + >r >r make-pane r> paragraph-style + r> pane-current add-gadget ; + [ drop t ] "Prettyprint" [ . ] define-command [ drop t ] "Describe" [ describe ] define-command [ drop t ] "Push on data stack" [ ] define-command