2008-02-27 18:15:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2006, 2008 Slava Pestov.
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-10 21:32:17 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								USING: accessors continuations kernel models namespaces
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-14 01:39:02 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								       prettyprint ui ui.commands ui.gadgets ui.gadgets.labelled assocs
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								       ui.gadgets.tracks ui.gadgets.buttons ui.gadgets.panes
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								       ui.gadgets.status-bar ui.gadgets.scrollers ui.gestures sequences
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								       hashtables inspector ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: ui.tools.traceback
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2007-11-16 01:19:13 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <callstack-display> ( model -- gadget )
							 | 
						
					
						
							
								
									
										
										
										
											2008-08-31 17:17:46 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ [ call>> callstack. ] when* ]
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-21 02:25:59 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    t "Call stack" <labelled-pane> ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2007-11-16 01:19:13 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <datastack-display> ( model -- gadget )
							 | 
						
					
						
							
								
									
										
										
										
											2008-08-31 17:17:46 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ [ data>> stack. ] when* ]
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-21 02:25:59 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    t "Data stack" <labelled-pane> ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2007-11-16 01:19:13 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <retainstack-display> ( model -- gadget )
							 | 
						
					
						
							
								
									
										
										
										
											2008-08-31 17:24:40 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ [ retain>> stack. ] when* ]
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-21 02:25:59 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    t "Retain stack" <labelled-pane> ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-10 21:32:17 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								TUPLE: traceback-gadget < track ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-21 02:25:59 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: traceback-gadget pref-dim* drop { 550 600 } ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <traceback-gadget> ( model -- gadget )
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-27 15:36:04 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    { 0 1 } traceback-gadget new-track
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        swap >>model
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-14 01:39:02 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    dup model>>
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-27 15:36:04 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        { 1 0 } <track>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            over <datastack-display> 1/2 track-add
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            swap <retainstack-display> 1/2 track-add
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        1/3 track-add
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-14 01:39:02 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-24 17:16:13 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    dup model>> <callstack-display> 2/3 track-add
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-14 01:39:02 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-24 17:16:13 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    dup <toolbar> f track-add ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-27 18:15:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <namestack-display> ( model -- gadget )
							 | 
						
					
						
							
								
									
										
										
										
											2008-08-31 17:17:46 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ [ name>> namestack. ] when* ]
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-27 18:15:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    <pane-control> ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <variables-gadget> ( model -- gadget )
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-10 21:32:17 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    <namestack-display> { 400 400 } <limited-scroller> ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-27 18:15:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: variables ( traceback -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-08-30 17:31:42 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    model>> <variables-gadget>
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-27 18:15:52 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    "Dynamic variables" open-status-window ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: traceback-window ( continuation -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    <model> <traceback-gadget> "Traceback" open-window ;
							 |