fix: four real defects in the party plumbing

Leaving a project never closed its socket. That was untidy before; with
presence it means peers go on seeing you viewing something you walked away
from, and the old project's deltas land in the next one's db while it loads.
::nav-list, ::nav-create and ::open-project now drop it.

A parked move belongs to the party it came from. Leaving one — or the sender
leaving it — left the park behind, so closing a form afterwards would drag you
back to people you were no longer with. Changing party drops it, and a replay
from someone who is no longer a mate drops it too.

Nav is the only message that steers another browser, and it arrives relayed
from whatever a peer chose to send. A non-integer playhead reaching
scene/assert-frame would have thrown inside the event loop and taken the
editor down; a stack naming a clip would have dropped you into a context you
can't stand in. Validate the shape up front: root-first, timelines all the way
down, a real frame — and ignore what fails rather than parking it forever.

A refused .play() (autoplay policy, in a tab with no interaction yet) left the
echo flag set, swallowing the next genuine play we should have broadcast. The
effect now reports the refusal, which both clears the flag and keeps
:playing? honest.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>

scenes/consumers.py

@@ -1,22 +1,60 @@
 import json
+import uuid
 
 from channels.generic.websocket import AsyncWebsocketConsumer
 
 
 class SceneConsumer(AsyncWebsocketConsumer):
-    """One connection per open project. Joins the project's group and relays
+    """One connection per open project. Two things ride it.
-    scene deltas the server broadcasts (see scenes.views.scene). Read-only:
+
-    edits still go through the PUT endpoint, which is the broadcast source."""
+    Scene deltas: relayed from what the server broadcasts on a save (see
+    scenes.views.scene). Read-only — edits still go through the PUT endpoint,
+    which is the broadcast source.
+
+    Presence: who's viewing, which ad-hoc party they're in, and where that party
+    is looking. Peers gossip it between themselves and work the party out
+    locally (tl.party); all this does is hand out a connection id, stamp the
+    sender's server-side identity onto every message — so nobody can post as
+    somebody else — and relay. Nothing about a party is stored anywhere.
+    """
+
+    RELAYED = ("state", "nav")
 
     async def connect(self):
-        self.pk = self.scope['url_route']['kwargs']['pk']
+        self.pk = self.scope["url_route"]["kwargs"]["pk"]
-        self.group = f'project_{self.pk}'
+        self.group = f"project_{self.pk}"
+        self.cid = uuid.uuid4().hex[:12]
+        user = self.scope.get("user")
+        self.username = user.get_username() if user and user.is_authenticated else None
         await self.channel_layer.group_add(self.group, self.channel_name)
         await self.accept()
+        await self.send(text_data=json.dumps(
+            {"kind": "welcome", "cid": self.cid, "user": self.username}))
+        # the room answers a join with their own state, so rosters fill in both ways
+        await self._relay({"kind": "join"})
 
     async def disconnect(self, code):
-        await self.channel_layer.group_discard(self.group, self.channel_name)
+        if hasattr(self, "cid"):
+            await self._relay({"kind": "leave"})
+            await self.channel_layer.group_discard(self.group, self.channel_name)
+
+    async def receive(self, text_data=None, bytes_data=None):
+        try:
+            msg = json.loads(text_data or "{}")
+        except ValueError:
+            return
+        if isinstance(msg, dict) and msg.get("kind") in self.RELAYED:
+            await self._relay(msg)
+
+    async def _relay(self, msg):
+        await self.channel_layer.group_send(
+            self.group,
+            {"type": "peer.msg", "msg": {**msg, "cid": self.cid, "user": self.username}})
+
+    # broadcast handler: {type: "peer.msg", msg: {...}} — presence gossip
+    async def peer_msg(self, event):
+        await self.send(text_data=json.dumps(event["msg"]))
 
     # broadcast handler: {type: "scene.delta", delta: {...}}
     async def scene_delta(self, event):
-        await self.send(text_data=json.dumps(event['delta']))
+        await self.send(text_data=json.dumps(event["delta"]))

scenes/tests.py

@@ -1,9 +1,12 @@
 import json
 
+from channels.testing import WebsocketCommunicator
 from django.contrib.auth import get_user_model
-from django.test import Client, TestCase
+from django.contrib.auth.models import AnonymousUser
+from django.test import Client, TestCase, TransactionTestCase
 
 from scenes.models import Project, Revision
+from server.asgi import application
 
 User = get_user_model()
 
@@ -103,3 +106,58 @@ class AccessTests(SceneApiTestCase):
         User.objects.create_user("carol", password="pw")
         carol = Client(); carol.login(username="carol", password="pw")
         self.assertEqual(self.put(carol, changed={"a1": ann("x")}).status_code, 404)
+
+
+class PresenceRelayTests(TransactionTestCase):
+    """The socket hands out connection ids and stamps identity; the party itself
+    is worked out in the browsers, so there is nothing here to store or trust."""
+
+    def setUp(self):
+        self.alice = User.objects.create_user("alice", password="pw")
+        self.project = Project.objects.create(owner=self.alice, name="p")
+
+    async def open(self, user=None):
+        comm = WebsocketCommunicator(application, f"/ws/projects/{self.project.pk}/")
+        comm.scope["user"] = user or AnonymousUser()
+        connected, _ = await comm.connect()
+        self.assertTrue(connected)
+        return comm, await comm.receive_json_from()
+
+    async def test_welcome_carries_an_id_and_the_signed_in_name(self):
+        comm, welcome = await self.open(self.alice)
+        self.assertEqual(welcome["kind"], "welcome")
+        self.assertEqual(welcome["user"], "alice")
+        self.assertTrue(welcome["cid"])
+        await comm.disconnect()
+
+    async def test_presence_is_stamped_with_the_server_side_identity(self):
+        a, a_hello = await self.open(self.alice)
+        await a.receive_json_from()                       # our own join, echoed back
+        b, _ = await self.open()
+        self.assertEqual((await a.receive_json_from())["kind"], "join")
+
+        await b.send_json_to({"kind": "state", "party": a_hello["cid"],
+                              "joinable": True, "joining": a_hello["cid"],
+                              "user": "alice", "cid": "forged"})
+        seen = await a.receive_json_from()
+        self.assertEqual(seen["party"], a_hello["cid"])
+        self.assertIsNone(seen["user"])                   # anonymous, not "alice"
+        self.assertNotEqual(seen["cid"], "forged")
+        await a.disconnect(); await b.disconnect()
+
+    async def test_scene_edits_are_not_accepted_over_the_socket(self):
+        a, _ = await self.open(self.alice)
+        await a.receive_json_from()                       # join
+        await a.send_json_to({"kind": "scene", "changed": {"a1": ann("x")}})
+        self.assertTrue(await a.receive_nothing(timeout=0.2))
+        await a.disconnect()
+
+    async def test_leaving_tells_the_room(self):
+        a, _ = await self.open(self.alice)
+        await a.receive_json_from()                       # join
+        b, b_hello = await self.open()
+        await a.receive_json_from()                       # b's join
+        await b.disconnect()
+        bye = await a.receive_json_from()
+        self.assertEqual((bye["kind"], bye["cid"]), ("leave", b_hello["cid"]))
+        await a.disconnect()

tl/resources/public/css/app.css

@@ -658,6 +658,48 @@ html.dark .timeline-head {
                    font-family: var(--chicago); font-size: 11px; white-space: nowrap; }
 .menu-pop button:hover { background: var(--ink); color: var(--paper); }
 
+/* --- who's viewing: presence cluster + party menu ----------------------- */
+.presence { display: flex; align-items: center; gap: 5px; }
+.avatars { display: flex; align-items: center; gap: 3px; padding: 1px 4px;
+           background: var(--paper); border: 1px solid transparent; cursor: pointer; }
+.avatars:hover, .presence.in-party .avatars { border-color: var(--ink); }
+.avatar { width: 18px; height: 18px; flex: 0 0 auto; border: 1px solid var(--ink);
+          border-radius: 50%; display: inline-flex; align-items: center;
+          justify-content: center; font-family: var(--chicago); font-size: 10px;
+          color: #000; box-sizing: border-box; }
+/* party-mates wear the badge; everyone else is just present */
+.avatar.mate { box-shadow: 0 0 0 2px var(--paper), 0 0 0 3px var(--ink); }
+.avatar.more { background: var(--paper) !important; color: var(--ink); font-size: 9px; }
+.party-tag { font-family: var(--chicago); font-size: 9px; letter-spacing: 1px;
+             text-transform: uppercase; padding: 0 3px; margin-right: 2px;
+             background: var(--ink); color: var(--paper); }
+.solo-btn { font-size: 10px; }
+/* detached while authoring: still in the party, just not being steered by it */
+.presence.detached .party-tag { background: var(--paper); color: var(--ink);
+                                border: 1px solid var(--ink); }
+.presence.detached .avatar.mate { box-shadow: none; opacity: 0.5; }
+
+.peer-pop { min-width: 232px; padding: 0; }
+.peer-group { padding: 4px; border-bottom: 1px solid var(--ink); }
+.peer-group:last-of-type { border-bottom: none; }
+.peer-group.mine { background: var(--shade); }
+.peer-group-head { display: flex; align-items: center; justify-content: space-between;
+                   gap: 8px; padding: 2px 4px 4px; font-family: var(--chicago);
+                   font-size: 10px; letter-spacing: 0.5px; text-transform: uppercase;
+                   color: var(--mute); }
+.peer-group.mine .peer-group-head { color: var(--ink); }
+.peer-row { display: flex; align-items: center; gap: 6px; padding: 3px 4px; }
+.peer-name { flex: 1; min-width: 0; overflow: hidden; text-overflow: ellipsis;
+             white-space: nowrap; font-size: 12px; }
+.peer-you { color: var(--mute); }
+.peer-closed { font-size: 10px; color: var(--mute); }
+.link-btn { background: none; border: none; padding: 0 2px; cursor: pointer;
+            font-family: var(--chicago); font-size: 10px; color: var(--ink);
+            text-decoration: underline; }
+.link-btn:hover { background: var(--ink); color: var(--paper); text-decoration: none; }
+.peer-setting { display: flex; align-items: center; gap: 6px; padding: 6px 8px;
+                border-top: 2px solid var(--ink); font-size: 11px; cursor: pointer; }
+
 /* --- annotation / script pane tabs ------------------------------------- */
 .pane-wrap { flex: 1; min-width: 0; display: flex; flex-direction: column; }
 .pane-tabs { display: flex; gap: 0; background: var(--paper); border-bottom: 1px solid var(--ink); }

tl/src/tl/api.cljs

@@ -70,25 +70,96 @@
         nil)
       fallback))
 
-;; --- realtime: live peer deltas over a websocket --------------------------
+;; --- realtime: the project socket ----------------------------------------
-;; Not a fetch, so it can't ride :http-xhrio; it dispatches ::peer-delta itself.
+;; Two things ride it: scene deltas the server broadcasts after a PUT (the
+;; untagged message, kept as the default branch below), and the presence gossip
+;; peers send each other — who's viewing, who's in which party, and where the
+;; party is looking. Not fetches, so they can't ride :http-xhrio; each message
+;; dispatches its own event.
 
 (defn- ->clj [x] (js->clj x :keywordize-keys true))
 
 (defonce ^:private socket (atom nil))
+(defonce ^:private conn (atom {:id nil :tries 0 :timer nil}))
+
+(defn- event-for [{:keys [kind] :as msg}]
+  [(case kind
+     "welcome" :tl.events/peer-welcome
+     "join"    :tl.events/peer-join
+     "state"   :tl.events/peer-state
+     "leave"   :tl.events/peer-leave
+     "nav"     :tl.events/peer-nav
+     :tl.events/peer-delta)                     ; untagged = a scene delta
+   msg])
+
+(defn- ws-url [id]
+  (let [l     js/window.location
+        proto (if (= "https:" (.-protocol l)) "wss:" "ws:")
+        host  (if (= "" api-port) (.-host l) (str (.-hostname l) ":" api-port))]
+    (str proto "//" host "/ws/projects/" id "/")))
+
+(declare open!)
+
+;; A dropped socket is the normal case, not the exception — a laptop lid, a
+;; tunnel, a backend redeploy. Back off up to ~15s and keep trying; the welcome
+;; that comes back is what tells the app to catch up on what it missed.
+(defn- retry-later! [id]
+  (let [tries (:tries @conn)]
+    (swap! conn assoc
+           :tries (inc tries)
+           :timer (js/setTimeout #(open! id) (min 15000 (* 500 (js/Math.pow 2 tries)))))))
+
+(defn- open! [id]
+  (when (= id (:id @conn))
+    (let [s (js/WebSocket. (ws-url id))]
+      (reset! socket s)
+      (set! (.-onopen s) (fn [_] (swap! conn assoc :tries 0)))
+      (set! (.-onerror s) (fn [_] (js/console.warn "scene sync socket error; peer updates paused")))
+      (set! (.-onmessage s) (fn [e] (rf/dispatch (event-for (->clj (js/JSON.parse (.-data e)))))))
+      ;; off the wire we stop hearing about peers, so stop claiming to see them.
+      ;; Only the *current* socket does this — closing the previous one on a
+      ;; project switch must not wipe the new one's roster or retry into it.
+      (set! (.-onclose s) (fn [_]
+                            (when (identical? s @socket)
+                              (reset! socket nil)
+                              (rf/dispatch [:tl.events/peers-reset])
+                              (retry-later! id)))))))
 
 (defn connect-scene!
-  "Open (or replace) the websocket that streams peer scene deltas for project
+  "Open (or replace) the websocket for project `id`, and keep it open."
-   `id`. Incoming messages dispatch ::peer-delta, which merges them in."
   [id]
-  (when-let [s @socket] (.close s))
+  (some-> (:timer @conn) js/clearTimeout)
-  (when id
+  (when-let [s @socket] (set! (.-onclose s) nil) (.close s))
-    (let [l     js/window.location
+  (reset! socket nil)
-          proto (if (= "https:" (.-protocol l)) "wss:" "ws:")
+  (reset! conn {:id id :tries 0 :timer nil})
-          host  (if (= "" api-port) (.-host l) (str (.-hostname l) ":" api-port))
+  (when id (open! id)))
-          url   (str proto "//" host "/ws/projects/" id "/")
+
-          s     (js/WebSocket. url)]
+(defn- send! [msg]
-      (reset! socket s)
+  (when-let [s @socket]
-      (set! (.-onerror s) (fn [_] (js/console.warn "scene sync socket error; peer updates paused")))
+    (when (= 1 (.-readyState s))                ; OPEN — silently skip otherwise
-      (set! (.-onmessage s)
+      (.send s (js/JSON.stringify (clj->js msg))))))
-            (fn [e] (rf/dispatch [:tl.events/peer-delta (->clj (js/JSON.parse (.-data e)))]))))))
+
+;; our presence state (party membership + whether we let people in) — rare
+;; enough to go straight out
+(def send-state! send!)
+
+;; Nav rides every scrub and every jump, so it is throttled: leading edge for a
+;; snappy first move, trailing edge so the party lands on the final position
+;; rather than wherever the last tick happened to fall.
+(def ^:private nav-gap-ms 120)
+(defonce ^:private nav-last (atom 0))
+(defonce ^:private nav-timer (atom nil))
+(defonce ^:private nav-pending (atom nil))
+
+(defn- flush-nav! []
+  (reset! nav-timer nil)
+  (reset! nav-last (js/Date.now))
+  (when-let [m @nav-pending] (reset! nav-pending nil) (send! m)))
+
+(defn send-nav! [msg]
+  (reset! nav-pending msg)
+  (when @nav-timer (js/clearTimeout @nav-timer))
+  (let [due (max 0 (- nav-gap-ms (- (js/Date.now) @nav-last)))]
+    (if (zero? due)
+      (flush-nav!)
+      (reset! nav-timer (js/setTimeout flush-nav! due)))))

tl/src/tl/db.cljs

@@ -19,6 +19,10 @@
    :scene {:tracks {}
            :groups {:root {:type :timeline :name "root"}}}
 
+   ;; who else is viewing, and the ad-hoc party we're in (see tl.party).
+   ;; :me is our connection id, handed out by the server; the roster is gossip.
+   :peers {:me nil :roster {} :joinable true :parked nil}
+
    ;; view state
    :view  {:stack     [:root]             ; timeline-stack; top = current context
            :playheads {}                  ; per-context local playhead

tl/src/tl/events.cljs

@@ -6,6 +6,7 @@
    [tl.api :as api]
    [tl.db :as db]
    [tl.otio :as otio]
+   [tl.party :as party]
    [tl.routes :as routes]
    [tl.scene :as scene]))
 
@@ -88,6 +89,49 @@
     (assoc fx :route/replace-project-state (route-state db))
     fx))
 
+(defn- seek-fx
+  "Effect map putting the video on the current context's playhead (nothing when
+   the context resolves to no footage)."
+  [db]
+  (let [ctx  (peek (get-in db [:view :stack]))
+        segs (scene/content-segments (:scene db) ctx)
+        sf   (scene/local->source segs (scene/playhead (:view db) ctx))]
+    (when sf {:player/seek (/ sf (:fps db))})))
+
+;; --- parties: telling the others where we're looking ----------------------
+;; The roster and the party maths live in tl.party; these are the two ends of
+;; it inside the event layer — what we broadcast, and the gate on broadcasting.
+
+(defn- roster [db] (get-in db [:peers :roster] {}))
+(defn- my-cid [db] (get-in db [:peers :me]))
+
+(defn- nav-state
+  "Where we're looking, as the party sees it: which timeline we're in, where the
+   playhead sits, and whether we're rolling."
+  [db]
+  (let [stack (get-in db [:view :stack])]
+    {:kind "nav"
+     :stack (mapv name stack)
+     :playhead (scene/playhead (:view db) (peek stack))
+     :playing (boolean (get-in db [:view :playing?]))}))
+
+(defn- authoring?
+  "Is a draft open? Authoring means hunting around the timeline for marks, which
+   is nobody else's business — so while it's open we detach from the party: we
+   don't drive it (here) and it doesn't drive us (::peer-nav), and we catch up
+   with wherever it got to when the form closes (::finish-edit)."
+  [db]
+  (boolean (some :draft (vals (get-in db [:scene :groups])))))
+
+(defn- sync-view
+  "URL + party for an event that moved the view. Only deliberate moves go out:
+   playback ticks are left alone, because every member is running the same clip
+   off its own clock and a stream of positions would just fight them."
+  [fx db]
+  (cond-> (sync-route fx db)
+    (and (seq (party/peers (roster db) (my-cid db))) (not (authoring? db)))
+    (assoc :peer/nav (nav-state db))))
+
 ;; --- auth + routing -------------------------------------------------------
 
 (rf/reg-event-fx ::set-auth
@@ -131,14 +175,21 @@
 ;; the next one) doesn't flash the previous project's name/scene/thumbnails or a
 ;; stale load error while the next one loads.
 (defn- reset-project [db]
-  (merge db (select-keys db/default-db [:project :scene :fps :view :load :save-error])))
+  (merge db (select-keys db/default-db [:project :scene :fps :view :load :save-error :peers])))
 
+;; Leaving also drops the socket. It isn't just tidiness any more: an open
+;; socket keeps us in the project's roster, so peers would go on seeing us
+;; viewing something we walked away from — and its deltas would land in the
+;; next project's db while that one loads.
 (rf/reg-event-fx ::nav-list
                  (fn [{:keys [db]} _] {:db (-> (reset-project db) (assoc :page :list))
+                                       :connect-scene nil
                                        :fetch-projects true}))
 (rf/reg-event-db ::set-projects (fn [db [_ ps]] (assoc db :projects ps :projects-error nil)))
-(rf/reg-event-db ::nav-create (fn [db _] (-> (reset-project db)
+(rf/reg-event-fx ::nav-create (fn [{:keys [db]} _]
-                                             (assoc :page :create :create-error nil))))
+                                {:db (-> (reset-project db)
+                                         (assoc :page :create :create-error nil))
+                                 :connect-scene nil}))
 
 ;; loading a project is a three-hop chain: detail → OTIO file → scene, each
 ;; feeding the next, and any hop's failure lands the editor in :error.
@@ -148,6 +199,7 @@
                             (assoc :page :editor)
                             (assoc-in [:load :status] :loading)
                             (assoc-in [:view :route-state] view-state))
+                    :connect-scene nil            ; the previous project's, until ::project-ready
                     :http-xhrio (api/GET (str "/api/projects/" id "/")
                                          {:on-success [::project-detail-loaded]
                                           :on-failure [::project-load-error]})}))
@@ -190,16 +242,230 @@
 ;; A peer saved: merge their attributed groups in (and drop deletions). We keep
 ;; any group we're currently editing (flagged :draft) so a peer save can't yank
 ;; an in-progress edit out from under us — our own save is authoritative for it.
-(rf/reg-event-db
+(defn- merge-delta [db {:keys [changed deleted]}]
+  (let [restored (scene/restore-annotations changed)
+        drafts   (into #{} (keep (fn [[gid g]] (when (:draft g) gid))
+                                 (get-in db [:scene :groups])))]
+    (update-in db [:scene :groups]
+               (fn [groups]
+                 (-> (apply dissoc groups (map keyword deleted))
+                     (into (remove (fn [[gid _]] (contains? drafts gid)) restored)))))))
+
+(defn- prune-stack
+  "A peer deleted a timeline we were standing in: fall back to the nearest
+   surviving ancestor rather than rendering an empty context."
+  [db]
+  (let [stack (get-in db [:view :stack])
+        live  (vec (valid-stack (:scene db) stack))]
+    (cond-> db (not= live stack) (assoc-in [:view :stack] live))))
+
+(rf/reg-event-fx
  ::peer-delta
- (fn [db [_ {:keys [changed deleted]}]]
+ (fn [{:keys [db]} [_ delta]]
-   (let [restored (scene/restore-annotations changed)
+   (let [was    (get-in db [:view :stack])
-         drafts   (into #{} (keep (fn [[gid g]] (when (:draft g) gid))
+         db     (-> db (merge-delta delta) prune-stack)
-                                  (get-in db [:scene :groups])))]
+         parked (get-in db [:peers :parked])]
-     (update-in db [:scene :groups]
+     (cond-> {:db db}
-                (fn [groups]
+       (not= was (get-in db [:view :stack])) (merge (seek-fx db))
-                  (-> (apply dissoc groups (map keyword deleted))
+       ;; a party jump we had to park (below) may be applicable now that this
-                      (into (remove (fn [[gid _]] (contains? drafts gid)) restored))))))))
+       ;; delta has landed — the group it pointed at was probably in it.
+       parked (assoc :dispatch [::peer-nav parked])))))
+
+;; --- presence: who else is viewing, and the party we're in ---------------
+;; Everything the peers know about each other arrives here as gossip; tl.party
+;; turns the roster into parties. The server only stamps identity and relays,
+;; so a party forms, drives and dissolves entirely between the browsers in it.
+
+(def ^:private joinable-key "tl/joinable")
+
+(rf/reg-fx :peer/nav   api/send-nav!)
+(rf/reg-fx :peer/state api/send-state!)
+(rf/reg-fx :peer/remember-joinable
+           (fn [on?] (.setItem js/localStorage joinable-key (if on? "1" "0"))))
+
+(defn- joinable-pref [] (not= "0" (.getItem js/localStorage joinable-key)))
+
+(defn- state-msg
+  "Our presence state. `joining` names the peer we just clicked Join on — they
+   adopt the party id if they're solo and letting people in; everyone else reads
+   it as \"the sender is the newcomer\"."
+  ([db] (state-msg db nil))
+  ([db joining]
+   {:kind "state"
+    :party (party/party-of (roster db) (my-cid db))
+    :joinable (boolean (get-in db [:peers :joinable]))
+    :joining joining}))
+
+(defn- upsert-peer [db {:keys [cid user] :as msg}]
+  (cond-> db
+    cid (update-in [:peers :roster cid] merge
+                   (cond-> {:cid cid :user (or user "guest")}
+                     (contains? msg :party)    (assoc :party (:party msg))
+                     (contains? msg :joinable) (assoc :joinable (boolean (:joinable msg)))))))
+
+;; Off the wire: everyone we could see is now a guess, so drop the roster. The
+;; party *id* we keep — it's just a name the members still carry, so coming back
+;; is a matter of saying it again rather than asking anyone's permission.
+(rf/reg-event-db
+ ::peers-reset
+ (fn [db _]
+   (assoc db :peers (merge (:peers db/default-db)
+                           {:dropped true
+                            :rejoin (party/party-of (roster db) (my-cid db))}))))
+
+;; The server hands us our connection id. Answer with our own state so the room
+;; learns whether we're joinable before anyone tries — and, if this is a socket
+;; coming *back*, pull the scene we missed while we were gone.
+(rf/reg-event-fx
+ ::peer-welcome
+ (fn [{:keys [db]} [_ msg]]
+   (let [{:keys [dropped rejoin]} (:peers db)
+         cid (:cid msg)
+         db  (-> db
+                 (assoc-in [:peers :me] cid)
+                 (assoc-in [:peers :joinable] (joinable-pref))
+                 (upsert-peer msg)
+                 (assoc-in [:peers :roster cid :party] rejoin)
+                 (update :peers merge {:dropped false :rejoin nil}))
+         id  (get-in db [:project :id])]
+     (cond-> {:db db :peer/state (state-msg db)}
+       (and dropped id)
+       (assoc :http-xhrio (api/GET (str "/api/projects/" id "/scene/")
+                                   {:on-success [::scene-resynced]
+                                    :on-failure [::ignore-error]}))))))
+
+;; Back after a drop: the socket only streams deltas, so anything saved while we
+;; were away never reached us. Merge the server's authored layer in the same way
+;; a live delta merges — drafts we're holding stay ours.
+;;
+;; Deliberately additive. "Absent from the server" can also mean "saved a
+;; moment ago and the PUT hasn't landed", and a wrong deletion costs someone
+;; their work while a stale extra group costs a reload — so a deletion missed
+;; while we were offline lingers until one.
+(rf/reg-event-db
+ ::scene-resynced
+ (fn [db [_ resp]]
+   (merge-delta db {:changed (get-in resp [:scene :groups] {})})))
+
+;; someone arrived: note them, and announce ourselves so their roster fills in.
+(rf/reg-event-fx
+ ::peer-join
+ (fn [{:keys [db]} [_ msg]]
+   (let [db (upsert-peer db msg)]
+     (cond-> {:db db}
+       (not= (my-cid db) (:cid msg)) (assoc :peer/state (state-msg db))))))
+
+(rf/reg-event-db
+ ::peer-leave
+ (fn [db [_ {:keys [cid]}]]
+   (update-in db [:peers :roster] dissoc cid)))
+
+(rf/reg-event-fx
+ ::peer-state
+ (fn [{:keys [db]} [_ {:keys [cid joining party] :as msg}]]
+   (let [me     (my-cid db)
+         db     (upsert-peer db msg)
+         ;; they clicked Join on us while we were flying solo: take on the id
+         ;; they derived from our cid. Nobody hosts — we both just carry it.
+         adopt? (and me (= me joining)
+                     (nil? (party/party-of (roster db) me))
+                     (get-in db [:peers :joinable]))
+         db     (cond-> db adopt? (assoc-in [:peers :roster me :party] party))
+         r      (roster db)
+         mine   (party/party-of r me)]
+     (cond-> {:db db}
+       adopt? (assoc :peer/state (state-msg db))
+       ;; a newcomer landed in our party and we drew the short straw: show them
+       ;; where we are, instead of parking them until somebody moves.
+       (and joining mine (= mine (party/party-of r cid))
+            (= me (party/responder r mine cid)))
+       (assoc :peer/nav (nav-state db))))))
+
+;; Changing party drops anything parked: it's a position from the party we just
+;; left, and replaying it later (on the way out of a form, say) would drag us
+;; back to people we're no longer with.
+(defn- set-party [db pid]
+  (-> db (assoc-in [:peers :roster (my-cid db) :party] pid)
+         (assoc-in [:peers :parked] nil)))
+
+(rf/reg-event-fx
+ ::join
+ (fn [{:keys [db]} [_ cid]]
+   (let [me (my-cid db) r (roster db)]
+     (if (party/joinable? r me cid)
+       (let [db (set-party db (party/join-id r cid))]
+         {:db db :peer/state (state-msg db cid)})
+       {:db db}))))
+
+(rf/reg-event-fx
+ ::go-solo
+ (fn [{:keys [db]} _]
+   (if (my-cid db)
+     (let [db (set-party db nil)]
+       {:db db :peer/state (state-msg db)})
+     {:db db})))
+
+(rf/reg-event-fx
+ ::set-joinable
+ (fn [{:keys [db]} [_ on?]]
+   (let [db (assoc-in db [:peers :joinable] (boolean on?))]
+     {:db db :peer/state (state-msg db) :peer/remember-joinable (boolean on?)})))
+
+;; Nav is the only message that steers another browser, and it arrives relayed
+;; from whatever a peer chose to send. Nothing downstream should have to cope
+;; with a shape it can't use — a bad frame reaching scene/assert-frame would
+;; throw inside the event loop and take the editor down with it.
+(defn- nav-stack
+  "The peer's stack as context keywords, or nil if it isn't one we could stand
+   in: it has to start at the root and name timelines all the way down."
+  [stack]
+  (let [ks (when (sequential? stack) (mapv #(when (string? %) (keyword %)) stack))]
+    (when (and (seq ks) (= :root (first ks)) (every? some? ks)) ks)))
+
+(defn- nav-frame [n]
+  (when (and (number? n) (not (neg? n)) (== n (js/Math.floor n))) n))
+
+(defn- standable? [db gid]
+  (contains? #{:timeline :annotation} (get-in db [:scene :groups gid :type])))
+
+;; A party-mate moved. We take their whole view — which timeline, where in it,
+;; rolling or not — because in a party anyone drives.
+(rf/reg-event-fx
+ ::peer-nav
+ (fn [{:keys [db]} [_ {:keys [cid playing] :as msg}]]
+   (let [stack    (nav-stack (:stack msg))
+         playhead (nav-frame (:playhead msg))]
+     (cond
+       (not (party/mirrors? (roster db) (my-cid db) cid))
+       ;; not (or no longer) one of ours — and if we were holding their move
+       ;; from when they were, it's stale now
+       {:db (cond-> db (= cid (get-in db [:peers :parked :cid]))
+                    (assoc-in [:peers :parked] nil))}
+
+       (not (and stack playhead)) {:db db}      ; nothing we can act on
+
+       ;; Two reasons to hold a move rather than take it, and one answer to
+       ;; both — park the latest one and replay it when the reason clears:
+       ;;   · we're authoring, so we're off on our own (::finish-edit replays)
+       ;;   · they jumped into a group we haven't been told about yet, because
+       ;;     they made it a moment ago and its scene delta is still in flight
+       ;;     (::peer-delta replays). Truncating to an ancestor instead would
+       ;;     strand us somewhere they aren't.
+       (or (authoring? db) (not (every? #(standable? db %) stack)))
+       {:db (assoc-in db [:peers :parked] msg)}
+
+       :else
+       (let [ctx       (peek stack)
+             playing?  (boolean (get-in db [:view :playing?]))
+             transport (not= (boolean playing) playing?)
+             db        (-> db
+                           (assoc-in [:peers :parked] nil)
+                           (assoc-in [:peers :echo] transport)
+                           (assoc-in [:view :stack] stack)
+                           (assoc-in [:view :playheads ctx] playhead))]
+         (cond-> (merge (sync-route {:db db} db) (seek-fx db))
+           (and transport playing)       (assoc :player/play true)
+           (and transport (not playing)) (assoc :player/pause true)))))))
 
 
 (rf/reg-event-fx
@@ -611,14 +877,29 @@
                          sf    (scene/local->source segs local)]
                      {:db db :player/seek (when sf (/ sf (:fps db)))})))
 
+;; `source` is :tick when the playback clock moved us rather than the user; the
+;; party hears about deliberate moves only (see sync-view).
 (rf/reg-event-fx ::set-playhead
-                 (fn [{:keys [db]} [_ ctx lf]]
+                 (fn [{:keys [db]} [_ ctx lf source]]
                    (let [lf      (scene/assert-frame "playhead" lf)
                          next-db (-> db
                                      (assoc-in [:view :playheads ctx] lf)
                                      (sync-draft-mark-for-playhead ctx lf))]
-                     (sync-route {:db next-db} next-db))))
+                     (if (= :tick source)
-(rf/reg-event-db ::set-playing (fn [db [_ p]] (assoc-in db [:view :playing?] p)))
+                       (sync-route {:db next-db} next-db)
+                       (sync-view {:db next-db} next-db)))))
+;; The <video> is the source of truth here, so this fires both for our own
+;; transport and for a play the party started. Re-broadcasting the latter would
+;; bounce the starter's playhead back at them, so ::peer-nav flags the plays it
+;; asked for and we swallow exactly those.
+(rf/reg-event-fx ::set-playing
+                 (fn [{:keys [db]} [_ p]]
+                   (let [echo?   (get-in db [:peers :echo])
+                         next-db (-> db (assoc-in [:view :playing?] p)
+                                        (assoc-in [:peers :echo] false))]
+                     (if echo?
+                       {:db next-db}
+                       (sync-view {:db next-db} next-db)))))
 ;; reveal an annotation's immediate children into the current timeline lane
 (rf/reg-event-db ::toggle-children
                  (fn [db [_ gid]]
@@ -632,11 +913,8 @@
 ;; we land in, at its remembered playhead (0 = that context's start).
 (defn- enter-ctx
   [db stack-fn]
-  (let [db   (update-in db [:view :stack] stack-fn)
+  (let [db (update-in db [:view :stack] stack-fn)]
-        ctx  (peek (get-in db [:view :stack]))
+    (sync-view (merge {:db db :player/pause true} (seek-fx db)) db)))
-        segs (scene/content-segments (:scene db) ctx)
-        sf   (scene/local->source segs (scene/playhead (:view db) ctx))]
-    (sync-route {:db db :player/pause true :player/seek (when sf (/ sf (:fps db)))} db)))
 
 (rf/reg-event-fx ::expand   (fn [{:keys [db]} [_ gid]] (enter-ctx db #(conj % gid))))
 (rf/reg-event-fx ::collapse (fn [{:keys [db]} _] (enter-ctx db #(if (> (count %) 1) (pop %) %))))
@@ -685,15 +963,17 @@
 
 ;; Edit the annotation you're currently inside: drop into its parent timeline so
 ;; its marks are editable there, remembering to pop back when done. Root has no
-;; parent (and no marks) — edit it in place.
+;; parent (and no marks) — edit it in place. The draft flag goes on *before* the
+;; pop, so that pop is ours alone and doesn't drag the party up a level with us.
 (rf/reg-event-fx ::edit-here
                  (fn [{:keys [db]} [_ gid]]
                    (let [root? (= :timeline (get-in db [:scene :groups gid :type]))
+                         db    (-> db (assoc-in [:scene :groups gid :draft] :edit)
+                                      (assoc-in [:view :pt] :new)
+                                      (assoc-in [:view :edit-return] (when-not root? gid)))
                          fx    (if root? {:db db} (enter-ctx db pop))]
-                     (update fx :db #(-> % (assoc-in [:scene :groups gid :draft] :edit)
+                     (update fx :db #(assoc-in % [:view :edit-context]
-                                           (assoc-in [:view :pt] :new)
+                                               (peek (get-in % [:view :stack])))))))
-                                           (assoc-in [:view :edit-context] (peek (get-in % [:view :stack])))
-                                           (assoc-in [:view :edit-return] (when-not root? gid)))))))
 (rf/reg-event-fx ::finish-edit
                  (fn [{:keys [db]} _]
                    ;; leaving the form (save OR cancel): tear down all authoring
@@ -704,8 +984,16 @@
                                       (assoc-in [:view :pt] nil)
                                       (assoc-in [:view :draft-stage] nil)
                                       (assoc-in [:view :edit-return] nil)
-                                      (assoc-in [:view :edit-context] nil))]
+                                      (assoc-in [:view :edit-context] nil))
+                         ;; back on the party's clock: whatever it did while we
+                         ;; were heads-down is parked, and replaying it now puts
+                         ;; us exactly where the others are. It also takes
+                         ;; priority over hopping back into the annotation we
+                         ;; were editing — that hop would only broadcast a
+                         ;; position we're about to leave.
+                         parked   (get-in db [:peers :parked])]
                      (cond
+                       parked   {:db db :dispatch [::peer-nav parked]}
                        return-g (enter-ctx db #(conj % return-g))
                        :else    {:db db}))))
 (rf/reg-event-db ::draft-focus (fn [db [_ pt]]    (assoc-in db [:view :pt] pt)))

tl/src/tl/party.cljs

@@ -0,0 +1,85 @@
+(ns tl.party
+  "Ad-hoc viewing parties, derived from the presence roster.
+
+   Presence is a flat map of cid → {:cid :user :party :joinable}, gossiped over
+   the project socket (tl.api). A party is nothing but an id that its members
+   carry: nobody hosts one, you only join one. Joining someone who is flying
+   solo adopts *their cid* as the id, so two people clicking Join in the same
+   instant land in the same party, and the party outlives whoever was joined
+   first. Everyone in a party drives everyone else — a nav from any member
+   moves all the others — which is why joining someone needs their consent
+   (:joinable), and why leaving is one click.
+
+   Everything here is a pure function of the roster, so every peer computes the
+   same answer from the same gossip and the server never has to know any of it."
+  (:refer-clojure :exclude [groups]))
+
+(defn party-of [roster cid] (get-in roster [cid :party]))
+
+(defn members
+  "cids carrying party id `pid`. nil isn't a party, so it has no members."
+  [roster pid]
+  (if pid
+    (into #{} (keep (fn [[cid p]] (when (= pid (:party p)) cid))) roster)
+    #{}))
+
+(defn peers
+  "The OTHER members of `cid`'s party."
+  [roster cid]
+  (disj (members roster (party-of roster cid)) cid))
+
+(defn in-party?
+  "A party id nobody else carries isn't a party — it's a join that went
+   unanswered, or the last one standing. Either way: solo."
+  [roster cid]
+  (boolean (seq (peers roster cid))))
+
+(defn join-id
+  "The party id you take on by joining `cid`: theirs if they're in one, else
+   their own cid. Deriving it from the target rather than minting a fresh one
+   is what makes simultaneous joins converge on a single party."
+  [roster cid]
+  (or (party-of roster cid) cid))
+
+(defn joinable?
+  "May `me` join `cid`? They have to be someone else, have to be letting people
+   in, and have to not already be in the party we're in."
+  [roster me cid]
+  (boolean (and me cid (not= me cid)
+                (get-in roster [cid :joinable])
+                (let [theirs (party-of roster cid)]
+                  (or (nil? theirs) (not= theirs (party-of roster me)))))))
+
+(defn mirrors?
+  "Does `me` apply a nav broadcast from `sender`? Same party, different person."
+  [roster me sender]
+  (let [mine (party-of roster me)]
+    (boolean (and me (not= me sender) mine (= mine (party-of roster sender))))))
+
+(defn responder
+  "The one member of `pid` that answers `newcomer` with the party's current
+   position, so a join draws a single reply instead of one per member: the
+   lowest cid among the members who were already there. Deterministic, and
+   still hostless — it's recomputed from whoever is present."
+  [roster pid newcomer]
+  (first (sort (disj (members roster pid) newcomer))))
+
+(defn groups
+  "The roster laid out for the who's-viewing menu: parties first — mine, then
+   the rest largest-first — and everyone flying solo in a final {:id nil} group.
+   Members are named maps (:cid merged in), sorted by username."
+  [roster me]
+  (let [named   (fn [cid] (assoc (get roster cid) :cid cid))
+        by-user (fn [cids] (mapv named (sort-by (juxt #(str (get-in roster [% :user])) str) cids)))
+        mine    (party-of roster me)
+        parties (->> (keep :party (vals roster))
+                     distinct
+                     (keep (fn [pid]
+                             (let [m (members roster pid)]
+                               (when (> (count m) 1)
+                                 {:id pid :members (by-user m)}))))
+                     (sort-by (juxt #(not= mine (:id %)) #(- (count (:members %))) #(str (:id %))))
+                     vec)
+        solo    (by-user (remove #(in-party? roster %) (keys roster)))]
+    (cond-> parties
+      (seq solo) (conj {:id nil :members solo}))))

tl/src/tl/subs.cljs

@@ -2,6 +2,7 @@
   (:require [clojure.string :as str]
             [re-frame.core :as rf]
             [tl.filter :as filter]
+            [tl.party :as party]
             [tl.scene :as scene]))
 
 (rf/reg-sub ::status  (fn [db] (get-in db [:load :status])))
@@ -53,6 +54,46 @@
 
 (rf/reg-sub ::context :<- [::stack] (fn [stack _] (peek stack)))
 
+;; --- presence / parties ---------------------------------------------------
+
+(rf/reg-sub ::my-cid   (fn [db] (get-in db [:peers :me])))
+(rf/reg-sub ::roster   (fn [db] (get-in db [:peers :roster] {})))
+(rf/reg-sub ::joinable (fn [db] (boolean (get-in db [:peers :joinable]))))
+
+;; everyone on the socket, me first, for the avatar cluster — each flagged with
+;; whether they're in the party I'm in.
+(rf/reg-sub
+ ::peers
+ :<- [::roster] :<- [::my-cid]
+ (fn [[r me] _]
+   (let [mates (party/peers r me)]
+     (->> (vals r)
+          (sort-by (juxt #(not= me (:cid %)) #(str (:user %)) :cid))
+          (mapv #(assoc % :you? (= me (:cid %)) :mate? (contains? mates (:cid %))))))))
+
+(rf/reg-sub ::in-party? :<- [::roster] :<- [::my-cid]
+            (fn [[r me] _] (party/in-party? r me)))
+
+;; authoring detaches us from the party until the form closes (see ::finish-edit)
+(rf/reg-sub ::detached? :<- [::in-party?] :<- [::draft-group]
+            (fn [[in? draft] _] (boolean (and in? draft))))
+
+;; the who's-viewing menu: parties (mine first) then everyone flying solo, with
+;; each row told whether I'm allowed to join it.
+(rf/reg-sub
+ ::peer-groups
+ :<- [::roster] :<- [::my-cid]
+ (fn [[r me] _]
+   (let [mine (party/party-of r me)]
+     (mapv (fn [g]
+             (-> g
+                 (assoc :mine? (and (:id g) (= (:id g) mine)))
+                 (update :members
+                         (fn [ms] (mapv #(assoc % :you? (= me (:cid %))
+                                                  :join? (party/joinable? r me (:cid %)))
+                                        ms)))))
+           (party/groups r me)))))
+
 ;; Any non-draft annotation can receive marks from the current context.
 (rf/reg-sub
  ::associate-targets
@@ -264,12 +305,16 @@
 (defn- binding-bars [scene ctx segs annotations bound]
   (vec
    (mapcat (fn [gid]
-             (let [g (get-in scene [:groups gid])]
+             (let [g (get-in scene [:groups gid])
+                   segments (scene/resolve scene gid)
+                   bars #(if (= gid ctx)
+                           (scene/merge-bars (map :local %))
+                           (scene/project-bars % segs))]
                (concat
                 (when (seq (bound g))
-                  [{:gids (bound g) :bars (scene/project-bars (scene/resolve scene gid) segs)}])
+                  [{:gids (bound g) :bars (bars segments)}])
                 (for [m (:marks g) :when (seq (bound m))]
-                  {:gids (bound m) :bars (scene/mark-bars scene gid (:id m) segs)}))))
+                  {:gids (bound m) :bars (bars (filter #(= (:id m) (:mark %)) segments))}))))
            (conj (set (map :id annotations)) ctx))))
 
 (rf/reg-sub ::drawing-bars

tl/src/tl/views.cljs

@@ -152,10 +152,10 @@
                                   discontinuity? (assoc :pending-ns ns))))
                   (when discontinuity?
                     (seek-video! fps ns))
-                  (rf/dispatch [::events/set-playhead ctx nl]))
+                  (rf/dispatch [::events/set-playhead ctx nl :tick]))
-              (do (rf/dispatch [::events/set-playhead ctx (+ ls (- se ss))])  ; snap to the very end
+              (do (rf/dispatch [::events/set-playhead ctx (+ ls (- se ss)) :tick]) ; snap to the very end
                   (.pause v)))                                   ; end → pause event disengages
-            (rf/dispatch [::events/set-playhead ctx (+ ls (- sf ss))])))))
+            (rf/dispatch [::events/set-playhead ctx (+ ls (- sf ss)) :tick])))))
     (when @play (reset! raf (js/requestAnimationFrame play-tick)))))
 
 (defn- engage-play!
@@ -188,6 +188,15 @@
 
 ;; effects the stack events use to keep the player on the current context
 (rf/reg-fx :player/pause (fn [_]    (when-let [v @video-el] (.pause v))))
+;; A party-mate started playback. .play() can be refused (autoplay policy, if
+;; this tab has had no interaction yet) — say so rather than leaving an
+;; unhandled rejection, because ::set-playing is also what clears the flag that
+;; stops us echoing a mirrored play back at them.
+(rf/reg-fx :player/play  (fn [_] (when-let [v @video-el]
+                                   (when (.-paused v)
+                                     (some-> (.play v)
+                                             (.catch (fn [_]
+                                                       (rf/dispatch [::events/set-playing false]))))))))
 (rf/reg-fx :player/seek  (fn [secs] (when (and @video-el secs) (set! (.-currentTime @video-el) secs))))
 
 (defn- ann-scroll-to?
@@ -1205,13 +1214,13 @@
                       (when (has-type? e "text/ann")
                         (.stopPropagation e) (.preventDefault e) (reset! over? true)))
      :on-drag-leave (fn [_] (reset! over? false))
-     ;; plain drop MOVES the edge you grabbed onto this card; ⌜⌥/Alt⌟-drop ADDS
+     ;; plain drop MOVES the edge you grabbed onto this card; SHIFT-drop LINKS
-     ;; (links, keeping the source edge).
+     ;; (adds this edge, keeping the source one) — Blender's M / ⇧M.
      :on-drop       (fn [e]
                       (let [src (.. e -dataTransfer (getData "text/ann"))]
                         (when (seq src)
                           (.stopPropagation e) (.preventDefault e) (reset! over? false)
-                          (rf/dispatch [::events/reparent (keyword src) (:id a) (.-altKey e)]))))}))
+                          (rf/dispatch [::events/reparent (keyword src) (:id a) (.-shiftKey e)]))))}))
 
 (defn- annotation-card [a scene ctx segs nmap authed? open by-parent revealed source-parent seen]
   (r/with-let [over? (r/atom false) hov? (r/atom false)]
@@ -2092,6 +2101,72 @@
              [:button {:on-click #(grab (routes/project-url id [:root] nil) :project)}
               (if (= @copied :project) "✓ Link copied" "Copy link to the whole project")]]])]))))
 
+;; --- who's viewing: presence + ad-hoc parties -----------------------------
+;; The cluster of faces is the Google-Docs part; the menu behind it is where a
+;; party is joined or left. Nobody hosts a party — see tl.party — so every row
+;; offers the same thing: Join, or (for the one you're in) Leave.
+
+(defn- avatar [{:keys [user you? mate?]}]
+  [:span.avatar {:class (str (when mate? "mate ") (when you? "you"))
+                 :style {:background (str "hsl(" (mod (hash (or user "guest")) 360)
+                                          " 58% 58%)")}
+                 :title (str user (when you? " (you)"))}
+   (str/upper-case (subs (if (seq user) user "?") 0 1))])
+
+(defn- peer-group-row [{:keys [id mine? members]}]
+  [:div.peer-group {:class (when mine? "mine")}
+   [:div.peer-group-head
+    [:span (cond mine?     (str "Your party · " (count members))
+                 (nil? id) "Not in a party"
+                 :else     (str "Party · " (count members)))]
+    (cond
+      mine? [:button.link-btn {:on-click #(rf/dispatch [::events/go-solo])} "Leave"]
+      id    (when-let [door (some #(when (:join? %) (:cid %)) members)]
+              [:button.link-btn {:on-click #(rf/dispatch [::events/join door])} "Join"]))]
+   (for [p members]
+     ^{:key (:cid p)}
+     [:div.peer-row
+      [avatar p]
+      [:span.peer-name (:user p) (when (:you? p) [:span.peer-you " (you)"])]
+      (cond
+        (:you? p)  nil
+        (:join? p) [:button.link-btn {:on-click #(rf/dispatch [::events/join (:cid p)])} "Join"]
+        ;; only once we've actually heard them say so — an absent flag just
+        ;; means their state hasn't come round yet
+        (false? (:joinable p)) [:span.peer-closed "not joinable"])])])
+
+(defn presence []
+  (let [open? (r/atom false)]
+    (fn []
+      (let [peers    @(rf/subscribe [::subs/peers])
+            in?      @(rf/subscribe [::subs/in-party?])
+            off?     @(rf/subscribe [::subs/detached?])
+            joinable @(rf/subscribe [::subs/joinable])
+            extra    (max 0 (- (count peers) 4))]
+        (when (seq peers)
+          [:div.menu-wrap.presence {:class (str (when in? "in-party ") (when off? "detached"))}
+           [:button.avatars {:on-click #(swap! open? not)
+                             :title (cond off? "Editing on your own — you'll catch up with the party when you're done"
+                                          in?  "You're in a party"
+                                          :else "Who's viewing")}
+            (when in? [:span.party-tag (if off? "editing" "party")])
+            (for [p (take 4 peers)] ^{:key (:cid p)} [avatar p])
+            (when (pos? extra) [:span.avatar.more (str "+" extra)])]
+           (when in?
+             [:button.bar-btn.solo-btn {:on-click #(rf/dispatch [::events/go-solo])
+                                        :title "Watch on your own again"} "Leave"])
+           (when @open?
+             [:<>
+              [:div.menu-backdrop {:on-click #(reset! open? false)}]
+              [:div.menu-pop.peer-pop
+               (for [g @(rf/subscribe [::subs/peer-groups])]
+                 ^{:key (str (:id g))} [peer-group-row g])
+               [:label.peer-setting
+                [:input {:type "checkbox" :checked joinable
+                         :on-change #(rf/dispatch [::events/set-joinable
+                                                   (.. % -target -checked)])}]
+                "Let others join me"]]])])))))
+
 (defn user-menu []
   (let [open? (r/atom false)]
     (fn []
@@ -2121,6 +2196,7 @@
       [:span.title-name (or (:name proj)
                             (when (= :loading @(rf/subscribe [::subs/status])) "Loading…"))]]
      [:div.titlebar-right
+      [presence]
       [share-menu]
       (when authed? [user-menu])]]))
 

tl/test/tl/flow_test.cljs

@@ -8,10 +8,17 @@
             [tl.scene :as s]
             [tl.scene-test :as fixture]))
 
-(doseq [k [:player/pause :player/seek :http-xhrio :route :route/replace-project-state
+(doseq [k [:player/pause :player/play :player/seek :http-xhrio :route
-           :connect-scene :fetch-projects :poll-thumbnails :upload-project]]
+           :route/replace-project-state :connect-scene :fetch-projects
+           :poll-thumbnails :upload-project :peer/remember-joinable]]
   (rf/reg-fx k (fn [_] nil)))
 
+;; presence effects are the wire; capture instead of stubbing so the tests can
+;; assert on what the party would actually hear.
+(defonce sent (atom []))
+(rf/reg-fx :peer/nav   (fn [m] (swap! sent conj [:nav m])))
+(rf/reg-fx :peer/state (fn [m] (swap! sent conj [:state m])))
+
 (defn seed []
   (let [sc (-> fixture/base
                (fixture/annotation :a1 [:root] (s/make-mark fixture/base :root 0 100))
@@ -21,6 +28,16 @@
 (defn setup! [scene stack]
   (reset! rdb/app-db {:scene scene :fps 24 :project {:id nil}
                       :view {:stack stack :playheads {} :revealed #{} :zoom 1 :row-h 20}}))
+(defn peers!
+  "Put us on the socket as `me`, in a party with `mates` when there are any."
+  [me mates]
+  (reset! sent [])
+  (swap! rdb/app-db assoc :project {:id 7}
+         :peers {:me me :joinable true
+                 :roster (into {me {:cid me :user me :party (when (seq mates) "p")}}
+                               (map (fn [c] [c {:cid c :user c :party "p" :joinable true}]))
+                               mates)}))
+
 (defn scene* [] (:scene @rdb/app-db))
 (defn group [gid] (get-in (scene*) [:groups gid]))
 (defn pane-ids [] (set (map :id @(rf/subscribe [::subs/all-annotations]))))
@@ -157,6 +174,28 @@
    (is (= [:d] (mapv :id @(rf/subscribe [::subs/active-drawings]))))
    (is (= #{:n} @(rf/subscribe [::subs/active-note-set])))))
 
+(deftest repeated-marks-bind-to-own-occurrences-but-project-in-other-contexts
+  (rf-test/run-test-sync
+   (let [marks (mapv (fn [i [a b]]
+                       (assoc (fixture/mark i (fixture/part :a a b))
+                              :drawings [i] :notes [i]))
+                     [:d1 :d2 :d3 :d4] [[12 72] [51 96] [22 77] [22 90]])
+         sc (reduce #(assoc-in %1 [:groups %2] {:type :drawing :strokes []})
+                    (apply fixture/annotation fixture/base :repeat [:root] marks)
+                    [:d1 :d2 :d3 :d4])]
+     (setup! sc [:root :repeat])
+     (doseq [[frame expected] [[0 #{:d1}] [55 #{:d1}] [59 #{:d1}]
+                               [60 #{:d2}] [104 #{:d2}] [105 #{:d3}]
+                               [159 #{:d3}] [160 #{:d4}] [227 #{:d4}] [228 #{}]]]
+       (rf/dispatch [::ev/set-playhead :repeat frame])
+       (is (= expected (set (map :id @(rf/subscribe [::subs/active-drawings])))))
+       (is (= expected @(rf/subscribe [::subs/active-note-set]))))
+     (setup! sc [:root])
+     (rf/dispatch [::ev/set-playhead :root 67])
+     (is (= #{:d1 :d2 :d3 :d4}
+            (set (map :id @(rf/subscribe [::subs/active-drawings])))))
+     (is (= #{:d1 :d2 :d3 :d4} @(rf/subscribe [::subs/active-note-set]))))))
+
 (deftest nested-repeat-projection-is-shared-by-editor-and-lane
   (rf-test/run-test-sync
    (setup! fixture/base [:root])
@@ -228,3 +267,153 @@
    (rf/dispatch [::ev/reparent :x :b1])
    (is (= #{:b1} (s/membership (scene*) :x)))
    (is (not (contains? (pane-ids) :x)))))
+
+;; --- presence / ad-hoc parties -------------------------------------------
+
+(deftest a-party-mates-jump-takes-us-with-them
+  (rf-test/run-test-sync
+   (setup! (seed) [:root])
+   (peers! "me" ["you"])
+   (rf/dispatch [::ev/peer-nav {:cid "you" :stack ["root" "a1"] :playhead 5 :playing false}])
+   (is (= [:root :a1] @(rf/subscribe [::subs/stack])))
+   (is (= 5 @(rf/subscribe [::subs/playhead])))
+   (testing "someone outside the party doesn't move us"
+     (rf/dispatch [::ev/peer-nav {:cid "stranger" :stack ["root"] :playhead 0 :playing false}])
+     (is (= [:root :a1] @(rf/subscribe [::subs/stack]))))
+   (testing "and neither does our own broadcast coming back"
+     (rf/dispatch [::ev/peer-nav {:cid "me" :stack ["root"] :playhead 0 :playing false}])
+     (is (= [:root :a1] @(rf/subscribe [::subs/stack]))))))
+
+(deftest a-jump-into-an-annotation-we-have-not-been-told-about-waits-for-it
+  ;; the save that created it is a PUT and the jump rides the socket, so the two
+  ;; can land out of order. Park the jump rather than stranding us at the root.
+  (rf-test/run-test-sync
+   (setup! (seed) [:root])
+   (peers! "me" ["you"])
+   (rf/dispatch [::ev/peer-nav {:cid "you" :stack ["root" "fresh"] :playhead 0 :playing false}])
+   (is (= [:root] @(rf/subscribe [::subs/stack])))
+   (rf/dispatch [::ev/peer-delta {:changed {:fresh {:type "annotation" :in ["root"]
+                                                    :name "fresh" :marks []}}}])
+   (is (= [:root :fresh] @(rf/subscribe [::subs/stack])))
+   (is (nil? (get-in @rdb/app-db [:peers :parked])))))
+
+(deftest a-peer-deleting-the-timeline-we-are-standing-in-pops-us-out
+  (rf-test/run-test-sync
+   (setup! (seed) [:root :a1])
+   (peers! "me" [])
+   (rf/dispatch [::ev/peer-delta {:deleted ["a1"]}])
+   (is (= [:root] @(rf/subscribe [::subs/stack])))))
+
+(deftest being-joined-adopts-the-party-and-answers-with-where-we-are
+  (rf-test/run-test-sync
+   (setup! (seed) [:root])
+   (peers! "me" [])
+   (rf/dispatch [::ev/peer-state {:cid "you" :user "you" :party "me"
+                                  :joinable true :joining "me"}])
+   (is (= "me" (get-in @rdb/app-db [:peers :roster "me" :party])))
+   (is (= #{:state :nav} (set (map first @sent))))
+   (testing "with the door shut, a join doesn't pull us in"
+     (peers! "solo" [])
+     (swap! rdb/app-db assoc-in [:peers :joinable] false)
+     (rf/dispatch [::ev/peer-state {:cid "you" :user "you" :party "solo"
+                                    :joinable true :joining "solo"}])
+     (is (nil? (get-in @rdb/app-db [:peers :roster "solo" :party]))))))
+
+(deftest only-deliberate-moves-reach-the-party
+  (rf-test/run-test-sync
+   (setup! (seed) [:root])
+   (peers! "me" ["you"])
+   (rf/dispatch [::ev/set-playhead :root 10 :tick])   ; the playback clock ticking
+   (is (= [] @sent))
+   (rf/dispatch [::ev/set-playhead :root 20])         ; a scrub
+   (rf/dispatch [::ev/expand :a1])
+   (is (= [["root"] ["root" "a1"]] (map (comp :stack second) @sent)))
+   (testing "and a party of one says nothing at all"
+     (peers! "me" [])
+     (rf/dispatch [::ev/set-playhead :root 30])
+     (is (= [] @sent)))))
+
+(deftest a-mirrored-play-is-not-echoed-back-at-the-peer-who-started-it
+  (rf-test/run-test-sync
+   (setup! (seed) [:root])
+   (peers! "me" ["you"])
+   (rf/dispatch [::ev/peer-nav {:cid "you" :stack ["root"] :playhead 0 :playing true}])
+   (reset! sent [])
+   (rf/dispatch [::ev/set-playing true])              ; our <video> reporting the play
+   (is (= [] @sent))
+   (testing "our own next transport change still goes out"
+     (rf/dispatch [::ev/set-playing false])
+     (is (= [:nav] (map first @sent))))))
+
+(deftest authoring-detaches-from-the-party-and-catches-up-on-the-way-out
+  (rf-test/run-test-sync
+   (setup! (seed) [:root])
+   (peers! "me" ["you"])
+   (rf/dispatch [::ev/edit-annotation :a1])          ; hunting for marks
+   (reset! sent [])
+   (testing "our mark-hunting is our own business"
+     (rf/dispatch [::ev/set-playhead :root 40])
+     (rf/dispatch [::ev/expand :b1])
+     (is (= [] @sent)))
+   (testing "and the party can't drag us off the form"
+     (rf/dispatch [::ev/peer-nav {:cid "you" :stack ["root"] :playhead 120 :playing false}])
+     (is (= [:root :b1] @(rf/subscribe [::subs/stack])))
+     (is (some? (get-in @rdb/app-db [:peers :parked]))))
+   (testing "closing the form puts us exactly where the party got to"
+     (rf/dispatch [::ev/save-group :a1 (group :a1) (group :a1)])
+     (rf/dispatch [::ev/finish-edit])
+     (is (= [:root] @(rf/subscribe [::subs/stack])))
+     (is (= 120 @(rf/subscribe [::subs/playhead])))
+     (is (nil? (get-in @rdb/app-db [:peers :parked]))))))
+
+(deftest opening-an-annotation-to-edit-it-does-not-pull-the-party-up-a-level
+  (rf-test/run-test-sync
+   (setup! (seed) [:root :a1])
+   (peers! "me" ["you"])
+   (rf/dispatch [::ev/edit-here :a1])                ; pops to :root to expose marks
+   (is (= [:root] @(rf/subscribe [::subs/stack])))
+   (is (= [] @sent))))
+
+(deftest a-malformed-nav-is-ignored-not-obeyed-and-never-throws
+  ;; nav is the only message that steers another browser, and it arrives
+  ;; relayed from whatever a peer chose to send
+  (rf-test/run-test-sync
+   (setup! (seed) [:root :a1])
+   (peers! "me" ["you"])
+   (doseq [bad [{:stack ["root" "a1"] :playhead 10.5}       ; not a frame
+                {:stack ["root" "a1"] :playhead -4}
+                {:stack ["root" "a1"] :playhead nil}
+                {:stack ["a1"] :playhead 0}                 ; doesn't start at the root
+                {:stack [] :playhead 0}
+                {:stack nil :playhead 0}
+                {:stack ["root" 7] :playhead 0}]]
+     (rf/dispatch [::ev/peer-nav (assoc bad :cid "you" :playing false)])
+     (is (= [:root :a1] @(rf/subscribe [::subs/stack])) (pr-str bad))
+     (is (nil? (get-in @rdb/app-db [:peers :parked])) (pr-str bad)))
+   (testing "and a context we could never stand in is held, not entered"
+     ;; :a is a clip — it exists, so it is not a not-yet-synced group
+     (rf/dispatch [::ev/peer-nav {:cid "you" :stack ["root" "a"] :playhead 0 :playing false}])
+     (is (= [:root :a1] @(rf/subscribe [::subs/stack]))))))
+
+(deftest leaving-the-party-drops-a-move-we-were-holding
+  (rf-test/run-test-sync
+   (setup! (seed) [:root])
+   (peers! "me" ["you"])
+   (rf/dispatch [::ev/edit-annotation :a1])              ; detached: their move parks
+   (rf/dispatch [::ev/peer-nav {:cid "you" :stack ["root" "b1"] :playhead 3 :playing false}])
+   (is (some? (get-in @rdb/app-db [:peers :parked])))
+   (rf/dispatch [::ev/go-solo])                          ; …but then we leave
+   (is (nil? (get-in @rdb/app-db [:peers :parked])))
+   (rf/dispatch [::ev/save-group :a1 (group :a1) (group :a1)])
+   (rf/dispatch [::ev/finish-edit])
+   (is (= [:root] @(rf/subscribe [::subs/stack])) "not dragged back to people we left")))
+
+(deftest a-held-move-from-someone-who-left-the-party-is-dropped-on-replay
+  (rf-test/run-test-sync
+   (setup! (seed) [:root])
+   (peers! "me" ["you"])
+   (rf/dispatch [::ev/edit-annotation :a1])
+   (rf/dispatch [::ev/peer-nav {:cid "you" :stack ["root" "b1"] :playhead 3 :playing false}])
+   (swap! rdb/app-db assoc-in [:peers :roster "you" :party] nil)   ; they went solo
+   (rf/dispatch [::ev/peer-delta {}])                              ; triggers the replay
+   (is (nil? (get-in @rdb/app-db [:peers :parked])))))

tl/test/tl/party_test.cljs

@@ -0,0 +1,61 @@
+(ns tl.party-test
+  (:require [cljs.test :refer-macros [deftest is testing]]
+            [tl.party :as party]))
+
+(defn- roster [& entries]
+  (into {} (map (fn [[cid user p joinable]]
+                  [cid {:cid cid :user user :party p :joinable (not (false? joinable))}]))
+        entries))
+
+(def ^:private solo (roster ["a" "ann" nil] ["b" "bo" nil] ["c" "cy" nil]))
+
+(deftest joining-a-solo-peer-takes-their-cid-as-the-party-id
+  ;; deterministic, so two people clicking Join at once converge instead of
+  ;; minting two parties that each end up with one member
+  (is (= "a" (party/join-id solo "a")))
+  (is (= "a" (party/join-id (assoc-in solo ["b" :party] "a") "b"))))
+
+(deftest a-party-id-nobody-else-carries-is-not-a-party
+  (let [r (assoc-in solo ["b" :party] "a")]          ; b joined a; a hasn't answered
+    (is (not (party/in-party? r "b")))
+    (is (empty? (party/peers r "b")))))
+
+(deftest members-drive-each-other-and-nobody-else
+  (let [r (-> solo (assoc-in ["a" :party] "a") (assoc-in ["b" :party] "a"))]
+    (is (party/in-party? r "a"))
+    (is (= #{"b"} (party/peers r "a")))
+    (is (party/mirrors? r "a" "b"))
+    (is (party/mirrors? r "b" "a"))
+    (is (not (party/mirrors? r "a" "a")))            ; never our own broadcast
+    (is (not (party/mirrors? r "c" "a")))            ; outsider stays put
+    (is (not (party/mirrors? r "a" "c")))))
+
+(deftest joining-needs-consent-and-is-not-offered-twice
+  (let [r (-> solo (assoc-in ["a" :party] "a") (assoc-in ["b" :party] "a")
+              (assoc-in ["c" :joinable] false))]
+    (is (party/joinable? r "c" "a"))                 ; c may join a's party
+    (is (not (party/joinable? r "a" "c")))           ; c is not letting people in
+    (is (not (party/joinable? r "a" "b")))           ; already in it together
+    (is (not (party/joinable? r "a" "a")))))         ; not ourselves
+
+(deftest one-member-answers-a-newcomer-and-it-is-never-the-newcomer
+  (let [r (-> solo (assoc-in ["a" :party] "a") (assoc-in ["b" :party] "a")
+              (assoc-in ["c" :party] "a"))]
+    (is (= "a" (party/responder r "a" "c")))
+    (is (= "a" (party/responder r "a" "b")))
+    ;; the peer that was joined answers, even though the joiner minted the id
+    (is (= "b" (party/responder (-> solo (assoc-in ["a" :party] "b")
+                                         (assoc-in ["b" :party] "b"))
+                                "b" "a")))))
+
+(deftest menu-groups-my-party-first-then-parties-then-everyone-solo
+  (let [r (-> (roster ["a" "ann" nil] ["b" "bo" nil] ["c" "cy" nil]
+                      ["d" "di" nil] ["e" "ed" nil])
+              (assoc-in ["a" :party] "a") (assoc-in ["b" :party] "a")
+              (assoc-in ["d" :party] "d") (assoc-in ["e" :party] "d"))
+        gs (party/groups r "d")]
+    (is (= ["d" "a" nil] (mapv :id gs)))
+    (is (= [["di" "ed"] ["ann" "bo"] ["cy"]]
+           (mapv #(mapv :user (:members %)) gs)))
+    (testing "an unanswered join shows its author as solo, not as a party"
+      (is (= [nil] (mapv :id (party/groups (assoc-in solo ["b" :party] "a") "b")))))))