diff --git a/core/prettyprint/backend/backend.factor b/core/prettyprint/backend/backend.factor index 4965b8d5c4..1a376ef0e1 100644 --- a/core/prettyprint/backend/backend.factor +++ b/core/prettyprint/backend/backend.factor @@ -22,11 +22,13 @@ GENERIC: pprint* ( obj -- ) ! Atoms : word-style ( word -- style ) - [ - dup presented set - dup parsing? over delimiter? rot t eq? or or - [ bold font-style set ] when - ] H{ } make-assoc ; + dup "word-style" word-prop >hashtable [ + [ + dup presented set + dup parsing? over delimiter? rot t eq? or or + [ bold font-style set ] when + ] bind + ] keep ; : word-name* ( word -- str ) word-name "( no name )" or ; @@ -129,15 +131,9 @@ M: pathname pprint* dup pathname-string "P\" " pprint-string ; dup zero? [ 2drop f ] [ >r head r> ] if ] when ; -: pprint-hilite ( n object -- ) - pprint* hilite-index get = [ hilite ] when ; - : pprint-elements ( seq -- ) - do-length-limit >r dup hilite-quotation get eq? [ - [ length ] keep [ pprint-hilite ] 2each - ] [ - [ pprint* ] each - ] if + do-length-limit >r + [ pprint* ] each r> [ "~" swap number>string " more~" 3append text ] when* ; GENERIC: pprint-delims ( obj -- start end ) diff --git a/core/prettyprint/prettyprint.factor b/core/prettyprint/prettyprint.factor index 39c0951559..4a728b81de 100644 --- a/core/prettyprint/prettyprint.factor +++ b/core/prettyprint/prettyprint.factor @@ -6,7 +6,8 @@ math namespaces sequences strings io.styles io.streams.string vectors words prettyprint.backend prettyprint.sections prettyprint.config sorting splitting math.parser vocabs definitions effects tuples io.files classes continuations -hashtables classes.mixin classes.union classes.predicate ; +hashtables classes.mixin classes.union classes.predicate +combinators quotations ; : make-pprint ( obj quot -- block in use ) [ @@ -85,20 +86,48 @@ hashtables classes.mixin classes.union classes.predicate ; : .s ( -- ) datastack stack. ; : .r ( -- ) retainstack stack. ; -: callframe. ( seq pos -- ) +SYMBOL: -> + +\ -> +{ { foreground { 1 1 1 1 } } { background { 0 0 0 1 } } } +"word-style" set-word-prop + + ] swap 3append ] [ - . - ] if* ; + drop + ] if ; + +PRIVATE> : callstack. ( callstack -- ) - callstack>array 2 [ callframe. ] assoc-each ; + callstack>array 2 [ + remove-breakpoints + 2 nesting-limit [ . ] with-variable + ] assoc-each ; : .c ( -- ) callstack callstack. ; diff --git a/core/prettyprint/sections/sections-docs.factor b/core/prettyprint/sections/sections-docs.factor index 24a947c80b..d55ec36bbd 100644 --- a/core/prettyprint/sections/sections-docs.factor +++ b/core/prettyprint/sections/sections-docs.factor @@ -74,7 +74,6 @@ HELP: section { $link block } { $link inset } { $link flow } - { $link hilite } { $link colon } } "Instances of this class have the following slots:" diff --git a/core/prettyprint/sections/sections.factor b/core/prettyprint/sections/sections.factor index 3531034404..6ca365c919 100644 --- a/core/prettyprint/sections/sections.factor +++ b/core/prettyprint/sections/sections.factor @@ -157,11 +157,6 @@ TUPLE: block sections ; { highlight t } } ; -: hilite ( -- ) - last-section - dup section-style hilite-style union - swap set-section-style ; - : start-group ( -- ) t last-section set-section-start-group? ;