:: :: :: :::: /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) [~ +>] --