urbit/pkg/arvo/lib/hood/drum.hoon
Philip Monk 76b917f426
dojo: add tab completion
This is initial support for type-aware tab completion.  When you hit tab, it tries to complete the word you're in the middle of using a face or arm in the subject at that point in the code.  It also shows all possible matches and their associated types.  It's nearly instantaneous.  Notes:

- It advances to the longest common prefix, so if you hit tab on `ab` and the only possible results are `abcde` and `abcdz`, then it'll write `abcd` and print both out (with their types).

- If there are fewer than ten matches, it prints the type along with the face.  Printing types is too slow to use all the time, but with 10 it's essentially instantaneous.

- The match closest in the subject to you (i.e. smallest axis number) is displayed lowest (closest to your focus).

Examples below, where `<TAB>` represents me hitting tab while my cursor is at that position (the line with the `<TAB>` is not preserved in the actual output).

```
~zod:dojo> eth<TAB>
-----
ethereum        #t/<11.qcl {<3.ltb 27.ipf 7.ecf 36.uek 92.bjk 247.ows 51.mvt 126.xjf 41.mac 1.ane $141> <21.yeb 27.ipf 7.ecf 36.uek 92.bjk 247.ows 51.mvt 126.xjf 41.mac 1.ane $141>}>
ethereum-types  #t/<3.ltb 27.ipf 7.ecf 36.uek 92.bjk 247.ows 51.mvt 126.xjf 41.mac 1.ane $141>
~zod:dojo> ethereum
~zod:dojo> |=  zong=@ud  z<TAB>
-----
zing  #t/<1.dqs {* <126.xjf 41.mac 1.ane $141>}>
zap   #t/<1.iot {tub/{p/{p/@ud q/@ud} q/""} <1.rff {daf/@t <247.ows 51.mvt 126.xjf 41.mac 1.ane $141>}>}>
zuse  #t/$309
zong  #t/@ud
~zod:dojo> |=  zong=@ud  zo<TAB>
-----
zong  #t/@ud
~zod:dojo> |=  zong=@ud  zong
~zod:dojo> <TAB>
hoon-version
trel
quip
pole
unit
qual
lone
... about 600 more lines ...
unity
html
zuse
eny
now
our
~zod:dojo>
```

Functionally, this is in a state where I'd be comfortable shipping it.  It doesn't interfere with anything if you don't press tab, and it's perfectly OTA-able.  I do think its output is a little verbose, but that can be tuned over time as people try it and determine what feels good in practice.

Additional notes:

- There are plenty of similar systems for other languages, but my most direct inspiration is Idris's editor tools.  This is implemented for the dojo, but I actually want it in my editor, which is why the meat is all defind in a library.  I've only tested on dojo one-liners, so I don't know the performance on large blocks of code.

- The default type printer isn't great for this use case.  In particular,
	- Cores should not print anything about their context
  - The `#t/` should go away
  - If it looks like a gate, we should print its return value
  - Maybe special handling for molds, but if the above is done, then for example `bone` is  `* -> @ud`.

- The worst part about our wing ordering is that it really screws up tab completion.  You want to do `point.owner-address` instead of `owner-address.point` because that lets you type `point.ow<TAB>`.  I weakly prefer reading it how we do it now, but it's really not great.  You could do an (dojo-specific?) alternate syntax of `point;owner-address`; this is a simple transformation.

- Regardless of the above, this should handle the case where we're in the middle of defining a wing; it doesn't right now.

- When a variable is shadowed, we show both of them.  We should probably show the shadowed one with a `^`.

- We probably shouldn't print out hundreds of results.  Maybe just the closest 50 with ellipses.

- This gets you any face in your subject, regardless of whether its type is reasonable.  We could limit that some by copying the `gol` logic in mint, so that if the pseudo-backward-inference engine happens to know what type it should be, you can filter the tab results according to if they nest in that type.  This would be "strongly type-aware".
2019-10-30 23:19:25 -07:00

1066 lines
35 KiB
Plaintext

:: :: ::
:::: /hoon/drum/hood/lib :: ::
:: :: ::
/? 310 :: version
/- *sole
/+ sole
:: :: ::
:::: :: ::
:: :: ::
|% :: ::
++ part {$drum $2 pith-2} ::
++ part-old {$drum $1 pith-1} ::
:: ::
++ pith-1 :: pre-style
%+ cork pith-2 ::
|:($:pith-2 +<(bin ((map bone source-1)))) ::
:: ::
++ source-1 ::
%+ cork source ::
|:($:source +<(mir ((pair @ud (list @c))))) :: style-less mir
:: ::
++ pith-2 ::
$: sys/(unit bone) :: local console
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)
?: lit
:~ %dojo
%azimuth-tracker
==
%+ welp
?: ?=(%pawn (clan:title our)) ~
:~ %acme
%dns
%azimuth-tracker
==
:~ %lens
%dojo
%modulo
%launch
%publish
%clock
%weather
%group-store
%group-hook
%permission-store
%permission-hook
%permission-group-hook
%chat-store
%chat-hook
%chat-view
%chat-cli
==
::
++ deft-fish :: default connects
|= our/ship
%- ~(gas in *(set gill:gall))
^- (list gill:gall)
[[our %chat-cli] [our %dojo] ~]
::
++ make :: initial part
|= our/ship
^- part
:* %drum
%2
sys=~
eel=(deft-fish our)
ray=~
fur=~
bin=~
==
::
::
++ 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])
--
::
::::
::
|= {hid/bowl:gall part} :: main drum work
=+ (~(gut by bin) ost.hid *source)
=* dev -
=> |% :: arvo structures
++ pear :: request
$% {$sole-action p/sole-action} ::
== ::
++ lime :: update
$% {$dill-blit dill-blit:dill} ::
== ::
++ card :: general card
$% {$conf wire dock ship term} ::
{$diff lime} ::
{$peer wire dock path} ::
{$poke wire dock pear} ::
{$pull wire dock ~} ::
== ::
++ move (pair bone card) :: user-level move
--
|_ {moz/(list move) biz/(list dill-blit:dill)}
++ 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 move part)
:: 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))]
::
++ 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-klin 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]) ::
::
++ reap-phat :: ack connect
|= {way/wire saw/(unit tang)}
=< se-abet =< se-view
=+ gyl=(de-gill way)
?~ saw
(se-join gyl)
(se-dump:(se-drop & gyl) u.saw)
::
++ 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 & gyl)
:_ u.saw
>[%drum-coup-fail src.hid ost.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]))
==
::
++ quit-phat ::
|= way/wire
=< se-abet =< se-view
=+ gyl=(de-gill way)
~& [%drum-quit src.hid ost.hid gyl]
(se-drop %| gyl)
:: :: ::
:::: :: ::
:: :: ::
++ se-abet :: resolve
^- (quip move part)
=* pith +<+.$
?. se-ably
=. . se-adit
[(flop moz) pith]
=. sys ?^(sys sys `ost.hid)
=. . se-subze:se-adze:se-adit
:_ pith(bin (~(put by bin) ost.hid dev))
%- flop
^- (list move)
?~ biz moz
:_ moz
[ost.hid %diff %dill-blit ?~(t.biz i.biz [%mor (flop biz)])]
::
++ se-ably (~(has by sup.hid) ost.hid) :: caused by console
::
++ se-adit :: update servers
^+ .
%+ roll
:: ensure dojo is first in the list,
:: guaranteeing its display on-boot.
::
%+ sort ~(tap in ray)
|= [a=well:gall b=well:gall]
?: |(=(%dojo q.a) =(%dojo q.b)) =(%dojo q.a)
(aor a b)
=< .(con +>)
|: $:{wel/well:gall con/_..se-adit} ^+ con
=. +>.$ con
=+ hig=(~(get by fur) q.wel)
?: &(?=(^ hig) |(?=(~ u.hig) =(p.wel syd.u.u.hig))) +>.$
=. +>.$ (se-text "activated app {(trip p.wel)}/{(trip q.wel)}")
%- se-emit(fur (~(put by fur) q.wel ~))
[ost.hid %conf [%drum p.wel q.wel ~] [our.hid q.wel] our.hid p.wel]
::
++ se-adze :: update connections
^+ .
%+ roll ~(tap in eel)
=< .(con +>)
|: $:{gil/gill:gall con/_.} ^+ con
=. +>.$ con
?: (~(has by fug) gil)
+>.$
(se-peer gil)
::
++ se-subze :: downdate connections
=< .(dev (~(got by bin) ost.hid))
=. bin (~(put by bin) ost.hid dev)
^+ .
%- ~(rep by bin)
=< .(con +>)
|: $:{{ost/bone dev/source} con/_.} ^+ con
=+ xeno=se-subze-local:%_(con ost.hid ost, dev dev)
xeno(ost.hid ost.hid.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.hid) &
=+ 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 ~
`(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
|= wel/well:gall
^+ +>
?: (~(has in ray) wel)
(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-dump :: print tanks
|= tac/(list tank)
^+ +>
?. se-ably ((slog tac) +>.$)
=/ 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 ^+ +>
?~ sys ~&(%se-blit-no-sys +>)
(se-emit [u.sys %diff %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 :: emit move
|= mov/move
%_(+> moz [mov moz])
::
++ se-text :: return text
|= txt/tape
^+ +>
?. ((sane %t) (crip txt)) :: XX upstream validation
~& bad-text+<`*`txt>
+>
?. se-ably ((slog [%leaf txt]~) +>.$)
(se-blit %out (tuba txt))
::
++ se-poke :: send a poke
|= {gyl/gill:gall par/pear}
(se-emit [ost.hid %poke (en-gill gyl) gyl par])
::
++ se-peer :: send a peer
|= gyl/gill:gall
%- se-emit(fug (~(put by fug) gyl ~))
[ost.hid %peer (en-gill gyl) gyl /sole]
::
++ se-pull :: cancel subscription
|= gyl/gill:gall
(se-emit [ost.hid %pull (en-gill gyl) gyl ~])
::
++ 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/pear +>(..ta (se-poke gyl a))) :: poke gyl
::
++ ta-act :: send action
|= act/sole-action
^+ +>
(ta-poke %sole-action act)
::
++ 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 %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 %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)
{$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 %ret ~)
::
++ ta-tab :: hear tab
(ta-act %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))
--
--