/- *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 %lens == ?: lit ~ :~ %acme %clock %dojo %launch %publish %weather %group-store %group-pull-hook %group-push-hook %invite-store %invite-hook %chat-store %chat-hook %chat-view %chat-cli %herm %contact-store %contact-hook %contact-view %metadata-store %metadata-hook %s3-store %file-server %glob %graph-store %graph-pull-hook %graph-push-hook %hark-store %hark-graph-hook %hark-group-hook %hark-chat-hook %observe-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 "[{}, driving {}]") :: ++ 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-fade :: fade app |= wel=well:gall =< se-abet =< se-view (se-fade 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-fade =;(f (f !<(_+<.f vase)) poke-fade) %drum-unlink =;(f (f !<(_+<.f vase)) poke-unlink) == :: ++ on-load |= [hood-version=@ud 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 %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 (lte hood-version %11) => (se-born | %home %hark-graph-hook) => (se-born | %home %hark-group-hook) => (se-born | %home %hark-chat-hook) => (se-born | %home %hark-store) => (se-born | %home %observe-hook) (se-born | %home %herm) ..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 {}") +>.$(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-subit: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 :~ %chat-store %contact-store %group-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-subit :: downdate servers =/ ruf=(list term) ~(tap in ~(key by fur)) |- ^+ this ?~ ruf this ?: (~(has in ray) [%home i.ruf]) $(ruf t.ruf) =/ wire [%drum %fade i.ruf ~] =. this (se-emit %pass wire %arvo %g %fade i.ruf %slay) $(ruf t.ruf, fur (~(del by fur) i.ruf)) :: ++ 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 {}/{}]") %= +> ray (~(put in ray) wel) eel (~(put in eel) [our.hid q.wel]) == :: ++ se-fade :: delete server |= wel=well:gall ^+ +> ?. (~(has in ray) wel) (se-text "[fade not running {}/{}]") %= +> ray (~(del in ray) 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 [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 {}]") ?> ?=(~ (~(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) ^+ +> ?: =(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 (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)) -- --