mirror of
https://github.com/urbit/shrub.git
synced 2024-12-23 19:05:48 +03:00
4482997a16
This stops slogging the tab completion and intead adds a +sole-effect for tab completion output. This is morally correct, and it lets dojo clients show tab completions how they want. For example, web dojo could implement this as a drop-down box. Another advantage is that this puts the rendering logic in drum, which knows the width of the terminal. Thus, we can make sure each match takes no more than one line by truncating with ellipses. If there's only one match and it's already fully typed, then we display the whole type.
1098 lines
36 KiB
Plaintext
1098 lines
36 KiB
Plaintext
:: :: ::
|
|
:::: /hoon/drum/hood/lib :: ::
|
|
:: :: ::
|
|
/? 310 :: version
|
|
/- *sole
|
|
/+ sole, easy-print
|
|
:: :: ::
|
|
:::: :: ::
|
|
:: :: ::
|
|
|% :: ::
|
|
++ part {$drum $2 pith-2} ::
|
|
++ part-old {$drum $1 pith-1} ::
|
|
:: ::
|
|
++ pith-1 :: pre-style
|
|
%+ cork pith-2 ::
|
|
|:($:pith-2 +<(bin ((map bone source-1)))) ::
|
|
:: ::
|
|
++ source-1 ::
|
|
%+ cork source ::
|
|
|:($:source +<(mir ((pair @ud (list @c))))) :: style-less mir
|
|
:: ::
|
|
++ pith-2 ::
|
|
$: sys/(unit bone) :: local console
|
|
eel/(set gill:gall) :: connect to
|
|
ray/(set well:gall) ::
|
|
fur/(map dude:gall (unit server)) :: servers
|
|
bin/(map bone source) :: terminals
|
|
== ::
|
|
:: :: ::
|
|
:::: :: ::
|
|
:: :: ::
|
|
++ server :: running server
|
|
$: syd/desk :: app identity
|
|
cas/case :: boot case
|
|
== ::
|
|
++ kill :: kill ring
|
|
$: pos/@ud :: ring position
|
|
num/@ud :: number of entries
|
|
max/_60 :: max entries
|
|
old/(list (list @c)) :: entries proper
|
|
== ::
|
|
++ source :: input device
|
|
$: edg/_80 :: terminal columns
|
|
off/@ud :: window offset
|
|
kil/kill :: kill buffer
|
|
inx/@ud :: ring index
|
|
fug/(map gill:gall (unit target)) :: connections
|
|
mir/(pair @ud stub) :: mirrored terminal
|
|
== ::
|
|
++ history :: past input
|
|
$: pos/@ud :: input position
|
|
num/@ud :: number of entries
|
|
lay/(map @ud (list @c)) :: editing overlay
|
|
old/(list (list @c)) :: entries proper
|
|
== ::
|
|
++ search :: reverse-i-search
|
|
$: pos/@ud :: search position
|
|
str/(list @c) :: search string
|
|
== ::
|
|
++ target :: application target
|
|
$: $= blt :: curr & prev belts
|
|
%+ pair
|
|
(unit dill-belt:dill)
|
|
(unit dill-belt:dill)
|
|
ris/(unit search) :: reverse-i-search
|
|
hit/history :: all past input
|
|
pom/sole-prompt :: static prompt
|
|
inp/sole-command :: input state
|
|
== ::
|
|
--
|
|
:: :: ::
|
|
:::: :: ::
|
|
:: :: ::
|
|
|%
|
|
++ deft-apes :: default servers
|
|
|= [our/ship lit/?]
|
|
%- ~(gas in *(set well:gall))
|
|
^- (list well:gall)
|
|
:: boot all default apps off the home desk
|
|
::
|
|
=- (turn - |=(a=term home+a))
|
|
^- (list term)
|
|
?: lit
|
|
:~ %dojo
|
|
%azimuth-tracker
|
|
==
|
|
%+ welp
|
|
?: ?=(%pawn (clan:title our)) ~
|
|
:~ %acme
|
|
%dns
|
|
%azimuth-tracker
|
|
==
|
|
:~ %lens
|
|
%dojo
|
|
%modulo
|
|
%launch
|
|
%publish
|
|
%clock
|
|
%weather
|
|
%group-store
|
|
%group-hook
|
|
%permission-store
|
|
%permission-hook
|
|
%permission-group-hook
|
|
%chat-store
|
|
%chat-hook
|
|
%chat-view
|
|
%chat-cli
|
|
==
|
|
::
|
|
++ deft-fish :: default connects
|
|
|= our/ship
|
|
%- ~(gas in *(set gill:gall))
|
|
^- (list gill:gall)
|
|
[[our %chat-cli] [our %dojo] ~]
|
|
::
|
|
++ make :: initial part
|
|
|= our/ship
|
|
^- part
|
|
:* %drum
|
|
%2
|
|
sys=~
|
|
eel=(deft-fish our)
|
|
ray=~
|
|
fur=~
|
|
bin=~
|
|
==
|
|
::
|
|
::
|
|
++ en-gill :: gill to wire
|
|
|= gyl/gill:gall
|
|
^- wire
|
|
[%drum %phat (scot %p p.gyl) q.gyl ~]
|
|
::
|
|
++ de-gill :: gill from wire
|
|
|= way/wire ^- gill:gall
|
|
?>(?=({@ @ ~} way) [(slav %p i.way) i.t.way])
|
|
--
|
|
::
|
|
::::
|
|
::
|
|
|= {hid/bowl:gall part} :: main drum work
|
|
=+ (~(gut by bin) ost.hid *source)
|
|
=* dev -
|
|
=> |% :: arvo structures
|
|
++ pear :: request
|
|
$% {$sole-action p/sole-action} ::
|
|
== ::
|
|
++ lime :: update
|
|
$% {$dill-blit dill-blit:dill} ::
|
|
== ::
|
|
++ card :: general card
|
|
$% {$conf wire dock ship term} ::
|
|
{$diff lime} ::
|
|
{$peer wire dock path} ::
|
|
{$poke wire dock pear} ::
|
|
{$pull wire dock ~} ::
|
|
== ::
|
|
++ move (pair bone card) :: user-level move
|
|
--
|
|
|_ {moz/(list move) biz/(list dill-blit:dill)}
|
|
++ diff-sole-effect-phat :: app event
|
|
|= {way/wire fec/sole-effect}
|
|
=< se-abet =< se-view
|
|
=+ gyl=(de-gill way)
|
|
?: (se-aint gyl) +>.$
|
|
(se-diff gyl fec)
|
|
::
|
|
++ peer ::
|
|
|= pax/path
|
|
~| [%drum-unauthorized our+our.hid src+src.hid] :: ourself
|
|
?> (team:title our.hid src.hid) :: or our own moon
|
|
=< se-abet =< se-view
|
|
(se-text "[{<src.hid>}, driving {<our.hid>}]")
|
|
::
|
|
++ poke-set-boot-apps ::
|
|
|= lit/?
|
|
^- (quip move part)
|
|
:: We do not run se-abet:se-view here because that starts the apps,
|
|
:: and some apps are not ready to start (eg Talk crashes because the
|
|
:: terminal has width 0). It appears the first message to drum must
|
|
:: be the peer.
|
|
::
|
|
[~ +<+.^$(ray (deft-apes our.hid lit))]
|
|
::
|
|
++ poke-dill-belt :: terminal event
|
|
|= bet/dill-belt:dill
|
|
=< se-abet =< se-view
|
|
(se-belt bet)
|
|
::
|
|
++ poke-dill-blit :: terminal output
|
|
|= bit/dill-blit:dill
|
|
se-abet:(se-blit-sys bit)
|
|
::
|
|
++ poke-start :: start app
|
|
|= wel/well:gall
|
|
=< se-abet =< se-view
|
|
(se-born wel)
|
|
::
|
|
++ poke-link :: connect app
|
|
|= gyl/gill:gall
|
|
=< se-abet =< se-view
|
|
(se-link gyl)
|
|
::
|
|
++ poke-unlink :: disconnect app
|
|
|= gyl/gill:gall
|
|
=< se-abet =< se-view
|
|
(se-klin gyl)
|
|
::
|
|
++ poke-exit :: shutdown
|
|
|= ~
|
|
se-abet:(se-blit-sys `dill-blit:dill`[%qit ~])
|
|
::
|
|
++ poke-put :: write file
|
|
|= {pax/path txt/@}
|
|
se-abet:(se-blit-sys [%sav pax txt]) ::
|
|
::
|
|
++ reap-phat :: ack connect
|
|
|= {way/wire saw/(unit tang)}
|
|
=< se-abet =< se-view
|
|
=+ gyl=(de-gill way)
|
|
?~ saw
|
|
(se-join gyl)
|
|
(se-dump:(se-drop & gyl) u.saw)
|
|
::
|
|
++ take-coup-phat :: ack poke
|
|
|= {way/wire saw/(unit tang)}
|
|
=< se-abet =< se-view
|
|
?~ saw +>
|
|
=+ gyl=(de-gill way)
|
|
?: (se-aint gyl) +>.$
|
|
%- se-dump:(se-drop & gyl)
|
|
:_ u.saw
|
|
>[%drum-coup-fail src.hid ost.hid gyl]<
|
|
::
|
|
++ take-onto :: ack start
|
|
|= {way/wire saw/(each suss:gall tang)}
|
|
=< se-abet =< se-view
|
|
?> ?=({@ @ ~} way)
|
|
?> (~(has by fur) i.t.way)
|
|
=/ wel/well:gall [i.way i.t.way]
|
|
?- saw
|
|
{%| *} (se-dump p.saw)
|
|
{%& *} ?> =(q.wel p.p.saw)
|
|
:: =. +>.$ (se-text "live {<p.saw>}")
|
|
+>.$(fur (~(put by fur) q.wel `[p.wel %da r.p.saw]))
|
|
==
|
|
::
|
|
++ quit-phat ::
|
|
|= way/wire
|
|
=< se-abet =< se-view
|
|
=+ gyl=(de-gill way)
|
|
~& [%drum-quit src.hid ost.hid gyl]
|
|
(se-drop %| gyl)
|
|
:: :: ::
|
|
:::: :: ::
|
|
:: :: ::
|
|
++ se-abet :: resolve
|
|
^- (quip move part)
|
|
=* pith +<+.$
|
|
?. se-ably
|
|
=. . se-adit
|
|
[(flop moz) pith]
|
|
=. sys ?^(sys sys `ost.hid)
|
|
=. . se-subze:se-adze:se-adit
|
|
:_ pith(bin (~(put by bin) ost.hid dev))
|
|
%- flop
|
|
^- (list move)
|
|
?~ biz moz
|
|
:_ moz
|
|
[ost.hid %diff %dill-blit ?~(t.biz i.biz [%mor (flop biz)])]
|
|
::
|
|
++ se-ably (~(has by sup.hid) ost.hid) :: caused by console
|
|
::
|
|
++ se-adit :: update servers
|
|
^+ .
|
|
%+ roll
|
|
:: ensure dojo is first in the list,
|
|
:: guaranteeing its display on-boot.
|
|
::
|
|
%+ sort ~(tap in ray)
|
|
|= [a=well:gall b=well:gall]
|
|
?: |(=(%dojo q.a) =(%dojo q.b)) =(%dojo q.a)
|
|
(aor a b)
|
|
=< .(con +>)
|
|
|: $:{wel/well:gall con/_..se-adit} ^+ con
|
|
=. +>.$ con
|
|
=+ hig=(~(get by fur) q.wel)
|
|
?: &(?=(^ hig) |(?=(~ u.hig) =(p.wel syd.u.u.hig))) +>.$
|
|
=. +>.$ (se-text "activated app {(trip p.wel)}/{(trip q.wel)}")
|
|
%- se-emit(fur (~(put by fur) q.wel ~))
|
|
[ost.hid %conf [%drum p.wel q.wel ~] [our.hid q.wel] our.hid p.wel]
|
|
::
|
|
++ se-adze :: update connections
|
|
^+ .
|
|
%+ roll ~(tap in eel)
|
|
=< .(con +>)
|
|
|: $:{gil/gill:gall con/_.} ^+ con
|
|
=. +>.$ con
|
|
?: (~(has by fug) gil)
|
|
+>.$
|
|
(se-peer gil)
|
|
::
|
|
++ se-subze :: downdate connections
|
|
=< .(dev (~(got by bin) ost.hid))
|
|
=. bin (~(put by bin) ost.hid dev)
|
|
^+ .
|
|
%- ~(rep by bin)
|
|
=< .(con +>)
|
|
|: $:{{ost/bone dev/source} con/_.} ^+ con
|
|
=+ xeno=se-subze-local:%_(con ost.hid ost, dev dev)
|
|
xeno(ost.hid ost.hid.con, dev dev.con, bin (~(put by bin) ost dev.xeno))
|
|
::
|
|
++ se-subze-local
|
|
^+ .
|
|
%- ~(rep by fug)
|
|
=< .(con +>)
|
|
|: $:{{gil/gill:gall *} con/_.} ^+ con
|
|
=. +>.$ con
|
|
?: (~(has in eel) gil)
|
|
+>.$
|
|
(se-nuke gil)
|
|
::
|
|
++ se-aint :: ignore result
|
|
|= gyl/gill:gall
|
|
^- ?
|
|
?. (~(has by bin) ost.hid) &
|
|
=+ gyr=(~(get by fug) gyl)
|
|
|(?=(~ gyr) ?=(~ u.gyr))
|
|
::
|
|
++ se-alas :: recalculate index
|
|
|= gyl/gill:gall
|
|
=+ [xin=0 wag=se-amor]
|
|
|- ^+ +>.^$
|
|
?~ wag +>.^$(inx 0)
|
|
?: =(i.wag gyl) +>.^$(inx xin)
|
|
$(wag t.wag, xin +(xin))
|
|
::
|
|
++ se-amor :: live targets
|
|
^- (list gill:gall)
|
|
%+ skim ~(tap in eel)
|
|
|=(a/gill:gall ?=({~ ~ *} (~(get by fug) a)))
|
|
::
|
|
++ se-anon :: rotate index
|
|
=+ wag=se-amor
|
|
?~ wag +
|
|
:: ~& [%se-anon inx+inx wag+wag nex+(mod +(inx) (lent se-amor))]
|
|
+(off 0, inx (mod +(inx) (lent wag)))
|
|
::
|
|
++ se-agon :: current gill
|
|
^- (unit gill:gall)
|
|
=+ wag=se-amor
|
|
?~ wag ~
|
|
`(snag inx `(list gill:gall)`wag)
|
|
::
|
|
++ se-belt :: handle input
|
|
|= bet/dill-belt:dill
|
|
^+ +>
|
|
?: ?=({?($cru $hey $rez $yow) *} bet) :: target-agnostic
|
|
?- bet
|
|
{$cru *} (se-dump:(se-text (trip p.bet)) q.bet)
|
|
{$hey *} +>(mir [0 ~]) :: refresh
|
|
{$rez *} +>(edg (dec p.bet)) :: resize window
|
|
{$yow *} ~&([%no-yow -.bet] +>)
|
|
==
|
|
=+ gul=se-agon
|
|
?: |(?=(~ gul) (se-aint u.gul))
|
|
(se-blit %bel ~)
|
|
ta-abet:(ta-belt:(se-tame u.gul) bet)
|
|
::
|
|
++ se-born :: new server
|
|
|= wel/well:gall
|
|
^+ +>
|
|
?: (~(has in ray) wel)
|
|
(se-text "[already running {<p.wel>}/{<q.wel>}]")
|
|
%= +>
|
|
ray (~(put in ray) wel)
|
|
eel (~(put in eel) [our.hid q.wel])
|
|
==
|
|
::
|
|
++ se-drop :: disconnect
|
|
|= {pej/? gyl/gill:gall}
|
|
^+ +>
|
|
=+ lag=se-agon
|
|
?. (~(has by fug) gyl) +>.$
|
|
=. fug (~(del by fug) gyl)
|
|
=. eel ?.(pej eel (~(del in eel) gyl))
|
|
=. +>.$ ?. &(?=(^ lag) !=(gyl u.lag))
|
|
+>.$(inx 0)
|
|
(se-alas u.lag)
|
|
=. +>.$ (se-text "[unlinked from {<gyl>}]")
|
|
?: =(gyl [our.hid %dojo]) :: undead dojo
|
|
(se-link gyl)
|
|
+>.$
|
|
::
|
|
++ se-tab :: print tab completions
|
|
|= tl/(list {=term =type})
|
|
^+ +>
|
|
=/ 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]
|
|
?: lots
|
|
leaf+(trip term)
|
|
=/ type-tank ~(duck easy-print type)
|
|
=/ 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)
|
|
^+ +>
|
|
?. se-ably ((slog tac) +>.$)
|
|
=/ wol/wall
|
|
(zing (turn (flop tac) |=(a/tank (~(win re a) [0 edg]))))
|
|
|- ^+ +>.^$
|
|
?~ wol +>.^$
|
|
?. ((sane %t) (crip i.wol)) :: XX upstream validation
|
|
~& bad-text+<`*`i.wol>
|
|
$(wol t.wol)
|
|
$(wol t.wol, +>.^$ (se-blit %out (tuba i.wol)))
|
|
::
|
|
++ se-join :: confirm connection
|
|
|= gyl/gill:gall
|
|
^+ +>
|
|
=. +> (se-text "[linked to {<gyl>}]")
|
|
?> ?=(~ (~(got by fug) gyl))
|
|
(se-alas(fug (~(put by fug) gyl `*target)) gyl)
|
|
::
|
|
++ se-nuke :: teardown connection
|
|
|= gyl/gill:gall
|
|
^+ +>
|
|
(se-drop:(se-pull gyl) & gyl)
|
|
::
|
|
++ se-klin :: disconnect app
|
|
|= gyl/gill:gall
|
|
+>(eel (~(del in eel) gyl))
|
|
::
|
|
++ se-link :: connect to app
|
|
|= gyl/gill:gall
|
|
+>(eel (~(put in eel) gyl))
|
|
::
|
|
++ se-blit :: give output
|
|
|= bil/dill-blit:dill
|
|
+>(biz [bil biz])
|
|
::
|
|
++ se-blit-sys :: output to system
|
|
|= bil/dill-blit:dill ^+ +>
|
|
?~ sys ~&(%se-blit-no-sys +>)
|
|
(se-emit [u.sys %diff %dill-blit bil])
|
|
::
|
|
++ se-show :: show buffer, raw
|
|
|= lin/(pair @ud stub)
|
|
^+ +>
|
|
=. p.lin (add p.lin (lent-stye:klr q.lin))
|
|
?: =(mir lin) +>
|
|
=. +> ?:(=(p.mir p.lin) +> (se-blit %hop p.lin))
|
|
=. +> ?:(=(q.mir q.lin) +> (se-blit %pom q.lin))
|
|
+>(mir lin)
|
|
::
|
|
++ se-just :: adjusted buffer
|
|
|= {pom/stub lin/(pair @ud (list @c))}
|
|
^+ +>
|
|
=/ pol (lent-char:klr pom)
|
|
=/ pos (add pol p.lin)
|
|
?: (gte (div (mul pol 100) edg) 35) :: old style (long prompt)
|
|
=/ off ?:((lte pos edg) 0 (sub pos edg))
|
|
%+ se-show
|
|
(sub pos off)
|
|
(swag:klr [off edg] (welp pom [*stye q.lin]~))
|
|
=/ end (sub edg pol)
|
|
=. off ?: (gth p.lin (add end off))
|
|
(sub p.lin end)
|
|
?: (lth p.lin off)
|
|
(min p.lin (dec off))
|
|
off
|
|
%+ se-show
|
|
(sub pos off)
|
|
(welp pom [*stye (swag [off end] q.lin)]~)
|
|
::
|
|
++ se-view :: flush buffer
|
|
^+ .
|
|
=+ gul=se-agon
|
|
?: |(?=(~ gul) (se-aint u.gul)) +
|
|
(se-just ta-vew:(se-tame u.gul))
|
|
::
|
|
++ se-emit :: emit move
|
|
|= mov/move
|
|
%_(+> moz [mov moz])
|
|
::
|
|
++ se-text :: return text
|
|
|= txt/tape
|
|
^+ +>
|
|
?. ((sane %t) (crip txt)) :: XX upstream validation
|
|
~& bad-text+<`*`txt>
|
|
+>
|
|
?. se-ably ((slog [%leaf txt]~) +>.$)
|
|
(se-blit %out (tuba txt))
|
|
::
|
|
++ se-poke :: send a poke
|
|
|= {gyl/gill:gall par/pear}
|
|
(se-emit [ost.hid %poke (en-gill gyl) gyl par])
|
|
::
|
|
++ se-peer :: send a peer
|
|
|= gyl/gill:gall
|
|
%- se-emit(fug (~(put by fug) gyl ~))
|
|
[ost.hid %peer (en-gill gyl) gyl /sole]
|
|
::
|
|
++ se-pull :: cancel subscription
|
|
|= gyl/gill:gall
|
|
(se-emit [ost.hid %pull (en-gill gyl) gyl ~])
|
|
::
|
|
++ se-tame :: switch connection
|
|
|= gyl/gill:gall
|
|
^+ ta
|
|
~(. ta gyl (need (~(got by fug) gyl)))
|
|
::
|
|
++ se-diff :: receive results
|
|
|= {gyl/gill:gall fec/sole-effect}
|
|
^+ +>
|
|
ta-abet:(ta-fec:(se-tame gyl) fec)
|
|
::
|
|
++ ta :: per target
|
|
|_ {gyl/gill:gall target} :: app and state
|
|
++ ta-abet :: resolve
|
|
^+ ..ta
|
|
..ta(fug (~(put by fug) gyl ``target`+<+))
|
|
::
|
|
++ ta-poke |=(a/pear +>(..ta (se-poke gyl a))) :: poke gyl
|
|
::
|
|
++ ta-act :: send action
|
|
|= act/sole-action
|
|
^+ +>
|
|
(ta-poke %sole-action act)
|
|
::
|
|
++ ta-aro :: hear arrow
|
|
|= key/?($d $l $r $u)
|
|
^+ +>
|
|
=. ris ~
|
|
?- key
|
|
$d ?. =(num.hit pos.hit)
|
|
(ta-mov +(pos.hit))
|
|
?: =(0 (lent buf.say.inp))
|
|
ta-bel
|
|
(ta-hom:ta-nex %set ~)
|
|
$l ?: =(0 pos.inp) ta-bel
|
|
+>(pos.inp (dec pos.inp))
|
|
$r ?: =((lent buf.say.inp) pos.inp)
|
|
ta-bel
|
|
+>(pos.inp +(pos.inp))
|
|
$u ?:(=(0 pos.hit) ta-bel (ta-mov (dec pos.hit)))
|
|
==
|
|
::
|
|
++ ta-bel :: beep
|
|
.(..ta (se-blit %bel ~), q.blt ~) :: forget belt
|
|
::
|
|
++ ta-belt :: handle input
|
|
|= bet/dill-belt:dill
|
|
^+ +>
|
|
?< ?=({?($cru $hey $rez $yow) *} bet) :: target-specific
|
|
=. blt [q.blt `bet] :: remember belt
|
|
?- bet
|
|
{$aro *} (ta-aro p.bet)
|
|
{$bac *} ta-bac
|
|
{$ctl *} (ta-ctl p.bet)
|
|
{$del *} ta-del
|
|
{$met *} (ta-met p.bet)
|
|
{$ret *} ta-ret
|
|
{$txt *} (ta-txt p.bet)
|
|
==
|
|
::
|
|
++ ta-det :: send edit
|
|
|= ted/sole-edit
|
|
^+ +>
|
|
(ta-act %det [[his.ven.say.inp own.ven.say.inp] (sham buf.say.inp) ted])
|
|
::
|
|
++ ta-bac :: hear backspace
|
|
^+ .
|
|
?^ ris
|
|
?: =(~ str.u.ris)
|
|
ta-bel
|
|
.(str.u.ris (scag (dec (lent str.u.ris)) str.u.ris))
|
|
?: =(0 pos.inp)
|
|
?~ buf.say.inp
|
|
(ta-act %clr ~)
|
|
ta-bel
|
|
(ta-hom %del (dec pos.inp))
|
|
::
|
|
++ ta-ctl :: hear control
|
|
|= key/@ud
|
|
^+ +>
|
|
=. ris ?.(?=(?($g $r) key) ~ ris)
|
|
?+ key ta-bel
|
|
$a +>(pos.inp 0)
|
|
$b (ta-aro %l)
|
|
$c ta-bel
|
|
$d ?^ buf.say.inp
|
|
ta-del
|
|
?: (~(has in (deft-fish our.hid)) gyl)
|
|
+>(..ta (se-blit qit+~)) :: quit pier
|
|
+>(..ta (se-klin gyl)) :: unlink app
|
|
$e +>(pos.inp (lent buf.say.inp))
|
|
$f (ta-aro %r)
|
|
$g ?~ ris ta-bel
|
|
(ta-hom(pos.hit num.hit, ris ~) [%set ~])
|
|
$i ta-tab
|
|
$k =+ len=(lent buf.say.inp)
|
|
?: =(pos.inp len)
|
|
ta-bel
|
|
(ta-kil %r [pos.inp (sub len pos.inp)])
|
|
$l +>(..ta (se-blit %clr ~))
|
|
$n (ta-aro %d)
|
|
$p (ta-aro %u)
|
|
$r ?~ ris
|
|
+>(ris `[pos.hit ~])
|
|
?: =(0 pos.u.ris)
|
|
ta-bel
|
|
(ta-ser ~)
|
|
$t =+ len=(lent buf.say.inp)
|
|
?: |(=(0 pos.inp) (lth len 2))
|
|
ta-bel
|
|
=+ sop=(sub pos.inp ?:(=(len pos.inp) 2 1))
|
|
(ta-hom (rep:edit [sop 2] (flop (swag [sop 2] buf.say.inp))))
|
|
$u ?: =(0 pos.inp)
|
|
ta-bel
|
|
(ta-kil %l [0 pos.inp])
|
|
$v ta-bel
|
|
$w ?: =(0 pos.inp)
|
|
ta-bel
|
|
=+ sop=(ta-pos %l %ace pos.inp)
|
|
(ta-kil %l [(sub pos.inp sop) sop])
|
|
$x +>(..ta se-anon)
|
|
$y ?: =(0 num.kil)
|
|
ta-bel
|
|
(ta-hom (cat:edit pos.inp ta-yan))
|
|
==
|
|
::
|
|
++ ta-del :: hear delete
|
|
^+ .
|
|
?: =((lent buf.say.inp) pos.inp)
|
|
ta-bel
|
|
(ta-hom %del pos.inp)
|
|
::
|
|
++ ta-erl :: hear local error
|
|
|= pos/@ud
|
|
ta-bel(pos.inp (min pos (lent buf.say.inp)))
|
|
::
|
|
++ ta-err :: hear remote error
|
|
|= pos/@ud
|
|
(ta-erl (~(transpose sole say.inp) pos))
|
|
::
|
|
++ ta-fec :: apply effect
|
|
|= fec/sole-effect
|
|
^+ +>
|
|
?- fec
|
|
{$bel *} ta-bel
|
|
{$blk *} +>
|
|
{$clr *} +>(..ta (se-blit fec))
|
|
{$det *} (ta-got +.fec)
|
|
{$err *} (ta-err p.fec)
|
|
{$klr *} +>(..ta (se-blit %klr (make:klr p.fec)))
|
|
{$mor *} |- ^+ +>.^$
|
|
?~ p.fec +>.^$
|
|
$(p.fec t.p.fec, +>.^$ ^$(fec i.p.fec))
|
|
{$nex *} ta-nex
|
|
{$pro *} (ta-pro +.fec)
|
|
{$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 %ret ~)
|
|
::
|
|
++ ta-tab :: hear tab
|
|
(ta-act %tab pos.inp)
|
|
::
|
|
++ ta-ser :: reverse search
|
|
|= ext/(list @c)
|
|
^+ +>
|
|
?: |(?=(~ ris) =(0 pos.u.ris))
|
|
ta-bel
|
|
=+ sop=?~(ext (dec pos.u.ris) pos.u.ris)
|
|
=+ tot=(weld str.u.ris ext)
|
|
=+ dol=(slag (sub num.hit sop) old.hit)
|
|
=/ sup
|
|
|- ^- (unit @ud)
|
|
?~ dol ~
|
|
?^ (find tot i.dol)
|
|
`sop
|
|
$(sop (dec sop), dol t.dol)
|
|
?~ sup ta-bel
|
|
(ta-mov(str.u.ris tot, pos.u.ris u.sup) (dec u.sup))
|
|
::
|
|
++ ta-txt :: hear text
|
|
|= txt/(list @c)
|
|
^+ +>
|
|
?^ ris
|
|
(ta-ser txt)
|
|
(ta-hom (cat:edit pos.inp txt))
|
|
::
|
|
++ ta-vew :: computed prompt
|
|
^- {pom/stub lin/(pair @ud (list @c))}
|
|
=; vew/(pair (list @c) styx)
|
|
[(make:klr q.vew) pos.inp p.vew]
|
|
?: vis.pom
|
|
:- buf.say.inp :: default prompt
|
|
?~ ris
|
|
cad.pom
|
|
:(welp "(reverse-i-search)'" (tufa str.u.ris) "': ")
|
|
:- (reap (lent buf.say.inp) `@c`'*') :: hidden input
|
|
%+ welp
|
|
cad.pom
|
|
?~ buf.say.inp ~
|
|
:(welp "<" (scow %p (end 4 1 (sham buf.say.inp))) "> ")
|
|
::
|
|
++ ta-yan :: yank
|
|
(snag (sub num.kil pos.kil) old.kil)
|
|
--
|
|
++ edit :: produce sole-edits
|
|
|%
|
|
++ cat :: mass insert
|
|
|= {pos/@ud txt/(list @c)}
|
|
^- sole-edit
|
|
:- %mor
|
|
|- ^- (list sole-edit)
|
|
?~ txt ~
|
|
[[%ins pos i.txt] $(pos +(pos), txt t.txt)]
|
|
::
|
|
++ cut :: mass delete
|
|
|= {pos/@ud num/@ud}
|
|
^- sole-edit
|
|
:- %mor
|
|
|- ^- (list sole-edit)
|
|
?: =(0 num) ~
|
|
[[%del pos] $(num (dec num))]
|
|
::
|
|
++ rep :: mass replace
|
|
|= {{pos/@ud num/@ud} txt/(list @c)}
|
|
^- sole-edit
|
|
:~ %mor
|
|
(cut pos num)
|
|
(cat pos txt)
|
|
==
|
|
++ any :: matches?
|
|
|= {a/sole-edit b/$-(sole-edit ?)}
|
|
^- ?
|
|
?. ?=($mor -.a) (b a)
|
|
(lien p.a |=(c/sole-edit ^$(a c)))
|
|
--
|
|
++ offset :: calculate offsets
|
|
|%
|
|
++ alnm :: alpha-numeric
|
|
|= a/@ ^- ?
|
|
?| &((gte a '0') (lte a '9'))
|
|
&((gte a 'A') (lte a 'Z'))
|
|
&((gte a 'a') (lte a 'z'))
|
|
==
|
|
::
|
|
++ ace :: next whitespace
|
|
|= a/(list @)
|
|
=| {b/_| i/@ud}
|
|
|- ^- @ud
|
|
?~ a i
|
|
=/ c !=(32 i.a)
|
|
=. b |(b c)
|
|
?: &(b !|(=(0 i) c)) i
|
|
$(i +(i), a t.a)
|
|
::
|
|
++ edg :: next word boundary
|
|
|= a/(list @)
|
|
=| {b/_| i/@ud}
|
|
|- ^- @ud
|
|
?~ a i
|
|
=/ c (alnm i.a)
|
|
=. b |(b c)
|
|
?: &(b !|(=(0 i) c)) i
|
|
$(i +(i), a t.a)
|
|
::
|
|
++ wrd :: next or current word
|
|
|= a/(list @)
|
|
=| i/@ud
|
|
|- ^- @ud
|
|
?: |(?=(~ a) (alnm i.a)) i
|
|
$(i +(i), a t.a)
|
|
--
|
|
::
|
|
++ klr :: styx/stub engine
|
|
=, dill
|
|
|%
|
|
++ make :: stub from styx
|
|
|= a/styx ^- stub
|
|
=| b/stye
|
|
%+ reel
|
|
|- ^- stub
|
|
%- zing %+ turn a
|
|
|= a/$@(@t (pair styl styx))
|
|
?@ a [b (tuba (trip a))]~
|
|
^$(a q.a, b (styd p.a b))
|
|
::
|
|
|= {a/(pair stye (list @c)) b/stub}
|
|
?~ b [a ~]
|
|
?. =(p.a p.i.b) [a b]
|
|
[[p.a (weld q.a q.i.b)] t.b]
|
|
::
|
|
++ styd :: stye from styl
|
|
|= {a/styl b/stye} ^+ b :: with inheritance
|
|
:+ ?~ p.a p.b
|
|
?~ u.p.a ~
|
|
(~(put in p.b) u.p.a)
|
|
(fall p.q.a p.q.b)
|
|
(fall q.q.a q.q.b)
|
|
::
|
|
++ lent-stye
|
|
|= a/stub ^- @
|
|
(roll (lnts-stye a) add)
|
|
::
|
|
++ lent-char
|
|
|= a/stub ^- @
|
|
(roll (lnts-char a) add)
|
|
::
|
|
++ lnts-stye :: stub pair head lengths
|
|
|= a/stub ^- (list @)
|
|
%+ turn a
|
|
|= a/(pair stye (list @c))
|
|
;: add :: presumes impl of cvrt:ansi in %dill
|
|
(mul 5 2) :: bg
|
|
(mul 5 2) :: fg
|
|
=+ b=~(wyt in p.p.a) :: effect
|
|
?:(=(0 b) 0 (mul 4 +(b)))
|
|
==
|
|
::
|
|
++ lnts-char :: stub pair tail lengths
|
|
|= a/stub ^- (list @)
|
|
%+ turn a
|
|
|= a/(pair stye (list @c))
|
|
(lent q.a)
|
|
::
|
|
++ brek :: index + incl-len of
|
|
|= {a/@ b/(list @)} :: stub pair w/ idx a
|
|
=| {c/@ i/@}
|
|
|- ^- (unit (pair @ @))
|
|
?~ b ~
|
|
=. c (add c i.b)
|
|
?: (gte c a)
|
|
`[i c]
|
|
$(i +(i), b t.b)
|
|
::
|
|
++ slag :: slag stub, keep stye
|
|
|= {a/@ b/stub}
|
|
^- stub
|
|
=+ c=(lnts-char b)
|
|
=+ i=(brek a c)
|
|
?~ i b
|
|
=+ r=(^slag +(p.u.i) b)
|
|
?: =(a q.u.i)
|
|
r
|
|
=+ n=(snag p.u.i b)
|
|
:_ r :- p.n
|
|
(^slag (sub (snag p.u.i c) (sub q.u.i a)) q.n)
|
|
::
|
|
++ scag :: scag stub, keep stye
|
|
|= {a/@ b/stub}
|
|
^- stub
|
|
=+ c=(lnts-char b)
|
|
=+ i=(brek a c)
|
|
?~ i b
|
|
?: =(a q.u.i)
|
|
(^scag +(p.u.i) b)
|
|
%+ welp
|
|
(^scag p.u.i b)
|
|
=+ n=(snag p.u.i b)
|
|
:_ ~ :- p.n
|
|
(^scag (sub (snag p.u.i c) (sub q.u.i a)) q.n)
|
|
::
|
|
++ swag :: swag stub, keep stye
|
|
|= {{a/@ b/@} c/stub}
|
|
(scag b (slag a c))
|
|
--
|
|
--
|