58 lines
1.6 KiB
Factor
58 lines
1.6 KiB
Factor
|
! Copyright (C) 2006 Slava Pestov.
|
||
|
|
! See http://factorcode.org/license.txt for BSD license.
|
||
|
|
IN: gadgets-listener
|
||
|
|
DEFER: call-listener
|
||
|
|
|
||
|
|
IN: gadgets
|
||
|
|
USING: arrays errors gadgets gadgets-buttons
|
||
|
|
gadgets-labels gadgets-panes gadgets-presentations
|
||
|
|
gadgets-scrolling gadgets-theme gadgets-viewports gadgets-lists
|
||
|
|
generic hashtables io kernel math models namespaces prettyprint
|
||
|
|
queues sequences test threads help sequences words timers ;
|
||
|
|
|
||
|
|
: <debugger-button>
|
||
|
|
[ call-listener drop ] curry <bevel-button> ;
|
||
|
|
|
||
|
|
: <restart-list> ( seq -- gadget )
|
||
|
|
[ drop ] [ restart-name ] rot <model> <list> ;
|
||
|
|
|
||
|
|
TUPLE: debugger restarts ;
|
||
|
|
|
||
|
|
: <debugger-display> ( error restart-list -- gadget )
|
||
|
|
>r [ error. ] make-pane r>
|
||
|
|
2array make-pile
|
||
|
|
1 over set-pack-fill ;
|
||
|
|
|
||
|
|
C: debugger ( error restarts -- gadget )
|
||
|
|
{
|
||
|
|
{
|
||
|
|
[ gadget get { debugger } <toolbar> ]
|
||
|
|
f f @top
|
||
|
|
}
|
||
|
|
{
|
||
|
|
[ <restart-list> ]
|
||
|
|
set-debugger-restarts
|
||
|
|
[ <debugger-display> <scroller> ]
|
||
|
|
@center
|
||
|
|
}
|
||
|
|
} make-frame* dup popup-theme ;
|
||
|
|
|
||
|
|
M: debugger focusable-child*
|
||
|
|
debugger-restarts ;
|
||
|
|
|
||
|
|
debugger "toolbar" {
|
||
|
|
{ "Data stack" T{ key-down f f "s" } [ :s ] }
|
||
|
|
{ "Retain stack" T{ key-down f f "r" } [ :r ] }
|
||
|
|
{ "Call stack" T{ key-down f f "c" } [ :c ] }
|
||
|
|
{ "Help" T{ key-down f f "h" } [ :help ] }
|
||
|
|
{ "Edit" T{ key-down f f "e" } [ :edit ] }
|
||
|
|
} [
|
||
|
|
first3 [ call-listener drop ] curry 3array
|
||
|
|
] map define-commands
|
||
|
|
|
||
|
|
: debugger-window ( error restarts -- )
|
||
|
|
restarts get <debugger> "Error" open-titled-window ;
|
||
|
|
|
||
|
|
: ui-try ( quot -- )
|
||
|
|
[ debugger-window ] recover ;
|