mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-11-28 11:40:11 +03:00
a4e20facb7
This simplifies the behavior of individual blits, making their implementation simpler and giving arvo more control. This lets us write on top of existing content, instead of completely replacing the affected row. Additionally, lets us draw starting at the cursor position, instead of the leftmost column. To retain the previous behavior, preface with [%hop 0] to move the cursor to the start of the line, [%wyp ~] to clear the existing content, and finally your %lin to render it.
1145 lines
36 KiB
Plaintext
1145 lines
36 KiB
Plaintext
/- *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 .
|
|
++ klr klr:format
|
|
+$ 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
|
|
=. 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 {<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 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 {<p.wel>}/{<q.wel>}]")
|
|
%= +>
|
|
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 {<p.wel>}/{<q.wel>}]")
|
|
%= +>
|
|
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>}]")
|
|
?: =(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-blin :: print and newline
|
|
|= lin=dill-blit:dill
|
|
^+ +>
|
|
:: newline means we need to redraw the prompt,
|
|
:: so update the prompt mirror accordingly.
|
|
::
|
|
=. mir [0 ~]
|
|
::TODO doing hops and wyps conditionally based on the mirror state seems
|
|
:: better, but doesn't cover edge cases. results in dojo's ">=" being
|
|
:: rendered alongside the prompt in scrollback, for example.
|
|
:: figure out a way to make that work!
|
|
(se-blit %mor [%hop 0] [%wyp ~] lin [%nel ~] ~)
|
|
::
|
|
++ 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-blin %lin (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) +>
|
|
(se-blit(mir lin) %mor [%hop 0] [%wyp ~] [%klr q.lin] [%hop p.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-blin %lin (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
|
|
[%hit *] (ta-hit +.bet)
|
|
[%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=@c
|
|
^+ +>
|
|
=. 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(q.mir ~) %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-hit :: hear click
|
|
|= [r=@ud c=@ud]
|
|
^+ +>
|
|
?. =(0 r) +>
|
|
=/ pol=@ud
|
|
(lent-char:klr (make:klr cad.pom))
|
|
?: (lth c pol) +>.$
|
|
+>.$(pos.inp (min (sub c pol) (lent buf.say.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 +>(..ta (se-blit fec))
|
|
[%bel *] ta-bel
|
|
[%blk *] +>
|
|
[%bye *] +>(..ta (se-klin gyl))
|
|
[%det *] (ta-got +.fec)
|
|
[%err *] (ta-err p.fec)
|
|
[%klr *] +>(..ta (se-blin %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))
|
|
[%txt *] +>(..ta (se-text p.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=@c
|
|
^+ +>
|
|
=. 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)
|
|
--
|
|
--
|