basis/ui/tools/tools.factor

   1 ! Copyright (C) 2006, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors 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 fry ;
  13 IN: ui.tools
  14
  15 : <workspace-tabs> ( workspace -- tabs )
  16     model>>
  17         "tool-switching" workspace command-map commands>>
  18         [ command-string ] { } assoc>map <enum> >alist
  19     <toggle-buttons> ;
  20
  21 : <workspace-book> ( workspace -- gadget )
  22         <gadget>
  23         <browser-gadget>
  24         <inspector-gadget>
  25         <profiler-gadget>
  26     4array
  27     swap model>> <book> ;
  28
  29 : <workspace> ( -- workspace )
  30     { 0 1 } workspace new-track
  31         0 <model> >>model
  32         <listener-gadget> >>listener
  33         dup <workspace-book> >>book
  34
  35         dup <workspace-tabs> f track-add
  36         dup book>> 0 track-add
  37         dup listener>> 1 track-add
  38         add-toolbar ;
  39
  40 : resize-workspace ( workspace -- )
  41     dup sizes>> over control-value 0 = [
  42         0 over set-second
  43         1 swap set-third
  44     ] [
  45         2/3 over set-second
  46         1/3 swap set-third
  47     ] if relayout ;
  48
  49 M: workspace model-changed
  50     nip
  51     dup listener>> output>> scroll>bottom
  52     dup resize-workspace
  53     request-focus ;
  54
  55 [ workspace-window ] ui-hook set-global
  56
  57 : select-tool ( workspace n -- ) swap book>> model>> set-model ;
  58
  59 : com-listener ( workspace -- ) 0 select-tool ;
  60
  61 : com-browser ( workspace -- ) 1 select-tool ;
  62
  63 : com-inspector ( workspace -- ) 2 select-tool ;
  64
  65 : com-profiler ( workspace -- ) 3 select-tool ;
  66
  67 workspace "tool-switching" f {
  68     { T{ key-down f { A+ } "1" } com-listener }
  69     { T{ key-down f { A+ } "2" } com-browser }
  70     { T{ key-down f { A+ } "3" } com-inspector }
  71     { T{ key-down f { A+ } "4" } com-profiler }
  72 } define-command-map
  73
  74 workspace "multi-touch" f {
  75     { T{ zoom-out-action } com-listener }
  76     { T{ up-action } refresh-all }
  77 } define-command-map
  78
  79 \ workspace-window
  80 H{ { +nullary+ t } } define-command
  81
  82 \ refresh-all
  83 H{ { +nullary+ t } { +listener+ t } } define-command
  84
  85 workspace "workflow" f {
  86     { T{ key-down f { C+ } "n" } workspace-window }
  87     { T{ key-down f f "ESC" } hide-popup }
  88     { T{ key-down f f "F2" } refresh-all }
  89 } define-command-map
  90
  91 [
  92     <workspace> dup "Factor workspace" open-status-window
  93 ] workspace-window-hook set-global
  94
  95 : inspect-continuation ( traceback -- )
  96     control-value '[ _ inspect ] call-listener ;
  97
  98 traceback-gadget "toolbar" f {
  99     { T{ key-down f f "v" } variables }
 100     { T{ key-down f f "n" } inspect-continuation }
 101 } define-command-map