extra/ui/tools/debugger/debugger.factor

   1 ! Copyright (C) 2006, 2007 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays ui ui.commands ui.gestures ui.gadgets
   4 ui.gadgets.worlds ui.gadgets.packs ui.gadgets.buttons
   5 ui.gadgets.labels ui.gadgets.panes ui.gadgets.presentations
   6 ui.gadgets.viewports ui.gadgets.lists ui.gadgets.tracks
   7 ui.gadgets.scrollers ui.gadgets.panes hashtables io kernel math
   8 models namespaces sequences sequences words continuations
   9 debugger prettyprint ui.tools.traceback help editors ;
  10 IN: ui.tools.debugger
  11
  12 : <restart-list> ( restarts restart-hook -- gadget )
  13     [ restart-name ] rot <model> <list> ;
  14
  15 TUPLE: debugger restarts ;
  16
  17 : <debugger-display> ( restart-list error -- gadget )
  18     [
  19         <pane> [ [ print-error ] with-pane ] keep gadget,
  20         gadget,
  21     ] make-filled-pile ;
  22
  23 : <debugger> ( error restarts restart-hook -- gadget )
  24     debugger construct-empty
  25     [
  26         toolbar,
  27         <restart-list> g-> set-debugger-restarts
  28         swap <debugger-display> <scroller> 1 track,
  29     ] { 0 1 } build-track ;
  30
  31 M: debugger focusable-child* debugger-restarts ;
  32
  33 : debugger-window ( error -- )
  34     #! No restarts for the debugger window
  35     f [ drop ] <debugger> "Error" open-window ;
  36
  37 [ debugger-window ] ui-error-hook set-global
  38
  39 M: world-error error.
  40     "An error occurred while drawing the world " write
  41     dup world-error-world pprint-short "." print
  42     "This world has been deactivated to prevent cascading errors." print
  43     delegate error. ;
  44
  45 debugger "gestures" f {
  46     { T{ button-down } request-focus }
  47 } define-command-map
  48
  49 : com-traceback error-continuation get traceback-window ;
  50
  51 \ com-traceback H{ { +nullary+ t } } define-command
  52
  53 \ :help H{ { +nullary+ t } { +listener+ t } } define-command
  54
  55 \ :edit H{ { +nullary+ t } } define-command
  56
  57 debugger "toolbar" f {
  58     { T{ key-down f f "s" } com-traceback }
  59     { T{ key-down f f "h" } :help }
  60     { T{ key-down f f "e" } :edit }
  61 } define-command-map