urbit/pkg/arvo/lib/hood/drum.hoon

/-  *sole
/+  sole
|%
+$  any-state  $%(state)
+$  state  [%2 pith-2]
::
++  pith-2                                              ::
  $:  eel/(set gill:gall)                               ::  connect to
      ray/(set well:gall)                               ::
      fur/(map dude:gall (unit server))                 ::  servers
      bin/(map bone source)                             ::  terminals
  ==                                                    ::
::                                                      ::
++  server                                              ::  running server
  $:  syd/desk                                          ::  app identity
      cas/case                                          ::  boot case
  ==                                                    ::
++  kill                                                ::  kill ring
  $:  pos/@ud                                           ::  ring position
      num/@ud                                           ::  number of entries
      max/_60                                           ::  max entries
      old/(list (list @c))                              ::  entries proper
  ==                                                    ::
++  source                                              ::  input device
  $:  edg/_80                                           ::  terminal columns
      off/@ud                                           ::  window offset
      kil/kill                                          ::  kill buffer
      inx/@ud                                           ::  ring index
      fug/(map gill:gall (unit target))                 ::  connections
      mir/(pair @ud stub)                               ::  mirrored terminal
  ==                                                    ::
++  history                                             ::  past input
  $:  pos/@ud                                           ::  input position
      num/@ud                                           ::  number of entries
      lay/(map @ud (list @c))                           ::  editing overlay
      old/(list (list @c))                              ::  entries proper
  ==                                                    ::
++  search                                              ::  reverse-i-search
  $:  pos/@ud                                           ::  search position
      str/(list @c)                                     ::  search string
  ==                                                    ::
++  target                                              ::  application target
  $:  $=  blt                                           ::  curr & prev belts
        %+  pair
          (unit dill-belt:dill)
        (unit dill-belt:dill)
      ris/(unit search)                                 ::  reverse-i-search
      hit/history                                       ::  all past input
      pom/sole-prompt                                   ::  static prompt
      inp/sole-command                                  ::  input state
  ==                                                    ::
--
::                                                      ::  ::
::::                                                    ::  ::
  ::                                                    ::  ::
|%
++  deft-apes                                           ::  default servers
  |=  [our=ship lit=?]
  %-  ~(gas in *(set well:gall))
  ^-  (list well:gall)
  ::  boot all default apps off the home desk
  ::
  =-  (turn - |=(a=term home+a))
  ^-  (list term)
  %+  welp
    :~  %dojo
        %spider
        %eth-watcher
        %azimuth-tracker
        %ping
        %goad
    ==
  ?:  lit
    ~
  :~  %acme
      %lens
      %clock
      %dojo
      %launch
      %publish
      %weather
      %group-store
      %group-pull-hook
      %group-push-hook
      %permission-store
      %permission-hook
      %permission-group-hook
      %invite-store
      %invite-hook
      %chat-store
      %chat-hook
      %chat-view
      %chat-cli
      %soto
      %contact-store
      %contact-hook
      %contact-view
      %link-store
      %link-proxy-hook
      %link-listen-hook
      %link-view
      %metadata-store
      %metadata-hook
      %s3-store
      %file-server
      %glob
      %graph-store
      %graph-pull-hook
      %graph-push-hook
  ==
::
++  deft-fish                                           ::  default connects
  |=  our=ship
  %-  ~(gas in *(set gill:gall))
  ^-  (list gill:gall)
  [[our %dojo] [our %chat-cli]~]
::
++  en-gill                                           ::  gill to wire
  |=  gyl=gill:gall
  ^-  wire
  [%drum %phat (scot %p p.gyl) q.gyl ~]
::
++  de-gill                                           ::  gill from wire
  |=  way=wire  ^-  gill:gall
  ?>(?=([@ @ ~] way) [(slav %p i.way) i.t.way])
--
::  TODO: remove .ost
::
|=  [hid=bowl:gall state]
=*  sat  +<+
=/  ost  0
=+  (~(gut by bin) ost *source)
=*  dev  -
=|  moz=(list card:agent:gall)
=|  biz=(list dill-blit:dill)
|%
++  this  .
+$  state      ^state      ::  proxy
+$  any-state  ^any-state  ::  proxy
++  on-init  se-abet:this(eel (deft-fish our.hid))
++  diff-sole-effect-phat                             ::  app event
  |=  {way/wire fec/sole-effect}
  =<  se-abet  =<  se-view
  =+  gyl=(de-gill way)
  ?:  (se-aint gyl)  +>.$
  (se-diff gyl fec)
::
++  peer                                              ::
  |=  pax/path
  ~|  [%drum-unauthorized our+our.hid src+src.hid]    ::  ourself
  ?>  (team:title our.hid src.hid)               ::  or our own moon
  =<  se-abet  =<  se-view
  (se-text "[{<src.hid>}, driving {<our.hid>}]")
::
++  poke-set-boot-apps                                ::
  |=  lit=?
  ^-  (quip card:agent:gall ^state)
  ::  We do not run se-abet:se-view here because that starts the apps,
  ::  and some apps are not ready to start (eg Talk crashes because the
  ::  terminal has width 0).  It appears the first message to drum must
  ::  be the peer.
  ::
  =.  ray  (deft-apes our.hid lit)
  [~ sat]
::
++  poke-dill-belt                                    ::  terminal event
  |=  bet/dill-belt:dill
  =<  se-abet  =<  se-view
  (se-belt bet)
::
++  poke-dill-blit                                    ::  terminal output
  |=  bit/dill-blit:dill
  se-abet:(se-blit-sys bit)
::
++  poke-start                                        ::  start app
  |=  wel/well:gall
  =<  se-abet  =<  se-view
  (se-born & wel)
::
++  poke-link                                         ::  connect app
  |=  gyl/gill:gall
  =<  se-abet  =<  se-view
  (se-link gyl)
::
++  poke-unlink                                       ::  disconnect app
  |=  gyl/gill:gall
  =<  se-abet  =<  se-view
  (se-drop:(se-pull gyl) & gyl)
::
++  poke-exit                                         ::  shutdown
  |=  ~
  se-abet:(se-blit-sys `dill-blit:dill`[%qit ~])
::
++  poke-put                                          ::  write file
  |=  {pax/path txt/@}
  se-abet:(se-blit-sys [%sav pax txt])                ::
::
++  poke
  |=  [=mark =vase]
  ?+  mark  ~|([%poke-drum-bad-mark mark] !!)
    %drum-dill-belt      =;(f (f !<(_+<.f vase)) poke-dill-belt)
    %drum-dill-blit      =;(f (f !<(_+<.f vase)) poke-dill-blit)
    %drum-exit           =;(f (f !<(_+<.f vase)) poke-exit)
    %drum-link           =;(f (f !<(_+<.f vase)) poke-link)
    %drum-put            =;(f (f !<(_+<.f vase)) poke-put)
    %drum-set-boot-apps  =;(f (f !<(_+<.f vase)) poke-set-boot-apps)
    %drum-start          =;(f (f !<(_+<.f vase)) poke-start)
    %drum-unlink         =;(f (f !<(_+<.f vase)) poke-unlink)
  ==
::
++  on-load
  |=  [hood-version=?(%1 %2 %3 %4 %5 %6 %7 %8 %9 %10) old=any-state]
  =<  se-abet  =<  se-view
  =.  sat  old
  =.  dev  (~(gut by bin) ost *source)
  =?  ..on-load  (lte hood-version %4)
    ~>  %slog.0^leaf+"drum: starting os1 agents"
    =>  (se-born | %home %s3-store)
    =>  (se-born | %home %link-view)
    =>  (se-born | %home %link-listen-hook)
    =>  (se-born | %home %link-store)
    =>  (se-born | %home %link-proxy-hook)
    =>  (se-born | %home %contact-view)
    =>  (se-born | %home %contact-hook)
    =>  (se-born | %home %contact-store)
    =>  (se-born | %home %metadata-hook)
    =>  (se-born | %home %metadata-store)
    =>  (se-born | %home %goad)
    ~>  %slog.0^leaf+"drum: resubscribing to %dojo and %chat-cli"
    =>  (se-drop:(se-pull our.hid %dojo) | our.hid %dojo)
    (se-drop:(se-pull our.hid %chat-cli) | our.hid %chat-cli)
  =?  ..on-load  (lte hood-version %5)
    (se-born | %home %file-server)
  =?  ..on-load  (lte hood-version %7)
    (se-born | %home %glob)
  =?  ..on-load  (lte hood-version %8)
    =>  (se-born | %home %group-push-hook)
    (se-born | %home %group-pull-hook)
  =?  ..on-load  (lte hood-version %9)
   (se-born | %home %graph-store)
  =?  ..on-load  (lte hood-version %10)
    =>  (se-born | %home %graph-push-hook)
    (se-born | %home %graph-pull-hook)
  ..on-load
::
++  reap-phat                                         ::  ack connect
  |=  {way/wire saw/(unit tang)}
  =<  se-abet  =<  se-view
  =+  gyl=(de-gill way)
  ?~  saw
    (se-join gyl)
  ::  Don't print stack trace because we probably just crashed to
  ::  indicate we don't connect to the console.
  ::
  (se-drop & gyl)
::
++  take-arvo
  |=  [=wire =sign-arvo]
  %+  take-onto  wire
  ?>  ?=(%onto +<.sign-arvo)
  +>.sign-arvo
::
++  take-coup-phat                                    ::  ack poke
  |=  {way/wire saw/(unit tang)}
  =<  se-abet  =<  se-view
  ?~  saw  +>
  =+  gyl=(de-gill way)
  ?:  (se-aint gyl)  +>.$
  %-  se-dump:(se-drop:(se-pull gyl) & gyl)
  :_  u.saw
  >[%drum-coup-fail src.hid gyl]<
::
++  take-onto                                         ::  ack start
  |=  {way/wire saw/(each suss:gall tang)}
  =<  se-abet  =<  se-view
  ?>  ?=({@ @ ~} way)
  ?>  (~(has by fur) i.t.way)
  =/  wel/well:gall  [i.way i.t.way]
  ?-  saw
    {%| *}  (se-dump p.saw)
    {%& *}  ?>  =(q.wel p.p.saw)
            ::  =.  +>.$  (se-text "live {<p.saw>}")
            +>.$(fur (~(put by fur) q.wel `[p.wel %da r.p.saw]))
  ==
::
++  take-agent
  |=  [=wire =sign:agent:gall]
  ?+  wire  ~|([%drum-bad-take-agent wire -.sign] !!)
      [%drum %phat *]
    ?-  -.sign
        %poke-ack   (take-coup-phat t.t.wire p.sign)
        %watch-ack  (reap-phat t.t.wire p.sign)
        %kick       (quit-phat t.t.wire)
        %fact
      %+  diff-sole-effect-phat  t.t.wire
      ?>  ?=(%sole-effect p.cage.sign)
      !<(sole-effect q.cage.sign)
   ==
 ==
::
++  quit-phat                                         ::
  |=  way/wire
  =<  se-abet  =<  se-view
  =+  gyl=(de-gill way)
  ~&  [%drum-quit src.hid gyl]
  (se-drop %| gyl)
::                                                    ::  ::
::::                                                  ::  ::
  ::                                                  ::  ::
++  se-abet                                           ::  resolve
  ^-  (quip card:agent:gall state)
  =.  .  se-subze:se-adze:se-adit
  :_  sat(bin (~(put by bin) ost dev))
  ^-  (list card:agent:gall)
  ?~  biz  (flop moz)
  :_  (flop moz)
  =/  =dill-blit:dill  ?~(t.biz i.biz [%mor (flop biz)])
  [%give %fact ~[/drum] %dill-blit !>(dill-blit)]
::
++  se-adit                                           ::  update servers
  ^+  this
  |^
  =/  servers=(list well:gall)
    (sort ~(tap in ray) sort-by-priorities)
  |-
  ?~  servers
    this
  =/  wel=well:gall
    i.servers
  =/  =wire  [%drum p.wel q.wel ~]
  =/  hig=(unit (unit server))
    (~(get by fur) q.wel)
  ?:  &(?=(^ hig) |(?=(~ u.hig) =(p.wel syd.u.u.hig)))
    $(servers t.servers)
  =.  fur
    (~(put by fur) q.wel ~)
  =.  this
    (se-text "activated app {(trip p.wel)}/{(trip q.wel)}")
  =.  this
    %-  se-emit
    [%pass wire %arvo %g %conf q.wel]
  $(servers t.servers)
  ::
  ++  priorities
    ^-  (list (set @))
    :~
      :: set up stores with priority: depended on, but never depending
      %-  sy
      :~  %permission-store
          %chat-store
          %contact-store
          %group-store
          %link-store
          %invite-store
          %metadata-store
      ==
      :: ensure chat-cli can sub to invites
      :: and file server can receive pokes
      (sy ~[%chat-hook %file-server])
    ==
  ++  sort-by-priorities
    =/  priorities  priorities
    |=  [[desk a=term] [desk b=term]]
    ^-  ?
    ?~  priorities
      (aor a b)
    =*  priority  i.priorities
    ?:  &((~(has in priority) a) (~(has in priority) b))
      (aor a b)
    ?:  (~(has in priority) a)
      %.y
    ?:  (~(has in priority) b)
      %.n
    $(priorities t.priorities)
  --
::
++  se-adze                                           ::  update connections
  ^+  .
  %+  roll
    %+  sort
      ~(tap in eel)
    |=  [[@ a=term] [@ b=term]]
    ?:  =(a %dojo)  %.n
    ?:  =(b %dojo)  %.y
    (aor a b)
  =<  .(con +>)
  |:  $:{gil/gill:gall con/_.}  ^+  con
  =.  +>.$  con
  ?:  (~(has by fug) gil)
    +>.$
  (se-peer gil)
::
++  se-subze                                          ::  downdate connections
  =<  .(dev (~(got by bin) ost))
  =.  bin  (~(put by bin) ost dev)
  ^+  .
  %-  ~(rep by bin)
  =<  .(con +>)
  |:  $:{{ost/bone dev/source} con/_.}  ^+  con
  =+  xeno=se-subze-local:%_(con ost ost, dev dev)
  xeno(ost ost.con, dev dev.con, bin (~(put by bin) ost dev.xeno))
::
++  se-subze-local
  ^+  .
  %-  ~(rep by fug)
  =<  .(con +>)
  |:  $:{{gil/gill:gall *} con/_.}  ^+  con
  =.  +>.$  con
  ?:  (~(has in eel) gil)
    +>.$
  (se-nuke gil)
::
++  se-aint                                           ::  ignore result
  |=  gyl/gill:gall
  ^-  ?
  ?.  (~(has by bin) ost)  &
  =+  gyr=(~(get by fug) gyl)
  |(?=(~ gyr) ?=(~ u.gyr))
::
++  se-alas                                           ::  recalculate index
  |=  gyl/gill:gall
  =+  [xin=0 wag=se-amor]
  |-  ^+  +>.^$
  ?~  wag  +>.^$(inx 0)
  ?:  =(i.wag gyl)  +>.^$(inx xin)
  $(wag t.wag, xin +(xin))
::
++  se-amor                                           ::  live targets
  ^-  (list gill:gall)
  %+  skim  ~(tap in eel)
  |=(a/gill:gall ?=({~ ~ *} (~(get by fug) a)))
::
++  se-anon                                           ::  rotate index
  =+  wag=se-amor
  ?~  wag  +
  ::  ~&  [%se-anon inx+inx wag+wag nex+(mod +(inx) (lent se-amor))]
  +(off 0, inx (mod +(inx) (lent wag)))
::
++  se-agon                                           ::  current gill
  ^-  (unit gill:gall)
  =+  wag=se-amor
  ?~  wag  ~
  ~|  [inx=inx wag=wag fug=fug eel=eel]
  `(snag inx `(list gill:gall)`wag)
::
++  se-belt                                           ::  handle input
  |=  bet/dill-belt:dill
  ^+  +>
  ?:  ?=({?($cru $hey $rez $yow) *} bet)              ::  target-agnostic
    ?-  bet
      {$cru *}  (se-dump:(se-text (trip p.bet)) q.bet)
      {$hey *}  +>(mir [0 ~])                         ::  refresh
      {$rez *}  +>(edg (dec p.bet))                   ::  resize window
      {$yow *}  ~&([%no-yow -.bet] +>)
    ==
  =+  gul=se-agon
  ?:  |(?=(~ gul) (se-aint u.gul))
    (se-blit %bel ~)
  ta-abet:(ta-belt:(se-tame u.gul) bet)
::
++  se-born                                           ::  new server
  |=  [print-on-repeat=? wel=well:gall]
  ^+  +>
  ?:  (~(has in ray) wel)
    ?.  print-on-repeat  +>
    (se-text "[already running {<p.wel>}/{<q.wel>}]")
  %=  +>
    ray  (~(put in ray) wel)
    eel  (~(put in eel) [our.hid q.wel])
  ==
::
++  se-drop                                           ::  disconnect
  |=  {pej/? gyl/gill:gall}
  ^+  +>
  =+  lag=se-agon
  ?.  (~(has by fug) gyl)  +>.$
  =.  fug  (~(del by fug) gyl)
  =.  eel  ?.(pej eel (~(del in eel) gyl))
  =.  +>.$  ?.  &(?=(^ lag) !=(gyl u.lag))
              +>.$(inx 0)
            (se-alas u.lag)
  =.  +>.$  (se-text "[unlinked from {<gyl>}]")
  ?:  =(gyl [our.hid %dojo])                          ::  undead dojo
    (se-link gyl)
  +>.$
::
++  se-tab                                            ::  print tab completions
  |=  tl/(list {=cord =tank})
  ^+  +>
  =/  lots  (gth (lent tl) 10)
  =/  long
    ?:  lots
      0
    (roll (turn tl |=([=term *] (met 3 term))) max)
  %-  se-dump
  %-  flop
  ^-  (list tank)
  :-  leaf+"-----"
  %+  turn  tl
  |=  [=term =type=tank]
  ?:  lots
    leaf+(trip term)
  =/  type-text  ~(ram re type-tank)
  =/  spaces  (trip (fil 3 (sub long (met 3 term)) ' '))
  =/  =tape  "{(trip term)} {spaces} {type-text}"
  ::  If type is too long and not the only result, abbreviate
  ::
  ?:  (gth (lent type-text) edg)
    ?:  ?=([* ~] tl)
      :+  %rose
        ["" "" ""]
      ~[leaf+(trip term) type-tank]
    leaf+(weld (scag (sub edg 3) tape) "...")
  leaf+tape
::
++  se-dump                                           ::  print tanks
  |=  tac/(list tank)
  ^+  +>
  =/  wol/wall
    (zing (turn (flop tac) |=(a/tank (~(win re a) [0 edg]))))
  |-  ^+  +>.^$
  ?~  wol  +>.^$
  ?.  ((sane %t) (crip i.wol))  :: XX upstream validation
    ~&  bad-text+<`*`i.wol>
    $(wol t.wol)
  $(wol t.wol, +>.^$ (se-blit %out (tuba i.wol)))
::
++  se-join                                           ::  confirm connection
  |=  gyl/gill:gall
  ^+  +>
  =.  +>  (se-text "[linked to {<gyl>}]")
  ?>  ?=(~ (~(got by fug) gyl))
  (se-alas(fug (~(put by fug) gyl `*target)) gyl)
::
++  se-nuke                                           ::  teardown connection
  |=  gyl/gill:gall
  ^+  +>
  (se-drop:(se-pull gyl) & gyl)
::
++  se-klin                                           ::  disconnect app
  |=  gyl/gill:gall
  +>(eel (~(del in eel) gyl))
::
++  se-link                                           ::  connect to app
  |=  gyl/gill:gall
  +>(eel (~(put in eel) gyl))
::
++  se-blit                                           ::  give output
  |=  bil/dill-blit:dill
  +>(biz [bil biz])
::
++  se-blit-sys                                       ::  output to system
  |=  bil/dill-blit:dill  ^+  +>
  (se-emit %give %fact ~[/drum] %dill-blit !>(bil))
::
++  se-show                                           ::  show buffer, raw
  |=  lin/(pair @ud stub)
  ^+  +>
  =.  p.lin  (add p.lin (lent-stye:klr q.lin))
  ?:  =(mir lin)  +>
  =.  +>  ?:(=(p.mir p.lin) +> (se-blit %hop p.lin))
  =.  +>  ?:(=(q.mir q.lin) +> (se-blit %pom q.lin))
  +>(mir lin)
::
++  se-just                                           ::  adjusted buffer
  |=  {pom/stub lin/(pair @ud (list @c))}
  ^+  +>
  =/  pol  (lent-char:klr pom)
  =/  pos  (add pol p.lin)
  ?:  (gte (div (mul pol 100) edg) 35)      :: old style (long prompt)
    =/  off  ?:((lte pos edg) 0 (sub pos edg))
    %+  se-show
      (sub pos off)
    (swag:klr [off edg] (welp pom [*stye q.lin]~))
  =/  end  (sub edg pol)
  =.  off  ?:  (gth p.lin (add end off))
             (sub p.lin end)
           ?:  (lth p.lin off)
             (min p.lin (dec off))
           off
  %+  se-show
    (sub pos off)
  (welp pom [*stye (swag [off end] q.lin)]~)
::
++  se-view                                           ::  flush buffer
  ^+  .
  =+  gul=se-agon
  ?:  |(?=(~ gul) (se-aint u.gul))  +
  (se-just ta-vew:(se-tame u.gul))
::
++  se-emit
  |=  card:agent:gall
  %_(+> moz [+< moz])
::
++  se-text                                           ::  return text
  |=  txt/tape
  ^+  +>
  ?.  ((sane %t) (crip txt))  :: XX upstream validation
    ~&  bad-text+<`*`txt>
    +>
  (se-blit %out (tuba txt))
::
++  se-poke                                           ::  send a poke
  |=  {gyl/gill:gall par/cage}
  (se-emit %pass (en-gill gyl) %agent gyl %poke par)
::
++  se-peer                                           ::  send a peer
  |=  gyl/gill:gall
  =/  =path  /sole/(cat 3 'drum_' (scot %p our.hid))
  %-  se-emit(fug (~(put by fug) gyl ~))
  [%pass (en-gill gyl) %agent gyl %watch path]
::
++  se-pull                                           ::  cancel subscription
  |=  gyl/gill:gall
  (se-emit %pass (en-gill gyl) %agent gyl %leave ~)
::
++  se-tame                                           ::  switch connection
  |=  gyl/gill:gall
  ^+  ta
  ~(. ta gyl (need (~(got by fug) gyl)))
::
++  se-diff                                           ::  receive results
  |=  {gyl/gill:gall fec/sole-effect}
  ^+  +>
  ta-abet:(ta-fec:(se-tame gyl) fec)
::
++  ta                                                ::  per target
  |_  {gyl/gill:gall target}                         ::  app and state
  ++  ta-abet                                         ::  resolve
    ^+  ..ta
    ..ta(fug (~(put by fug) gyl ``target`+<+))
  ::
  ++  ta-poke  |=(a/cage +>(..ta (se-poke gyl a)))    ::  poke gyl
  ::
  ++  ta-act                                          ::  send action
    |=  act/sole-action
    ^+  +>
    (ta-poke %sole-action !>(act))
  ::
  ++  ta-id  (cat 3 'drum_' (scot %p our.hid))        ::  per-ship duct id
  ::
  ++  ta-aro                                          ::  hear arrow
    |=  key/?($d $l $r $u)
    ^+  +>
    =.  ris  ~
    ?-  key
      $d  ?.  =(num.hit pos.hit)
            (ta-mov +(pos.hit))
          ?:  =(0 (lent buf.say.inp))
            ta-bel
          (ta-hom:ta-nex %set ~)
      $l  ?:  =(0 pos.inp)  ta-bel
          +>(pos.inp (dec pos.inp))
      $r  ?:  =((lent buf.say.inp) pos.inp)
            ta-bel
          +>(pos.inp +(pos.inp))
      $u  ?:(=(0 pos.hit) ta-bel (ta-mov (dec pos.hit)))
    ==
  ::
  ++  ta-bel                                          ::  beep
    .(..ta (se-blit %bel ~), q.blt ~)                 ::  forget belt
  ::
  ++  ta-belt                                         ::  handle input
    |=  bet/dill-belt:dill
    ^+  +>
    ?<  ?=({?($cru $hey $rez $yow) *} bet)            ::  target-specific
    =.  blt  [q.blt `bet]                             ::  remember belt
    ?-  bet
      {$aro *}  (ta-aro p.bet)
      {$bac *}  ta-bac
      {$ctl *}  (ta-ctl p.bet)
      {$del *}  ta-del
      {$met *}  (ta-met p.bet)
      {$ret *}  ta-ret
      {$txt *}  (ta-txt p.bet)
    ==
  ::
  ++  ta-det                                          ::  send edit
    |=  ted/sole-edit
    ^+  +>
    %^    ta-act
        ta-id
      %det
    [[his.ven.say.inp own.ven.say.inp] (sham buf.say.inp) ted]
  ::
  ++  ta-bac                                          ::  hear backspace
    ^+  .
    ?^  ris
      ?:  =(~ str.u.ris)
        ta-bel
      .(str.u.ris (scag (dec (lent str.u.ris)) str.u.ris))
    ?:  =(0 pos.inp)
      ?~  buf.say.inp
        (ta-act ta-id %clr ~)
      ta-bel
    (ta-hom %del (dec pos.inp))
  ::
  ++  ta-ctl                                          ::  hear control
    |=  key/@ud
    ^+  +>
    =.  ris  ?.(?=(?($g $r) key) ~ ris)
    ?+    key    ta-bel
        $a  +>(pos.inp 0)
        $b  (ta-aro %l)
        $c  ta-bel
        $d  ?^  buf.say.inp
              ta-del
            ?:  (~(has in (deft-fish our.hid)) gyl)
              +>(..ta (se-blit qit+~))                ::  quit pier
            +>(..ta (se-klin gyl))                    ::  unlink app
        $e  +>(pos.inp (lent buf.say.inp))
        $f  (ta-aro %r)
        $g  ?~  ris  ta-bel
            (ta-hom(pos.hit num.hit, ris ~) [%set ~])
        $i  ta-tab
        $k  =+  len=(lent buf.say.inp)
            ?:  =(pos.inp len)
              ta-bel
            (ta-kil %r [pos.inp (sub len pos.inp)])
        $l  +>(..ta (se-blit %clr ~))
        $n  (ta-aro %d)
        $p  (ta-aro %u)
        $r  ?~  ris
              +>(ris `[pos.hit ~])
            ?:  =(0 pos.u.ris)
              ta-bel
            (ta-ser ~)
        $t  =+  len=(lent buf.say.inp)
            ?:  |(=(0 pos.inp) (lth len 2))
              ta-bel
            =+  sop=(sub pos.inp ?:(=(len pos.inp) 2 1))
            (ta-hom (rep:edit [sop 2] (flop (swag [sop 2] buf.say.inp))))
        $u  ?:  =(0 pos.inp)
              ta-bel
            (ta-kil %l [0 pos.inp])
        $v  ta-bel
        $w  ?:  =(0 pos.inp)
              ta-bel
            =+  sop=(ta-pos %l %ace pos.inp)
            (ta-kil %l [(sub pos.inp sop) sop])
        $x  +>(..ta se-anon)
        $y  ?:  =(0 num.kil)
              ta-bel
            (ta-hom (cat:edit pos.inp ta-yan))
    ==
  ::
  ++  ta-del                                          ::  hear delete
    ^+  .
    ?:  =((lent buf.say.inp) pos.inp)
      ta-bel
    (ta-hom %del pos.inp)
  ::
  ++  ta-erl                                          ::  hear local error
    |=  pos/@ud
    ta-bel(pos.inp (min pos (lent buf.say.inp)))
  ::
  ++  ta-err                                          ::  hear remote error
    |=  pos/@ud
    (ta-erl (~(transpose sole say.inp) pos))
  ::
  ++  ta-fec                                          ::  apply effect
    |=  fec/sole-effect
    ^+  +>
    ?-  fec
      {$bel *}  ta-bel
      {$blk *}  +>
      {$clr *}  +>(..ta (se-blit fec))
      {$det *}  (ta-got +.fec)
      {$err *}  (ta-err p.fec)
      {$klr *}  +>(..ta (se-blit %klr (make:klr p.fec)))
      {$mor *}  |-  ^+  +>.^$
                ?~  p.fec  +>.^$
                $(p.fec t.p.fec, +>.^$ ^$(fec i.p.fec))
      {$nex *}  ta-nex
      {$pro *}  (ta-pro +.fec)
      {$tab *}  +>(..ta (se-tab p.fec))
      {$tan *}  +>(..ta (se-dump p.fec))
      {$sag *}  +>(..ta (se-blit fec))
      {$sav *}  +>(..ta (se-blit fec))
      {$txt *}  +>(..ta (se-text p.fec))
      {$url *}  +>(..ta (se-blit fec))
    ==
  ::
  ++  ta-dog                                          ::  change cursor
    |=  ted/sole-edit
    %_    +>
        pos.inp
      =+  len=(lent buf.say.inp)
      %+  min  len
      |-  ^-  @ud
      ?-  ted
        {$del *}  ?:((gth pos.inp p.ted) (dec pos.inp) pos.inp)
        {$ins *}  ?:((gte pos.inp p.ted) +(pos.inp) pos.inp)
        {$mor *}  |-  ^-  @ud
                  ?~  p.ted  pos.inp
                  $(p.ted t.p.ted, pos.inp ^$(ted i.p.ted))
        {$nop *}  pos.inp
        {$set *}  len
      ==
    ==
  ::
  ++  ta-off                                          ::  reset buffer offset
    |=  ted/sole-edit
    =?  off  (any:edit ted |=(a/sole-edit ?=($set -.a)))  0
    +>
  ::
  ++  ta-got                                          ::  apply change
    |=  cal/sole-change
    =^  ted  say.inp  (~(receive sole say.inp) cal)
    (ta-dog:(ta-off ted.cal) ted)
  ::
  ++  ta-hom                                          ::  local edit
    |=  ted/sole-edit
    ^+  +>
    =.  +>  (ta-det:(ta-off ted) ted)
    (ta-dog(say.inp (~(commit sole say.inp) ted)) ted)
  ::
  ++  ta-jump                                         ::  buffer pos
    |=  {dir/?($l $r) til/?($ace $edg $wrd) pos/@ud}
    ^-  @ud
    %-  ?:(?=($l dir) sub add)
    [pos (ta-pos dir til pos)]
  ::
  ++  ta-kil                                          ::  kill selection
    |=  {dir/?($l $r) sel/{@ @}}
    ^+  +>
    =+  buf=(swag sel buf.say.inp)
    %.  (cut:edit sel)
    %=  ta-hom
        kil
      ?.  ?&  ?=(^ old.kil)
              ?=(^ p.blt)
              ?|  ?=({$ctl ?($k $u $w)} u.p.blt)
                  ?=({$met ?($d $bac)} u.p.blt)
          ==  ==
        %=  kil                                       ::  prepend
          num  +(num.kil)
          pos  +(num.kil)
          old  (scag max.kil `(list (list @c))`[buf old.kil])
        ==
      %=  kil                                         ::  cumulative yanks
        pos  num.kil
        old  :_  t.old.kil
             ?-  dir
               $l  (welp buf i.old.kil)
               $r  (welp i.old.kil buf)
      ==     ==
    ==
  ::
  ++  ta-met                                          ::  meta key
    |=  key/@ud
    ^+  +>
    =.  ris  ~
    ?+    key    ta-bel
      $dot  ?.  &(?=(^ old.hit) ?=(^ i.old.hit))      ::  last "arg" from hist
              ta-bel
            =+  old=`(list @c)`i.old.hit
            =+  sop=(ta-jump(buf.say.inp old) %l %ace (lent old))
            (ta-hom (cat:edit pos.inp (slag sop old)))
            ::
      $bac  ?:  =(0 pos.inp)                          ::  kill left-word
              ta-bel
            =+  sop=(ta-pos %l %edg pos.inp)
            (ta-kil %l [(sub pos.inp sop) sop])
            ::
      $b    ?:  =(0 pos.inp)                          ::  jump left-word
              ta-bel
            +>(pos.inp (ta-jump %l %edg pos.inp))
            ::
      $c    ?:  =(pos.inp (lent buf.say.inp))         ::  capitalize
              ta-bel
            =+  sop=(ta-jump %r %wrd pos.inp)
            %-  ta-hom(pos.inp (ta-jump %r %edg sop))
            %+  rep:edit  [sop 1]
            ^-  (list @c)  ^-  (list @)               :: XX unicode
            (cuss `tape``(list @)`(swag [sop 1] buf.say.inp))
            ::
      $d    ?:  =(pos.inp (lent buf.say.inp))         ::  kill right-word
              ta-bel
            (ta-kil %r [pos.inp (ta-pos %r %edg pos.inp)])
            ::
      $f    ?:  =(pos.inp (lent buf.say.inp))         ::  jump right-word
              ta-bel
            +>(pos.inp (ta-jump %r %edg pos.inp))
            ::
      $r    %-  ta-hom(lay.hit (~(put by lay.hit) pos.hit ~))
            :-  %set                                  ::  revert hist edit
            ?:  =(pos.hit num.hit)  ~
            (snag (sub num.hit +(pos.hit)) old.hit)
            ::
      $t    =+  a=(ta-jump %r %edg pos.inp)           ::  transpose words
            =+  b=(ta-jump %l %edg a)
            =+  c=(ta-jump %l %edg b)
            ?:  =(b c)
              ta-bel
            =+  next=[b (sub a b)]
            =+  prev=[c (ta-pos %r %edg c)]
            %-  ta-hom(pos.inp a)
            :~  %mor
                (rep:edit next (swag prev buf.say.inp))
                (rep:edit prev (swag next buf.say.inp))
            ==
            ::
      ?($u $l)                                        ::  upper/lower case
            ?:  =(pos.inp (lent buf.say.inp))
              ta-bel
            =+  case=?:(?=($u key) cuss cass)
            =+  sop=(ta-jump %r %wrd pos.inp)
            =+  sel=[sop (ta-pos %r %edg sop)]
            %-  ta-hom
            %+  rep:edit  sel
            ^-  (list @c)  ^-  (list @)               :: XX unicode
            (case `tape``(list @)`(swag sel buf.say.inp))
            ::
      $y    ?.  ?&  ?=(^ old.kil)                     ::  rotate & yank
                    ?=(^ p.blt)
                    ?|  ?=({$ctl $y} u.p.blt)
                        ?=({$met $y} u.p.blt)
                ==  ==
              ta-bel
            =+  las=(lent ta-yan)
            =.  pos.kil  ?:(=(1 pos.kil) num.kil (dec pos.kil))
            (ta-hom (rep:edit [(sub pos.inp las) las] ta-yan))
    ==
  ::
  ++  ta-mov                                          ::  move in history
    |=  sop/@ud
    ^+  +>
    ?:  =(sop pos.hit)  +>
    %-  %=  ta-hom
          pos.hit  sop
          lay.hit  (~(put by lay.hit) pos.hit buf.say.inp)
        ==
    :-  %set
    %.  (~(get by lay.hit) sop)
    (bond |.((snag (sub num.hit +(sop)) old.hit)))
  ::
  ++  ta-nex                                          ::  advance history
    ^+  .
    =.  ris  ~
    =.  lay.hit  ~
    ?:  ?|  ?=(~ buf.say.inp)
            &(?=(^ old.hit) =(buf.say.inp i.old.hit))
        ==
      .(pos.hit num.hit)
    %_  .
      num.hit  +(num.hit)
      pos.hit  +(num.hit)
      old.hit  [buf.say.inp old.hit]
    ==
  ::
  ++  ta-pos                                          ::  buffer pos offset
    |=  {dir/?($l $r) til/?($ace $edg $wrd) pos/@ud}
    ^-  @ud
    %-  ?-  til  $ace  ace:offset
                 $edg  edg:offset
                 $wrd  wrd:offset
        ==
    ?-  dir  $l  (flop (scag pos buf.say.inp))
             $r  (slag pos buf.say.inp)
    ==
  ::
  ++  ta-pro                                          ::  set prompt
    |=  pom/sole-prompt
    %_    +>
        pom
      %_    pom
          cad
        ;:  welp
          ?.  ?=($earl (clan:title p.gyl))
            (cite:title p.gyl)
          (scow %p p.gyl)
        ::
          ":"
          (trip q.gyl)
          cad.pom
        ==
      ==
    ==
  ::
  ++  ta-ret                                          ::  hear return
    (ta-act ta-id %ret ~)
  ::
  ++  ta-tab                                          ::  hear tab
    (ta-act ta-id %tab pos.inp)
  ::
  ++  ta-ser                                          ::  reverse search
    |=  ext/(list @c)
    ^+  +>
    ?:  |(?=(~ ris) =(0 pos.u.ris))
      ta-bel
    =+  sop=?~(ext (dec pos.u.ris) pos.u.ris)
    =+  tot=(weld str.u.ris ext)
    =+  dol=(slag (sub num.hit sop) old.hit)
    =/  sup
        |-  ^-  (unit @ud)
        ?~  dol  ~
        ?^  (find tot i.dol)
          `sop
        $(sop (dec sop), dol t.dol)
    ?~  sup  ta-bel
    (ta-mov(str.u.ris tot, pos.u.ris u.sup) (dec u.sup))
  ::
  ++  ta-txt                                          ::  hear text
    |=  txt/(list @c)
    ^+  +>
    ?^  ris
      (ta-ser txt)
    (ta-hom (cat:edit pos.inp txt))
  ::
  ++  ta-vew                                          ::  computed prompt
    ^-  {pom/stub lin/(pair @ud (list @c))}
    =;  vew/(pair (list @c) styx)
      [(make:klr q.vew) pos.inp p.vew]
    ?:  vis.pom
      :-  buf.say.inp                                 ::  default prompt
      ?~  ris
        cad.pom
      :(welp "(reverse-i-search)'" (tufa str.u.ris) "': ")
    :-  (reap (lent buf.say.inp) `@c`'*')             ::  hidden input
    %+  welp
      cad.pom
    ?~  buf.say.inp  ~
    :(welp "<" (scow %p (end 4 1 (sham buf.say.inp))) "> ")
  ::
  ++  ta-yan                                          ::  yank
    (snag (sub num.kil pos.kil) old.kil)
  --
++  edit                                              ::  produce sole-edits
  |%
  ++  cat                                             ::  mass insert
    |=  {pos/@ud txt/(list @c)}
    ^-  sole-edit
    :-  %mor
    |-  ^-  (list sole-edit)
    ?~  txt  ~
    [[%ins pos i.txt] $(pos +(pos), txt t.txt)]
  ::
  ++  cut                                             ::  mass delete
    |=  {pos/@ud num/@ud}
    ^-  sole-edit
    :-  %mor
    |-  ^-  (list sole-edit)
    ?:  =(0 num)  ~
    [[%del pos] $(num (dec num))]
  ::
  ++  rep                                             ::  mass replace
    |=  {{pos/@ud num/@ud} txt/(list @c)}
    ^-  sole-edit
    :~  %mor
        (cut pos num)
        (cat pos txt)
    ==
  ++  any                                             ::  matches?
    |=  {a/sole-edit b/$-(sole-edit ?)}
    ^-  ?
    ?.  ?=($mor -.a)  (b a)
    (lien p.a |=(c/sole-edit ^$(a c)))
  --
++  offset                                            ::  calculate offsets
  |%
  ++  alnm                                            ::  alpha-numeric
    |=  a/@  ^-  ?
    ?|  &((gte a '0') (lte a '9'))
        &((gte a 'A') (lte a 'Z'))
        &((gte a 'a') (lte a 'z'))
    ==
  ::
  ++  ace                                             ::  next whitespace
    |=  a/(list @)
    =|  {b/_| i/@ud}
    |-  ^-  @ud
    ?~  a  i
    =/  c  !=(32 i.a)
    =.  b  |(b c)
    ?:  &(b !|(=(0 i) c))  i
    $(i +(i), a t.a)
  ::
  ++  edg                                             ::  next word boundary
    |=  a/(list @)
    =|  {b/_| i/@ud}
    |-  ^-  @ud
    ?~  a  i
    =/  c  (alnm i.a)
    =.  b  |(b c)
    ?:  &(b !|(=(0 i) c))  i
    $(i +(i), a t.a)
  ::
  ++  wrd                                             ::  next or current word
    |=  a/(list @)
    =|  i/@ud
    |-  ^-  @ud
    ?:  |(?=(~ a) (alnm i.a))  i
    $(i +(i), a t.a)
  --
::
++  klr                                               ::  styx/stub engine
  =,  dill
  |%
  ++  make                                            ::  stub from styx
    |=  a/styx  ^-  stub
    =|  b/stye
    %+  reel
    |-  ^-  stub
    %-  zing  %+  turn  a
    |=  a/$@(@t (pair styl styx))
    ?@  a  [b (tuba (trip a))]~
    ^$(a q.a, b (styd p.a b))
    ::
    |=  {a/(pair stye (list @c)) b/stub}
    ?~  b  [a ~]
    ?.  =(p.a p.i.b)  [a b]
    [[p.a (weld q.a q.i.b)] t.b]
  ::
  ++  styd                                            ::  stye from styl
    |=  {a/styl b/stye}  ^+  b                        ::  with inheritance
    :+  ?~  p.a  p.b
        ?~  u.p.a  ~
        (~(put in p.b) u.p.a)
     (fall p.q.a p.q.b)
     (fall q.q.a q.q.b)
  ::
  ++  lent-stye
    |=  a/stub  ^-  @
    (roll (lnts-stye a) add)
  ::
  ++  lent-char
    |=  a/stub  ^-  @
    (roll (lnts-char a) add)
  ::
  ++  lnts-stye                                       ::  stub pair head lengths
    |=  a/stub  ^-  (list @)
    %+  turn  a
    |=  a/(pair stye (list @c))
    ;:  add                        ::  presumes impl of cvrt:ansi in %dill
        (mul 5 2)                  ::  bg
        (mul 5 2)                  ::  fg
        =+  b=~(wyt in p.p.a)      ::  effect
        ?:(=(0 b) 0 (mul 4 +(b)))
    ==
  ::
  ++  lnts-char                                       ::  stub pair tail lengths
    |=  a/stub  ^-  (list @)
    %+  turn  a
    |=  a/(pair stye (list @c))
    (lent q.a)
  ::
  ++  brek                                            ::  index + incl-len of
    |=  {a/@ b/(list @)}                              ::  stub pair w/ idx a
    =|  {c/@ i/@}
    |-  ^-  (unit (pair @ @))
    ?~  b  ~
    =.  c  (add c i.b)
    ?:  (gte c a)
      `[i c]
    $(i +(i), b t.b)
  ::
  ++  slag                                            ::  slag stub, keep stye
    |=  {a/@ b/stub}
    ^-  stub
    =+  c=(lnts-char b)
    =+  i=(brek a c)
    ?~  i  b
    =+  r=(^slag +(p.u.i) b)
    ?:  =(a q.u.i)
      r
    =+  n=(snag p.u.i b)
    :_  r  :-  p.n
    (^slag (sub (snag p.u.i c) (sub q.u.i a)) q.n)
  ::
  ++  scag                                            ::  scag stub, keep stye
    |=  {a/@ b/stub}
    ^-  stub
    =+  c=(lnts-char b)
    =+  i=(brek a c)
    ?~  i  b
    ?:  =(a q.u.i)
      (^scag +(p.u.i) b)
    %+  welp
      (^scag p.u.i b)
    =+  n=(snag p.u.i b)
    :_  ~  :-  p.n
    (^scag (sub (snag p.u.i c) (sub q.u.i a)) q.n)
  ::
  ++  swag                                            ::  swag stub, keep stye
    |=  {{a/@ b/@} c/stub}
    (scag b (slag a c))
  --
--