diff --git a/bin/solid.pill b/bin/solid.pill index 4e94b2904..d20c5a0d4 100644 --- a/bin/solid.pill +++ b/bin/solid.pill @@ -1,3 +1,3 @@ version https://git-lfs.github.com/spec/v1 -oid sha256:4c69f15d99dee616721a2c1617d35c5befad3343b918a25a819880546b783b98 -size 9017827 +oid sha256:6eba700d43103eaff83a0d58d3656ec11cf0d2ac6a7937293ada967e15fd832e +size 8946520 diff --git a/pkg/arvo/age/dojo.hoon b/pkg/arvo/age/dojo.hoon index 8c3c9ce4c..6426ec7f8 100644 --- a/pkg/arvo/age/dojo.hoon +++ b/pkg/arvo/age/dojo.hoon @@ -10,10 +10,11 @@ :::: :: :::: :: :: :: => |% :: external structures + ++ id @tasession :: session id ++ house :: all state $: $5 egg/@u :: command count - hoc/(map bone session) :: conversations + hoc/(map id session) :: conversations == :: ++ session :: per conversation $: say/sole-share :: command-line state @@ -300,7 +301,7 @@ ++ xsell `$-(vase tank)`vase-to-tank:pprint :: ++ he :: per session - |_ {hid/bowl:mall ost=bone moz/(list card:agent:mall) session} + |_ {hid/bowl:mall =id moz/(list card:agent:mall) session} :: ++ he-beam ^- beam @@ -795,21 +796,19 @@ == :: ++ he-abet :: resolve - [(flop moz) %_(state hoc (~(put by hoc) ost +<+>+))] - :: - ++ he-abut :: discard - => he-stop - [(flop moz) %_(state hoc (~(del by hoc) ost))] + [(flop moz) %_(state hoc (~(put by hoc) id +<+>+))] :: ++ he-card :: emit gift |= =card:agent:mall ^+ +> + =? card ?=(%pass -.card) + card(p [id p.card]) %_(+> moz [card moz]) :: ++ he-diff :: emit update |= fec/sole-effect ^+ +> - (he-card %give %fact `/sole %sole-effect !>(fec)) + (he-card %give %fact `/sole/[id] %sole-effect !>(fec)) :: ++ he-stop :: abort work ^+ . @@ -1155,7 +1154,6 @@ !>([our=our now=now eny=eny]:hid) -- -- -=/ ost=bone 0 ^- agent:mall |_ hid=bowl:mall ++ on-init @@ -1172,14 +1170,21 @@ ++ on-poke |= [=mark =vase] ^- (quip card:agent:mall _..on-init) - =/ a-session=session (~(got by hoc) ost) - =/ he-full ~(. he hid ost ~ a-session) =^ moves state ^- (quip card:agent:mall house) ?+ mark ~|([%dojo-poke-bad-mark mark] !!) - %sole-action he-abet:(he-type:he-full !<(sole-action vase)) - %lens-command he-abet:(he-lens:he-full !<(command:lens vase)) - %json ~& jon=!<(json vase) `state + %sole-action + =+ !<([=id =sole-action] vase) + he-abet:(~(he-type he hid id ~ (~(got by hoc) id)) sole-action) + :: + %lens-command + =+ !<([=id =command:lens] vase) + he-abet:(~(he-lens he hid id ~ (~(got by hoc) id)) command) + :: + %json + ~& jon=!<(json vase) + `state + :: %wipe ~& %dojo-wipe =. hoc @@ -1201,22 +1206,21 @@ ^- (quip card:agent:mall _..on-init) ~? !=(our.hid src.hid) [%dojo-peer-stranger src.hid] ?> (team:title our.hid src.hid) - =^ moves-1 state - ?. (~(has by hoc) ost) [~ state] - ~& [%dojo-peer-replaced ost] - ~(he-abut he hid ost ~ (~(got by hoc) ost)) - =^ moves-2 state + ?> ?=([%sole @ ~] path) + =/ id i.t.path + =? hoc (~(has by hoc) id) + ~& [%dojo-peer-replaced id] + (~(del by hoc) id) + =. hoc =/ =session %*(. *session -.dir [our.hid %home ud+0]) - ?> ?=([%sole *] path) - he-abet:(~(he-peer he hid ost moves-1 session) t.path) - [moves-2 ..on-init] + (~(put by hoc) id session) + [~ ..on-init] :: ++ on-leave - |= path - =^ moves state - ~(he-abut he hid ost ~ (~(got by hoc) ost)) - =. hoc (~(del by hoc) ost) - [moves ..on-init] + |= =path + ?> ?=([%sole *] path) + =. hoc (~(del by hoc) t.path) + [~ ..on-init] :: ++ on-peek |= path @@ -1224,27 +1228,29 @@ :: ++ on-agent |= [=wire =sign:agent:mall] - =/ =session (~(got by hoc) ost) + ?> ?=([@ *] wire) + =/ =session (~(got by hoc) i.wire) =^ moves state - he-abet:(~(he-unto he hid ost ~ session) wire sign) + he-abet:(~(he-unto he hid i.wire ~ session) t.wire sign) [moves ..on-init] :: ++ on-arvo |= [=wire =sign-arvo] - =/ =session (~(got by hoc) ost) - =/ he-full ~(. he hid ost ~ session) + ?> ?=([@ *] wire) + =/ =session (~(got by hoc) i.wire) + =/ he-full ~(. he hid i.wire ~ session) =^ moves state =< he-abet ?+ +<.sign-arvo ~|([%dojo-bad-take +<.sign-arvo] !!) - %made (he-made:he-full wire +>.sign-arvo) - %http-response (he-http-response:he-full wire +>.sign-arvo) + %made (he-made:he-full t.wire +>.sign-arvo) + %http-response (he-http-response:he-full t.wire +>.sign-arvo) == [moves ..on-init] :: ++ on-fail |= [=term =tang] - =/ =session (~(got by hoc) ost) + =/ =session (~(got by hoc) 'drum') =^ moves state - he-abet:(~(he-lame he hid ost ~ session) term tang) + he-abet:(~(he-lame he hid 'drum' ~ session) term tang) [moves ..on-init] -- diff --git a/pkg/arvo/age/hood.hoon b/pkg/arvo/age/hood.hoon index 93ddd9f8d..e9bb14735 100644 --- a/pkg/arvo/age/hood.hoon +++ b/pkg/arvo/age/hood.hoon @@ -100,7 +100,7 @@ ++ ably :: save part =+ $:{(list) hood-part} |@ ++ $ - [(flop +<-) (~(put by lac) +<+< +<+)] + [+<- (~(put by lac) +<+< +<+)] -- :: :: :: :::: :: :: generic handling diff --git a/pkg/arvo/age/lens.hoon b/pkg/arvo/age/lens.hoon new file mode 100644 index 000000000..c80c60bf1 --- /dev/null +++ b/pkg/arvo/age/lens.hoon @@ -0,0 +1,214 @@ +/- lens, *sole +/+ base64, *server, default-agent +/= lens-mark /: /===/mar/lens/command + /!noun/ +=, format +|% +:: +lens-out: json or named octet-stream +:: ++$ lens-out + $% [%json =json] + [%mime =mime] + == ++$ state + $% $: %0 + job=(unit [eyre-id=@ta com=command:lens]) + == + == +:: +-- +:: +=| =state +|_ =bowl:mall ++* this . + def ~(. (default-agent this %|) bowl) +:: +++ on-init on-init:def +++ on-save !>(state) +++ on-load + |= old=vase + `this(state !<(^state old)) +:: +++ on-poke + |= [=mark =vase] + ^- (quip card:agent:mall _this) + ?. ?=(%handle-http-request mark) + (on-poke:def mark vase) + =+ !<([eyre-id=@ta =inbound-request:eyre] vase) + ?> ?=(~ job.state) + :: + =/ request-line (parse-request-line url.request.inbound-request) + =/ site (flop site.request-line) + :: + =/ jon=json + (need (de-json:html q:(need body.request.inbound-request))) + =/ com=command:lens + (json:grab:lens-mark jon) + :: + ?: ?=(%export -.source.com) + ~& [%export app.source.com] + :_ this(job.state (some [eyre-id com])) + [%pass /export %agent [our.bowl app.source.com] %watch /export]~ + :: + ?: ?=(%import -.source.com) + ?~ enc=(de:base64 base64-jam.source.com) + !! + :: + =/ c=* (cue q.u.enc) + :: + :_ this(job.state (some [eyre-id com])) + [%pass /import %agent [our.bowl app.source.com] %poke %import !>(c)]~ + :: + :_ this(job.state (some [eyre-id com])) + [%pass /sole %agent [our.bowl %dojo] %watch /sole/[eyre-id]]~ +:: +++ on-watch + |= =path + ^- (quip card:agent:mall _this) + ?: ?=([%http-response *] path) + `this + (on-watch:def path) +:: +++ on-leave on-leave:def +++ on-peek on-peek:def +++ on-agent + |= [=wire =sign:agent:mall] + ^- (quip card:agent:mall _this) + |^ + ?+ wire (on-agent:def wire sign) + [%import ~] + ?> ?=(%poke-ack -.sign) + ?> ?=(^ job.state) + :_ this(job.state ~) + %+ give-simple-payload:app eyre-id.u.job.state + [[200 ~] `(as-octt:mimes:html "\"Imported data\"")] + :: + [%export ~] + ?+ -.sign (on-agent:def wire sign) + %watch-ack + ?~ p.sign + `this + ?> ?=(^ job.state) + :_ this(job.state ~) + (give-simple-payload:app eyre-id.u.job.state not-found:gen) + :: + %fact + =^ cards this (take-export !<(* q.cage.sign)) + :_ this :_ cards + ?> ?=(^ job.state) + ?> ?=(%export -.source.com.u.job.state) + [%pass /export %agent [our.bowl app.source.com.u.job.state] %leave ~] + == + :: + [%sole ~] + ?+ -.sign (on-agent:def wire sign) + %watch-ack + ?> ?=(^ job.state) + ?^ p.sign + :_ this(job.state ~) + (give-simple-payload:app eyre-id.u.job.state not-found:gen) + :_ this :_ ~ + :* %pass /sole + %agent [our.bowl %dojo] + %poke %lens-command !> + [eyre-id.u.job.state com.u.job.state] + == + :: + %fact + ?> ?=(%sole-effect p.cage.sign) + =^ cards this (take-sole-effect !<(sole-effect q.cage.sign)) + [[[%pass /sole %agent [our.bowl %dojo] %leave ~] cards] this] + == + == + :: + ++ take-export + |= data=* + ^- (quip card:agent:mall _this) + ?> ?=(^ job.state) + ?> ?=(%export -.source.com.u.job.state) + =/ app-name=tape (trip app.source.com.u.job.state) + =/ output=@t (crip "/{app-name}/jam") + :: + =/ jon=json + =/ =atom (jam data) + =/ =octs [(met 3 atom) atom] + =/ enc (en:base64 octs) + (pairs:enjs:format file+s+output data+s+enc ~) + :: + :_ this(job.state ~) + %+ give-simple-payload:app eyre-id.u.job.state + (json-response:gen (json-to-octs jon)) + :: + ++ take-sole-effect + |= fec=sole-effect + ^- (quip card:agent:mall _this) + =/ out + |- ^- (unit lens-out) + =* loop $ + ?+ -.fec + ~ + :: + %tan + %- some + :- %json + %- wall:enjs:format + (turn (flop p.fec) |=(=tank ~(ram re tank))) + :: + %txt + (some %json s+(crip p.fec)) + :: + %sag + %- some + [%mime p.fec (as-octs:mimes:html (jam q.fec))] + :: + %sav + :: XX use +en:base64 or produce %mime a la %sag + :: + %- some + :- %json + %- pairs:enjs:format + :~ file+s+(crip <`path`p.fec>) + data+s+(crip (en-base64:mimes:html q.fec)) + == + :: + %mor + =/ all `(list lens-out)`(murn p.fec |=(a=sole-effect loop(fec a))) + ?~ all ~ + ~| [%multiple-effects all] + ?> ?=(~ t.all) + (some i.all) + == + :: + ?~ out + [~ this] + :: + ?> ?=(^ job.state) + :_ this(job.state ~) + %+ give-simple-payload:app eyre-id.u.job.state + ?- -.u.out + %json + (json-response:gen (json-to-octs json.u.out)) + :: + %mime + =/ headers + :~ ['content-type' 'application/octet-stream'] + ?> ?=([@ @ ~] p.mime.u.out) + :- 'content-disposition' + ^- @t + %^ cat 3 + 'attachment; filename=' + (rap 3 '"' i.p.mime.u.out '.' i.t.p.mime.u.out '"' ~) + == + [[200 headers] (some q.mime.u.out)] + == + -- +:: +++ on-arvo + |= [=wire =sign-arvo] + ^- (quip card:agent:mall _this) + ?. ?=(%bound +<.sign-arvo) + (on-arvo:def wire sign-arvo) + [~ this] +:: +++ on-fail on-fail:def +-- diff --git a/pkg/arvo/age/talk.hoon b/pkg/arvo/age/talk.hoon deleted file mode 100644 index c10695b6c..000000000 --- a/pkg/arvo/age/talk.hoon +++ /dev/null @@ -1,2630 +0,0 @@ -:: :: :: -:::: /app/talk/hoon :: :: - :: :: :: -:: -::TODO maybe keep track of received grams per circle, too? -:: -::TODO [type query] => [press tab to cycle search results, newest-first] -:: => [escape to clear] -:: -:: This client implementation makes use of the %inbox -:: for all its subscriptions and messaging. All -:: rumors received are exclusively about the %inbox, -:: since that's the only thing the client ever -:: subscribes to. -:: -/- sole-sur=sole :: structures -/+ *hall, sole-lib=sole, default-agent :: libraries -/= seed /~ !>(.) -:: -:::: - :: -=> :: # - :: # %arch - :: # - :: data structures - :: - |% - ++ state :: application state - $: :: messaging state :: - grams/(list telegram) :: all history - known/(map serial @ud) :: messages heard - last/@ud :: last heard - count/@ud :: (lent grams) - sources/(set circle) :: our subscriptions - :: circle details :: - remotes/(map circle group) :: remote presences - mirrors/(map circle config) :: remote configs - :: ui state :: - nicks/(map ship nick) :: human identities - bound/(map audience char) :: bound circle glyphs - binds/(jug char audience) :: circle glyph lookup - cli/shell :: interaction state - == :: - ++ shell :: console session - $: latest/@ud :: latest shown msg num - say/sole-share:sole-sur :: console state - active/audience :: active targets - settings/(set term) :: frontend settings - width/@ud :: display width - timez/(pair ? @ud) :: timezone adjustment - == :: - +$ card card:agent:mall :: - ++ work :: interface action - $% :: circle management :: - {$join (map circle range) (unit char)} :: subscribe to - {$leave audience} :: unsubscribe from - {$create security name cord (unit char)} :: create circle - {$delete name (unit cord)} :: delete circle - {$depict name cord} :: change description - {$filter name ? ?} :: change message rules - {$invite name (set ship)} :: give permission - {$banish name (set ship)} :: deny permission - {$source name (map circle range)} :: add source - {$unsource name (map circle range)} :: remove source - {$read name @ud} :: set read count - :: personal metadata :: - {$attend audience (unit presence)} :: set our presence - {$name audience human} :: set our name - :: messaging :: - {$say (list speech)} :: send message - {$eval cord hoon} :: send #-message - {$target p/audience q/(unit work)} :: set active targets - {$reply $@(@ud {@u @ud}) (list speech)} :: reply to - :: displaying info :: - {$number $@(@ud {@u @ud})} :: relative/absolute - {$who audience} :: presence - {$what (unit $@(char audience))} :: show bound glyph - {$circles ~} :: show our circles - {$sources circle} :: show active sources - :: ui settings :: - {$bind char (unit audience)} :: bind glyph - {$unbind char (unit audience)} :: unbind glyph - {$nick (unit ship) (unit cord)} :: un/set/show nick - {$set term} :: enable setting - {$unset term} :: disable setting - {$width @ud} :: change display width - {$timez ? @ud} :: adjust shown times - :: miscellaneous :: - {$show circle} :: show membership - {$hide circle} :: hide membership - {$help ~} :: print usage info - == :: - ++ glyphs `wall`~[">=+-" "}),." "\"'`^" "$%&@"] :: circle char pool ' - -- -=> |% - ++ states - $%({$1 s/state} {$0 s/state-0}) - :: - ++ state-0 - (cork state |=(a/state a(mirrors (~(run by mirrors.a) config-0)))) - ++ config-0 - {src/(set source-0) cap/cord tag/tags fit/filter con/control} - ++ source-0 - {cir/circle ran/range-0} - ++ range-0 - %- unit - $: hed/place-0 - tal/(unit place-0) - == - ++ place-0 - $% {$da @da} - {$ud @ud} - {$sd @sd} - == - -- -:: -:: Formal agent -:: -=; talk-core - =| stat=[%1 state] - ^- agent:mall - |_ =bowl:mall - +* this . - ++ handle-init - ^- step:agent:mall - =^ cards talk-core (~(prep talk-core bowl stat) ~) - [cards this(stat +<+.talk-core)] - :: - ++ handle-extract-state - !>(stat) - :: - ++ handle-upgrade-state - |= old-state=vase - ^- step:agent:mall - =/ =states !<(states old-state) - =^ cards talk-core (~(prep talk-core bowl stat) `states) - [cards this(stat +<+.talk-core)] - :: - ++ handle-poke - |= [=mark =vase] - ^- step:agent:mall - =^ cards talk-core - ?+ mark ~|([%talk-bad-mark mark] !!) - %noun (~(poke-noun talk-core bowl stat) !<(@t vase)) - %sole-action - %- ~(poke-sole-action talk-core bowl stat) - !<(sole-action:sole-sur vase) - == - [cards this(stat +<+.talk-core)] - :: - ++ handle-subscribe - |= =path - ^- step:agent:mall - =^ cards=(list card:agent:mall) talk-core - (~(peer talk-core bowl stat) path) - [cards this(stat +<+.talk-core)] - :: - ++ handle-unsubscribe ~(handle-unsubscribe default-agent bowl this) - ++ handle-peek ~(handle-peek default-agent bowl this) - :: - ++ handle-agent-response - |= [=wire =gift:agent:mall] - ^- step:agent:mall - =^ cards talk-core - =/ t ~(. talk-core bowl stat) - ?- -.gift - %http-response !! - %poke-ack (coup-client-action:t +>.wire +.gift) - %subscription-ack `talk-core - %subscription-close - ?+ wire ~|([%talk-bad-sub-close-wire wire] !!) - [%server %client *] (quit-server-client:t +>.wire) - [%server %inbox *] (quit-server-inbox:t +>.wire) - == - :: - %subscription-update - ?+ p.cage.gift ~|([%talk-bad-sub-up-mark wire p.cage.gift] !!) - %hall-prize (diff-hall-prize:t wire !<(prize q.cage.gift)) - %hall-rumor (diff-hall-rumor:t wire !<(rumor q.cage.gift)) - == - == - [cards this(stat +<+.talk-core)] - :: - ++ handle-arvo-response ~(handle-arvo-response default-agent bowl this) - ++ handle-error ~(handle-error default-agent bowl this) - -- -:: -:: # -:: # %work -:: # -:: functional cores and arms. -:: -|_ {bol/bowl:mall $1 state} -:: -:: # %transition -:: prep transition -+| %transition -:: -++ prep - :: adapts state - :: - =| mos/(list card) - |= old/(unit states) - ^- (quip card _..prep) - ?~ old - ta-done:ta-init:ta - ?- -.u.old - $1 - [mos ..prep(+<+ u.old)] - :: - $0 - =. mos [[%pass /server/inbox %agent server %unsubscribe ~] peer-inbox mos] - =- $(old `[%1 s.u.old(mirrors -)]) - |^ - (~(run by mirrors.s.u.old) prep-config) - :: - ++ prep-config - |= cof/config-0 - ^- config - =. src.cof - %- ~(gas in *(set source)) - (murn ~(tap in src.cof) prep-source) - :* src.cof - cap.cof - tag.cof - fit.cof - con.cof - 0 - == - :: - ++ prep-source - |= src/source-0 - ^- (unit source) - =+ nan=(prep-range ran.src) - ?~ nan - ~& [%forgetting-source src] - ~ - `src(ran u.nan) - :: - ++ prep-range - |= ran/range-0 - ^- (unit range) - ?~ ran `ran - :: ranges with a relative end aren't stored because they end - :: immediately, so if we find one we can safely discard it. - ?: ?=({$~ {$sd @sd}} tal.u.ran) ~ - :: we replace relative range starts with the current date. - :: this is practically correct. - ?: ?=({$sd @sd} hed.u.ran) - `ran(hed.u [%da now.bol]) - `ran - -- - == -:: -:: # -:: # %utility -:: # -:: small utility functions. -+| %utility -:: -++ self - (true-self [our now our]:bol) -:: -++ server - :: our hall instance - ^- dock - [self %hall] -:: -++ inbox - :: client's circle name - :: - :: produces the name of the circle used by this - :: client for all its operations - ^- name - %inbox -:: -++ incir - :: client's circle - :: - :: ++inbox, except a full circle. - ^- circle - [self inbox] -:: -++ renum - :: find the grams list index for gram with serial. - |= ser/serial - ^- (unit @ud) - =+ num=(~(get by known) ser) - ?~ num ~ - `(sub count +(u.num)) -:: -++ recall - :: find a known gram with serial {ser}. - |= ser/serial - ^- (unit telegram) - =+ num=(renum ser) - ?~ num ~ - `(snag u.num grams) -:: -++ bound-from-binds - :: bound from binds - :: - :: using a mapping of character to audiences, create - :: a mapping of audience to character. - :: - |: bin=binds - ^+ bound - %- ~(gas by *(map audience char)) - =- (zing -) - %+ turn ~(tap by bin) - |= {a/char b/(set audience)} - (turn ~(tap by b) |=(c/audience [c a])) -:: -++ glyph - :: finds a new glyph for assignment. - :: - |= idx/@ - =< cha - %+ reel glyphs - |= {all/tape ole/{cha/char num/@}} - =+ new=(snag (mod idx (lent all)) all) - =+ num=~(wyt in (~(get ju binds) new)) - ?~ cha.ole [new num] - ?: (lth num.ole num) - ole - [new num] -:: -++ peer-client - :: ui state peer card - ^- card - :* %pass - /server/client - %agent - server - %subscribe - /client - == -:: -++ peer-inbox - ^- card - :* %pass - /server/inbox - %agent - server - %subscribe - :: - %+ welp /circle/[inbox]/grams/config/group - ?. =(0 count) - [(scot %ud last) ~] - =+ history-msgs=200 - [(cat 3 '-' (scot %ud history-msgs)) ~] - == -:: -:: # -:: # %engines -:: # -:: main cores. -+| %engines -:: -++ ta - :: per transaction - :: - :: for every transaction/event (poke, peer etc.) - :: talk receives, the ++ta transaction core is - :: called. - :: in processing transactions, ++ta may modify app - :: state, or create cards. these cards get produced - :: upon finalizing the core's with with ++ta-done. - :: when making changes to the shell, the ++sh core is - :: used. - :: - |_ :: cards: cards created by core operations. - :: sole-effects: sole effects created by core operations - :: - $: cards/(list card) - sole-effects/(list sole-effect:sole-sur) - == - :: - :: # %resolve - +| %resolve - :: - ++ ta-done - :: resolve core - :: - :: produces the cards stored in ++ta's cards. - :: %sole-effect cards get squashed into a %mor. - :: - ^+ [*(list card) +>] - :_ +> - =/ foc/(unit sole-effect:sole-sur) - ?~ sole-effects ~ - ?~ t.sole-effects `i.sole-effects :: single sole-effect - `[%mor (flop sole-effects)] :: more sole-effects - :: produce cards or sole-effects and cards. - ?~ foc (flop cards) - [[%give %subscription-update `/sole %sole-effect !>(u.foc)] (flop cards)] - :: - :: # - :: # %emitters - :: # - :: arms that create outward changes. - +| %emitters - :: - ++ ta-emil - :: emit card list - :: - :: adds multiple cards to the core's list. - :: flops to emulate ++ta-emit. - :: - |= mol/(list card) - %_(+> cards (welp (flop mol) cards)) - :: - ++ ta-emit - :: adds a card to the core's list. - :: - |= mov/card - %_(+> cards [mov cards]) - :: - :: # - :: # %interaction-events - :: # - :: arms that apply events we received. - +| %interaction-events - :: - ++ ta-init - :: subscribes to our hall. - :: - %- ta-emil - ^- (list card) - ~[peer-client peer-inbox] - :: - ++ ta-take - :: accept prize - :: - |= piz/prize - ^+ +> - ?+ -.piz +> - $client - %= +> - binds gys.piz - bound (bound-from-binds gys.piz) - nicks nis.piz - == - :: - $circle - %. nes.piz - %= ta-unpack - sources (~(run in src.loc.cos.piz) head) - mirrors (~(put by rem.cos.piz) incir loc.cos.piz) - remotes (~(put by rem.pes.piz) incir loc.pes.piz) - == - == - :: - ++ ta-hear - :: apply change - :: - |= rum/rumor - ^+ +> - ?+ -.rum +> - $client - ?- -.rum.rum - $glyph - (ta-change-glyph +.rum.rum) - :: - $nick - +>(nicks (change-nicks nicks who.rum.rum nic.rum.rum)) - == - :: - $circle - (ta-change-circle rum.rum) - == - :: - ++ ta-change-circle - :: apply circle change - :: - |= rum/rumor-story - ^+ +> - ?+ -.rum - ~&([%unexpected-circle-rumor -.rum] +>) - :: - $gram - (ta-open nev.rum) - :: - $config - =+ cur=(~(gut by mirrors) cir.rum *config) - =. +>.$ - =< sh-done - %- ~(sh-show-config sh cli) - [cir.rum cur dif.rum] - =? +>.$ - ?& ?=($source -.dif.rum) - add.dif.rum - =(cir.rum incir) - == - =* cir cir.src.dif.rum - =+ ren=~(cr-phat cr cir) - =+ gyf=(~(get by bound) [cir ~ ~]) - =< sh-done - =/ sho - :: only present if we're here indefinitely. - =* ran ran.src.dif.rum - ?. |(?=(~ ran) ?=(~ tal.u.ran)) - ~(. sh cli) - %- ~(sh-act sh cli) - [%notify [cir ~ ~] `%hear] - ?^ gyf - (sh-note:sho "has glyph {[u.gyf ~]} for {ren}") - :: we use the rendered circle name to determine - :: the glyph for higher glyph consistency when - :: federating. - =+ cha=(glyph (mug ren)) - (sh-work:sho %bind cha `[cir ~ ~]) - %= +>.$ - sources - ?. &(?=($source -.dif.rum) =(cir.rum incir)) - sources - %. cir.src.dif.rum - ?: add.dif.rum - ~(put in sources) - ~(del in sources) - :: - mirrors - ?: ?=($remove -.dif.rum) (~(del by mirrors) cir.rum) - %+ ~(put by mirrors) cir.rum - (change-config cur dif.rum) - == - :: - $status - =+ rem=(~(gut by remotes) cir.rum *group) - =+ cur=(~(gut by rem) who.rum *status) - =. +>.$ - =< sh-done - %- ~(sh-show-status sh cli) - [cir.rum who.rum cur dif.rum] - %= +>.$ - remotes - %+ ~(put by remotes) cir.rum - ?: ?=($remove -.dif.rum) (~(del by rem) who.rum) - %+ ~(put by rem) who.rum - (change-status cur dif.rum) - == - == - :: - ++ ta-change-glyph - :: applies new set of glyph bindings. - :: - |= {bin/? gyf/char aud/audience} - ^+ +> - =+ nek=(change-glyphs binds bin gyf aud) - ?: =(nek binds) +>.$ :: no change - =. binds nek - =. bound (bound-from-binds nek) - sh-done:~(sh-prod sh cli) - :: - :: # - :: # %messages - :: # - :: storing and updating messages. - +| %messages - :: - ++ ta-unpack - :: open envelopes - :: - :: the client currently doesn't care about nums. - :: - |= nes/(list envelope) - ^+ +> - ?~ nes +> - $(nes t.nes, +> (ta-open i.nes)) - :: - ++ ta-open - :: learn message from an envelope. - :: - |= nev/envelope - ^+ +> - =? last (gth num.nev last) num.nev - (ta-learn gam.nev) - :: - ++ ta-learn - :: save/update message - :: - :: store an incoming telegram, updating if it - :: already exists. - :: - |= gam/telegram - ^+ +> - =+ old=(renum uid.gam) - ?~ old - (ta-append gam) :: add - (ta-revise u.old gam) :: modify - :: - ++ ta-append - :: store a new telegram. - :: - |= gam/telegram - ^+ +> - =: grams [gam grams] - count +(count) - known (~(put by known) uid.gam count) - == - =< sh-done - (~(sh-gram sh cli) gam) - :: - ++ ta-revise - :: modify a telegram we know. - :: - |= {num/@ud gam/telegram} - =+ old=(snag num grams) - ?: =(gam old) +>.$ :: no change - =. grams - %+ welp - (scag num grams) - [gam (slag +(num) grams)] - ?: =(sep.gam sep.old) +>.$ :: no worthy change - =< sh-done - (~(sh-gram sh cli) gam) - :: - :: # - :: # %console - :: # - :: arms for shell functionality. - +| %console - :: - ++ ta-console - :: initialize the shell of this client. - :: - ^+ . - =| she/shell - :: XXX: +sy should be smarter than this - =/ circle-list=(list circle) [incir ~] - =. active.she (sy circle-list) - =. width.she 80 - sh-done:~(sh-prod sh she) - :: - ++ ta-sole - :: apply sole input - :: - |= act/sole-action:sole-sur - ^+ +> - sh-done:(~(sh-sole sh cli) act) - :: - ++ sh - :: per console - :: - :: shell core, responsible for handling user input - :: and the related actions, and outputting changes - :: to the cli. - :: - |_ $: :: she: console state. - :: - she/shell - == - :: - :: # %resolve - +| %resolve - :: - ++ sh-done - :: stores changes to the cli. - :: - ^+ +> - +>(cli she) - :: - :: # - :: # %emitters - :: # - :: arms that create outward changes. - +| %emitters - :: - ++ sh-fact - :: adds a console effect to ++ta's cards. - :: - |= fec/sole-effect:sole-sur - ^+ +> - +>(sole-effects [fec sole-effects]) - :: - ++ sh-act - :: adds an action to ++ta's cards. - :: - |= act/action - ^+ +> - %= +> - cards - :_ cards - :* %pass - /client/action - %agent - server - %poke - [%hall-action !>(act)] - == - == - :: - :: # - :: # %cli-interaction - :: # - :: processing user input as it happens. - +| %cli-interaction - :: - ++ sh-sole - :: applies sole action. - :: - |= act/sole-action:sole-sur - ^+ +> - ?- -.act - $det (sh-edit +.act) - $clr ..sh-sole :: (sh-pact ~) :: XX clear to PM-to-self? - $ret sh-obey - == - :: - ++ sh-edit - :: apply sole edit - :: - :: called when typing into the cli prompt. - :: applies the change and does sanitizing. - :: - |= cal/sole-change:sole-sur - ^+ +> - =^ inv say.she (~(transceive sole-lib say.she) cal) - =+ fix=(sh-sane inv buf.say.she) - ?~ lit.fix - +>.$ - :: just capital correction - ?~ err.fix - (sh-slug fix) - :: allow interior edits and deletes - ?. &(?=($del -.inv) =(+(p.inv) (lent buf.say.she))) - +>.$ - (sh-slug fix) - :: - ++ sh-read - :: command parser - :: - :: parses the command line buffer. produces work - :: items which can be executed by ++sh-work. - :: - =< work - :: # %parsers - :: various parsers for command line input. - |% - ++ expr - :: [cord hoon] - |= tub/nail %. tub - %+ stag (crip q.tub) - wide:(vang & [&1:% &2:% (scot %da now.bol) |3:%]) - :: - ++ dare - :: @dr - %+ sear - |= a/coin - ?. ?=({$$ $dr @} a) ~ - (some `@dr`+>.a) - nuck:so - :: - ++ ship ;~(pfix sig fed:ag) :: ship - ++ shiz :: ship set - %+ cook - |=(a/(list ^ship) (~(gas in *(set ^ship)) a)) - (most ;~(plug com (star ace)) ship) - :: - ++ cire :: local circle - ;~(pfix cen urs:ab) - :: - ++ circ :: circle - ;~ pose - (cold incir col) - ;~(pfix net (stag (^sein:title self) urs:ab)) - ;~ pfix cen - %+ stag self - %+ sear |=(circ=name ?:(=('' circ) ~ (some circ))) - urs:ab - == - :: - %+ cook - |= {a/@p b/(unit term)} - [a ?^(b u.b %inbox)] - ;~ plug - ship - (punt ;~(pfix net urs:ab)) - == - == - :: - ++ circles-flat :: collapse mixed list - |= a/(list (each circle (set circle))) - ^- (set circle) - ?~ a ~ - ?- -.i.a - %& (~(put in $(a t.a)) p.i.a) - %| (~(uni in $(a t.a)) p.i.a) - == - :: - ++ cirs :: non-empty circles - %+ cook circles-flat - %+ most ;~(plug com (star ace)) - (^pick circ (sear sh-glyf glyph)) - :: - ++ drat - :: @da or @dr - :: - :: pas: whether @dr's are in the past or not. - |= pas/? - =- ;~(pfix sig (sear - crub:so)) - |= a/^dime - ^- (unit @da) - ?+ p.a ~ - $da `q.a - $dr :- ~ - %. [now.bol q.a] - ?:(pas sub add) - == - :: - ++ pont :: point for range - :: hed: whether this is the head or tail point. - |= hed/? - ;~ pose - (cold [%da now.bol] (jest 'now')) - (stag %da (drat hed)) - placer - == - :: - ++ rang :: subscription range - =+ ;~ pose - (cook some ;~(pfix net (pont |))) - (easy ~) - == - ;~ pose - (cook some ;~(plug ;~(pfix net (pont &)) -)) - (easy ~) - == - :: - ++ sorz :: non-empty sources - %+ cook ~(gas by *(map circle range)) - (most ;~(plug com (star ace)) ;~(plug circ rang)) - :: - ++ pick :: message reference - ;~(pose nump (cook lent (star mic))) - :: - ++ nump :: number reference - ;~ pose - ;~(pfix hep dem:ag) - ;~ plug - (cook lent (plus (just '0'))) - ;~(pose dem:ag (easy 0)) - == - (stag 0 dem:ag) - == - :: - ++ pore :: security - (perk %channel %village %journal %mailbox ~) - :: - ++ lobe :: y/n loob - ;~ pose - (cold %& ;~(pose (jest 'y') (jest '&') (just 'true'))) - (cold %| ;~(pose (jest 'n') (jest '|') (just 'false'))) - == - :: - ++ message :: exp, lin or url msg - ;~ pose - ;~(plug (cold %eval hax) expr) - (stag %say speeches) - == - :: - ++ speeches :: lin or url msgs - %+ most (jest '•') - ;~ pose - (stag %url aurf:de-purl:html) - :(stag %lin & ;~(pfix vat text)) - :(stag %lin | ;~(less mic hax text)) - == - :: - ++ text :: msg without break - %+ cook crip - (plus ;~(less (jest '•') next)) - :: - ++ nick (cook crip (plus next)) :: nickname - ++ glyph (mask "/\\\{( - ?~ lit +> - =^ lic say.she - (~(transmit sole-lib say.she) `sole-edit:sole-sur`?~(t.lit i.lit [%mor lit])) - (sh-fact [%mor [%det lic] ?~(err ~ [%err u.err]~)]) - :: - ++ sh-obey - :: apply result - :: - :: called upon hitting return in the prompt. if - :: input is invalid, ++sh-slug is called. - :: otherwise, the appropriate work is done and - :: the entered command (if any) gets displayed - :: to the user. - :: - =+ fix=(sh-sane [%nop ~] buf.say.she) - ?^ lit.fix - (sh-slug fix) - =+ jub=(rust (tufa buf.say.she) sh-read) - ?~ jub (sh-fact %bel ~) - %. u.jub - =< sh-work - =+ buf=buf.say.she - =? ..sh-obey &(?=({$';' *} buf) !?=($reply -.u.jub)) - (sh-note (tufa `(list @)`buf)) - =^ cal say.she (~(transmit sole-lib say.she) [%set ~]) - %+ sh-fact %mor - :~ [%nex ~] - [%det cal] - == - :: - :: # - :: # %user-action - :: # - :: processing user actions. - +| %user-action - :: - ++ sh-work - :: do work - :: - :: implements worker arms for different talk - :: commands. - :: worker arms must produce updated state. - :: - |= job/work - ^+ +> - =< work - |% - :: - :: # - :: # %helpers - :: # - +| %helpers - :: - ++ work - :: call correct worker - ?- -.job - :: circle management - $join (join +.job) - $leave (leave +.job) - $create (create +.job) - $delete (delete +.job) - $depict (depict +.job) - $filter (filter +.job) - $invite (permit & +.job) - $banish (permit | +.job) - $source (source & +.job) - $unsource (source | +.job) - $read (read +.job) - :: personal metadata - $attend (attend +.job) - $name (set-name +.job) - :: messaging - $say (say +.job) - $eval (eval +.job) - $target (target +.job) - $reply (reply +.job) - :: displaying info - $number (number +.job) - $who (who +.job) - $what (what +.job) - $circles circles - $sources (list-sources +.job) - :: ui settings - $bind (bind +.job) - $unbind (unbind +.job) - $nick (nick +.job) - $set (wo-set +.job) - $unset (unset +.job) - $width (width +.job) - $timez (timez +.job) - :: miscelaneous - $show (public & +.job) - $hide (public | +.job) - $help help - == - :: - ++ activate - :: prints message details. - :: - |= gam/telegram - ^+ ..sh-work - =+ tay=~(. tr settings.she gam) - =. ..sh-work (sh-fact tr-fact:tay) - sh-prod(active.she aud.gam) - :: - ++ deli - :: gets absolute message number from relative. - :: - |= {max/@ud nul/@u fin/@ud} - ^- @ud - =+ dog=|-(?:(=(0 fin) 1 (mul 10 $(fin (div fin 10))))) - =. dog (mul dog (pow 10 nul)) - =- ?:((lte - max) - (sub - dog)) - (add fin (sub max (mod max dog))) - :: - ++ set-glyph - :: new glyph binding - :: - :: applies glyph binding to our state and sends - :: an action. - :: - |= {cha/char aud/audience} - =: bound (~(put by bound) aud cha) - binds (~(put ju binds) cha aud) - == - sh-prod:(sh-act %glyph cha aud &) - :: - ++ unset-glyph - :: remote old glyph binding - :: - :: removes either {aud} or all bindings on a - :: glyph and sends an action. - :: - |= {cha/char aud/(unit audience)} - =/ ole/(set audience) - ?^ aud [u.aud ~ ~] - (~(get ju binds) cha) - =. ..sh-work (sh-act %glyph cha (fall aud ~) |) - |- ^+ ..sh-work - ?~ ole ..sh-work - =. ..sh-work $(ole l.ole) - =. ..sh-work $(ole r.ole) - %= ..sh-work - bound (~(del by bound) n.ole) - binds (~(del ju binds) cha n.ole) - == - :: - ++ reverse-nicks - :: finds all ships whose handle matches {nym}. - :: - |= nym/^nick - ^- (list ship) - %+ murn ~(tap by nicks) - |= {p/ship q/^nick} - ?. =(q nym) ~ - [~ u=p] - :: - ++ hoon-head - :: eval data - :: - :: makes a vase of environment data to evaluate - :: against (for #-messages). - :: - ^- vase - !> ^- {our/@p now/@da eny/@uvI} - [self now.bol (shas %eny eny.bol)] - :: - :: # - :: # %circle-management - :: # - +| %circle-management - :: - ++ join - :: %join - :: - :: change local mailbox config to include - :: subscriptions to {pas}. - :: - |= {pos/(map circle range) gyf/(unit char)} - ^+ ..sh-work - =+ pas=~(key by pos) - =? ..sh-work ?=(^ gyf) - (bind u.gyf `pas) - =. ..sh-work - sh-prod(active.she pas) - :: default to a day of backlog - =. pos - %- ~(run by pos) - |= r/range - ?~(r `[da+(sub now.bol ~d1) ~] r) - (sh-act %source inbox & pos) - :: - ++ leave - :: %leave - :: - :: change local mailbox config to exclude - :: subscriptions to {pas}. - :: - |= pas/(set circle) - ^+ ..sh-work - :: remove *all* sources relating to {pas}. - =/ pos - %- ~(gas in *(set ^source)) - %- zing - =/ sos - =- ~(tap in src:-) - (~(gut by mirrors) incir *config) - %+ turn ~(tap in pas) - |= c/circle - %+ skim sos - |=(s/^source =(cir.s c)) - =. ..sh-work - (sh-act %source inbox | pos) - (sh-act %notify pas ~) - :: - ++ create - :: %create - :: - :: creates circle {nom} with specified config. - :: - |= {sec/security nom/name txt/cord gyf/(unit char)} - ^+ ..sh-work - =. ..sh-work - (sh-act %create nom txt sec) - (join [[[self nom] ~] ~ ~] gyf) - :: - ++ delete - :: %delete - :: - :: deletes our circle {nom}, after optionally - :: sending a last announce message {say}. - :: - |= {nom/name say/(unit cord)} - ^+ ..sh-work - (sh-act %delete nom say) - :: - ++ depict - :: %depict - :: - :: changes the description of {nom} to {txt}. - :: - |= {nom/name txt/cord} - ^+ ..sh-work - (sh-act %depict nom txt) - :: - ++ permit - :: %invite / %banish - :: - :: invites or banishes {sis} to/from our - :: circle {nom}. - :: - |= {inv/? nom/name sis/(set ship)} - ^+ ..sh-work - =. ..sh-work (sh-act %permit nom inv sis) - =- (sh-act %phrase - [%inv inv [self nom]]~) - %- ~(rep in sis) - |= {s/ship a/audience} - (~(put in a) [s %i]) - :: - ++ filter - |= {nom/name cus/? utf/?} - ^+ ..sh-work - (sh-act %filter nom cus utf) - :: - ++ source - :: %source - :: - :: adds {pas} to {nom}'s src. - :: - |= {sub/? nom/name pos/(map circle range)} - ^+ ..sh-work - (sh-act %source nom sub pos) - :: - ++ read - :: %read - :: - :: set {red} for {nom} - :: - |= {nom/name red/@ud} - ^+ ..sh-work - (sh-act %read nom red) - :: - :: # - :: # %personal-metadata - :: # - +| %personal-metadata - :: - ++ attend - :: sets our presence to {pec} for {aud}. - :: - |= {aud/audience pec/(unit presence)} - ^+ ..sh-work - (sh-act %notify aud pec) - :: - ++ set-name - :: sets our name to {man} for {aud}. - :: - |= {aud/audience man/human} - ^+ ..sh-work - (sh-act %naming aud man) - :: - :: # - :: # %messaging - :: # - +| %messaging - :: - ++ say - :: sends message. - :: - |= sep/(list speech) - ^+ ..sh-work - (sh-act %phrase active.she sep) - :: - ++ eval - :: run - :: - :: executes {exe} and sends both its code and - :: result. - :: - |= {txt/cord exe/hoon} - => |.([(sell (slap (slop hoon-head seed) exe))]~) - =+ tan=p:(mule .) - (say [%exp txt tan] ~) - :: - ++ target - :: %target - :: - :: sets messaging target, then execute {woe}. - :: - |= {aud/audience woe/(unit ^work)} - ^+ ..sh-work - =. ..sh-pact (sh-pact aud) - ?~(woe ..sh-work work(job u.woe)) - :: - ++ reply - :: %reply - :: - :: send a reply to the selected message. - :: - |= {num/$@(@ud {p/@u q/@ud}) sep/(list speech)} - ^+ ..sh-work - :: =- (say (turn ... [%ire - s])) nest-fails on the - ??? - ::TODO what's friendlier, reply-to-null or error? - =/ ser/serial - ?@ num - ?: (gte num count) 0v0 - uid:(snag num grams) - ?: (gth q.num count) 0v0 - ?: =(count 0) 0v0 - =+ msg=(deli (dec count) num) - uid:(snag (sub count +(msg)) grams) - (say (turn sep |=(s/speech [%ire ser s]))) - :: - :: # - :: # %displaying-info - :: # - +| %displaying-info - :: - ++ who - :: %who - :: - :: prints presence lists for {cis} or all. - :: - |= cis/(set circle) ^+ ..sh-work - =< (sh-fact %mor (murn (sort ~(tap by remotes) aor) .)) - |= {cir/circle gop/group} ^- (unit sole-effect:sole-sur) - ?. |(=(~ cis) (~(has in cis) cir)) ~ - ?: =(%mailbox sec.con:(~(gut by mirrors) cir *config)) ~ - ?. (~(has in sources) cir) ~ - =- `[%tan rose+[", " `~]^- leaf+~(cr-full cr cir) ~] - =< (murn (sort ~(tap by gop) aor) .) - |= {a/ship b/presence c/human} ^- (unit tank) - =? c =(han.c `(scot %p a)) [~ tru.c] - ?- b - $gone ~ - $idle `leaf+:(weld "idle " (scow %p a) " " (trip (fall han.c ''))) - $hear `leaf+:(weld "hear " (scow %p a) " " (trip (fall han.c ''))) - $talk `leaf+:(weld "talk " (scow %p a) " " (trip (fall han.c ''))) - == - :: - ++ what - :: %what - :: - :: prints binding details. goes both ways. - :: - :: XX this type is a misjunction, audience can be ~ - :: - |= qur/(unit $@(char audience)) - ^+ ..sh-work - ?^ qur - ?^ u.qur - =+ cha=(~(get by bound) u.qur) - (sh-fact %txt ?~(cha "none" [u.cha]~)) - =+ pan=~(tap in (~(get ju binds) `@t`u.qur)) - ?: =(~ pan) (sh-fact %txt "~") - =< (sh-fact %mor (turn pan .)) - |=(a/audience [%txt ~(ar-phat ar a)]) - %+ sh-fact %mor - %- ~(rep by binds) - |= $: {gyf/char aus/(set audience)} - lis/(list sole-effect:sole-sur) - == - %+ weld lis - ^- (list sole-effect:sole-sur) - %- ~(rep in aus) - |= {a/audience l/(list sole-effect:sole-sur)} - %+ weld l - ^- (list sole-effect:sole-sur) - [%txt [gyf ' ' ~(ar-phat ar a)]]~ - :: - ++ number - :: %number - :: - :: finds selected message, expand it. - :: - |= num/$@(@ud {p/@u q/@ud}) - ^+ ..sh-work - |- - ?@ num - ?: (gte num count) - (sh-lame "{(scow %s (new:si | +(num)))}: no such telegram") - =. ..sh-fact (sh-fact %txt "? {(scow %s (new:si | +(num)))}") - (activate (snag num grams)) - ?. (gte q.num count) - ?: =(count 0) - (sh-lame "0: no messages") - =+ msg=(deli (dec count) num) - =. ..sh-fact (sh-fact %txt "? {(scow %ud msg)}") - (activate (snag (sub count +(msg)) grams)) - (sh-lame "…{(reap p.num '0')}{(scow %ud q.num)}: no such telegram") - :: - ++ circles - :: %circles - :: - :: list all local circles. - :: - ^+ ..sh-work - =/ piz - =- .^(prize %gx -) - %+ weld /(scot %p our.bol)/hall/(scot %da now.bol) - /circles/(scot %p our.bol)/hall-prize - ?> ?=($circles -.piz) - %+ sh-fact %mor - %+ turn (sort ~(tap in cis.piz) lth) - |= a/name [%txt "%{(trip a)}"] - :: - ++ list-sources - :: %sources - :: - :: display the active sources for our circle. - :: - |= cir/circle - ^+ ..sh-work - %+ sh-fact %mor - %+ turn - :: make sure to exclude {nom} itself. - =- ~(tap in (~(del in src:-) [cir ~])) - (~(gut by mirrors) cir *config) - |= s/^source - ^- sole-effect:sole-sur - :- %txt - %+ weld ~(cr-phat cr cir.s) - %+ roll (range-to-path ran.s) - |= {a/@ta b/tape} - :(weld b "/" (trip a)) - :: - :: # - :: # %ui-settings - :: # - +| %ui-settings - :: - ++ bind - :: %bind - :: - :: binds targets {aud} to the glyph {cha}. - :: - |= {cha/char aud/(unit audience)} - ^+ ..sh-work - ?~ aud $(aud `active.she) - =+ ole=(~(get by bound) u.aud) - ?: =(ole [~ cha]) ..sh-work - %. "bound {} {}" - sh-note:sh-prod:(set-glyph cha u.aud) - :: - ++ unbind - :: %unbind - :: - :: unbinds targets {aud} to glyph {cha}. - :: - |= {cha/char aud/(unit audience)} - ^+ ..sh-work - ?. ?| &(?=(^ aud) (~(has by bound) u.aud)) - &(?=(~ aud) (~(has by binds) cha)) - == - ..sh-work - %. "unbound {}" - sh-note:sh-prod:(unset-glyph cha aud) - :: - ++ nick - :: %nick - :: - :: either shows, sets or unsets nicknames - :: depending on arguments. - :: - |= {her/(unit ship) nym/(unit ^nick)} - ^+ ..sh-work - :: no arguments, show all - ?: ?=({~ ~} +<) - %+ sh-fact %mor - %+ turn ~(tap by nicks) - |= {p/ship q/^nick} - :- %txt - "{

}: {}" - :: show her nick - ?~ nym - ?> ?=(^ her) - =+ asc=(~(get by nicks) u.her) - %+ sh-fact %txt - ?~ asc "{} unbound" - "{}: {}" - :: show nick ship - ?~ her - %+ sh-fact %mor - %+ turn (reverse-nicks u.nym) - |= p/ship - [%txt "{

}: {}"] - %. [%nick u.her (fall nym '')] - %= sh-act - nicks - ?~ u.nym - :: unset nickname - (~(del by nicks) u.her) - :: set nickname - (~(put by nicks) u.her u.nym) - == - :: - ++ wo-set - :: %set - :: - :: enables ui setting flag. - :: - |= seg/term - ^+ ..sh-work - ?~ seg - %+ sh-fact %mor - %+ turn ~(tap in settings.she) - |= s/term - [%txt (trip s)] - %= ..sh-work - settings.she (~(put in settings.she) seg) - == - :: - ++ unset - :: %unset - :: - :: disables ui setting flag. - :: - |= neg/term - ^+ ..sh-work - %= ..sh-work - settings.she (~(del in settings.she) neg) - == - :: - ++ width - :: ;set width - :: - :: change the display width in cli. - :: - |= wid/@ud - ^+ ..sh-work - ..sh-work(width.she (max 30 wid)) - :: - ++ timez - :: ;set timezone - :: - :: adjust the displayed timestamp. - :: - |= tim/(pair ? @ud) - ^+ ..sh-work - ..sh-work(timez.she tim) - :: - :: # - :: # %miscellaneous - :: # - +| %miscellaneous - :: - ++ public - :: show/hide membership - :: - :: adds or removes the circle from the public - :: membership list. - :: - |= {add/? cir/circle} - (sh-act %public add cir) - :: - ++ help - :: %help - :: - :: prints help message - :: - (sh-fact %txt "see https://urbit.org/docs/using/messaging/") - -- - :: - ++ sh-pact - :: update active aud - :: - :: change currently selected audience to {aud} - :: and update the prompt. - :: - |= aud/audience - ^+ +> - :: ensure we can see what we send. - =+ act=(sh-pare aud) - ?: =(active.she act) +>.$ - sh-prod(active.she act) - :: - ++ sh-pare - :: adjust target list - :: - :: if the audience {aud} does not contain a - :: circle we're subscribed to, add our mailbox - :: to the audience (so that we can see our own - :: message). - :: - |= aud/audience - ?: (sh-pear aud) aud - (~(put in aud) incir) - :: - ++ sh-pear - :: hearback - :: - :: produces true if any circle is included in - :: our subscriptions, meaning, we hear messages - :: sent to {aud}. - :: - |= aud/audience - ?~ aud | - ?| (~(has in sources) `circle`n.aud) - $(aud l.aud) - $(aud r.aud) - == - :: - ++ sh-glyf - :: decode glyph - :: - :: finds the circle(s) that match a glyph. - :: - |= cha/char ^- (unit audience) - =+ lax=(~(get ju binds) cha) - :: no circle. - ?: =(~ lax) ~ - :: single circle. - ?: ?=({* ~ ~} lax) `n.lax - :: in case of multiple audiences, pick the most recently active one. - |- ^- (unit audience) - ?~ grams ~ - :: get first circle from a telegram's audience. - =+ pan=(silt ~(tap in aud.i.grams)) - ?: (~(has in lax) pan) `pan - $(grams t.grams) - :: - :: # - :: # %differs - :: # - :: arms that calculate differences between datasets. - +| %differs - :: - ++ sh-group-diff - :: group diff parts - :: - :: calculates the difference between two presence - :: lists, producing lists of removed, added and - :: changed presences. - :: - |= {one/group two/group} - =| $= ret - $: old/(list (pair ship status)) - new/(list (pair ship status)) - cha/(list (pair ship status)) - == - ^+ ret - =. ret - =+ eno=~(tap by one) - |- ^+ ret - ?~ eno ret - =. ret $(eno t.eno) - ?: =(%gone pec.q.i.eno) ret - =+ unt=(~(get by two) p.i.eno) - ?~ unt - ret(old [i.eno old.ret]) - ?: =(%gone pec.u.unt) - ret(old [i.eno old.ret]) - ?: =(q.i.eno u.unt) ret - ret(cha [[p.i.eno u.unt] cha.ret]) - =. ret - =+ owt=~(tap by two) - |- ^+ ret - ?~ owt ret - =. ret $(owt t.owt) - ?: =(%gone pec.q.i.owt) ret - ?. (~(has by one) p.i.owt) - ret(new [i.owt new.ret]) - ?: =(%gone pec:(~(got by one) p.i.owt)) - ret(new [i.owt new.ret]) - ret - ret - :: - ++ sh-rempe-diff - :: remotes diff - :: - :: calculates the difference between two remote - :: presence maps, producing a list of removed, - :: added and changed presences maps. - :: - |= {one/(map circle group) two/(map circle group)} - =| $= ret - $: old/(list (pair circle group)) - new/(list (pair circle group)) - cha/(list (pair circle group)) - == - ^+ ret - =. ret - =+ eno=~(tap by one) - |- ^+ ret - ?~ eno ret - =. ret $(eno t.eno) - =+ unt=(~(get by two) p.i.eno) - ?~ unt - ret(old [i.eno old.ret]) - ?: =(q.i.eno u.unt) ret - ret(cha [[p.i.eno u.unt] cha.ret]) - =. ret - =+ owt=~(tap by two) - |- ^+ ret - ?~ owt ret - =. ret $(owt t.owt) - ?: (~(has by one) p.i.owt) - ret - ret(new [i.owt new.ret]) - ret - :: - ++ sh-remco-diff - :: config diff parts - :: - :: calculates the difference between two config - :: maps, producing lists of removed, added and - :: changed configs. - :: - |= {one/(map circle config) two/(map circle config)} - =| $= ret - $: old/(list (pair circle config)) - new/(list (pair circle config)) - cha/(list (pair circle config)) - == - ^+ ret - =. ret - =+ eno=~(tap by one) - |- ^+ ret - ?~ eno ret - =. ret $(eno t.eno) - =+ unt=(~(get by two) p.i.eno) - ?~ unt - ret(old [i.eno old.ret]) - ?: =(q.i.eno u.unt) ret - ret(cha [[p.i.eno u.unt] cha.ret]) - =. ret - =+ owt=~(tap by two) - |- ^+ ret - ?~ owt ret - =. ret $(owt t.owt) - ?: (~(has by one) p.i.owt) - ret - ret(new [i.owt new.ret]) - ret - :: - ++ sh-set-diff - :: set diff - :: - :: calculates the difference between two sets, - :: procuding lists of removed and added items. - :: - |* {one/(set *) two/(set *)} - :- ^= old ~(tap in (~(dif in one) two)) - ^= new ~(tap in (~(dif in two) one)) - :: - :: # - :: # %printers - :: # - :: arms for printing data to the cli. - +| %printers - :: - ++ sh-lame - :: send error - :: - :: just puts some text into the cli as-is. - :: - |= txt/tape - (sh-fact [%txt txt]) - :: - ++ sh-note - :: shell message - :: - :: left-pads {txt} with heps and prints it. - :: - |= txt/tape - ^+ +> - =+ lis=(simple-wrap txt (sub width.she 16)) - %+ sh-fact %mor - =+ ?:((gth (lent lis) 0) (snag 0 lis) "") - :- txt+(runt [14 '-'] '|' ' ' -) - %+ turn (slag 1 lis) - |=(a/tape txt+(runt [14 ' '] '|' ' ' a)) - :: - ++ sh-prod - :: show prompt - :: - :: makes and stores a card to modify the cli - :: prompt to display the current audience. - :: - ^+ . - %+ sh-fact %pro - :+ & %talk-line - ^- tape - =/ rew/(pair (pair cord cord) audience) - [['[' ']'] active.she] - =+ cha=(~(get by bound) q.rew) - ?^ cha ~[u.cha ' '] - =+ por=~(ar-prom ar q.rew) - (weld `tape`[p.p.rew por] `tape`[q.p.rew ' ' ~]) - :: - ++ sh-rend - :: prints a telegram as rendered by ++tr-rend. - :: - |= gam/telegram - ^+ +> - =+ lis=~(tr-rend tr settings.she gam) - ?~ lis +>.$ - %+ sh-fact %mor - %+ turn `(list tape)`lis - =+ nom=(scag 7 (cite:title self)) - |= t/tape - ?. ?& (~(has in settings.she) %notify) - ?=(^ (find nom (slag 15 t))) - == - [%txt t] - [%mor [%txt t] [%bel ~] ~] - :: - ++ sh-numb - :: prints a message number, left-padded by heps. - :: - |= num/@ud - ^+ +> - =+ bun=(scow %ud num) - %+ sh-fact %txt - (runt [(sub 13 (lent bun)) '-'] "[{bun}]") - :: - ++ sh-cure - :: renders a security kind. - :: - |= a/security - ^- tape - (scow %tas a) - :: - ++ sh-scis - :: render status - :: - :: gets the presence of {saz} as a tape. - :: - |= sat/status - ^- tape - ['%' (trip pec.sat)] - :: - ++ sh-show-status - :: prints presence changes to the cli. - :: - |= {cir/circle who/ship cur/status dif/diff-status} - ^+ +> - ?: (~(has in settings.she) %quiet) +> - %- sh-note - %+ weld - (weld ~(cr-phat cr cir) ": ") - ?- -.dif - $full - "hey {(scow %p who)} {(scow %tas pec.sat.dif)}" - :: - $presence - "see {(scow %p who)} {(scow %tas pec.dif)}" - :: - $human - %+ weld "nom {(scow %p who)}" - ?: ?=($true -.dif.dif) ~ - =- " '{(trip (fall han.man.cur ''))}' -> '{-}'" - %- trip - =- (fall - '') - ?- -.dif.dif - $full han.man.dif.dif - $handle han.dif.dif - == - :: - $remove - "bye {(scow %p who)}" - == - :: - ++ sh-show-config - :: prints config changes to the cli. - :: - |= {cir/circle cur/config dif/diff-config} - ^+ +> - ?: (~(has in settings.she) %quiet) +> - ?: ?=($full -.dif) - =. +> - (sh-note (weld "new " (~(cr-show cr cir) ~))) - =. +> $(dif [%caption cap.cof.dif]) - $(dif [%filter fit.cof.dif]) - ?: ?=($remove -.dif) - (sh-note (weld "rip " (~(cr-show cr cir) ~))) - ?: ?=(?($usage $read) -.dif) +> - %- sh-note - %+ weld - (weld ~(cr-phat cr cir) ": ") - ?- -.dif - $source - %+ weld ?:(add.dif "onn " "off ") - ~(cr-full cr cir.src.dif) - :: - $caption - "cap: {(trip cap.dif)}" - :: - $filter - ;: weld - "fit: caps:" - ?:(cas.fit.dif "Y" "n") - " unic:" - ?:(utf.fit.dif "✔" "n") - == - :: - $secure - "sec {(trip sec.con.cur)} -> {(trip sec.dif)}" - :: - $permit - %+ weld - =? add.dif - ?=(?($channel $mailbox) sec.con.cur) - !add.dif - ?:(add.dif "inv " "ban ") - ^- tape - %- ~(rep in sis.dif) - |= {s/ship t/tape} - =? t ?=(^ t) (weld t ", ") - (weld t (cite:title s)) - == - :: - ++ sh-gram - :: show telegram - :: - :: prints the telegram. every fifth message, - :: print the message number also. - :: - |= gam/telegram - ^+ +> - =+ num=(~(got by known) uid.gam) - =. +>.$ - :: if the number isn't directly after latest, print it always. - ?. =(num +(latest.she)) - (sh-numb num) - :: if the number is directly after latest, print every fifth. - ?. =(0 (mod num 5)) +>.$ - (sh-numb num) - (sh-rend(latest.she num) gam) - :: - ++ sh-grams - :: prints multiple telegrams. - :: - |= gaz/(list telegram) - ^+ +> - ?~ gaz +> - $(gaz t.gaz, +> (sh-gram i.gaz)) - -- - -- -:: -:: # -:: # %renderers -:: # -:: rendering cores. -+| %renderers -:: -++ cr - :: circle renderer - :: - :: used in both circle and ship rendering. - :: - |_ :: one: the circle. - :: - one/circle - :: - ++ cr-beat - :: {one} more relevant? - :: - :: returns true if one is better to show, false - :: otherwise. prioritizes: our > main > size. - :: - |= two/circle - ^- ? - :: the circle that's ours is better. - ?: =(self hos.one) - ?. =(self hos.two) & - ?< =(nom.one nom.two) - :: if both circles are ours, the main story is better. - ?: =(%inbox nom.one) & - ?: =(%inbox nom.two) | - :: if neither are, pick the "larger" one. - (lth nom.one nom.two) - :: if one isn't ours but two is, two is better. - ?: =(self hos.two) | - ?: =(hos.one hos.two) - :: if they're from the same ship, pick the "larger" one. - (lth nom.one nom.two) - :: if they're from different ships, neither ours, pick hierarchically. - (lth (xeb hos.one) (xeb hos.two)) - :: - ++ cr-best - :: returns the most relevant circle. - :: - |= two/circle - ?:((cr-beat two) one two) - :: - ++ cr-curt - :: prints a ship name in 14 characters. - :: - :: left-pads with spaces. {mup} signifies - :: "are there other targets besides this one?" - :: - |= mup/? - ^- tape - =+ raw=(cite:title hos.one) - (runt [(sub 14 (lent raw)) ' '] raw) - :: - ++ cr-nick - :: get nick for ship, or shortname if no nick. - :: - :: left-pads with spaces. - :: - |= aud/audience - ^- tape - =/ nic/(unit cord) - ?: (~(has by nicks) hos.one) - (~(get by nicks) hos.one) - %- ~(rep in aud) - |= {cir/circle han/(unit cord)} - ?^ han han - =+ gop=(~(get by remotes) cir) - ?~ gop ~ - han.man:(~(gut by u.gop) hos.one *status) - ?~ nic (cr-curt |) - =+ raw=(scag 14 (trip u.nic)) - =+ len=(sub 14 (lent raw)) - (weld (reap len ' ') raw) - :: - :: todo: figure out why enabling the doccord causes a nest fail, even when - :: attached to the arm instead of the product. - :: - ++ cr-phat ::: render accurately - ::: prints a circle fully, but still taking - ::: "shortcuts" where possible: - ::: ":" for local mailbox, "~ship" for foreign - ::: mailbox, "%channel" for local circle, - ::: "/channel" for parent circle. - :: - ^- tape - ?: =(hos.one self) - ?: =(nom.one inbox) - ":" - ['%' (trip nom.one)] - =+ wun=(cite:title hos.one) - ?: =(nom.one %inbox) - wun - ?: =(hos.one (^sein:title self)) - ['/' (trip nom.one)] - :(welp wun "/" (trip nom.one)) - :: - ++ cr-full (cr-show ~) :: render full width - :: - ++ cr-show - :: renders a circle as text. - :: - :: moy: multiple circles in audience? - |= moy/(unit ?) - ^- tape - :: render circle (as glyph if we can). - ?~ moy - =+ cha=(~(get by bound) one ~ ~) - =- ?~(cha - "{u.cha ~}") - ~(cr-phat cr one) - (~(cr-curt cr one) u.moy) - -- -:: -++ ar - :: audience renderer - :: - :: used for representing audiences (sets of circles) - :: as tapes. - :: - |_ :: aud: members of the audience. - :: - aud/audience - :: - ++ ar-best - :: find the most relevant circle in the set. - :: - ^- (unit circle) - ?~ aud ~ - :- ~ - |- ^- circle - =+ lef=`(unit circle)`ar-best(aud l.aud) - =+ rit=`(unit circle)`ar-best(aud r.aud) - =? n.aud ?=(^ lef) (~(cr-best cr n.aud) u.lef) - =? n.aud ?=(^ rit) (~(cr-best cr n.aud) u.rit) - n.aud - :: - ++ ar-deaf - :: remove ourselves from the audience. - :: - ^+ . - .(aud (~(del in aud) `circle`incir)) - :: - ++ ar-maud - :: multiple audience - :: - :: checks if there's multiple circles in the - :: audience via pattern matching. - :: - ^- ? - =. . ar-deaf - !?=($@(~ {* ~ ~}) aud) - :: - ++ ar-phat - :: render all circles, no glyphs. - :: - ^- tape - %- ~(rep in aud) - |= {c/circle t/tape} - =? t ?=(^ t) - (weld t ", ") - (weld t ~(cr-phat cr c)) - :: - ++ ar-prom - :: render all circles, ordered by relevance. - :: - ^- tape - =. . ar-deaf - =/ all - %+ sort `(list circle)`~(tap in aud) - |= {a/circle b/circle} - (~(cr-beat cr a) b) - =+ fir=& - |- ^- tape - ?~ all ~ - ;: welp - ?:(fir "" " ") - (~(cr-show cr i.all) ~) - $(all t.all, fir |) - == - :: - ++ ar-whom - :: render sender as the most relevant circle. - :: - (~(cr-show cr (need ar-best)) ~ ar-maud) - :: - ++ ar-dire - :: returns true if circle is a mailbox of ours. - :: - |= cir/circle ^- ? - ?& =(hos.cir self) - =+ sot=(~(get by mirrors) cir) - &(?=(^ sot) ?=($mailbox sec.con.u.sot)) - == - :: - ++ ar-glyf - :: todo: another place where doccords break things. - :: - ::: audience glyph - ::: - ::: get the glyph that corresponds to the audience. - ::: for mailbox messages and complex audiences, use - ::: reserved "glyphs". - :: - ^- tape - =+ cha=(~(get by bound) aud) - ?^ cha ~[u.cha] - ?. (lien ~(tap by aud) ar-dire) - "*" - ?: ?=({^ ~ ~} aud) - ":" - ";" - -- -:: -++ tr - :: telegram renderer - :: - :: responsible for converting telegrams and - :: everything relating to them to text to be - :: displayed in the cli. - :: - |_ $: :: sef: settings flags. - :: who: author. - :: sen: unique identifier. - :: aud: audience. - :: wen: timestamp. - :: sep: message contents. - :: - sef/(set term) - who/ship - sen/serial - aud/audience - wen/@da - sep/speech - == - :: - ++ tr-fact - :: activate effect - :: - :: produces sole-effect for printing message - :: details. - :: - ^- sole-effect:sole-sur - ~[%mor [%tan tr-meta] tr-body] - :: - ++ tr-rend - :: renders a telegram - :: - :: the first line will contain the author and - :: optional timestamp. - :: - ^- (list tape) - =/ wyd - %+ sub width.cli :: termwidth, - %+ add 14 :: minus author, - ?:((~(has in sef) %showtime) 10 0) :: minus timestamp. - =+ txs=(tr-text wyd) - ?~ txs ~ - :: render the author. - =/ nom/tape - ?: (~(has in sef) %nicks) - (~(cr-nick cr [who %inbox]) aud) - (~(cr-curt cr [who %inbox]) |) - :: regular indent. - =/ den/tape - (reap (lent nom) ' ') - :: timestamp, if desired. - =/ tam/tape - ?. (~(has in sef) %showtime) "" - =. wen - %. [wen (mul q.timez.cli ~h1)] - ?:(p.timez.cli add sub) - =+ dat=(yore wen) - =/ t - |= a/@ - %+ weld - ?:((lth a 10) "0" ~) - (scow %ud a) - =/ time - ;: weld - "~" (t h.t.dat) - "." (t m.t.dat) - "." (t s.t.dat) - == - %+ weld - (reap (sub +(wyd) (min wyd (lent (tuba i.txs)))) ' ') - time - %- flop - %+ roll `(list tape)`txs - |= {t/tape l/(list tape)} - ?~ l [:(weld nom t tam) ~] - [(weld den t) l] - :: - ++ tr-meta - :: metadata - :: - :: builds string that display metadata, including - :: message serial, timestamp, author and audience. - :: - ^- tang - =. wen (sub wen (mod wen (div wen ~s0..0001))) :: round - =+ hed=leaf+"{(scow %uv sen)} at {(scow %da wen)}" - =/ cis - %+ turn ~(tap in aud) - |= a/circle - leaf+~(cr-full cr a) - [%rose [" " ~ ~] [hed >who< [%rose [", " "to " ~] cis] ~]]~ - :: - ++ tr-body - :: message content - :: - :: long-form display of message contents, specific - :: to each speech type. - :: - |- ^- sole-effect:sole-sur - ?- -.sep - $lin - tan+~[leaf+"{?:(pat.sep "@ " "")}{(trip msg.sep)}"] - :: - $url - url+(crip (apix:en-purl:html url.sep)) - :: - $exp - =/ texp=tape ['>' ' ' (trip exp.sep)] - :- %mor - |- ^- (list sole-effect:sole-sur) - ?: =("" texp) [tan+res.sep ~] - =/ newl (find "\0a" texp) - ?~ newl [txt+texp $(texp "")] - =+ (trim u.newl texp) - :- txt+(scag u.newl texp) - $(texp [' ' ' ' (slag +(u.newl) texp)]) - :: - $ire - =+ num=(~(get by known) top.sep) - ?~ num $(sep sep.sep) - =+ gam=(snag (sub count +(u.num)) grams) - =- mor+[tan+- $(sep sep.sep) ~] - %- flop %+ weld - :_ ~ :- %leaf - %+ weld "in reply to: {(cite:title aut.gam)}: " - "[{(scow %ud u.num)}]" - %+ turn (~(tr-text tr sef gam) width.cli) - |=(t/tape [%leaf t]) - :: - $fat - [%mor $(sep sep.sep) tan+(tr-tach tac.sep) ~] - :: - $inv - :- %tan - :_ ~ - :- %leaf - %+ weld - ?: inv.sep - "you have been invited to " - "you have been banished from " - ~(cr-phat cr cir.sep) - :: - $app - [%mor tan+~[leaf+"[{(trip app.sep)}]: "] $(sep sep.sep) ~] - == - :: - ++ tr-tach - :: renders an attachment. - :: - |= att/attache - ^- tang - ?- -.att - $name (welp $(att tac.att) leaf+"= {(trip nom.att)}" ~) - $tank +.att - $text (turn (flop `(list cord)`+.att) |=(b/cord leaf+(trip b))) - == - :: - ++ tr-chow - :: truncate - :: - :: truncates the {txt} to be of max {len} - :: characters. if it does truncate, indicates it - :: did so by appending _ or …. - :: - |= {len/@u txt/tape} - ^- tape - ?: (gth len (lent txt)) txt - =. txt (scag len txt) - |- - ?~ txt txt - ?: =(' ' i.txt) - |- - :- '_' - ?. ?=({$' ' *} t.txt) - t.txt - $(txt t.txt) - ?~ t.txt "…" - [i.txt $(txt t.txt)] - :: - ++ tr-text - :: compact contents - :: - :: renders just the most important data of the - :: message. if possible, these stay within a single - :: line. - :: - :: pre: replace/append line prefix - ::TODO this should probably be redone someday. - =| pre/(unit (pair ? tape)) - |= wyd/@ud - ^- (list tape) - ?- -.sep - $fat - %+ weld $(sep sep.sep) - ^- (list tape) - ?+ -.tac.sep [" attached: ..." ~] - $name [(scag wyd " attached: {(trip nom.tac.sep)}") ~] - == - :: - $exp - =+ texp=(trip exp.sep) - =+ newline=(find "\0a" texp) - =? texp ?=(^ newline) - (weld (scag u.newline texp) " ...") - :- (tr-chow wyd '#' ' ' texp) - ?~ res.sep ~ - =- [' ' (tr-chow (dec wyd) ' ' -)]~ - ~(ram re (snag 0 `(list tank)`res.sep)) - :: - $ire - $(sep sep.sep, pre `[| "^ "]) - :: - $url - :_ ~ - =+ ful=(apix:en-purl:html url.sep) - =+ pef=q:(fall pre [p=| q=""]) - :: clean up prefix if needed. - =? pef =((scag 1 (flop pef)) " ") - (scag (dec (lent pef)) pef) - =. pef (weld "/" pef) - =. wyd (sub wyd +((lent pef))) :: account for prefix. - :: if the full url fits, just render it. - ?: (gte wyd (lent ful)) :(weld pef " " ful) - :: if it doesn't, prefix with _ and render just (the tail of) the domain. - %+ weld (weld pef "_") - =+ hok=r.p.p.url.sep - =- (swag [a=(sub (max wyd (lent -)) wyd) b=wyd] -) - ^- tape - =< ?: ?=(%& -.hok) - (reel p.hok .) - +:(scow %if p.hok) - |= {a/knot b/tape} - ?~ b (trip a) - (welp b '.' (trip a)) - :: - $lin - :: glyph prefix - =/ pef/tape - ?: &(?=(^ pre) p.u.pre) q.u.pre - ?: pat.sep " " - =- (weld - q:(fall pre [p=| q=" "])) - %~ ar-glyf ar - ?: =(who self) aud - (~(del in aud) [who %inbox]) - =/ lis/(list tape) - %+ simple-wrap - `tape``(list @)`(tuba (trip msg.sep)) - (sub wyd (min (div wyd 2) (lent pef))) - =+ lef=(lent pef) - =+ ?:((gth (lent lis) 0) (snag 0 lis) "") - :- (weld pef -) - %+ turn (slag 1 lis) - |=(a/tape (runt [lef ' '] a)) - :: - $inv - :_ ~ - %+ tr-chow wyd - %+ weld - ?: inv.sep - " invited you to " - " banished you from " - ~(cr-phat cr cir.sep) - :: - $app - $(sep sep.sep, pre `[& "[{(trip app.sep)}]: "]) - == - -- -:: -:: # -:: # %events -:: # -+| %events -:: -++ quit-server-client - |= wir/wire - ^- (quip card _+>) - [[peer-client]~ +>] -:: -++ quit-server-inbox - |= wir/wire - ^- (quip card _+>) - [[peer-inbox]~ +>] -:: -++ peer - :: incoming subscription on pax. - :: - |= pax/path - ^- (quip card _+>) - ?. =(src.bol our.bol) - ~! [%peer-talk-stranger src.bol] - !! - ?. ?=({$sole *} pax) - ~! [%peer-talk-strange pax] - !! - ta-done:ta-console:ta -:: -++ diff-hall-prize - :: accept query answer - :: - |= {way/wire piz/prize} - ^- (quip card _+>) - ta-done:(ta-take:ta piz) -:: -++ diff-hall-rumor - :: accept query change - :: - |= {way/wire rum/rumor} - ^- (quip card _+>) - ta-done:(ta-hear:ta rum) -:: -++ poke-sole-action - :: incoming sole action. process it. - :: - |= act/sole-action:sole-sur - ta-done:(ta-sole:ta act) -:: -::TODO for debug purposes. remove eventually. -:: users beware, here be dragons. -++ poke-noun - |= a/@t - ^- (quip card _+>) - ?: =(a 'check') - ~& 'verifying message reference integrity...' - =- ~&(- [~ +>.$]) - ~& [%count--lent count (lent grams)] - =+ %- ~(rep by known) - |= {{u/serial a/@ud} k/@ud m/@ud} - :- ?:((gth a k) a k) - ?: =(u uid:(snag (sub count +(a)) grams)) m +(m) - :- %check-talk - [known=k mismatch=m] - ?: =(a 'rebuild') - ~& 'rebuilding message references...' - =+ %+ reel grams - |= {t/telegram c/@ud k/(map serial @ud)} - [+(c) (~(put by k) uid.t c)] - [~ +>.$(count c, known k)] - ?: =(a 'reconnect') - ~& 'disconnecting and reconnecting to hall...' - :_ +> - :~ [%pass /server/client %agent server %unsubscribe ~] - [%pass /server/inbox %agent server %unsubscribe ~] - peer-client - peer-inbox - == - ?: =(a 'reset') - ~& 'full reset incoming, hold on to your cli...' - :_ +>(grams ~, known ~, count 0, last 0) - :~ [%pass /server/client %agent server %unsubscribe ~] - [%pass /server/inbox %agent server %unsubscribe ~] - peer-client - peer-inbox - == - :: this deletes a message from your backlog, and may - :: make talk throw stack traces. - :: **aka don't run this!** - ?: =(a 'screw') - ~& 'screwing things up...' - :- ~ - +>(grams (oust [0 1] grams)) - [~ +>] -:: -++ coup-client-action - :: accept n/ack - :: - |= {wir/wire fal/(unit tang)} - ^- (quip card _+>) - ?~ fal [~ +>] - %- (slog leaf+"action failed: " u.fal) - [~ +>] --- diff --git a/pkg/arvo/lib/hood/drum-mall.hoon b/pkg/arvo/lib/hood/drum-mall.hoon index 43d07c06d..52093a6f2 100644 --- a/pkg/arvo/lib/hood/drum-mall.hoon +++ b/pkg/arvo/lib/hood/drum-mall.hoon @@ -287,10 +287,9 @@ =* pith +<+.$ =. . se-subze:se-adze:se-adit :_ pith(bin (~(put by bin) ost dev)) - %- flop ^- (list card:agent:mall) - ?~ biz moz - :_ moz + ?~ biz (flop moz) + :_ (flop moz) =/ =dill-blit:dill ?~(t.biz i.biz [%mor (flop biz)]) [%give %fact `/drum %dill-blit !>(dill-blit)] :: @@ -534,7 +533,7 @@ ++ se-peer :: send a peer |= gyl/gill:gall %- se-emit(fug (~(put by fug) gyl ~)) - [%pass (en-gill gyl) %agent gyl %watch /sole] + [%pass (en-gill gyl) %agent gyl %watch /sole/drum] :: ++ se-pull :: cancel subscription |= gyl/gill:gall @@ -561,7 +560,7 @@ ++ ta-act :: send action |= act/sole-action ^+ +> - (ta-poke %sole-action !>(act)) + (ta-poke %sole-action !>(['drum' act])) :: ++ ta-aro :: hear arrow |= key/?($d $l $r $u) diff --git a/pkg/arvo/mar/sole/effect.hoon b/pkg/arvo/mar/sole/effect.hoon index efd99a4a3..a2177296f 100644 --- a/pkg/arvo/mar/sole/effect.hoon +++ b/pkg/arvo/mar/sole/effect.hoon @@ -59,6 +59,7 @@ $txt (frond %txt (tape p.sef)) $tan (frond %tan (tape (wush 160 p.sef))) $det (frond %det json:~(grow mar-sole-change +.sef)) + $tab (frond %tab a+(turn p.sef |=([=cord tan=^tank] (pairs match+s+cord info+(tape ~(ram re tan)) ~)))) :: $pro %+ frond %pro