urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-20 09:21:42 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #2434 from urbit/m/chat-cli

Browse Source 
chat-cli: support group-based chats
This commit is contained in:
ixv 2020-03-11 14:11:07 -07:00 committed by GitHub
commit 10f1e7e667
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
1 changed files with 322 additions and 208 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

530
pkg/arvo/app/chat-cli.hoon
View File

@ -17,8 +17,15 @@
::
|%
+$ card card:agent:gall
+$ state
$: grams=(list mail) :: all messages
::
+$ versioned-state
$% state-1
state-0
==
::
+$ state-1
$: %1
grams=(list mail) :: all messages
known=(set [target serial]) :: known message lookup
count=@ud :: (lent grams)
bound=(map target glyph) :: bound circle glyphs
@ -31,14 +38,27 @@
eny=@uvJ :: entropy
==
::
+$ state-0
$: grams=(list [[=ship =path] envelope]) :: all messages
known=(set [[=ship =path] serial]) :: known message lookup
count=@ud :: (lent grams)
bound=(map [=ship =path] glyph) :: bound circle glyphs
binds=(jug glyph [=ship =path]) :: circle glyph lookup
audience=(set [=ship =path]) :: active targets
settings=(set term) :: frontend flags
width=@ud :: display width
timez=(pair ? @ud) :: timezone adjustment
cli=state=sole-share:sole-sur :: console state
eny=@uvJ :: entropy
==
::
+$ mail [source=target envelope]
+$ target [=ship =path]
+$ target [in-group=? =ship =path]
::
+$ glyph char
++ glyphs "!@#$%^&()-=_+[]\{};'\\:\",.<>?"
++ glyphs "!@#$%^&()-=_+[]\{}'\\:\",.<>?"
::
::NOTE only the "simple" modes from rw-security
+$ nu-security ?(%channel %village)
+$ nu-security ?(%channel %village %village-with-group)
::
+$ command
$% [%target (set target)] :: set messaging target
@ -47,10 +67,10 @@
::
::
:: create chat
::[%create nu-security path (unit glyph) (unit ?)]
[%create nu-security path (unit glyph) (unit ?)]
[%delete path] :: delete chat
[%invite path (set ship)] :: allow
[%banish path (set ship)] :: disallow
[%invite [? path] (set ship)] :: allow
[%banish [? path] (set ship)] :: disallow
::
[%join target (unit glyph) (unit ?)] :: join target
[%leave target] :: nuke target
@ -71,8 +91,8 @@
== ::
::
--
=| state
=* all-state -
=| state-1
=* state -
::
%- agent:dbug
%+ verb |
@ -86,26 +106,22 @@
::
++ on-init
^- (quip card _this)
:- [connect:tc]~
%_ this
audience [[our-self:tc /] ~ ~]
settings (sy %showtime %notify ~)
width 80
==
=^ cards state (prep:tc ~)
[cards this]
::
++ on-save !>(all-state)
++ on-save !>(state)
::
++ on-load
|= old-state=vase
^- (quip card _this)
=/ old !<(state old-state)
=^ cards all-state (prep:tc `old)
=/ old !<(versioned-state old-state)
=^ cards state (prep:tc `old)
[cards this]
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
=^ cards all-state
=^ cards state
?+ mark (on-poke:def mark vase)
%noun (poke-noun:tc !<(* vase))
%sole-action (poke-sole-action:tc !<(sole-action:sole-sur vase))
@ -115,7 +131,7 @@
++ on-watch
|= =path
^- (quip card _this)
=^ cards all-state (peer:tc path)
=^ cards state (peer:tc path)
[cards this]
::
++ on-leave on-leave:def
@ -123,14 +139,22 @@
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
=^ cards all-state
=^ cards state
?- -.sign
%poke-ack [- all-state]:(on-agent:def wire sign)
%watch-ack [- all-state]:(on-agent:def wire sign)
%kick [?:(?=([%chat-store ~] wire) ~[connect:tc] ~) all-state]
%poke-ack [- state]:(on-agent:def wire sign)
%watch-ack [- state]:(on-agent:def wire sign)
::
%kick
:_ state
?+ wire ~
[%chat-store ~] ~[connect:tc]
[%invites ~] ~[connect-invites:tc]
==
::
%fact
?+ p.cage.sign ~|([%chat-cli-bad-sub-mark wire p.cage.sign] !!)
%chat-update (diff-chat-update:tc wire !<(chat-update q.cage.sign))
%chat-update (diff-chat-update:tc wire !<(chat-update q.cage.sign))
%invite-update (handle-invite-update:tc !<(invite-update q.cage.sign))
==
==
[cards this]
@ -143,58 +167,102 @@
:: +prep: setup & state adapter
::
++ prep
|= old=(unit state)
^- (quip card state)
?^ old
:_ u.old
?: (~(has by wex.bowl) [/chat-store our-self %chat-store])
~
~[connect]
=^ cards all-state
%_ catch-up
audience [[our-self /] ~ ~]
settings (sy %showtime %notify ~)
width 80
|= old=(unit versioned-state)
^- (quip card _state)
?~ old
=^ cards state
%_ catch-up
audience [[| our-self /] ~ ~]
settings (sy %showtime %notify ~)
width 80
==
[[connect connect-invites cards] state]
:- %+ weld
?: (~(has by wex.bowl) [/invites our-self %invite-store]) ~
~[connect-invites]
?: (~(has by wex.bowl) [/chat-store our-self %chat-store]) ~
~[connect]
::
^- state-1
?- -.u.old
%1 u.old(width 80)
::
?(~ ^)
:- %1
%= u.old
grams ~ ::NOTE this only impacts historic message lookup in chat-cli
::
known
^- (set [target serial])
%- ~(run in known.u.old)
|= [t=[ship path] s=serial]
[`target`[| t] s]
::
bound
^- (map target glyph)
%- ~(gas in *(map target glyph))
%+ turn ~(tap by bound.u.old)
|= [t=[ship path] g=glyph]
[`target`[| t] g]
::
binds
^- (jug glyph target)
%- ~(run by binds.u.old)
|= s=(set [ship path])
%- ~(run in s)
|= t=[ship path]
`target`[| t]
::
audience
^- (set target)
%- ~(run in audience.u.old)
|= t=[ship path]
`target`[| t]
==
[[connect cards] all-state]
==
:: +catch-up: process all chat-store state
::
++ catch-up
^- (quip card state)
^- (quip card _state)
=/ =inbox
.^ inbox
%gx
(scot %p our.bowl)
%chat-store
(scot %da now.bowl)
/all/noun
==
|- ^- (quip card state)
?~ inbox [~ all-state]
(scry-for inbox %chat-store /all)
|- ^- (quip card _state)
?~ inbox [~ state]
=* path p.n.inbox
=* mailbox q.n.inbox
=/ =target (path-to-target path)
=^ cards-n all-state (read-envelopes target envelopes.mailbox)
=^ cards-l all-state $(inbox l.inbox)
=^ cards-r all-state $(inbox r.inbox)
[:(weld cards-n cards-l cards-r) all-state]
=^ cards-n state (read-envelopes target envelopes.mailbox)
=^ cards-l state $(inbox l.inbox)
=^ cards-r state $(inbox r.inbox)
[:(weld cards-n cards-l cards-r) state]
:: +connect: connect to the chat-store
::
++ connect
^- card
[%pass /chat-store %agent [our-self %chat-store] %watch /updates]
::
++ connect-invites
^- card
[%pass /invites %agent [our.bowl %invite-store] %watch /invitatory/chat]
::
++ our-self (name:title our.bowl)
:: +target-to-path: prepend ship to the path
::
++ target-to-path
|= target
%+ weld
?:(in-group ~ /~)
[(scot %p ship) path]
:: +path-to-target: deduces a target from a mailbox path
::
++ path-to-target
|= =path
^- target
=^ in-group path
?. ?=([%'~' *] path)
[& path]
[| t.path]
:- in-group
?. ?=([@ @ *] path)
::TODO can we safely assert the above?
~& [%path-without-host path]
@ -206,24 +274,24 @@
::
++ poke-noun
|= a=*
^- (quip card state)
^- (quip card _state)
?: ?=(%connect a)
[[connect ~] all-state]
[[connect ~] state]
?: ?=(%catch-up a)
catch-up
[~ all-state]
[~ state]
:: +poke-sole-action: handle cli input
::
++ poke-sole-action
::TODO use id.act to support multiple separate sessions
|= [act=sole-action:sole-sur]
^- (quip card state)
^- (quip card _state)
(sole:sh-in act)
:: +peer: accept only cli subscriptions from ourselves
::
++ peer
|= =path
^- (quip card state)
^- (quip card _state)
?. (team:title our-self src.bowl)
~| [%peer-talk-stranger src.bowl]
!!
@ -233,40 +301,48 @@
:: display a fresh prompt
:- [prompt:sh-out ~]
:: start with fresh sole state
all-state(state.cli *sole-share:sole-sur)
state(state.cli *sole-share:sole-sur)
:: +handle-invite-update: get new invites
::
++ handle-invite-update
|= upd=invite-update
^- (quip card _state)
?+ -.upd [~ state]
%invite [[(show-invite:sh-out invite.upd) ~] state]
==
:: +diff-chat-update: get new mailboxes & messages
::
++ diff-chat-update
|= [=wire upd=chat-update]
^- (quip card state)
?+ -.upd [~ all-state]
^- (quip card _state)
?+ -.upd [~ state]
%create (notice-create (path-to-target path.upd))
%delete [[(show-delete:sh-out (path-to-target path.upd)) ~] all-state]
%delete [[(show-delete:sh-out (path-to-target path.upd)) ~] state]
%message (read-envelope (path-to-target path.upd) envelope.upd)
%messages (read-envelopes (path-to-target path.upd) envelopes.upd)
==
::
++ read-envelopes
|= [=target envs=(list envelope)]
^- (quip card state)
?~ envs [~ all-state]
=^ cards-i all-state (read-envelope target i.envs)
=^ cards-t all-state $(envs t.envs)
[(weld cards-i cards-t) all-state]
^- (quip card _state)
?~ envs [~ state]
=^ cards-i state (read-envelope target i.envs)
=^ cards-t state $(envs t.envs)
[(weld cards-i cards-t) state]
::
++ notice-create
|= =target
^- (quip card state)
=^ cards all-state
^- (quip card _state)
=^ cards state
?: (~(has by bound) target)
[~ all-state]
[~ state]
(bind-default-glyph target)
[[(show-create:sh-out target) cards] all-state]
[[(show-create:sh-out target) cards] state]
:: +bind-default-glyph: bind to default, or random available
::
++ bind-default-glyph
|= =target
^- (quip card state)
^- (quip card _state)
=; =glyph (bind-glyph glyph target)
|^ =/ g=glyph (choose glyphs)
?. (~(has by binds) g) g
@ -284,7 +360,7 @@
::
++ bind-glyph
|= [=glyph =target]
^- (quip card state)
^- (quip card _state)
::TODO should send these to settings store eventually
:: if the target was already bound to another glyph, un-bind that
::
@ -292,16 +368,16 @@
(~(del ju binds) (~(got by bound) target) target)
=. bound (~(put by bound) target glyph)
=. binds (~(put ju binds) glyph target)
[(show-glyph:sh-out glyph `target) all-state]
[(show-glyph:sh-out glyph `target) state]
:: +unbind-glyph: remove all binding for glyph
::
++ unbind-glyph
|= [=glyph targ=(unit target)]
^- (quip card state)
^- (quip card _state)
?^ targ
=. binds (~(del ju binds) glyph u.targ)
=. bound (~(del by bound) u.targ)
[(show-glyph:sh-out glyph ~) all-state]
[(show-glyph:sh-out glyph ~) state]
=/ ole=(set target)
(~(get ju binds) glyph)
=. binds (~(del by binds) glyph)
@ -311,7 +387,7 @@
=. bound $(ole l.ole)
=. bound $(ole r.ole)
(~(del by bound) n.ole)
[(show-glyph:sh-out glyph ~) all-state]
[(show-glyph:sh-out glyph ~) state]
:: +decode-glyph: find the target that matches a glyph, if any
::
++ decode-glyph
@ -334,12 +410,12 @@
::
++ read-envelope
|= [=target =envelope]
^- (quip card state)
^- (quip card _state)
?: (~(has in known) [target uid.envelope])
::NOTE we no-op only because edits aren't possible
[~ all-state]
[~ state]
:- (show-envelope:sh-out target envelope)
%_ all-state
%_ state
known (~(put in known) [target uid.envelope])
grams [[target envelope] grams]
count +(count)
@ -354,10 +430,10 @@
::
++ sole
|= act=sole-action:sole-sur
^- (quip card state)
^- (quip card _state)
?- -.dat.act
%det (edit +.dat.act)
%clr [~ all-state]
%clr [~ state]
%ret obey
%tab (tab +.dat.act)
==
@ -368,7 +444,7 @@
[%join leaf+";join ~ship/chat-name (glyph)"]
[%leave leaf+";leave ~ship/chat-name"]
::
::[%create leaf+";create [type] /chat-name (glyph)"]
[%create leaf+";create [type] /chat-name (glyph)"]
[%delete leaf+";delete /chat-name"]
[%invite leaf+";invite /chat-name ~ships"]
[%banish leaf+";banish /chat-name ~ships"]
@ -386,18 +462,18 @@
==
++ tab
|= pos=@ud
^- (quip card state)
^- (quip card _state)
?: ?| =(~ buf.state.cli)
!=(';' -.buf.state.cli)
==
:_ all-state
:_ state
[(effect:sh-out [%bel ~]) ~]
::
=+ (get-id:auto pos (tufa buf.state.cli))
=/ needle=term
(fall id '')
?: &(!=(pos 1) =(0 (met 3 needle)))
[~ all-state] :: autocomplete empty command iff user at start of command
[~ state] :: autocomplete empty command iff user at start of command
=/ options=(list (option:auto tank))
(search-prefix:auto needle tab-list)
=/ advance=term
@ -410,9 +486,9 @@
=? moves ?=(^ options)
[(tab:sh-out options) moves]
=| fxs=(list sole-effect:sole-sur)
|- ^- (quip card state)
|- ^- (quip card _state)
?~ to-send
[(flop moves) all-state]
[(flop moves) state]
=^ char state.cli
(~(transmit sole-lib state.cli) [%ins send-pos `@c`i.to-send])
%_ $
@ -427,17 +503,17 @@
::
++ edit
|= cal=sole-change:sole-sur
^- (quip card state)
^- (quip card _state)
=^ inv state.cli (~(transceive sole-lib state.cli) cal)
=+ fix=(sanity inv buf.state.cli)
?~ lit.fix
[~ all-state]
[~ state]
:: just capital correction
?~ err.fix
(slug fix)
:: allow interior edits and deletes
?. &(?=($del -.inv) =(+(p.inv) (lent buf.state.cli)))
[~ all-state]
[~ state]
(slug fix)
:: +sanity: check input sanity
::
@ -454,13 +530,13 @@
::
++ slug
|= [lit=(list sole-edit:sole-sur) err=(unit @u)]
^- (quip card state)
?~ lit [~ all-state]
^- (quip card _state)
?~ lit [~ state]
=^ lic state.cli
%- ~(transmit sole-lib state.cli)
^- sole-edit:sole-sur
?~(t.lit i.lit [%mor lit])
:_ all-state
:_ state
:_ ~
%+ effect:sh-out %mor
:- [%det lic]
@ -477,18 +553,18 @@
;~ pose
(stag %target tars)
::
:: ;~ (glue ace)
:: (tag %create)
:: security
:: ;~ plug
:: path
:: (punt ;~(pfix ace glyph))
:: (punt ;~(pfix ace (fuss 'y' 'n')))
:: ==
:: ==
:: ;~((glue ace) (tag %delete) path)
:: ;~((glue ace) (tag %invite) path ships)
:: ;~((glue ace) (tag %banish) path ships)
;~ (glue ace)
(tag %create)
security
;~ plug
path
(punt ;~(pfix ace glyph))
(punt ;~(pfix ace (fuss 'y' 'n')))
==
==
;~((glue ace) (tag %delete) path)
;~((glue ace) (tag %invite) tarx ships)
;~((glue ace) (tag %banish) tarx ships)
::
;~ (glue ace)
(tag %join)
@ -508,6 +584,7 @@
;~((glue ace) (tag %set) flag)
;~((glue ace) (tag %unset) flag)
;~(plug (cold %width (jest 'set width ')) dem:ag)
::
;~ plug
(cold %timezone (jest 'set timezone '))
;~ pose
@ -554,10 +631,13 @@
::
++ tag |*(a=@tas (cold a (jest a))) ::TODO into stdlib
++ ship ;~(pfix sig fed:ag)
++ path ;~(pfix net (most net urs:ab))
++ path ;~(pfix net ;~(plug urs:ab (easy ~))) ::NOTE short only, tmp
:: +tarl: local target, as /path
::
++ tarl (stag our-self path)
:: +tarx: local target, maybe group
::
++ tarx ;~(plug (fuss 'group ' '') path)
:: +tarp: sponsor target, as ^/path
::
++ tarp
@ -567,9 +647,14 @@
::
++ targ
;~ pose
tarl
tarp
;~(plug ship path)
;~ plug
(fuss 'group ' '')
;~ pose
tarl
tarp
;~(plug ship path)
==
==
(sear decode-glyph glyph)
==
:: +tars: set of comma-separated targs
@ -586,7 +671,7 @@
:: +security: security mode
::
++ security
(perk %channel %village ~)
(perk %channel %village-with-group %village ~)
::
:: +glyph: shorthand character
::
@ -653,16 +738,16 @@
:: the command (if any) gets echoed to the user.
::
++ obey
^- (quip card state)
^- (quip card _state)
=+ buf=buf.state.cli
=+ fix=(sanity [%nop ~] buf)
?^ lit.fix
(slug fix)
=+ jub=(rust (tufa buf) read)
?~ jub [[(effect:sh-out %bel ~) ~] all-state]
?~ jub [[(effect:sh-out %bel ~) ~] state]
=^ cal state.cli (~(transmit sole-lib state.cli) [%set ~])
=^ cards all-state (work u.jub)
:_ all-state
=^ cards state (work u.jub)
:_ state
%+ weld
^- (list card)
:: echo commands into scrollback
@ -677,13 +762,13 @@
::
++ work
|= job=command
^- (quip card state)
^- (quip card _state)
|^ ?- -.job
%target (set-target +.job)
%say (say +.job)
%eval (eval +.job)
::
:: %create (create +.job)
%create (create +.job)
%delete (delete +.job)
%invite (change-permission & +.job)
%banish (change-permission | +.job)
@ -734,116 +819,124 @@
:^ %invite /chat
(shax (jam [our-self where] who))
^- invite
=; desc=cord
[our-self %chat-hook where who desc]
%- crip
%+ weld
"You have been invited to chat at "
~(full tr [our-self where])
[our-self %chat-hook where who '']
==
:: +set-target: set audience, update prompt
::
++ set-target
|= tars=(set target)
^- (quip card state)
^- (quip card _state)
=. audience tars
[[prompt:sh-out ~] all-state]
[[prompt:sh-out ~] state]
:: +create: new local mailbox
::
::++ create
:: |= [security=nu-security =path gyf=(unit char) allow-history=(unit ?)]
:: ^- (quip card state)
:: ::TODO check if already exists
:: =/ =target [our-self path]
:: =. audience [target ~ ~]
:: =^ moz all-state
:: ?. ?=(^ gyf) [~ all-state]
:: (bind-glyph u.gyf target)
:: =- [[- moz] all-state]
:: %^ act %do-create %chat-view
:: :- %chat-view-action
:: !> ^- chat-view-action
:: :* %create
:: path
:: security
:: :: ensure we can read from/write to our own chats
:: ::
:: ?- security
:: %channel ~
:: %village [our-self ~ ~]
:: ==
:: (fall allow-history %.y)
:: ==
++ create
|= [security=nu-security =path gyf=(unit char) allow-history=(unit ?)]
^- (quip card _state)
=/ with-group=? ?=(%village-with-group security)
=/ =target [with-group our-self path]
=/ real-path=^path (target-to-path target)
=/ =rw-security
?- security
%channel %channel
?(%village %village-with-group) %village
==
?^ (scry-for (unit mailbox) %chat-store [%mailbox real-path])
=- [[- ~] state]
%- print:sh-out
"{(spud path)} already exists!"
=. audience [target ~ ~]
=^ moz state
?. ?=(^ gyf) [~ state]
(bind-glyph u.gyf target)
=- [[- moz] state]
%^ act %do-create %chat-view
:- %chat-view-action
!> ^- chat-view-action
:* %create
(rsh 3 1 (spat path))
''
real-path :: chat
real-path :: group
rw-security
~
(fall allow-history %.y)
==
:: +delete: delete local chats
::
++ delete
|= =path
^- (quip card state)
=- [[- ~] all-state]
^- (quip card _state)
=- [[- ~] state]
%^ act %do-delete %chat-view
:- %chat-view-action
!> ^- chat-view-action
[%delete (target-to-path our-self path)]
[%delete (target-to-path | our-self path)]
:: +change-permission: modify permissions on a local chat
::
++ change-permission
|= [allow=? =path ships=(set ship)]
^- (quip card state)
:_ all-state
=; card=(unit card)
%+ weld (drop card)
|= [allow=? [group=? =path] ships=(set ship)]
^- (quip card _state)
:_ state
=/ real-path=^path
(target-to-path group our-self path)
=; permit=(unit card)
%+ weld (drop permit)
?. allow ~
%+ turn ~(tap in ships)
(cury invite-card path)
=. path
[%chat (target-to-path our-self path)]
^- (list card)
%+ murn ~(tap in ships)
|= =ship
^- (unit card)
:: if they weren't permitted before, some hook will send an invite.
:: but if they already were, we want to send an invite ourselves.
::
?. %^ scry-for ?
%permission-store
[%permitted (scot %p ship) real-path]
~
`(invite-card real-path ship)
:: whitelist: empty if no matching permission, else true if whitelist
::
=/ whitelist=(unit ?)
=; perm=(unit permission)
?~(perm ~ `?=(%white kind.u.perm))
::TODO +permission-of-target?
.^ (unit permission)
%gx
(scot %p our-self)
%permission-store
(scot %da now.bowl)
%permission
(snoc path %noun)
==
%^ scry-for (unit permission)
%permission-store
[%permission real-path]
?~ whitelist
~& [%weird-no-permission path]
~& [%weird-no-permission real-path]
~
%- some
%^ act %do-permission %group-store
:- %group-action
!> ^- group-action
?: =(u.whitelist allow)
[%add ships path]
[%remove ships path]
[%add ships real-path]
[%remove ships real-path]
:: +join: sync with remote mailbox
::
++ join
|= [=target gyf=(unit char) ask-history=(unit ?)]
^- (quip card state)
=^ moz all-state
?. ?=(^ gyf) [~ all-state]
^- (quip card _state)
=^ moz state
?. ?=(^ gyf) [~ state]
(bind-glyph u.gyf target)
=. audience [target ~ ~]
=; =card
[[card prompt:sh-out moz] all-state]
[[card prompt:sh-out moz] state]
::TODO ideally we'd check permission first. attempting this and failing
:: gives ugly %chat-hook-reap
%^ act %do-join %chat-view
:- %chat-view-action
!> ^- chat-view-action
[%join ship.target path.target (fall ask-history %.y)]
[%join ship.target (target-to-path target) (fall ask-history %.y)]
:: +leave: unsync & destroy mailbox
::
::TODO allow us to "mute" local chats using this
++ leave
|= =target
=- [[- ~] all-state]
=- [[- ~] state]
?: =(our-self ship.target)
%- print:sh-out
"can't ;leave local chats, maybe use ;delete instead"
@ -855,10 +948,10 @@
::
++ say
|= =letter
^- (quip card state)
^- (quip card _state)
~! bowl
=/ =serial (shaf %msg-uid eny.bowl)
:_ all-state(eny (shax eny.bowl))
:_ state(eny (shax eny.bowl))
^- (list card)
%+ turn ~(tap in audience)
|= =target
@ -878,8 +971,8 @@
::
++ lookup-glyph
|= qur=(unit $@(glyph target))
^- (quip card state)
=- [[- ~] all-state]
^- (quip card _state)
=- [[- ~] state]
?^ qur
?^ u.qur
=+ gyf=(~(get by bound) u.qur)
@ -903,8 +996,8 @@
:: +show-settings: print enabled flags, timezone and width settings
::
++ show-settings
^- (quip card state)
:_ all-state
^- (quip card _state)
:_ state
:~ %- print:sh-out
%- zing
^- (list tape)
@ -924,24 +1017,24 @@
::
++ set-setting
|= =term
^- (quip card state)
[~ all-state(settings (~(put in settings) term))]
^- (quip card _state)
[~ state(settings (~(put in settings) term))]
:: +unset-setting: disable settings flag
::
++ unset-setting
|= =term
^- (quip card state)
[~ all-state(settings (~(del in settings) term))]
^- (quip card _state)
[~ state(settings (~(del in settings) term))]
:: +set-width: configure cli printing width
::
++ set-width
|= w=@ud
[~ all-state(width w)]
[~ state(width w)]
:: +set-timezone: configure timestamp printing adjustment
::
++ set-timezone
|= tz=[? @ud]
[~ all-state(timez tz)]
[~ state(timez tz)]
:: +select: expand message from number reference
::
++ select
@ -950,7 +1043,7 @@
:: (with leading zeros used for precision)
::
|= num=$@(rel=@ud [zeros=@u abs=@ud])
^- (quip card state)
^- (quip card _state)
|^ ?@ num
=+ tum=(scow %s (new:si | +(num)))
?: (gte rel.num count)
@ -968,7 +1061,7 @@
::
++ just-print
|= txt=tape
[[(print:sh-out txt) ~] all-state]
[[(print:sh-out txt) ~] state]
:: +index: get message index from absolute reference
::
++ index
@ -982,10 +1075,10 @@
::
++ activate
|= [number=tape index=@ud]
^- (quip card state)
^- (quip card _state)
=+ gam=(snag index grams)
=. audience [source.gam ~ ~]
:_ all-state
:_ state
^- (list card)
:~ (print:sh-out ['?' ' ' number])
(effect:sh-out ~(render-activate mr gam))
@ -995,17 +1088,14 @@
:: +chats: display list of local mailboxes
::
++ chats
^- (quip card state)
:_ all-state
^- (quip card _state)
:_ state
:_ ~
%- print-more:sh-out
=/ all
::TODO refactor
::TODO remote scries fail... but moon support?
.^ (set path)
%gx
/(scot %p our-self)/chat-store/(scot %da now.bowl)/keys/noun
==
%^ scry-for (set path)
%chat-store
/keys
%+ turn ~(tap in all)
%+ cork path-to-target
|= target
@ -1013,8 +1103,8 @@
:: +help: print (link to) usage instructions
::
++ help
^- (quip card state)
=- [[- ~] all-state]
^- (quip card _state)
=- [[- ~] state]
(print:sh-out "see https://urbit.org/using/operations/using-your-ship/#messaging")
--
--
@ -1131,6 +1221,14 @@
%+ weld "set: {[glyph ~]} "
?~ target "unbound"
~(phat tr u.target)
:: +show-invite: print incoming invite notification
::
++ show-invite
|= invite
^- card
%- note
%+ weld "invited to: "
~(phat tr (path-to-target path))
--
::
:: +tr: render targets
@ -1164,17 +1262,21 @@
::
++ full
^- tape
(weld (scow %p ship.one) (spud path.one))
;: weld
?:(in-group.one "g " "")
(scow %p ship.one)
(spud path.one)
==
:: +phat: render target with local shorthand
::
:: renders as ~ship/path.
:: for local mailboxes, renders just /path.
:: for sponsor's mailboxes, renders ^/path.
::
::NOTE but, given current implementation, all will be local
::
++ phat
^- tape
%+ weld
?:(in-group.one "g " "")
%+ weld
?: =(our-self ship.one) ~
?: =((sein:title our.bowl now.bowl our-self) ship.one) "^"
@ -1379,4 +1481,16 @@
[(sub wid u.ace) &]
:- (tufa (scag end `(list @)`txt))
$(txt (slag ?:(nex +(end) end) `tape`txt))
::
::NOTE anything that uses this breaks moons support, because moons don't sync
:: full app state rn
++ scry-for
|* [=mold app=term =path]
.^ mold
%gx
(scot %p our.bowl)
app
(scot %da now.bowl)
(snoc `^path`path %noun)
==
--