mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-12-14 17:41:33 +03:00
1238 lines
34 KiB
Plaintext
1238 lines
34 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
|
|
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
|
|
==
|
|
::
|
|
+$ sole-id @ta
|
|
+$ session
|
|
$: viewing=(set resource) :: connected graphs
|
|
history=(list uid:post) :: scrollback pointers
|
|
count=@ud :: (lent history)
|
|
audience=target :: active target
|
|
==
|
|
::
|
|
::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-0
|
|
%- 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
|
|
parser:(make:sh:tc sole-id)
|
|
::
|
|
++ tab-list
|
|
|= =sole-id
|
|
tab-list:sh:tc
|
|
::
|
|
++ on-command
|
|
|= [=sole-id =command]
|
|
=^ cards state
|
|
(work:(make:sh:tc sole-id) command)
|
|
[cards this]
|
|
::
|
|
++ on-connect
|
|
|= =sole-id
|
|
^- (quip card _this)
|
|
[[prompt:(make:sh-out:tc sole-id)]~ 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(width 80)]
|
|
::
|
|
=? 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
|
|
:* %+ ~(put in *(map sole-id session))
|
|
(cat 3 'drum_' (scot %p our.bowl))
|
|
:* ~ ~ 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
|
|
%+ welp
|
|
cards
|
|
?: %- ~(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
|
|
::
|
|
++ get-session
|
|
|= =sole-id
|
|
^- session
|
|
(~(gut by sessions) sole-id %*(. *session audience [our-self %$]))
|
|
:: +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)
|
|
?. ?=(?(%remove-graph %add-nodes) -.q.upd)
|
|
[~ state]
|
|
=/ sez=(list [=sole-id =session])
|
|
~(tap by sessions)
|
|
=| cards=(list card)
|
|
|-
|
|
?~ sez [cards state]
|
|
=^ caz session.i.sez
|
|
?- -.q.upd
|
|
%remove-graph (~(notice-remove se i.sez) +.q.upd)
|
|
::
|
|
%add-nodes
|
|
?. (~(has in viewing.session.i.sez) resource.q.upd)
|
|
[~ session.i.sez]
|
|
%+ ~(read-posts se i.sez)
|
|
resource.q.upd
|
|
(sort ~(tap by nodes.q.upd) ior)
|
|
==
|
|
=. sessions (~(put by sessions) i.sez)
|
|
$(sez t.sez, cards (weld cards caz))
|
|
:: +se: session event handling
|
|
::
|
|
++ se
|
|
|_ [=sole-id =session]
|
|
+* sh-out ~(. ^sh-out sole-id session)
|
|
::
|
|
++ read-posts
|
|
|= [=target nodes=(list [=index:post =node:graph])]
|
|
^- (quip card _session)
|
|
=^ 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 session]
|
|
=^ caz session
|
|
(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 _session)
|
|
:- (show-post:sh-out target post)
|
|
%_ session
|
|
history [[target index] history.session]
|
|
count +(count.session)
|
|
==
|
|
::
|
|
++ notice-remove
|
|
|= =target
|
|
^- (quip card _session)
|
|
?. (~(has in viewing.session) target)
|
|
[~ session]
|
|
:- [(show-delete:sh-out target) ~]
|
|
session(viewing (~(del in viewing.session) 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
|
|
|= [=session =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.session)
|
|
?: ?=([* ~ ~] lax) n.lax
|
|
:: in case of multiple audiences, pick the most recently active one
|
|
|- ^- target
|
|
?~ history.session -:~(tap in lax)
|
|
=* resource resource.i.history.session
|
|
?: (~(has in lax) resource)
|
|
resource
|
|
$(history.session t.history.session)
|
|
::
|
|
:: +sh: shoe handling
|
|
::
|
|
++ sh
|
|
|_ [=sole-id session]
|
|
+* session +<+
|
|
sh-out ~(. ^sh-out sole-id session)
|
|
put-ses state(sessions (~(put by sessions) sole-id session))
|
|
::
|
|
++ make
|
|
|= =^sole-id
|
|
%_ ..make
|
|
sole-id sole-id
|
|
+<+ (get-session sole-id)
|
|
==
|
|
:: +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 (cury decode-glyph session) 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 ~] put-ses]
|
|
:: +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")]~ put-ses]
|
|
=. viewing (~(put in viewing) target)
|
|
=^ cards state
|
|
?: (~(has by bound) target)
|
|
[~ state]
|
|
(bind-default-glyph target)
|
|
[[prompt:sh-out cards] put-ses]
|
|
:: +flee: stop printing messages from a resource
|
|
::
|
|
++ flee
|
|
|= =target
|
|
^- (quip card _state)
|
|
=. viewing (~(del in viewing) target)
|
|
[~ put-ses]
|
|
:: +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-0
|
|
!> ^- 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)
|
|
=. audience resource.uid
|
|
:_ put-ses
|
|
^- (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
|
|
|_ [=sole-id session]
|
|
++ make
|
|
|= =^sole-id
|
|
%_ ..make
|
|
sole-id sole-id
|
|
+<+ (get-session sole-id)
|
|
==
|
|
:: +effex: emit shoe effect card
|
|
::
|
|
++ effex
|
|
|= effect=shoe-effect:shoe
|
|
^- card
|
|
[%shoe ~[sole-id] 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
|
|
%+ 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
|
|
:_ |=(ls=(list tape) `tape`(zing (join " " ls)))
|
|
%+ roll contents
|
|
|= [=content:post out=(list (list tape))]
|
|
?- -.content
|
|
%text (append-inline out (trip text.content))
|
|
%mention (append-inline out (scow %p ship.content))
|
|
%reference (append-inline out "^")
|
|
::
|
|
%code
|
|
%+ snoc out
|
|
^- (list tape)
|
|
:- (trip expression.content)
|
|
?: =(~ output.content) ~
|
|
:- "\0a"
|
|
~(ram re (snag 0 output.content))^~
|
|
::
|
|
%url
|
|
%+ append-inline out
|
|
=+ 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))
|
|
==
|
|
::
|
|
++ append-newline
|
|
|= [content=(list (list tape)) newline=tape]
|
|
^- (list (list tape))
|
|
(snoc content ~[newline])
|
|
::
|
|
++ append-inline
|
|
|= [content=(list (list tape)) inline=tape]
|
|
^- (list (list tape))
|
|
?: =(~ content)
|
|
~[~[inline]]
|
|
=/ last
|
|
(dec (lent content))
|
|
=/ old=(list tape)
|
|
(snag last content)
|
|
=/ new=(list tape)
|
|
(snoc old inline)
|
|
(snap content last new)
|
|
|
|
:: +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)
|
|
==
|
|
--
|