From 66c240da57a393301ee5810dc5222db07c3bc7c3 Mon Sep 17 00:00:00 2001 From: slava Date: Mon, 31 Jul 2006 00:20:26 +0000 Subject: [PATCH] Prettyprinte now highlights elements properly --- TODO.FACTOR.txt | 2 +- library/io/stdio.factor | 93 ++++++++++++++++--------------- library/syntax/prettyprint.factor | 53 ++++++++++-------- library/syntax/see.factor | 10 ++-- library/tools/interpreter.factor | 2 +- 5 files changed, 85 insertions(+), 75 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 32d8cc0c04..052ad4c568 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -14,6 +14,7 @@ - history doesn't work in a good way if you ^K the input - history: move caret to end - finish gui stepper + - handled by walker itself - graphical module manager tool - services do not launch if factor not running - integrated error documentation @@ -21,7 +22,6 @@ - 'show' doesn't work if invoked from a listener on an object which is itself inspected in the listener - fix top level window positioning -- prettyprinter's highlighting of non-leaves doesn't really work - nasty inference regressions - [ [ dup call ] dup call ] infer hangs - the invalid recursion form case needs to be fixed, for inlines too diff --git a/library/io/stdio.factor b/library/io/stdio.factor index 18091b975a..c7e366cc41 100644 --- a/library/io/stdio.factor +++ b/library/io/stdio.factor @@ -1,46 +1,47 @@ -! Copyright (C) 2003, 2006 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -IN: io -USING: errors generic hashtables kernel namespaces sequences -strings styles ; - -! Default stream -SYMBOL: stdio - -: close ( -- ) stdio get stream-close ; - -: readln ( -- string/f ) stdio get stream-readln ; -: read1 ( -- char/f ) stdio get stream-read1 ; -: read ( count -- string ) stdio get stream-read ; - -: write1 ( char -- ) stdio get stream-write1 ; -: write ( string -- ) stdio get stream-write ; -: flush ( -- ) stdio get stream-flush ; - -: terpri ( -- ) stdio get stream-terpri ; -: format ( string style -- ) stdio get stream-format ; - -: with-nesting ( style quot -- ) - swap stdio get with-nested-stream ; - -: tabular-output ( grid style quot -- ) - swap stdio get with-stream-table ; - -: with-style ( style quot -- ) - swap stdio get with-stream-style ; - -: print ( string -- ) stdio get stream-print ; - -: with-stream* ( stream quot -- ) - [ swap stdio set call ] with-scope ; inline - -: with-stream ( stream quot -- ) - swap [ [ close ] cleanup ] with-stream* ; inline - -: bl ( -- ) " " write ; - -: write-object ( string object -- ) - presented associate format ; - -: write-outliner ( string object content -- ) - outline associate [ write-object ] with-nesting ; +! Copyright (C) 2003, 2006 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +IN: io +USING: errors generic hashtables kernel namespaces sequences +strings styles ; + +! Default stream +SYMBOL: stdio + +: close ( -- ) stdio get stream-close ; + +: readln ( -- string/f ) stdio get stream-readln ; +: read1 ( -- char/f ) stdio get stream-read1 ; +: read ( count -- string ) stdio get stream-read ; + +: write1 ( char -- ) stdio get stream-write1 ; +: write ( string -- ) stdio get stream-write ; +: flush ( -- ) stdio get stream-flush ; + +: terpri ( -- ) stdio get stream-terpri ; +: format ( string style -- ) stdio get stream-format ; + +: with-nesting ( style quot -- ) + swap stdio get with-nested-stream ; + +: tabular-output ( grid style quot -- ) + swap stdio get with-stream-table ; + +: with-style ( style quot -- ) + swap dup hash-empty? + [ drop call ] [ stdio get with-stream-style ] if ; + +: print ( string -- ) stdio get stream-print ; + +: with-stream* ( stream quot -- ) + [ swap stdio set call ] with-scope ; inline + +: with-stream ( stream quot -- ) + swap [ [ close ] cleanup ] with-stream* ; inline + +: bl ( -- ) " " write ; + +: write-object ( string object -- ) + presented associate format ; + +: write-outliner ( string object content -- ) + outline associate [ write-object ] with-nesting ; diff --git a/library/syntax/prettyprint.factor b/library/syntax/prettyprint.factor index 477d322a21..3b6c97d5d2 100644 --- a/library/syntax/prettyprint.factor +++ b/library/syntax/prettyprint.factor @@ -38,12 +38,13 @@ global [ GENERIC: pprint-section* -TUPLE: section start end nl-after? indent ; +TUPLE: section start end nl-after? indent style ; -C: section ( length -- section ) +C: section ( style length -- section ) >r position [ dup rot + dup ] change r> [ set-section-end ] keep [ set-section-start ] keep + [ set-section-style ] keep 0 over set-section-indent ; : line-limit? ( -- ? ) @@ -61,20 +62,19 @@ C: section ( length -- section ) terpri do-indent ] if ; -TUPLE: text string style ; +TUPLE: text string ; C: text ( string style -- section ) - pick length 1+
over set-delegate - [ set-text-style ] keep + [ >r over length 1+
r> set-delegate ] keep [ set-text-string ] keep ; M: text pprint-section* - dup text-string swap text-style format ; + dup text-string swap section-style format ; TUPLE: block sections ; -C: block ( -- block ) - 0
over set-delegate +C: block ( style -- block ) + [ >r 0
r> set-delegate ] keep V{ } clone over set-block-sections t over set-section-nl-after? tab-size get over set-section-indent ; @@ -115,12 +115,12 @@ C: block ( -- block ) ] if ; : pprint-section ( section -- ) - dup section-fits? - [ pprint-section* ] [ inset-section ] if ; + dup section-fits? [ pprint-section* ] [ inset-section ] if ; TUPLE: newline ; -C: newline ( -- section ) 0
over set-delegate ; +C: newline ( -- section ) + H{ } 0
over set-delegate ; M: newline pprint-section* ( newline -- ) section-start fresh-line ; @@ -134,12 +134,18 @@ M: newline pprint-section* ( newline -- ) section-start last-newline get = [ bl ] unless ] if ; +: