From cf4e0d78c31b6d9c2f1b6445be456c516435ebe3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 9 Feb 2009 00:25:05 -0600 Subject: [PATCH] Rework listener's debugger-popup code --- basis/listener/listener.factor | 15 ++-- basis/ui/tools/debugger/debugger-docs.factor | 6 +- basis/ui/tools/debugger/debugger.factor | 65 +++++++++++------ .../listener/completion/completion.factor | 60 +++------------ basis/ui/tools/listener/listener.factor | 73 ++++++++----------- basis/ui/tools/listener/popups/authors.txt | 1 + .../tools/listener/popups/popups-tests.factor | 4 + basis/ui/tools/listener/popups/popups.factor | 58 +++++++++++++++ basis/ui/tools/traceback/traceback.factor | 34 +++++++-- 9 files changed, 180 insertions(+), 136 deletions(-) create mode 100644 basis/ui/tools/listener/popups/authors.txt create mode 100644 basis/ui/tools/listener/popups/popups-tests.factor create mode 100644 basis/ui/tools/listener/popups/popups.factor diff --git a/basis/listener/listener.factor b/basis/listener/listener.factor index fc5f5c60b6..653b46ce68 100644 --- a/basis/listener/listener.factor +++ b/basis/listener/listener.factor @@ -54,7 +54,10 @@ SYMBOL: visible-vars SYMBOL: error-hook -[ print-error-and-restarts ] error-hook set-global +: call-error-hook ( error -- ) + error-continuation get error-hook get call ; + +[ drop print-error-and-restarts ] error-hook set-global SYMBOL: display-stacks? @@ -103,14 +106,8 @@ SYMBOL: max-stack-items : listen ( -- ) visible-vars. stacks. prompt. - [ read-quot [ [ error-hook get call ] recover ] [ bye ] if* ] - [ - dup lexer-error? [ - error-hook get call - ] [ - rethrow - ] if - ] recover ; + [ read-quot [ [ call-error-hook ] recover ] [ bye ] if* ] + [ dup lexer-error? [ call-error-hook ] [ rethrow ] if ] recover ; : until-quit ( -- ) quit-flag get [ quit-flag off ] [ listen until-quit ] if ; diff --git a/basis/ui/tools/debugger/debugger-docs.factor b/basis/ui/tools/debugger/debugger-docs.factor index 94c118953d..b68b349774 100644 --- a/basis/ui/tools/debugger/debugger-docs.factor +++ b/basis/ui/tools/debugger/debugger-docs.factor @@ -1,9 +1,9 @@ USING: ui.gadgets help.markup help.syntax kernel quotations -continuations debugger ui ; +continuations debugger ui continuations ; IN: ui.tools.debugger HELP: -{ $values { "error" "an error" } { "restarts" "a sequence of " { $link restart } " instances" } { "restart-hook" { $quotation "( list -- )" } } { "gadget" "a new " { $link gadget } } } +{ $values { "error" "an error" } { "continuation" continuation } { "restarts" "a sequence of " { $link restart } " instances" } { "restart-hook" { $quotation "( debugger -- )" } } { "debugger" "a new " { $link debugger } } } { $description "Creates a gadget displaying a description of the error, along with buttons to print the contents of the stacks in the listener, and a list of restarts." } ; @@ -11,5 +11,5 @@ HELP: { debugger-window } related-words HELP: debugger-window -{ $values { "error" "an error" } } +{ $values { "error" "an error" } { "continuation" continuation } } { $description "Opens a window with a description of the error." } ; diff --git a/basis/ui/tools/debugger/debugger.factor b/basis/ui/tools/debugger/debugger.factor index 9bd7be33ea..0a03ab4a46 100644 --- a/basis/ui/tools/debugger/debugger.factor +++ b/basis/ui/tools/debugger/debugger.factor @@ -1,47 +1,64 @@ -! Copyright (C) 2006, 2008 Slava Pestov. +! Copyright (C) 2006, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays hashtables io kernel math models namespaces sequences sequences words continuations debugger -prettyprint help editors ui ui.commands ui.gestures ui.gadgets +prettyprint help editors fonts ui ui.commands ui.gestures ui.gadgets ui.gadgets.worlds ui.gadgets.packs ui.gadgets.buttons ui.gadgets.labels ui.gadgets.panes ui.gadgets.presentations -ui.gadgets.viewports ui.gadgets.lists ui.gadgets.tracks -ui.gadgets.scrollers ui.gadgets.panes ui.tools.traceback ; +ui.gadgets.viewports ui.gadgets.tables ui.gadgets.tracks +ui.gadgets.scrollers ui.gadgets.panes ui.gadgets.borders +ui.tools.traceback ui.tools.inspector ; IN: ui.tools.debugger TUPLE: debugger < track error restarts restart-hook restart-list continuation ; > ] [ "Abort" ] if* "• " prepend 1array ; + : ( debugger -- gadget ) - [ restart-hook>> ] [ restarts>> ] bi - [ name>> ] swap ; inline + dup restarts>> f prefix + [ [ \ restart invoke-command ] when* ] >>action + swap restart-hook>> >>hook + restart-renderer >>renderer + t >>selection-required? + t >>single-click? ; inline : ( error -- pane ) [ [ print-error ] with-pane ] keep ; inline -: ( debugger -- gadget ) - - over error>> add-gadget - swap restart-list>> add-gadget ; inline +: ( debugger -- gadget ) + [ ] dip + [ error>> add-gadget ] + [ + dup restart-hook>> [ + [ "To continue, pick one of the options below:"
+ [ i:inspector ] >>action + stack-entry-renderer >>renderer + t >>single-click? ; + +: ( model quot title -- gadget ) + [ '[ dup _ when ] ] dip + ; + : ( model -- gadget ) [ [ call>> callstack. ] when* ] t "Call stack" ; : ( model -- gadget ) - [ [ data>> stack. ] when* ] - t "Data stack" ; + [ data>> ] "Data stack" ; : ( model -- gadget ) - [ [ retain>> stack. ] when* ] - t "Retain stack" ; + [ retain>> ] "Retain stack" ; TUPLE: traceback-gadget < track ;