prettyprint: cleanup duplicate code.
							parent
							
								
									d6828d38ff
								
							
						
					
					
						commit
						e42144e9ea
					
				| 
						 | 
				
			
			@ -35,6 +35,9 @@ IN: prettyprint
 | 
			
		|||
 | 
			
		||||
: short. ( obj -- ) pprint-short nl ;
 | 
			
		||||
 | 
			
		||||
: pprint-error ( obj -- str )
 | 
			
		||||
    class-of name>> "~pprint error: " "~" surround ;
 | 
			
		||||
 | 
			
		||||
: .b ( n -- ) >bin print ;
 | 
			
		||||
: .o ( n -- ) >oct print ;
 | 
			
		||||
: .h ( n -- ) >hex print ;
 | 
			
		||||
| 
						 | 
				
			
			@ -42,9 +45,7 @@ IN: prettyprint
 | 
			
		|||
: stack. ( seq -- )
 | 
			
		||||
    [
 | 
			
		||||
        [ short. ] [
 | 
			
		||||
            drop
 | 
			
		||||
            [ class-of name>> "~pprint error: " "~" surround ]
 | 
			
		||||
            keep write-object nl
 | 
			
		||||
            drop [ pprint-error ] keep write-object nl
 | 
			
		||||
        ] recover
 | 
			
		||||
    ] each ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,8 +1,8 @@
 | 
			
		|||
! Copyright (C) 2006, 2010 Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: accessors arrays classes continuations fonts fry
 | 
			
		||||
inspector kernel models models.arrow prettyprint sequences
 | 
			
		||||
ui.commands ui.gadgets ui.gadgets.borders ui.gadgets.buttons
 | 
			
		||||
USING: accessors arrays continuations fonts fry inspector
 | 
			
		||||
kernel models models.arrow prettyprint sequences ui.commands
 | 
			
		||||
ui.gadgets ui.gadgets.borders ui.gadgets.buttons
 | 
			
		||||
ui.gadgets.labeled ui.gadgets.panes ui.gadgets.scrollers
 | 
			
		||||
ui.gadgets.status-bar ui.gadgets.tables ui.gadgets.tracks
 | 
			
		||||
ui.gestures ui.tools.common ;
 | 
			
		||||
| 
						 | 
				
			
			@ -12,9 +12,8 @@ IN: ui.tools.traceback
 | 
			
		|||
TUPLE: stack-entry object string ;
 | 
			
		||||
 | 
			
		||||
: <stack-entry> ( object -- stack-entry )
 | 
			
		||||
    dup [ unparse-short ] [
 | 
			
		||||
        drop class-of name>> "~pprint error: " "~" surround
 | 
			
		||||
    ] recover stack-entry boa ;
 | 
			
		||||
    dup [ unparse-short ] [ drop pprint-error ] recover
 | 
			
		||||
    stack-entry boa ;
 | 
			
		||||
 | 
			
		||||
SINGLETON: stack-entry-renderer
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue