basis/ui/tools/inspector/slots/slots.factor

   1 ! Copyright (C) 2007, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors eval kernel math.vectors parser prettyprint
   4 refs sequences ui.commands ui.gadgets ui.gadgets.editors
   5 ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.toolbar
   6 ui.gadgets.tracks ui.gadgets.worlds ui.gestures ui.tools.common
   7 ;
   8 IN: ui.tools.inspector.slots
   9
  10 TUPLE: slot-editor < track ref close-hook update-hook text ;
  11
  12 : revert ( slot-editor -- )
  13     [ ref>> get-ref unparse-use ] [ text>> ] bi set-editor-string ;
  14
  15 \ revert H{
  16     { +description+ "Revert any uncomitted changes." }
  17 } define-command
  18
  19 : close ( slot-editor -- )
  20     dup close-hook>> call( slot-editor -- ) ;
  21
  22 \ close H{
  23     { +description+ "Close the slot editor without saving changes." }
  24 } define-command
  25
  26 : close-and-update ( slot-editor -- )
  27     [ update-hook>> call( -- ) ] [ close ] bi ;
  28
  29 : slot-editor-value ( slot-editor -- object )
  30     text>> control-value parse-fresh first ;
  31
  32 : commit ( slot-editor -- )
  33     [ [ slot-editor-value ] [ ref>> ] bi set-ref ]
  34     [ close-and-update ]
  35     bi ;
  36
  37 \ commit H{
  38     { +description+ "Parse the object being edited, and store the result back into the edited slot." }
  39 } define-command
  40
  41 : com-eval ( slot-editor -- )
  42     [ [ text>> editor-string eval( -- result ) ] [ ref>> ] bi set-ref ]
  43     [ close-and-update ]
  44     bi ;
  45
  46 \ com-eval H{
  47     { +listener+ t }
  48     { +description+ "Parse code which evaluates to an object, and store the result back into the edited slot." }
  49 } define-command
  50
  51 : delete ( slot-editor -- )
  52     [ ref>> delete-ref ] [ close-and-update ] bi ;
  53
  54 \ delete H{
  55     { +description+ "Delete the slot and close the slot editor." }
  56 } define-command
  57
  58 : <slot-editor> ( close-hook update-hook ref -- gadget )
  59     vertical slot-editor new-track with-lines
  60         swap >>ref
  61         swap >>update-hook
  62         swap >>close-hook
  63         add-toolbar
  64         <source-editor> >>text
  65         dup text>> margins <scroller> white-interior 1 track-add
  66         dup revert ;
  67
  68 M: slot-editor pref-dim* call-next-method { 600 200 } vmin ;
  69
  70 M: slot-editor focusable-child* text>> ;
  71
  72 slot-editor "toolbar" f {
  73     { T{ key-down f { C+ } "RET" } commit }
  74     { T{ key-down f { S+ C+ } "RET" } com-eval }
  75     { f revert }
  76     { f delete }
  77     { T{ key-down f f "ESC" } close }
  78 } define-command-map
  79
  80 : slot-editor-window ( close-hook update-hook assoc key key-string -- )
  81     [ <value-ref> <slot-editor> ]
  82     [
  83         <world-attributes>
  84             swap "Slot editor: " prepend >>title
  85             [ { dialog-window } append ] change-window-controls
  86     ] bi*
  87     open-status-window ;