basis/ui/gadgets/slots/slots.factor

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