library/ui/text/interactor.factor

   1 ! Copyright (C) 2006 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: gadgets-text
   4 USING: arrays definitions gadgets gadgets-panes
   5 generic hashtables help io kernel namespaces prettyprint styles
   6 threads sequences vectors definitions parser words strings ;
   7
   8 TUPLE: interactor history output continuation queue busy? ;
   9
  10 C: interactor ( output -- gadget )
  11     [ set-interactor-output ] keep
  12     <editor> over set-gadget-delegate
  13     V{ } clone over set-interactor-history
  14     dup dup set-control-self ;
  15
  16 M: interactor graft*
  17     f over set-interactor-busy? delegate graft* ;
  18
  19 : (interactor-eval) ( string interactor -- )
  20     dup interactor-busy? [
  21         2drop
  22     ] [
  23         t over set-interactor-busy?
  24         swap "\n" split <reversed> >vector
  25         over set-interactor-queue
  26         interactor-continuation schedule-thread
  27     ] if ;
  28
  29 SYMBOL: structured-input
  30
  31 : interactor-call ( quot gadget -- )
  32     dup interactor-output [
  33         "Command: " write over short.
  34     ] with-stream*
  35     >r structured-input set-global
  36     "\"structured-input\" \"gadgets-text\" lookup get-global call"
  37     r> (interactor-eval) ;
  38
  39 : interactor-input. ( string interactor -- )
  40     interactor-output [ dup print-input ] with-stream* ;
  41
  42 : interactor-eval ( string interactor -- )
  43     dup control-model clear-doc
  44     2dup interactor-history push-new
  45     2dup interactor-input.
  46     (interactor-eval) ;
  47
  48 : interactor-commit ( interactor -- )
  49     dup interactor-busy? [
  50         drop
  51     ] [
  52         [ editor-text ] keep interactor-eval
  53     ] if ;
  54
  55 M: interactor stream-readln
  56     dup interactor-queue empty? [
  57         f over set-interactor-busy?
  58         [ over set-interactor-continuation stop ] callcc0
  59     ] when interactor-queue pop ;
  60
  61 interactor "interactor" {
  62     { "Evaluate" T{ key-down f f "RETURN" } [ interactor-commit ] }
  63     { "Clear input" T{ key-down f { C+ } "k" } [ control-model clear-doc ] }
  64 } define-commands