mirror of
https://github.com/urbit/shrub.git
synced 2024-12-19 08:32:39 +03:00
6fd942e5fd
Makes chat-cli listen to graph-store rather than chat-store. Along the way, cuts some features. No longer supports channel creation, deletion, permission management or inviting. No longer lets you send messages to multiple targets at once. No longer displays messages from all joined chats, and no longer lets you join or leave chats. Instead, chat-cli solely concerns itself with viewing chat content you're already subscribed to (through use of Landscape or other rich clients). ;view ~host/chat to start printing messages for that chat when they come in, ;flee to toggle off. ;view to see what chats are enabled, ;chats to see all available chats. The removal of features acknowledges chat-cli's lack of real support for the modern, group-centric state of userspace. The intent of ;view ux is to prepare chat-cli for a multi-session terminal world.
1166 lines
32 KiB
Plaintext
1166 lines
32 KiB
Plaintext
:: chat-cli: cli chat client using chat-store and friends
|
|
::
|
|
:: pulls all known messages into a single stream.
|
|
:: type ;help for usage instructions.
|
|
::
|
|
:: note that while the chat-store only cares about paths,
|
|
:: we mostly deal with [ship path] (aka target) here.
|
|
:: when sending messages (through the chat hook),
|
|
:: we concat the ship onto the head of the path,
|
|
:: and trust it to take care of the rest.
|
|
::
|
|
/- *resource, post,
|
|
store=chat-store
|
|
/+ shoe, default-agent, verb, dbug,
|
|
graph=graph-store, libgraph=graph
|
|
::
|
|
|%
|
|
+$ card card:shoe
|
|
::
|
|
+$ versioned-state
|
|
$% state-3
|
|
state-2
|
|
state-1
|
|
state-0
|
|
==
|
|
::
|
|
+$ state-3
|
|
$: %3
|
|
::TODO support multiple sessions
|
|
:: sessions=(map sole-id session) :: sole sessions
|
|
$: viewing=(set resource) :: connected graphs
|
|
history=(list uid:post) :: scrollback pointers
|
|
count=@ud :: (lent history)
|
|
audience=target :: active target
|
|
==
|
|
bound=(map resource glyph) :: bound resource glyphs
|
|
binds=(jug glyph resource) :: resource glyph lookup
|
|
settings=(set term) :: frontend flags
|
|
width=@ud :: display width
|
|
timez=(pair ? @ud) :: timezone adjustment
|
|
==
|
|
::
|
|
::TODO remove for breach
|
|
+$ target-2 [in-group=? =ship =path]
|
|
+$ mail [source=target-2 envelope:store]
|
|
+$ state-2
|
|
$: %2
|
|
grams=(list mail) :: all messages
|
|
known=(set [target-2 serial:store]) :: known message lookup
|
|
count=@ud :: (lent grams)
|
|
bound=(map target-2 glyph) :: bound circle glyphs
|
|
binds=(jug glyph target-2) :: circle glyph lookup
|
|
audience=(set target-2) :: active targets
|
|
settings=(set term) :: frontend flags
|
|
width=@ud :: display width
|
|
timez=(pair ? @ud) :: timezone adjustment
|
|
==
|
|
::
|
|
+$ state-1
|
|
$: %1
|
|
grams=(list mail) :: all messages
|
|
known=(set [target-2 serial:store]) :: known message lookup
|
|
count=@ud :: (lent grams)
|
|
bound=(map target-2 glyph) :: bound circle glyphs
|
|
binds=(jug glyph target-2) :: circle glyph lookup
|
|
audience=(set target-2) :: active targets
|
|
settings=(set term) :: frontend flags
|
|
width=@ud :: display width
|
|
timez=(pair ? @ud) :: timezone adjustment
|
|
cli=state=sole-share:shoe :: console state
|
|
eny=@uvJ :: entropy
|
|
==
|
|
::
|
|
+$ state-0
|
|
$: grams=(list [[=ship =path] envelope:store]) :: all messages
|
|
known=(set [[=ship =path] serial:store]) :: 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:shoe :: console state
|
|
eny=@uvJ :: entropy
|
|
==
|
|
::
|
|
+$ target resource
|
|
::
|
|
+$ glyph char
|
|
++ glyphs "!@#$%^&()-=_+[]\{}'\\:\",.<>?"
|
|
::
|
|
+$ command
|
|
$% [%target target] :: set messaging target
|
|
[%say content:post] :: send message
|
|
[%eval cord hoon] :: send #-message
|
|
:: ::
|
|
[%view $?(~ target)] :: notice chat
|
|
[%flee target] :: ignore chat
|
|
:: ::
|
|
[%bind glyph target] :: bind glyph
|
|
[%unbind glyph (unit target)] :: unbind glyph
|
|
[%what (unit $@(char target))] :: glyph lookup
|
|
:: ::
|
|
[%settings ~] :: show active settings
|
|
[%set term] :: set settings flag
|
|
[%unset term] :: unset settings flag
|
|
[%width @ud] :: adjust display width
|
|
[%timezone ? @ud] :: adjust time printing
|
|
:: ::
|
|
[%select $@(rel=@ud [zeros=@u abs=@ud])] :: rel/abs msg selection
|
|
[%chats ~] :: list available chats
|
|
[%help ~] :: print usage info
|
|
== ::
|
|
::
|
|
--
|
|
=| state-3
|
|
=* state -
|
|
::
|
|
%- agent:dbug
|
|
%+ verb |
|
|
%- (agent:shoe command)
|
|
^- (shoe:shoe command)
|
|
=<
|
|
|_ =bowl:gall
|
|
+* this .
|
|
talk-core +>
|
|
tc ~(. talk-core bowl)
|
|
def ~(. (default-agent this %|) bowl)
|
|
des ~(. (default:shoe this command) bowl)
|
|
::
|
|
++ on-init
|
|
^- (quip card _this)
|
|
=^ cards state (prep:tc ~)
|
|
[cards this]
|
|
::
|
|
++ on-save !>(state)
|
|
::
|
|
++ on-load
|
|
|= old-state=vase
|
|
^- (quip card _this)
|
|
=/ old !<(versioned-state old-state)
|
|
=^ cards state (prep:tc `old)
|
|
[cards this]
|
|
::
|
|
++ on-poke
|
|
|= [=mark =vase]
|
|
^- (quip card _this)
|
|
=^ cards state
|
|
?+ mark (on-poke:def mark vase)
|
|
%noun (poke-noun:tc !<(* vase))
|
|
==
|
|
[cards this]
|
|
::
|
|
++ on-agent
|
|
|= [=wire =sign:agent:gall]
|
|
^- (quip card _this)
|
|
=^ cards state
|
|
?- -.sign
|
|
%poke-ack [- state]:(on-agent:def wire sign)
|
|
%watch-ack [- state]:(on-agent:def wire sign)
|
|
::
|
|
%kick
|
|
:_ state
|
|
?+ wire ~
|
|
[%graph-store ~] ~[connect:tc]
|
|
==
|
|
::
|
|
%fact
|
|
?+ p.cage.sign ~|([dap.bowl %bad-sub-mark wire p.cage.sign] !!)
|
|
%graph-update
|
|
%- on-graph-update:tc
|
|
!<(update:graph q.cage.sign)
|
|
==
|
|
==
|
|
[cards this]
|
|
::
|
|
++ on-watch on-watch:def
|
|
++ on-leave on-leave:def
|
|
++ on-peek on-peek:def
|
|
++ on-arvo on-arvo:def
|
|
++ on-fail on-fail:def
|
|
::
|
|
++ command-parser
|
|
|= sole-id=@ta
|
|
parser:sh:tc
|
|
::
|
|
++ tab-list
|
|
|= sole-id=@ta
|
|
tab-list:sh:tc
|
|
::
|
|
++ on-command
|
|
|= [sole-id=@ta =command]
|
|
=^ cards state
|
|
(work:sh:tc command)
|
|
[cards this]
|
|
::
|
|
++ on-connect
|
|
|= sole-id=@ta
|
|
^- (quip card _this)
|
|
[[prompt:sh-out:tc ~] this]
|
|
::
|
|
++ can-connect can-connect:des
|
|
++ on-disconnect on-disconnect:des
|
|
--
|
|
::
|
|
|_ =bowl:gall
|
|
+* libgraph ~(. ^libgraph bowl)
|
|
:: +prep: setup & state adapter
|
|
::
|
|
++ prep
|
|
|= old=(unit versioned-state)
|
|
^- (quip card _state)
|
|
?~ old
|
|
[~[connect] state]
|
|
::
|
|
=? u.old ?=(?(~ ^) -.u.old)
|
|
^- state-1
|
|
:- %1
|
|
%= u.old
|
|
grams ~ ::NOTE this only impacts historic message lookup in chat-cli
|
|
::
|
|
known
|
|
^- (set [target-2 serial:store])
|
|
%- ~(run in known.u.old)
|
|
|= [t=[ship path] s=serial:store]
|
|
[`target-2`[| t] s]
|
|
::
|
|
bound
|
|
^- (map target-2 glyph)
|
|
%- ~(gas by *(map target-2 glyph))
|
|
%+ turn ~(tap by bound.u.old)
|
|
|= [t=[ship path] g=glyph]
|
|
[`target-2`[| t] g]
|
|
::
|
|
binds
|
|
^- (jug glyph target-2)
|
|
%- ~(run by binds.u.old)
|
|
|= s=(set [ship path])
|
|
%- ~(run in s)
|
|
|= t=[ship path]
|
|
`target-2`[| t]
|
|
::
|
|
audience
|
|
^- (set target-2)
|
|
%- ~(run in audience.u.old)
|
|
|= t=[ship path]
|
|
`target-2`[| t]
|
|
==
|
|
::
|
|
=? u.old ?=(%1 -.u.old)
|
|
^- state-2
|
|
=, u.old
|
|
:* %2
|
|
grams known count
|
|
bound binds audience
|
|
settings width timez
|
|
==
|
|
::
|
|
=^ cards u.old
|
|
?. ?=(%2 -.u.old) [~ u.old]
|
|
:- :~ [%pass /chat-store %agent [our-self %chat-store] %leave ~]
|
|
[%pass /invites %agent [our.bowl %invite-store] %leave ~]
|
|
==
|
|
^- state-3
|
|
:- %3
|
|
:* :* viewing ~ 0
|
|
::
|
|
?~ audience.u.old *target
|
|
[ship ?~(path %$ i.path)]:n.audience.u.old
|
|
==
|
|
::
|
|
%- ~(gas by *(map resource glyph))
|
|
%+ turn ~(tap in bound.u.old)
|
|
|= [t=target-2 g=glyph]
|
|
[[ship.t ?~(path.t %$ i.path.t)] g]
|
|
::
|
|
^- (jug glyph resource)
|
|
%- ~(run by binds.u.old)
|
|
|= s=(set target-2)
|
|
%- ~(run in s)
|
|
|= t=target-2
|
|
[ship.t ?~(path.t %$ i.path.t)]
|
|
::
|
|
settings.u.old
|
|
width.u.old
|
|
timez.u.old
|
|
==
|
|
::
|
|
?> ?=(%3 -.u.old)
|
|
:_ u.old
|
|
?: %- ~(has by wex.bowl)
|
|
[/graph-store our-self %graph-store]
|
|
~
|
|
~[connect]
|
|
:: +connect: connect to the graph-store
|
|
::
|
|
++ connect
|
|
^- card
|
|
[%pass /graph-store %agent [our-self %graph-store] %watch /updates]
|
|
::
|
|
::TODO better moon support. (name:title our.bowl)
|
|
++ our-self our.bowl
|
|
:: +tor: term ordering for targets
|
|
::
|
|
++ tor
|
|
|= [[* a=term] [* b=term]]
|
|
(aor a b)
|
|
:: +ior: index ordering for nodes
|
|
::
|
|
++ ior
|
|
|= [[a=index:post *] [b=index:post *]]
|
|
(aor a b)
|
|
:: +safe-get-graph: virtualized +get-graph
|
|
::
|
|
++ safe-get-graph
|
|
|= =resource
|
|
^- (unit update:graph)
|
|
=/ res=(each update:graph tang)
|
|
::TODO doesn't actually contain the crash?
|
|
%- mule |.
|
|
(get-graph:libgraph resource)
|
|
?- -.res
|
|
%& `p.res
|
|
%| ~
|
|
==
|
|
:: +is-chat-graph: check whether graph contains chat-style data
|
|
::
|
|
++ is-chat-graph
|
|
|= =resource
|
|
^- ?
|
|
=/ update=(unit update:graph)
|
|
(safe-get-graph resource)
|
|
?~ update |
|
|
?> ?=(%add-graph -.q.u.update)
|
|
=(`%graph-validator-chat mark.q.u.update)
|
|
:: +poke-noun: debug helpers
|
|
::
|
|
++ poke-noun
|
|
|= a=*
|
|
^- (quip card _state)
|
|
?: ?=(%connect a)
|
|
[[connect ~] state]
|
|
[~ state]
|
|
:: +handle-graph-update: get new mailboxes & messages
|
|
::
|
|
++ on-graph-update
|
|
|= upd=update:graph
|
|
^- (quip card _state)
|
|
?+ -.q.upd [~ state]
|
|
%remove-graph (notice-remove +.q.upd)
|
|
::
|
|
%add-nodes
|
|
?. (~(has in viewing) resource.q.upd)
|
|
[~ state]
|
|
%+ read-posts resource.q.upd
|
|
(sort ~(tap by nodes.q.upd) ior)
|
|
==
|
|
::
|
|
++ read-posts
|
|
|= [=target nodes=(list [=index:post =node:graph])]
|
|
^- (quip card _state)
|
|
=^ cards nodes
|
|
^- (quip card _nodes)
|
|
=+ count=(lent nodes)
|
|
?. (gth count 10) [~ nodes]
|
|
:_ (swag [(sub count 10) 10] nodes)
|
|
[(print:sh-out "skipping {(scow %ud (sub count 10))} messages...")]~
|
|
|-
|
|
?~ nodes [cards state]
|
|
=^ caz state (read-post target [index post.node]:i.nodes)
|
|
$(cards (weld cards caz), nodes t.nodes)
|
|
::
|
|
:: +read-post: add envelope to state and show it to user
|
|
::
|
|
++ read-post
|
|
|= [=target =index:post =post:post]
|
|
^- (quip card _state)
|
|
:- (show-post:sh-out target post)
|
|
%_ state
|
|
history [[target index] history]
|
|
count +(count)
|
|
==
|
|
::
|
|
++ notice-remove
|
|
|= =target
|
|
^- (quip card _state)
|
|
:- [(show-delete:sh-out target) ~]
|
|
state(viewing (~(del in viewing) target))
|
|
::
|
|
:: +bind-default-glyph: bind to default, or random available
|
|
::
|
|
++ bind-default-glyph
|
|
|= =target
|
|
^- (quip card _state)
|
|
=; =glyph (bind-glyph glyph target)
|
|
|^ =/ g=glyph (choose glyphs)
|
|
?. (~(has by binds) g) g
|
|
=/ available=(list glyph)
|
|
%~ tap in
|
|
(~(dif in `(set glyph)`(sy glyphs)) ~(key by binds))
|
|
?~ available g
|
|
(choose available)
|
|
++ choose
|
|
|= =(list glyph)
|
|
=; i=@ud (snag i list)
|
|
(mod (mug target) (lent list))
|
|
--
|
|
:: +bind-glyph: add binding for glyph
|
|
::
|
|
++ bind-glyph
|
|
|= [=glyph =target]
|
|
^- (quip card _state)
|
|
::TODO should send these to settings store eventually
|
|
:: if the target was already bound to another glyph, un-bind that
|
|
::
|
|
=? binds (~(has by bound) target)
|
|
(~(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) state]
|
|
:: +unbind-glyph: remove all binding for glyph
|
|
::
|
|
++ unbind-glyph
|
|
|= [=glyph targ=(unit target)]
|
|
^- (quip card _state)
|
|
?^ targ
|
|
=. binds (~(del ju binds) glyph u.targ)
|
|
=. bound (~(del by bound) u.targ)
|
|
[(show-glyph:sh-out glyph ~) state]
|
|
=/ ole=(set target)
|
|
(~(get ju binds) glyph)
|
|
=. binds (~(del by binds) glyph)
|
|
=. bound
|
|
|-
|
|
?~ ole bound
|
|
=. bound $(ole l.ole)
|
|
=. bound $(ole r.ole)
|
|
(~(del by bound) n.ole)
|
|
[(show-glyph:sh-out glyph ~) state]
|
|
:: +decode-glyph: find the target that matches a glyph, if any
|
|
::
|
|
++ decode-glyph
|
|
|= =glyph
|
|
^- (unit target)
|
|
=+ lax=(~(get ju binds) glyph)
|
|
:: no target
|
|
?: =(~ lax) ~
|
|
%- some
|
|
:: single target
|
|
?: ?=([* ~ ~] lax) n.lax
|
|
:: in case of multiple matches, pick one we're viewing
|
|
=. lax (~(uni in lax) viewing)
|
|
?: ?=([* ~ ~] lax) n.lax
|
|
:: in case of multiple audiences, pick the most recently active one
|
|
|- ^- target
|
|
?~ history -:~(tap in lax)
|
|
=* resource resource.i.history
|
|
?: (~(has in lax) resource)
|
|
resource
|
|
$(history t.history)
|
|
::
|
|
:: +sh: shoe handling
|
|
::
|
|
++ sh
|
|
|%
|
|
:: +read: command parser
|
|
::
|
|
:: parses the command line buffer.
|
|
:: produces commands which can be executed by +work.
|
|
::
|
|
++ parser
|
|
|^
|
|
%+ stag |
|
|
%+ knee *command |. ~+
|
|
=- ;~(pose ;~(pfix mic -) message)
|
|
;~ pose
|
|
(stag %target targ)
|
|
::
|
|
;~((glue ace) (tag %view) targ)
|
|
;~((glue ace) (tag %flee) targ)
|
|
;~(plug (tag %view) (easy ~))
|
|
::
|
|
;~((glue ace) (tag %bind) glyph targ)
|
|
;~((glue ace) (tag %unbind) ;~(plug glyph (punt ;~(pfix ace targ))))
|
|
;~(plug (perk %what ~) (punt ;~(pfix ace ;~(pose glyph targ))))
|
|
::
|
|
;~(plug (tag %settings) (easy ~))
|
|
;~((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
|
|
(cold %| (just '-'))
|
|
(cold %& (just '+'))
|
|
==
|
|
%+ sear
|
|
|= a=@ud
|
|
^- (unit @ud)
|
|
?:(&((gte a 0) (lte a 14)) `a ~)
|
|
dem:ag
|
|
==
|
|
::
|
|
;~(plug (tag %chats) (easy ~))
|
|
;~(plug (tag %help) (easy ~))
|
|
::
|
|
(stag %select nump)
|
|
==
|
|
::
|
|
::TODO
|
|
:: ++ cmd
|
|
:: |* [cmd=term req=(list rule) opt=(list rule)]
|
|
:: |^ ;~ plug
|
|
:: (tag cmd)
|
|
:: ::
|
|
:: ::TODO this feels slightly too dumb
|
|
:: ?~ req
|
|
:: ?~ opt (easy ~)
|
|
:: (opt-rules opt)
|
|
:: ?~ opt (req-rules req)
|
|
:: ;~(plug (req-rules req) (opt-rules opt)) ::TODO rest-loop
|
|
:: ==
|
|
:: ++ req-rules
|
|
:: |* req=(lest rule)
|
|
:: =- ;~(pfix ace -)
|
|
:: ?~ t.req i.req
|
|
:: ;~(plug i.req $(req t.req))
|
|
:: ++ opt-rules
|
|
:: |* opt=(lest rule)
|
|
:: =- (punt ;~(pfix ace -))
|
|
:: ?~ t.opt ;~(pfix ace i.opt)
|
|
:: ;~(pfix ace ;~(plug i.opt $(opt t.opt)))
|
|
:: --
|
|
::
|
|
++ group ;~((glue fas) ship sym)
|
|
++ tag |*(a=@tas (cold a (jest a))) ::TODO into stdlib
|
|
++ ship ;~(pfix sig fed:ag)
|
|
++ name ;~(pfix fas urs:ab)
|
|
:: +tarl: local target, as /path
|
|
::
|
|
++ tarl (stag our-self name)
|
|
:: +targ: any target, as tarl, tarp, ~ship/path or glyph
|
|
::
|
|
++ targ
|
|
;~ pose
|
|
tarl
|
|
;~(plug ship name)
|
|
(sear decode-glyph glyph)
|
|
==
|
|
:: +tars: set of comma-separated targs
|
|
::
|
|
++ tars
|
|
%+ cook ~(gas in *(set target))
|
|
(most ;~(plug com (star ace)) targ)
|
|
:: +ships: set of comma-separated ships
|
|
::
|
|
++ ships
|
|
%+ cook ~(gas in *(set ^ship))
|
|
(most ;~(plug com (star ace)) ship)
|
|
:: +glyph: shorthand character
|
|
::
|
|
++ glyph (mask glyphs)
|
|
:: +flag: valid flag
|
|
::
|
|
++ flag
|
|
%- perk :~
|
|
%notify
|
|
%showtime
|
|
==
|
|
:: +nump: message number reference
|
|
::
|
|
++ nump
|
|
;~ pose
|
|
;~(pfix hep dem:ag)
|
|
;~ plug
|
|
(cook lent (plus (just '0')))
|
|
;~(pose dem:ag (easy 0))
|
|
==
|
|
(stag 0 dem:ag)
|
|
(cook lent (star mic))
|
|
==
|
|
:: +message: all messages
|
|
::
|
|
++ message
|
|
;~ pose
|
|
;~(plug (cold %eval hax) expr)
|
|
(stag %say content)
|
|
==
|
|
:: +content: simple messages
|
|
::TODO mentions
|
|
::
|
|
++ content
|
|
;~ pose
|
|
(stag %url turl)
|
|
(stag %text ;~(less mic hax text))
|
|
==
|
|
:: +turl: url parser
|
|
::
|
|
++ turl
|
|
=- (sear - text)
|
|
|= t=cord
|
|
^- (unit cord)
|
|
?~((rush t aurf:de-purl:html) ~ `t)
|
|
:: +text: text message body
|
|
::
|
|
++ text
|
|
%+ cook crip
|
|
(plus next)
|
|
:: +expr: parse expression into [cord hoon]
|
|
::
|
|
++ expr
|
|
|= tub=nail
|
|
%. tub
|
|
%+ stag (crip q.tub)
|
|
wide:(vang & [&1:% &2:% (scot %da now.bowl) |3:%])
|
|
--
|
|
:: +tab-list: command descriptions
|
|
::
|
|
++ tab-list
|
|
^- (list [@t tank])
|
|
:~
|
|
[';view' leaf+";view ~ship/chat-name (glyph)"]
|
|
[';flee' leaf+";flee ~ship/chat-name"]
|
|
::
|
|
[';bind' leaf+";bind [glyph] ~ship/chat-name"]
|
|
[';unbind' leaf+";unbind [glyph]"]
|
|
[';what' leaf+";what (~ship/chat-name) (glyph)"]
|
|
::
|
|
[';settings' leaf+";settings"]
|
|
[';set' leaf+";set key (value)"]
|
|
[';unset' leaf+";unset key"]
|
|
::
|
|
[';chats' leaf+";chats"]
|
|
[';help' leaf+";help"]
|
|
==
|
|
:: +work: run user command
|
|
::
|
|
++ work
|
|
|= job=command
|
|
^- (quip card _state)
|
|
|^ ?- -.job
|
|
%target (set-target +.job)
|
|
%say (say +.job)
|
|
%eval (eval +.job)
|
|
::
|
|
%view (view +.job)
|
|
%flee (flee +.job)
|
|
::
|
|
%bind (bind-glyph +.job)
|
|
%unbind (unbind-glyph +.job)
|
|
%what (lookup-glyph +.job)
|
|
::
|
|
%settings show-settings
|
|
%set (set-setting +.job)
|
|
%unset (unset-setting +.job)
|
|
%width (set-width +.job)
|
|
%timezone (set-timezone +.job)
|
|
::
|
|
%select (select +.job)
|
|
%chats chats
|
|
%help help
|
|
==
|
|
:: +act: build action card
|
|
::
|
|
++ act
|
|
|= [what=term app=term =cage]
|
|
^- card
|
|
:* %pass
|
|
/cli-command/[what]
|
|
%agent
|
|
[our-self app]
|
|
%poke
|
|
cage
|
|
==
|
|
:: +set-target: set audience, update prompt
|
|
::
|
|
++ set-target
|
|
|= =target
|
|
^- (quip card _state)
|
|
=. audience target
|
|
[[prompt:sh-out ~] state]
|
|
:: +view: start printing messages from a resource
|
|
::
|
|
++ view
|
|
|= target=$?(~ target)
|
|
^- (quip card _state)
|
|
:: without argument, print all we're viewing
|
|
::
|
|
?~ target
|
|
[[(show-chats:sh-out ~(tap in viewing))]~ state]
|
|
:: only view existing chat-type graphs
|
|
::
|
|
?. (is-chat-graph target)
|
|
[[(note:sh-out "no such chat")]~ state]
|
|
=^ cards state
|
|
?: (~(has by bound) target)
|
|
[~ state]
|
|
(bind-default-glyph target)
|
|
:- cards
|
|
state(viewing (~(put in viewing) target))
|
|
:: +flee: stop printing messages from a resource
|
|
::
|
|
++ flee
|
|
|= =target
|
|
^- (quip card _state)
|
|
[~ state(viewing (~(del in viewing) target))]
|
|
:: +say: send messages
|
|
::
|
|
++ say
|
|
|= msg=content:post
|
|
^- (quip card _state)
|
|
=/ =serial:store (shaf %msg-uid eny.bowl)
|
|
:_ state
|
|
:_ ~
|
|
::TODO move creation into lib?
|
|
%^ act %out-message
|
|
%graph-push-hook
|
|
:- %graph-update
|
|
!> ^- update:graph
|
|
:+ %0 now.bowl
|
|
:+ %add-nodes audience
|
|
%- ~(put by *(map index:post node:graph))
|
|
:- ~[now.bowl]
|
|
:_ *internal-graph:graph
|
|
^- post:post
|
|
[our-self ~[now.bowl] now.bowl [msg]~ ~ ~]
|
|
:: +eval: run hoon, send code and result as message
|
|
::
|
|
:: this double-virtualizes and clams to disable .^ for security reasons
|
|
::
|
|
++ eval
|
|
|= [txt=cord exe=hoon]
|
|
~& %eval-tmp-disabled
|
|
[~ state]
|
|
::TODO why -find.eval??
|
|
:: (say %code txt (eval:store bowl exe))
|
|
:: +lookup-glyph: print glyph info for all, glyph or target
|
|
::
|
|
++ lookup-glyph
|
|
|= qur=(unit $@(glyph target))
|
|
^- (quip card _state)
|
|
=- [[- ~] state]
|
|
?^ qur
|
|
?^ u.qur
|
|
=+ gyf=(~(get by bound) u.qur)
|
|
(print:sh-out ?~(gyf "none" [u.gyf]~))
|
|
=+ pan=~(tap in (~(get ju binds) `@t`u.qur))
|
|
?: =(~ pan) (print:sh-out "~")
|
|
=< (effect:sh-out %mor (turn pan .))
|
|
|=(t=target [%txt ~(phat tr t)])
|
|
%- print-more:sh-out
|
|
%- ~(rep by binds)
|
|
|= $: [=glyph tars=(set target)]
|
|
lis=(list tape)
|
|
==
|
|
%+ weld lis
|
|
^- (list tape)
|
|
%- ~(rep in tars)
|
|
|= [t=target l=(list tape)]
|
|
%+ weld l
|
|
^- (list tape)
|
|
[glyph ' ' ~(phat tr t)]~
|
|
:: +show-settings: print enabled flags, timezone and width settings
|
|
::
|
|
++ show-settings
|
|
^- (quip card _state)
|
|
:_ state
|
|
:~ %- print:sh-out
|
|
%- zing
|
|
^- (list tape)
|
|
:- "flags: "
|
|
%+ join ", "
|
|
(turn `(list @t)`~(tap in settings) trip)
|
|
::
|
|
%- print:sh-out
|
|
%+ weld "timezone: "
|
|
^- tape
|
|
:- ?:(p.timez '+' '-')
|
|
(scow %ud q.timez)
|
|
::
|
|
(print:sh-out "width: {(scow %ud width)}")
|
|
==
|
|
:: +set-setting: enable settings flag
|
|
::
|
|
++ set-setting
|
|
|= =term
|
|
^- (quip card _state)
|
|
[~ state(settings (~(put in settings) term))]
|
|
:: +unset-setting: disable settings flag
|
|
::
|
|
++ unset-setting
|
|
|= =term
|
|
^- (quip card _state)
|
|
[~ state(settings (~(del in settings) term))]
|
|
:: +set-width: configure cli printing width
|
|
::
|
|
++ set-width
|
|
|= w=@ud
|
|
[~ state(width (max 40 w))]
|
|
:: +set-timezone: configure timestamp printing adjustment
|
|
::
|
|
++ set-timezone
|
|
|= tz=[? @ud]
|
|
[~ state(timez tz)]
|
|
:: +select: expand message from number reference
|
|
::
|
|
++ select
|
|
::NOTE rel is the nth most recent message,
|
|
:: abs is the last message whose numbers ends in n
|
|
:: (with leading zeros used for precision)
|
|
::
|
|
|= num=$@(rel=@ud [zeros=@u abs=@ud])
|
|
^- (quip card _state)
|
|
|^ ?@ num
|
|
=+ tum=(scow %s (new:si | +(num)))
|
|
?: (gte rel.num count)
|
|
%- just-print
|
|
"{tum}: no such telegram"
|
|
(activate tum rel.num)
|
|
?. (gte abs.num count)
|
|
?: =(count 0)
|
|
(just-print "0: no messages")
|
|
=+ msg=(index (dec count) num)
|
|
(activate (scow %ud msg) (sub count +(msg)))
|
|
%- just-print
|
|
"…{(reap zeros.num '0')}{(scow %ud abs.num)}: no such telegram"
|
|
:: +just-print: full [cards state] output with a single print card
|
|
::
|
|
++ just-print
|
|
|= txt=tape
|
|
[[(print:sh-out txt) ~] state]
|
|
:: +index: get message index from absolute reference
|
|
::
|
|
++ index
|
|
|= [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)))
|
|
:: +activate: echo message selector and print details
|
|
::
|
|
++ activate
|
|
|= [number=tape index=@ud]
|
|
^- (quip card _state)
|
|
::NOTE graph store allows node deletion, so can this crash?
|
|
=/ =uid:post (snag index history)
|
|
=/ =node:graph (got-node:libgraph uid)
|
|
:_ state(audience resource.uid)
|
|
^- (list card)
|
|
:~ (print:sh-out ['?' ' ' number])
|
|
(effect:sh-out ~(render-activate mr resource.uid post.node))
|
|
prompt:sh-out
|
|
==
|
|
--
|
|
:: +chats: display list of joined chats
|
|
::
|
|
++ chats
|
|
^- (quip card _state)
|
|
:_ state
|
|
:_ ~
|
|
%- show-chats:sh-out
|
|
(skim ~(tap in get-keys:libgraph) is-chat-graph)
|
|
:: +help: print (link to) usage instructions
|
|
::
|
|
++ help
|
|
^- (quip card _state)
|
|
:_ state
|
|
=- (turn - print:sh-out)
|
|
:~ ";view ~host/chat to print messages for a chat you've already jonied."
|
|
";flee ~host/chat to stop printing messages for a chat."
|
|
"For more details:"
|
|
"https://urbit.org/using/operations/using-your-ship/#messaging"
|
|
==
|
|
--
|
|
--
|
|
::
|
|
:: +sh-out: ouput to session
|
|
::
|
|
++ sh-out
|
|
|%
|
|
:: +effex: emit shoe effect card
|
|
::
|
|
++ effex
|
|
|= effect=shoe-effect:shoe
|
|
^- card
|
|
[%shoe ~ effect]
|
|
:: +effect: emit console effect card
|
|
::
|
|
++ effect
|
|
|= effect=sole-effect:shoe
|
|
^- card
|
|
(effex %sole effect)
|
|
:: +print: puts some text into the cli as-is
|
|
::
|
|
++ print
|
|
|= txt=tape
|
|
^- card
|
|
(effect %txt txt)
|
|
:: +print-more: puts lines of text into the cli
|
|
::
|
|
++ print-more
|
|
|= txs=(list tape)
|
|
^- card
|
|
%+ effect %mor
|
|
(turn txs |=(t=tape [%txt t]))
|
|
:: +note: prints left-padded ---| txt
|
|
::
|
|
++ note
|
|
|= txt=tape
|
|
^- card
|
|
=+ lis=(simple-wrap txt (sub width 16))
|
|
%- print-more
|
|
=+ ?:((gth (lent lis) 0) (snag 0 lis) "")
|
|
:- (runt [14 '-'] '|' ' ' -)
|
|
%+ turn (slag 1 lis)
|
|
|=(a=tape (runt [14 ' '] '|' ' ' a))
|
|
:: +prompt: update prompt to display current audience
|
|
::
|
|
++ prompt
|
|
^- card
|
|
%+ effect %pro
|
|
:+ & %talk-line
|
|
=+ ~(show tr audience)
|
|
?:(=(1 (lent -)) "{-} " "[{-}] ")
|
|
:: +show-post: print incoming message
|
|
::
|
|
:: every five messages, prints the message number also.
|
|
:: if the message mentions the user's (shortened) ship name,
|
|
:: and the %notify flag is set, emit a bell.
|
|
::
|
|
++ show-post
|
|
|= [=target =post:post]
|
|
^- (list card)
|
|
%+ weld
|
|
^- (list card)
|
|
?. =(0 (mod count 5)) ~
|
|
:_ ~
|
|
=+ num=(scow %ud count)
|
|
%- print
|
|
(runt [(sub 13 (lent num)) '-'] "[{num}]")
|
|
^- (list card)
|
|
:- (effex ~(render-inline mr target post))
|
|
=; mentioned=?
|
|
?. mentioned ~
|
|
[(effect %bel ~)]~
|
|
%+ lien contents.post
|
|
(cury test %mention our.bowl)
|
|
:: +show-create: print mailbox creation notification
|
|
::
|
|
++ show-create
|
|
|= =target
|
|
^- card
|
|
(note "new: {~(phat tr target)}")
|
|
:: +show-delete: print mailbox deletion notification
|
|
::
|
|
++ show-delete
|
|
|= =target
|
|
^- card
|
|
(note "del: {~(phat tr target)}")
|
|
:: +show-glyph: print glyph un/bind notification
|
|
::
|
|
++ show-glyph
|
|
|= [=glyph target=(unit target)]
|
|
^- (list card)
|
|
:_ [prompt ~]
|
|
%- note
|
|
%+ weld "set: {[glyph ~]} "
|
|
?~ target "unbound"
|
|
~(phat tr u.target)
|
|
:: +show-chats: print list of targets
|
|
::
|
|
++ show-chats
|
|
|= chats=(list target)
|
|
^- card
|
|
%- print-more:sh-out
|
|
%+ turn (sort chats tor)
|
|
|= resource
|
|
"{(nome:mr entity)}/{(trip name)}"
|
|
--
|
|
::
|
|
:: +tr: render targets (resource identifiers)
|
|
::
|
|
++ tr
|
|
|_ tr=target
|
|
:: +full: render target fully, always (as ~ship/path)
|
|
::
|
|
++ full
|
|
^- tape
|
|
"{(scow %p entity.tr)}/{(trip name.tr)}"
|
|
:: +phat: render target with local shorthand
|
|
::
|
|
:: renders as ~ship/path.
|
|
:: for local mailboxes, renders just /path.
|
|
::
|
|
++ phat
|
|
^- tape
|
|
%+ weld
|
|
?: =(our-self entity.tr) ~
|
|
(scow %p entity.tr)
|
|
"/{(trip name.tr)}"
|
|
:: +show: render as tape, as glyph if we can
|
|
::
|
|
++ show
|
|
^- tape
|
|
=+ cha=(~(get by bound) tr)
|
|
?~(cha phat [u.cha ~])
|
|
:: +glyph: tape for glyph of target, defaulting to *
|
|
::
|
|
++ glyph
|
|
^- tape
|
|
[(~(gut by bound) tr '*') ~]
|
|
--
|
|
::
|
|
:: +mr: render messages
|
|
::
|
|
++ mr
|
|
|_ $: source=target
|
|
post:post
|
|
==
|
|
+* showtime (~(has in settings) %showtime)
|
|
notify (~(has in settings) %notify)
|
|
::
|
|
++ content-width
|
|
:: termwidth, minus author, timestamp, and padding
|
|
%+ sub width
|
|
%+ add 15
|
|
?:(showtime 11 0)
|
|
::
|
|
++ render-inline
|
|
^- shoe-effect:shoe
|
|
:+ %row
|
|
:- 15
|
|
?. showtime
|
|
~[(sub width 16)]
|
|
~[(sub width 26) 9]
|
|
:+ t+(crip (weld (nome author) ~(glyph tr source)))
|
|
t+(crip line)
|
|
?. showtime ~
|
|
:_ ~
|
|
:- %t
|
|
=. time-sent
|
|
%- ?:(p.timez add sub)
|
|
[time-sent (mul q.timez ~h1)]
|
|
=+ dat=(yore time-sent)
|
|
=* t (d-co:co 2)
|
|
=, t.dat
|
|
%- crip
|
|
:(weld "~" (t h) "." (t m) "." (t s))
|
|
::
|
|
++ line
|
|
^- tape
|
|
%- zing
|
|
%+ join "\0a"
|
|
%+ turn contents
|
|
|= =content:post
|
|
?- -.content
|
|
%text (trip text.content)
|
|
%mention (scow %p ship.content) ::TODO inline w/o newlines
|
|
%reference "^"
|
|
::
|
|
%code
|
|
%+ weld (trip expression.content)
|
|
?: =(~ output.content) ~
|
|
:- '\0a'
|
|
~(ram re (snag 0 output.content))
|
|
::
|
|
%url
|
|
=+ wyd=content-width
|
|
=+ ful=(trip url.content)
|
|
:: if the full url fits, just render it.
|
|
?: (gte wyd (lent ful)) ful
|
|
:: if it doesn't, prefix with _ and truncate domain with ellipses
|
|
=. wyd (sub wyd 2)
|
|
:- '_'
|
|
=- (weld - "_")
|
|
=+ prl=(rust ful aurf:de-purl:html)
|
|
?~ prl (scag wyd ful)
|
|
=+ hok=r.p.p.u.prl
|
|
=; domain=tape
|
|
%+ swag
|
|
[(sub (max wyd (lent domain)) wyd) wyd]
|
|
domain
|
|
?. ?=(%& -.hok)
|
|
+:(scow %if p.hok)
|
|
%+ reel p.hok
|
|
|= [a=knot b=tape]
|
|
?~ b (trip a)
|
|
(welp b '.' (trip a))
|
|
==
|
|
:: +activate: produce sole-effect for printing message details
|
|
::
|
|
++ render-activate
|
|
^- sole-effect:shoe
|
|
~[%mor [%tan meta] body]
|
|
:: +meta: render message metadata (serial, timestamp, author, target)
|
|
::
|
|
++ meta
|
|
^- tang
|
|
=+ hed=leaf+"{(scow %uv (fall hash 0))} at {(scow %da time-sent)}"
|
|
=/ src=tape ~(phat tr source)
|
|
[%rose [" " ~ ~] [hed >author< [%rose [", " "to " ~] [leaf+src]~] ~]]~
|
|
:: +body: long-form render of message contents
|
|
::
|
|
++ body
|
|
|- ^- sole-effect:shoe
|
|
:- %mor
|
|
%+ turn contents
|
|
|= =content:post
|
|
^- sole-effect:shoe
|
|
?- -.content
|
|
%text txt+(trip text.content)
|
|
%url url+url.content
|
|
%reference txt+"[reference to msg in {~(phat tr resource.uid.content)}]"
|
|
::
|
|
%mention
|
|
?. =(ship.content our-self) txt+(scow %p ship.content)
|
|
:- %mor
|
|
:- klr+[[`%br ~ ~]^(scow %p ship.content)]~ ::TODO inline
|
|
?.(notify ~ [%bel ~]~)
|
|
::
|
|
%code
|
|
:- %txt
|
|
%+ weld (trip expression.content)
|
|
?: =(~ output.content) ~
|
|
:- '\0a'
|
|
~(ram re (snag 0 output.content))
|
|
==
|
|
:: +nome: prints a ship name in 14 characters, left-padding with spaces
|
|
::
|
|
++ nome
|
|
|= =ship
|
|
^- tape
|
|
=+ raw=(cite:title ship)
|
|
(runt [(sub 14 (lent raw)) ' '] raw)
|
|
--
|
|
::
|
|
++ simple-wrap
|
|
|= [txt=tape wid=@ud]
|
|
^- (list tape)
|
|
?~ txt ~
|
|
=/ [end=@ud nex=?]
|
|
=+ ret=(find "\0a" (scag +(wid) `tape`txt))
|
|
?^ ret [u.ret &]
|
|
?: (lte (lent txt) wid) [(lent txt) &]
|
|
=+ ace=(find " " (flop (scag +(wid) `tape`txt)))
|
|
?~ ace [wid |]
|
|
[(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)
|
|
==
|
|
--
|