basis/ui/tools/operations/operations.factor

   1 ! Copyright (C) 2006, 2009 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors combinators.short-circuit compiler.errors
   4 compiler.units continuations definitions destructors editors
   5 help.topics io.pathnames io.styles kernel libc.private
   6 macros.expander models namespaces parser prettyprint
   7 prettyprint.config quotations see source-files.errors
   8 stack-checker threads tools.annotations tools.crossref
   9 tools.test tools.time tools.walker ui.clipboards ui.commands
  10 ui.gestures ui.operations ui.tools.browser ui.tools.deploy
  11 ui.tools.inspector ui.tools.listener ui.tools.traceback vocabs
  12 vocabs.loader vocabs.parser words ;
  13 IN: ui.tools.operations
  14
  15 ! Objects
  16 [ drop t ] \ inspector H{
  17     { +primary+ t }
  18 } define-operation
  19
  20 : com-prettyprint ( obj -- ) ... ;
  21
  22 [ drop t ] \ com-prettyprint H{
  23     { +listener+ t }
  24 } define-operation
  25
  26 : com-push ( obj -- obj ) ;
  27
  28 [ drop t ] \ com-push H{
  29     { +listener+ t }
  30 } define-operation
  31
  32 : com-unparse ( obj -- ) [ unparse listener-input ] without-limits ;
  33
  34 [ drop t ] \ com-unparse H{ } define-operation
  35
  36 : com-copy-object ( obj -- ) [ unparse clipboard get set-clipboard-contents ] without-limits ;
  37
  38 [ drop t ] \ com-copy-object H{ } define-operation
  39
  40 ! Models
  41 [ { [ model? ] [ ref>> ] } 1&& ] \ inspect-model H{
  42     { +primary+ t }
  43 } define-operation
  44
  45 ! Input
  46 : com-input ( obj -- ) string>> listener-input ;
  47
  48 [ input? ] \ com-input H{
  49     { +primary+ t }
  50     { +secondary+ t }
  51 } define-operation
  52
  53 ! Restart
  54 [ restart? ] \ continue-restart H{
  55     { +primary+ t }
  56     { +secondary+ t }
  57     { +listener+ t }
  58 } define-operation
  59
  60 ! Continuation
  61 [ continuation? ] \ traceback-window H{
  62     { +primary+ t }
  63     { +secondary+ t }
  64 } define-operation
  65
  66 ! Thread
  67 : com-thread-traceback-window ( thread -- )
  68     thread-continuation traceback-window ;
  69
  70 [ thread? ] \ com-thread-traceback-window H{
  71     { +primary+ t }
  72     { +secondary+ t }
  73 } define-operation
  74
  75 [ pathname? ] \ edit-file H{
  76     { +keyboard+ T{ key-down f { C+ } "e" } }
  77     { +primary+ t }
  78     { +secondary+ t }
  79     { +listener+ t }
  80 } define-operation
  81
  82 [ definition-mixin? ] \ edit H{
  83     { +keyboard+ T{ key-down f { C+ } "e" } }
  84     { +listener+ t }
  85 } define-operation
  86
  87 ! Source file error
  88 [ source-file-error? ] \ edit-error H{
  89     { +primary+ t }
  90     { +secondary+ t }
  91     { +listener+ t }
  92 } define-operation
  93
  94 : com-reload ( error -- )
  95     path>> run-file ;
  96
  97 [ compiler-error? ] \ com-reload H{
  98     { +listener+ t }
  99 } define-operation
 100
 101 ! Definitions
 102 : com-forget ( defspec -- )
 103     [ forget ] with-compilation-unit ;
 104
 105 [ definition-mixin? ] \ com-forget H{ } define-operation
 106
 107 [ topic? ] \ com-browse H{
 108     { +keyboard+ T{ key-down f { C+ } "h" } }
 109     { +primary+ t }
 110 } define-operation
 111
 112 [ word? ] \ usage. H{
 113     { +keyboard+ T{ key-down f { C+ } "u" } }
 114     { +listener+ t }
 115 } define-operation
 116
 117 [ word? ] \ fix H{
 118     { +keyboard+ T{ key-down f { C+ } "f" } }
 119     { +listener+ t }
 120 } define-operation
 121
 122 [ [ annotated? not ] [ word? ] bi and ] \ watch H{ } define-operation
 123
 124 [ annotated? ] \ reset H{ } define-operation
 125
 126 [ word? ] \ breakpoint H{ } define-operation
 127
 128 [ word? ] \ see H{
 129     { +listener+ t }
 130 } define-operation
 131
 132 GENERIC: com-stack-effect ( obj -- )
 133
 134 M: quotation com-stack-effect infer. ;
 135
 136 M: word com-stack-effect 1quotation com-stack-effect ;
 137
 138 : com-enter-in ( vocab -- ) vocab-name set-current-vocab ;
 139
 140 [ vocab? ] \ com-enter-in H{
 141     { +listener+ t }
 142 } define-operation
 143
 144 : com-use-vocab ( vocab -- ) vocab-name use-vocab ;
 145
 146 [ vocab-spec? ] \ com-use-vocab H{
 147     { +secondary+ t }
 148     { +listener+ t }
 149 } define-operation
 150
 151 [ vocab-spec? ] \ run H{
 152     { +listener+ t }
 153 } define-operation
 154
 155 [ vocab? ] \ test H{
 156     { +listener+ t }
 157 } define-operation
 158
 159 [ vocab-spec? ] \ deploy-tool H{ } define-operation
 160
 161 ! Quotations
 162 [ quotation? ] \ com-stack-effect H{
 163     { +keyboard+ T{ key-down f { C+ } "i" } }
 164     { +listener+ t }
 165 } define-operation
 166
 167 [ quotation? ] \ walk H{
 168     { +keyboard+ T{ key-down f { C+ } "w" } }
 169     { +listener+ t }
 170 } define-operation
 171
 172 [ quotation? ] \ time H{
 173     { +keyboard+ T{ key-down f { C+ } "t" } }
 174     { +listener+ t }
 175 } define-operation
 176
 177 : com-expand-macros ( quot -- ) expand-macros . ;
 178
 179 [ quotation? ] \ com-expand-macros H{
 180     { +keyboard+ T{ key-down f { C+ } "m" } }
 181     { +listener+ t }
 182 } define-operation
 183
 184 ! Disposables
 185 [ disposable? ] \ dispose H{ } define-operation
 186
 187 ! Disposables with a continuation
 188 PREDICATE: tracked-disposable < disposable
 189     continuation>> >boolean ;
 190
 191 PREDICATE: tracked-malloc-ptr < malloc-ptr
 192     continuation>> >boolean ;
 193
 194 : com-creation-traceback ( disposable -- )
 195     continuation>> traceback-window ;
 196
 197 [ tracked-disposable? ] \ com-creation-traceback H{
 198     { +primary+ t }
 199 } define-operation
 200
 201 [ tracked-malloc-ptr? ] \ com-creation-traceback H{
 202     { +primary+ t }
 203 } define-operation
 204
 205 ! Operations -> commands
 206 interactor
 207 "quotation"
 208 "These commands operate on the entire contents of the input area."
 209 [ ]
 210 [ quot-action ]
 211 define-operation-map