chat-cli: support multiple sole sessions

This commit is contained in:
fang 2020-11-23 16:02:11 +01:00
parent 6fd942e5fd
commit de13468f86
No known key found for this signature in database
GPG Key ID: EB035760C1BBA972

View File

@ -27,12 +27,7 @@
+$ state-3 +$ state-3
$: %3 $: %3
::TODO support multiple sessions ::TODO support multiple sessions
:: sessions=(map sole-id session) :: sole 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 bound=(map resource glyph) :: bound resource glyphs
binds=(jug glyph resource) :: resource glyph lookup binds=(jug glyph resource) :: resource glyph lookup
settings=(set term) :: frontend flags settings=(set term) :: frontend flags
@ -40,6 +35,14 @@
timez=(pair ? @ud) :: timezone adjustment 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 ::TODO remove for breach
+$ target-2 [in-group=? =ship =path] +$ target-2 [in-group=? =ship =path]
+$ mail [source=target-2 envelope:store] +$ mail [source=target-2 envelope:store]
@ -182,23 +185,23 @@
++ on-fail on-fail:def ++ on-fail on-fail:def
:: ::
++ command-parser ++ command-parser
|= sole-id=@ta |= =sole-id
parser:sh:tc parser:(make:sh:tc sole-id)
:: ::
++ tab-list ++ tab-list
|= sole-id=@ta |= =sole-id
tab-list:sh:tc tab-list:sh:tc
:: ::
++ on-command ++ on-command
|= [sole-id=@ta =command] |= [=sole-id =command]
=^ cards state =^ cards state
(work:sh:tc command) (work:(make:sh:tc sole-id) command)
[cards this] [cards this]
:: ::
++ on-connect ++ on-connect
|= sole-id=@ta |= =sole-id
^- (quip card _this) ^- (quip card _this)
[[prompt:sh-out:tc ~] this] [[prompt:(make:sh-out:tc sole-id)]~ this]
:: ::
++ can-connect can-connect:des ++ can-connect can-connect:des
++ on-disconnect on-disconnect:des ++ on-disconnect on-disconnect:des
@ -264,7 +267,9 @@
== ==
^- state-3 ^- state-3
:- %3 :- %3
:* :* viewing ~ 0 :* %+ ~(put in *(map sole-id session))
(cat 3 'drum_' (scot %p our.bowl))
:* ~ ~ 0
:: ::
?~ audience.u.old *target ?~ audience.u.old *target
[ship ?~(path %$ i.path)]:n.audience.u.old [ship ?~(path %$ i.path)]:n.audience.u.old
@ -301,6 +306,11 @@
:: ::
::TODO better moon support. (name:title our.bowl) ::TODO better moon support. (name:title our.bowl)
++ our-self 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: term ordering for targets
:: ::
++ tor ++ tor
@ -347,46 +357,64 @@
++ on-graph-update ++ on-graph-update
|= upd=update:graph |= upd=update:graph
^- (quip card _state) ^- (quip card _state)
?+ -.q.upd [~ state] ?. ?=(?(%remove-graph %add-nodes) -.q.upd)
%remove-graph (notice-remove +.q.upd) [~ state]
:: =/ sez=(list [=sole-id =session])
%add-nodes ~(tap by sessions)
?. (~(has in viewing) resource.q.upd) =| cards=(list card)
[~ 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] ?~ sez [cards state]
=^ caz state (read-post target [index post.node]:i.nodes) =^ caz session.i.sez
$(cards (weld cards caz), nodes t.nodes) ?- -.q.upd
%remove-graph (~(notice-remove se i.sez) +.q.upd)
::
%add-nodes
%+ ~(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
:: ::
:: +read-post: add envelope to state and show it to user ++ se
:: |_ [=sole-id =session]
++ read-post +* sh-out ~(. ^sh-out sole-id session)
|= [=target =index:post =post:post] ::
^- (quip card _state) ++ read-posts
:- (show-post:sh-out target post) |= [=target nodes=(list [=index:post =node:graph])]
%_ state ^- (quip card _session)
history [[target index] history] =^ cards nodes
count +(count) ^- (quip card _nodes)
== =+ count=(lent nodes)
:: ?. (gth count 10) [~ nodes]
++ notice-remove :_ (swag [(sub count 10) 10] nodes)
|= =target [(print:sh-out "skipping {(scow %ud (sub count 10))} messages...")]~
^- (quip card _state) |-
:- [(show-delete:sh-out target) ~] ?~ nodes [cards session]
state(viewing (~(del in viewing) target)) =^ 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: bind to default, or random available
:: ::
@ -441,7 +469,7 @@
:: +decode-glyph: find the target that matches a glyph, if any :: +decode-glyph: find the target that matches a glyph, if any
:: ::
++ decode-glyph ++ decode-glyph
|= =glyph |= [=session =glyph]
^- (unit target) ^- (unit target)
=+ lax=(~(get ju binds) glyph) =+ lax=(~(get ju binds) glyph)
:: no target :: no target
@ -450,20 +478,30 @@
:: single target :: single target
?: ?=([* ~ ~] lax) n.lax ?: ?=([* ~ ~] lax) n.lax
:: in case of multiple matches, pick one we're viewing :: in case of multiple matches, pick one we're viewing
=. lax (~(uni in lax) viewing) =. lax (~(uni in lax) viewing.session)
?: ?=([* ~ ~] lax) n.lax ?: ?=([* ~ ~] lax) n.lax
:: in case of multiple audiences, pick the most recently active one :: in case of multiple audiences, pick the most recently active one
|- ^- target |- ^- target
?~ history -:~(tap in lax) ?~ history.session -:~(tap in lax)
=* resource resource.i.history =* resource resource.i.history.session
?: (~(has in lax) resource) ?: (~(has in lax) resource)
resource resource
$(history t.history) $(history.session t.history.session)
:: ::
:: +sh: shoe handling :: +sh: shoe handling
:: ::
++ sh ++ 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 :: +read: command parser
:: ::
:: parses the command line buffer. :: parses the command line buffer.
@ -547,7 +585,7 @@
;~ pose ;~ pose
tarl tarl
;~(plug ship name) ;~(plug ship name)
(sear decode-glyph glyph) (sear (cury decode-glyph session) glyph)
== ==
:: +tars: set of comma-separated targs :: +tars: set of comma-separated targs
:: ::
@ -680,7 +718,7 @@
|= =target |= =target
^- (quip card _state) ^- (quip card _state)
=. audience target =. audience target
[[prompt:sh-out ~] state] [[prompt:sh-out ~] put-ses]
:: +view: start printing messages from a resource :: +view: start printing messages from a resource
:: ::
++ view ++ view
@ -693,19 +731,20 @@
:: only view existing chat-type graphs :: only view existing chat-type graphs
:: ::
?. (is-chat-graph target) ?. (is-chat-graph target)
[[(note:sh-out "no such chat")]~ state] [[(note:sh-out "no such chat")]~ put-ses]
=. viewing (~(put in viewing) target)
=^ cards state =^ cards state
?: (~(has by bound) target) ?: (~(has by bound) target)
[~ state] [~ state]
(bind-default-glyph target) (bind-default-glyph target)
:- cards [[prompt:sh-out cards] put-ses]
state(viewing (~(put in viewing) target))
:: +flee: stop printing messages from a resource :: +flee: stop printing messages from a resource
:: ::
++ flee ++ flee
|= =target |= =target
^- (quip card _state) ^- (quip card _state)
[~ state(viewing (~(del in viewing) target))] =. viewing (~(del in viewing) target)
[~ put-ses]
:: +say: send messages :: +say: send messages
:: ::
++ say ++ say
@ -848,7 +887,8 @@
::NOTE graph store allows node deletion, so can this crash? ::NOTE graph store allows node deletion, so can this crash?
=/ =uid:post (snag index history) =/ =uid:post (snag index history)
=/ =node:graph (got-node:libgraph uid) =/ =node:graph (got-node:libgraph uid)
:_ state(audience resource.uid) =. audience resource.uid
:_ put-ses
^- (list card) ^- (list card)
:~ (print:sh-out ['?' ' ' number]) :~ (print:sh-out ['?' ' ' number])
(effect:sh-out ~(render-activate mr resource.uid post.node)) (effect:sh-out ~(render-activate mr resource.uid post.node))
@ -880,13 +920,19 @@
:: +sh-out: ouput to session :: +sh-out: ouput to session
:: ::
++ sh-out ++ sh-out
|% |_ [=sole-id session]
++ make
|= =^sole-id
%_ ..make
sole-id sole-id
+<+ (get-session sole-id)
==
:: +effex: emit shoe effect card :: +effex: emit shoe effect card
:: ::
++ effex ++ effex
|= effect=shoe-effect:shoe |= effect=shoe-effect:shoe
^- card ^- card
[%shoe ~ effect] [%shoe ~[sole-id] effect]
:: +effect: emit console effect card :: +effect: emit console effect card
:: ::
++ effect ++ effect
@ -975,7 +1021,7 @@
++ show-chats ++ show-chats
|= chats=(list target) |= chats=(list target)
^- card ^- card
%- print-more:sh-out %- print-more
%+ turn (sort chats tor) %+ turn (sort chats tor)
|= resource |= resource
"{(nome:mr entity)}/{(trip name)}" "{(nome:mr entity)}/{(trip name)}"