mirror of
https://github.com/urbit/shrub.git
synced 2024-12-19 08:32:39 +03:00
87ca57c364
Start with |start %desk %app-name Everywhere in the kernel that we deal with marks, we infer the app it's connected to and use the marks from that desk. Also some light renaming in gall, especially path->wire and current-agent->yoke. Subsequent tasks: - Dojo needs a syntax to run generators and threads from other desks - The home desk should be split into at least a minimal base desk and big "userspace" desk. Dill's initialization logic should be updated to handle - |show-package, |install, and |uninstall should to be written - Clay should have smarter handling of system versions instead of just ignoring what's on each desk. It's not clear that this will work correctly when sys updates right now.
1226 lines
38 KiB
Plaintext
1226 lines
38 KiB
Plaintext
/- *sole
|
|
/+ sole
|
|
|%
|
|
+$ any-state $%(state state-2)
|
|
+$ state [%3 pith-3]
|
|
+$ state-2 [%2 pith-2]
|
|
::
|
|
++ pith-3 ::
|
|
$: eel=(set gill:gall) :: connect to
|
|
ray=(map dude:gall desk) ::
|
|
fur=(map dude:gall (unit server)) :: servers
|
|
bin=(map bone source) :: terminals
|
|
== ::
|
|
:: ::
|
|
++ 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 by *(map dap=term desk))
|
|
^- (list well:gall)
|
|
:: boot all default apps off the home desk
|
|
::
|
|
=- (turn - |=(a=term [a %home]))
|
|
^- (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-push-hook
|
|
%contact-pull-hook
|
|
%metadata-store
|
|
%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
|
|
%metadata-push-hook
|
|
%metadata-pull-hook
|
|
%group-view
|
|
%settings-store
|
|
%dm-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-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(- %3)
|
|
=. 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 %metadata-pull-hook)
|
|
=> (se-born | %home %metadata-push-hook)
|
|
(se-born | %home %herm)
|
|
=? ..on-load (lte hood-version %12)
|
|
=> (se-born | %home %contact-push-hook)
|
|
=> (se-born | %home %contact-pull-hook)
|
|
=> (se-born | %home %settings-store)
|
|
(se-born | %home %group-view)
|
|
=? ..on-load (lte hood-version %13)
|
|
=> (se-born | %home %dm-hook)
|
|
.(ray (~(gas by ray) (turn ~(tap in ray) |=(=well:gall [q.well p.well]))))
|
|
..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-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 [dap=term =desk])
|
|
(sort ~(tap by 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 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 by ray) 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 by ray) q.wel)
|
|
?. print-on-repeat +>
|
|
(se-text "[already running {<p.wel>}/{<q.wel>}]")
|
|
%= +>
|
|
ray (~(put by ray) q.wel p.wel)
|
|
eel (~(put in eel) [our.hid q.wel])
|
|
==
|
|
::
|
|
++ se-fade :: delete server
|
|
|= wel=well:gall
|
|
^+ +>
|
|
?. (~(has by ray) q.wel)
|
|
(se-text "[fade not running {<p.wel>}/{<q.wel>}]")
|
|
%= +>
|
|
ray (~(del by ray) 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
|
|
=/ 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
|
|
=/ =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 *] +>
|
|
[%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))
|
|
--
|
|
--
|