library/ui/tools/operations.factor

   1 ! Copyright (C) 2006 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: gadgets-workspace
   4 USING: definitions gadgets gadgets-browser gadgets-dataflow
   5 gadgets-help gadgets-listener gadgets-text gadgets-workspace
   6 hashtables help inference kernel namespaces parser prettyprint
   7 scratchpad sequences strings styles syntax test tools words
   8 generic models io ;
   9
  10 V{ } clone operations set-global
  11
  12 : define-operation ( class props -- )
  13     <operation> operations get push-new ;
  14
  15 M: operation invoke-command ( target operation -- )
  16     dup command-quot swap operation-listener?
  17     [ curry call-listener ] [ call ] if ;
  18
  19 : modify-listener-operation ( quot operation -- operation )
  20     clone t over set-operation-listener?
  21     modify-operation ;
  22
  23 : modify-listener-operations ( operations quot -- operations )
  24     swap [ modify-listener-operation ] map-with ;
  25
  26 ! Objects
  27 [ drop t ] H{
  28     { +default+ t }
  29     { +name+ "Inspect" }
  30     { +quot+ [ inspect ] }
  31     { +listener+ t }
  32 } define-operation
  33
  34 [ drop t ] H{
  35     { +name+ "Push" }
  36     { +quot+ [ ] }
  37     { +listener+ t }
  38 } define-operation
  39
  40 ! Input
  41 [ input? ] H{
  42     { +default+ t }
  43     { +name+ "Input" }
  44     { +quot+ [ listener-gadget call-tool ] }
  45 } define-operation
  46
  47 ! Pathnames
  48 [ pathname? ] H{
  49     { +default+ t }
  50     { +name+ "Edit" }
  51     { +quot+ [ pathname-string edit-file ] }
  52 } define-operation
  53
  54 [ pathname? ] H{
  55     { +name+ "Run file" }
  56     { +quot+ [ pathname-string [ run-file ] curry call-listener ] }
  57 } define-operation
  58
  59 ! Words
  60 [ word? ] H{
  61     { +default+ t }
  62     { +name+ "Browse" }
  63     { +keyboard+ T{ key-down f { A+ } "b" } }
  64     { +quot+ [ browser call-tool ] }
  65 } define-operation
  66
  67 [ word? ] H{
  68     { +name+ "Edit" }
  69     { +keyboard+ T{ key-down f { A+ } "e" } }
  70     { +quot+ [ edit ] }
  71 } define-operation
  72
  73 [ word? ] H{
  74     { +name+ "Documentation" }
  75     { +keyboard+ T{ key-down f { A+ } "h" } }
  76     { +quot+ [ help-gadget call-tool ] }
  77 } define-operation
  78
  79 [ word? ] H{
  80     { +name+ "Usage" }
  81     { +keyboard+ T{ key-down f { A+ } "u" } }
  82     { +quot+ [ usage. ] }
  83     { +listener+ t }
  84 } define-operation
  85
  86 [ word? ] H{
  87     { +name+ "Reload" }
  88     { +keyboard+ T{ key-down f { A+ } "r" } }
  89     { +quot+ [ reload ] }
  90     { +listener+ t }
  91 } define-operation
  92
  93 [ word? ] H{
  94     { +name+ "Watch" }
  95     { +quot+ [ watch ] }
  96     { +listener+ t }
  97 } define-operation
  98
  99 [ word? ] H{
 100     { +name+ "Word dataflow" }
 101     { +keyboard+ T{ key-down f { A+ } "d" } }
 102     { +quot+ [ word-def show-dataflow ] }
 103 } define-operation
 104
 105 ! Vocabularies
 106 [ vocab-link? ] H{
 107     { +default+ t }
 108     { +name+ "Browse" }
 109     { +quot+ [ browser call-tool ] }
 110 } define-operation
 111
 112 [ vocab-link? ] H{
 113     { +name+ "Enter in" }
 114     { +quot+ [ vocab-link-name [ set-in ] curry call-listener ] }
 115 } define-operation
 116
 117 [ vocab-link? ] H{
 118     { +name+ "Use" }
 119     { +quot+ [ vocab-link-name [ use+ ] curry call-listener ] }
 120 } define-operation
 121
 122 ! Link
 123 [ link? ] H{
 124     { +default+ t }
 125     { +name+ "Follow" }
 126     { +quot+ [ help-gadget call-tool ] }
 127 } define-operation
 128
 129 [ link? ] H{
 130     { +name+ "Edit" }
 131     { +quot+ [ edit ] }
 132 } define-operation
 133
 134 [ link? ] H{
 135     { +name+ "Reload" }
 136     { +quot+ [ reload ] }
 137 } define-operation
 138
 139 [ word-link? ] H{
 140     { +name+ "Definition" }
 141     { +quot+ [ link-name browser call-tool ] }
 142 } define-operation
 143
 144 ! Quotations
 145 [ quotation? ] H{
 146     { +name+ "Infer" }
 147     { +keyboard+ T{ key-down f { C+ A+ } "i" } }
 148     { +quot+ [ infer . ] }
 149     { +listener+ t }
 150 } define-operation
 151
 152 [ quotation? ] H{
 153     { +name+ "Quotation dataflow" }
 154     { +keyboard+ T{ key-down f { C+ A+ } "d" } }
 155     { +quot+ [ show-dataflow ] }
 156     { +listener+ t }
 157 } define-operation
 158
 159 [ quotation? ] H{
 160     { +name+ "Walk" }
 161     { +keyboard+ T{ key-down f { C+ A+ } "w" } }
 162     { +quot+ [ walk ] }
 163     { +listener+ t }
 164 } define-operation
 165
 166 [ quotation? ] H{
 167     { +name+ "Time" }
 168     { +keyboard+ T{ key-down f { C+ A+ } "t" } }
 169     { +quot+ [ time ] }
 170     { +listener+ t }
 171 } define-operation
 172
 173 ! Dataflow nodes
 174
 175 [ [ node? ] is? ] H{
 176     { +default+ t }
 177     { +name+ "Show dataflow" }
 178     { +quot+ [ dataflow-gadget call-tool ] }
 179 } define-operation
 180
 181 [ [ node? ] is? ] H{
 182     { +name+ "Inspect" }
 183     { +quot+ [ inspect ] }
 184     { +listener+ t }
 185 } define-operation
 186
 187 ! Define commands in terms of operations
 188
 189 ! Tile commands
 190 tile "Toolbar"
 191 \ word class-operations [ tile-definition ] modify-operations
 192 [ command-name "Browse" = not ] subset
 193 { "Close" f [ close-tile ] } add*
 194 define-commands
 195
 196 ! Interactor commands
 197 : word-action ( target -- quot )
 198     selected-word search ;
 199
 200 : quot-action ( interactor -- quot )
 201     dup editor-text swap select-all parse ;
 202
 203 interactor "Word commands"
 204 \ word class-operations
 205 [ word-action ] modify-listener-operations
 206 define-commands
 207
 208 interactor "Quotation commands"
 209 quotation class-operations
 210 [ quot-action ] modify-listener-operations
 211 define-commands