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