1
0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-12-28 09:27:39 +03:00
urbit/pkg/arvo/lib/hood/drum.hoon
fang 0bc1f49f0f
drum: only process pokes from the local ship
No mark files exist for any of the drum marks, so trying to poke remote drums
would fail anyway, but relying on the mark system in that way seems a bit
fragile, so we add an explicit permission check.
2022-01-13 00:24:31 +01:00

1008 lines
32 KiB
Plaintext

/- *sole
/+ sole
|%
+$ state state-4
+$ any-state
$~ *state
$% state-4
state-3
state-2
==
+$ state-4 [%4 pith-4]
+$ state-3 [%3 pith-3]
+$ state-2 [%2 pith-2]
::
+$ pith-4
$: eel=(set gill:gall) :: connect to
bin=(map bone source) :: terminals
== ::
::
++ pith-3 ::
$: eel=(set gill:gall) :: connect to
ray=(map dude:gall desk) ::
fur=(map dude:gall (unit *)) :: servers
bin=(map bone source) :: terminals
== ::
:: ::
++ pith-2 ::
$: eel=(set gill:gall) :: connect to
ray=(set well:gall) ::
fur=(map dude:gall (unit *)) :: servers
bin=(map bone source) :: terminals
== ::
:: ::
++ 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
== ::
--
:: :: ::
:::: :: ::
:: :: ::
|%
++ 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 (poke-link our.hid %dojo)
++ 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-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-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]
?> =(our src):hid
?+ 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-unlink =;(f (f !<(_+<.f vase)) poke-unlink)
==
::
++ on-load
|= [hood-version=@ud old=any-state]
=< se-abet =< se-view
=? old ?=(%2 -.old) [%4 [eel bin]:old]
=? old ?=(%3 -.old) [%4 [eel bin]:old]
::
?> ?=(%4 -.old)
=. sat old
=. dev (~(gut by bin) ost *source)
this
::
++ 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-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-agent
|= [=wire =sign:agent:gall]
?+ wire ~|([%drum-bad-take-agent wire -.sign] !!)
[%phat *]
?- -.sign
%poke-ack (take-coup-phat t.wire p.sign)
%watch-ack (reap-phat t.wire p.sign)
%kick (quit-phat t.wire)
%fact
%+ diff-sole-effect-phat 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
:_ 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-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-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
=/ gil=(unit gill:gall) se-agon
=. eel (~(del in eel) gyl)
?~ gil +>.$
?: =(gyl u.gil)
+>.$(inx 0)
(se-alas u.gil)
::
++ 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)
^+ +>
?: =(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
~> %slog.0^leaf/"drum: link {<[p q]:gyl>}"
=/ =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
?: =([our.hid %dojo] 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 *] +>
[%bye *] +>(..ta (se-klin gyl))
[%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 (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-char
|= a=stub ^- @
(roll (lnts-char a) add)
::
++ 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))
--
--