needs lib/coop io/stream io/grid fs/utag fs/sh mem/kv text/ed app/ed
unit app/gcon

addedbuf curbuf @ const gconbuf
"Ouput buffer\n" edstream puts
: selectcon gconbuf curbuf ! -1 to gutter ;

: insertgridcontents ( -- )
  grid Grid.lines begin
    dup while 1- dup grid io/grid line[] nip not while repeat
    1+ else then ( lastidx )
  0 do i grid io/grid line[] edstream write# LF edstream putc loop
  "Grid command inserted above" edstream puts ;

0 value hasoutput
0 value gridmode
0 value lastgridpos

: runrtype
  grid pos lastgridpos <> doto gridmode or |
  doto hasoutput 1 | not if
    selectcon appendline
    epos to mark
    grid clear then
  gridmode not if 2dup edstream write# then
  grid write# grid pos to lastgridpos ;
: consolerun ( ? xt -- ? )
  statusline ."Running..." flush.
  0 to hasoutput 0 to gridmode
  -1 grid to pos -1 to lastgridpos
  ['] runrtype RTYPE @! >r ( xt ) execute r> RTYPE !
  hasoutput if
    gridmode if insertgridcontents then
    selectcon reframe pagerefresh
    else statusline ."Ran command. There was no output." then ;
: run[] ( ... a u -- ... ) ['] interpret[] consolerun ;

: |C LControl or ;

kvtbl[
  CR |C  :>
    textsel[] ?dup not if
      drop curline line[] then ( a u )
    0 to visualmode
    run[] reframe pagerefresh ;
  'R' |C :>
    wordundercursor ?[] if
      []>str dup utag>.fs lookup if
        fs/core open nip ['] interpretstream consolerun endunit
        else sysdict find ?dup if consolerun then then
      reframe pagerefresh then ;
  'S' |C :>
    wordundercursor ?[] if
      []>str lookup# ['] listdir consolerun then ;
  'A' |C :> saveprevbuf selectcon fullrefresh ;
]kvtbl handlers

EDApp cloneapplication GConApp
GConApp newedctx const gconctx \ TODO: multi-task
0 value subctx \ nonzero when an App is invoked in run[]

:> subctx if
     evtype IDLE = if :selfdispatch then
     subctx context ! dispatch
   else :selfdispatch then ;
GConApp dispatch!

:> ( -- )
  ?type1 if exit then
  handlers evarg2 ?kvexec if
    displaypos else app/ed handlekey then ;
KEYPRESS GConApp sethandler

:> ( -- ) evarg1 dup to subctx ctxrunloop 0 to subctx ;
REGISTER GConApp sethandler

: gcon gconctx launchcontext ;
:~ edstream write# ;
: initgcon gconctx to rootcontext selectcon ['] ~ RTYPE ! ;