extra/ui/tools/tools.factor

   1 ! Copyright (C) 2006, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays assocs debugger ui.tools.workspace
   4 ui.tools.operations ui.tools.traceback ui.tools.browser
   5 ui.tools.inspector ui.tools.listener ui.tools.profiler
   6 ui.tools.operations inspector io kernel math models namespaces
   7 prettyprint quotations sequences ui ui.commands ui.gadgets
   8 ui.gadgets.books ui.gadgets.buttons ui.gadgets.labelled
   9 ui.gadgets.scrollers ui.gadgets.tracks ui.gadgets.worlds
  10 ui.gadgets.presentations ui.gestures words vocabs.loader
  11 tools.test tools.vocabs ui.gadgets.buttons ui.gadgets.status-bar
  12 mirrors ;
  13 IN: ui.tools
  14
  15 : <workspace-tabs> ( -- tabs )
  16     g gadget-model
  17     "tool-switching" workspace command-map
  18     [ command-string ] { } assoc>map <enum> >alist
  19     <toggle-buttons> ;
  20
  21 : <workspace-book> ( -- gadget )
  22     [
  23         <stack-display> ,
  24         <browser-gadget> ,
  25         <inspector-gadget> ,
  26         <profiler-gadget> ,
  27     ] { } make g gadget-model <book> ;
  28
  29 : <workspace> ( -- workspace )
  30     0 <model> { 0 1 } <track> workspace construct-control [
  31         [
  32             <listener-gadget> g set-workspace-listener
  33             <workspace-book> g set-workspace-book
  34             <workspace-tabs> f track,
  35             g workspace-book 1/5 track,
  36             g workspace-listener 4/5 track,
  37             toolbar,
  38         ] with-gadget
  39     ] keep ;
  40
  41 : resize-workspace ( workspace -- )
  42     dup track-sizes over control-value zero? [
  43         1/5 1 pick set-nth
  44         4/5 2 rot set-nth
  45     ] [
  46         2/3 1 pick set-nth
  47         1/3 2 rot set-nth
  48     ] if relayout ;
  49
  50 M: workspace model-changed
  51     nip
  52     dup workspace-listener listener-gadget-output scroll>bottom
  53     dup resize-workspace
  54     request-focus ;
  55
  56 [ workspace-window ] ui-hook set-global
  57
  58 : com-listener stack-display select-tool ;
  59
  60 : com-browser browser-gadget select-tool ;
  61
  62 : com-inspector inspector-gadget select-tool ;
  63
  64 : com-profiler profiler-gadget select-tool ;
  65
  66 workspace "tool-switching" f {
  67     { T{ key-down f { A+ } "1" } com-listener }
  68     { T{ key-down f { A+ } "2" } com-browser }
  69     { T{ key-down f { A+ } "3" } com-inspector }
  70     { T{ key-down f { A+ } "4" } com-profiler }
  71 } define-command-map
  72
  73 workspace "multi-touch" f {
  74     { T{ zoom-out-action } com-listener }
  75     { T{ up-action } refresh-all }
  76 } define-command-map
  77
  78 \ workspace-window
  79 H{ { +nullary+ t } } define-command
  80
  81 \ refresh-all
  82 H{ { +nullary+ t } { +listener+ t } } define-command
  83
  84 workspace "workflow" f {
  85     { T{ key-down f { C+ } "n" } workspace-window }
  86     { T{ key-down f f "ESC" } hide-popup }
  87     { T{ key-down f f "F2" } refresh-all }
  88 } define-command-map
  89
  90 [
  91     <workspace> dup "Factor workspace" open-status-window
  92 ] workspace-window-hook set-global
  93
  94 : inspect-continuation ( traceback -- )
  95     control-value [ inspect ] curry call-listener ;
  96
  97 traceback-gadget "toolbar" f {
  98     { T{ key-down f f "v" } variables }
  99     { T{ key-down f f "n" } inspect-continuation }
 100 } define-command-map