feat: transclusion (wip commit)

tl/shadow-cljs.edn

@@ -19,7 +19,10 @@
  {:test
   {:target    :node-test
    :output-to "target/node-tests.js"
-   :ns-regexp "-test$"}
+   :ns-regexp "-test$"
+   ;; minimal browser-global shim so tl.api / tl.routes load under node — lets the
+   ;; integration tests (tl.flow-test) drive the real re-frame events. No DOM.
+   :prepend "globalThis.window=globalThis;var __loc={protocol:'http:',hostname:'localhost',host:'localhost',origin:'http://localhost',href:'http://localhost/',hash:'',pathname:'/',search:''};globalThis.location=__loc;globalThis.window.location=__loc;globalThis.document={createElement:function(){return {style:{}};},addEventListener:function(){},removeEventListener:function(){},querySelector:function(){return null;},body:{}};globalThis.navigator={standalone:false,userAgent:'node'};var __ls={};globalThis.localStorage={getItem:function(k){return k in __ls?__ls[k]:null;},setItem:function(k,v){__ls[k]=String(v);},removeItem:function(k){delete __ls[k];}};globalThis.window.matchMedia=function(){return {matches:false,addListener:function(){},removeListener:function(){}};};globalThis.window.addEventListener=function(){};globalThis.window.removeEventListener=function(){};globalThis.window.history={replaceState:function(){},pushState:function(){}};globalThis.XMLHttpRequest=function(){};globalThis.XMLHttpRequest.prototype={open:function(){},send:function(){},setRequestHeader:function(){},abort:function(){}};"}
 
   :app
   {:target     :browser

tl/src/tl/events.cljs

@@ -797,7 +797,7 @@
    (let [scene (:scene db)
          ctx   (:parent (get-in scene [:groups gid]))
          segs  (scene/content-segments scene ctx)
-         [lo hi] (scene/mark-extent scene ctx gid mark-id segs)]
+         [lo hi] (scene/mark-extent scene gid mark-id segs)]
      (assoc-in db [:view :pt] {:proxy pid :which which :keep (if (= which :start) hi lo)}))))
 
 ;; complete a selection on the active draft: wrap the run [lo hi) in a proxy (a
@@ -897,7 +897,11 @@
          pid   (->> (get-in scene [:groups ann :marks])
                     (some #(when (= mark-id (:id %)) (get-in % [:start :ref]))))
          proxy (get-in scene [:groups pid])
-         ctx   (:parent (get-in scene [:groups ann]))
+         ;; roll against the VIEWED timeline (top of the stack), NOT the annotation's
+         ;; :parent — the drag's frames are local to what you're looking at, and a
+         ;; transcluded mark is being edited from a context other than its parent.
+         ;; For a normal (non-transcluded) mark the two are the same.
+         ctx   (peek (get-in db [:view :stack]))
          len   (scene/length (scene/content-segments scene ctx))
          ;; the dragged endpoint is a whole frame; the FIXED endpoint arrives
          ;; EXACT (fractional) so its mark re-derives identically. Only the fixed

tl/src/tl/otio.cljs

@@ -13,8 +13,14 @@
 (defn- clip? [item]
   (str/starts-with? (:OTIO_SCHEMA item "") "Clip"))
 
-(defn- frames [rational-time]
+(defn- frames
-  (:value rational-time))
+  "Frame number of a RationalTime, as a WHOLE frame. This is the ONE place a
+   fraction can enter: a rate conform (e.g. 23.976 NTSC) gives fractional source
+   positions (start_time). A frame is absolute and integer — you can't seek to half
+   a frame — so we snap here, at the boundary. Everything downstream is integer and
+   nothing else rounds (durations are already whole, so timeline tiling is exact)."
+  [rational-time]
+  (js/Math.round (:value rational-time)))
 
 (defn- clip-starts
   "Source start_time (frames) of every clip across all tracks."

tl/src/tl/scene.cljs

@@ -144,15 +144,25 @@
     (when-let [f (at->src scene (:ref point) (:at point))]   ; nil if dangling / out of range
       {:frame f})))
 
-(defn- rebase
+(defn- shift-local
-  "Shift `sub`'s :local to start at 0 and stamp :mark = `id` (the mark now owns
+  "Shift `sub`'s :local so the run starts at 0, WITHOUT touching :mark — pieces keep
-   these segments regardless of which target they were sliced from)."
+   the identity of the target they were sliced from. This is the RAW recursion's
-  [id sub]
+   output; content-segments uses it so a multi-clip mark stays a run of
+   individually-addressable clips (their own name/length/ref)."
+  [sub]
   (let [base (or (some-> sub first :local first) 0)]
     (mapv (fn [s] (let [[c d] (:local s)]
-                    (assoc s :mark id :local [(- c base) (- d base)])))
+                    (assoc s :local [(- c base) (- d base)])))
           sub)))
 
+(defn- rebase
+  "shift-local, then stamp :mark = `id` — the LANE/edit view, where the mark owns
+   every piece it resolves to (one bar per mark) regardless of which target they
+   were sliced from. The stamp is the only thing separating this from the raw
+   recursion (shift-local)."
+  [id sub]
+  (mapv #(assoc % :mark id) (shift-local sub)))
+
 (defn- instant-seg
   "A zero-length segment at local frame `la` of `tsegs` (for an instant mark),
    carrying that frame's src/track/thumb."
@@ -223,13 +233,52 @@
 
 ;; --- what the current timeline is made of --------------------------------
 
+(defn- content-mark-segs
+  "Context-local pieces of mark `m` for content-segments. A ref into a PROXY drills
+   in and exposes the proxy's per-clip run, each sub-clip mark kept individually
+   addressable (its own name/length/ref/trim, via shift-local) — instead of
+   collapsing every piece under `m`'s single id the way resolve does for the LANE
+   view (rebase). That collapse was the bug: drilling into a proxy-backed range made
+   every clip read with the FIRST piece's name + length, so sub-range selections
+   wouldn't save. Any OTHER mark — a plain clip ref, a single mark ref, an absolute
+   mark — is one piece and stays owned by `m` (resolve-mark), so nested marks there
+   remain annotation-relative, exactly as before this fix."
+  [scene gid {:keys [start end] :as m}]
+  (if (and (map? start) (= :proxy (:type (grp scene (:ref start)))))
+    (when-let [tsegs (seq (target-segs scene (:ref start)))]
+      (let [len   (length tsegs)
+            at->l #(if (neg? %) (+ len % 1) %)
+            la    (at->l (:at start))
+            lb    (at->l (:at end))]
+        (when (and (<= 0 la len) (<= 0 lb len) (<= la lb))
+          (shift-local (if (= la lb) (instant-seg tsegs la) (slice tsegs la lb))))))
+    (resolve-mark scene gid m)))
+
+(defn- content-resolve
+  "`resolve` for content-segments: lays a group's marks end to end, but each piece
+   keeps its underlying :mark (see content-mark-segs) so multi-clip marks don't
+   collapse to one addressable unit."
+  [scene gid]
+  (loop [[m & more] (:marks (grp scene gid)), off 0, out []]
+    (if (nil? m)
+      out
+      (if-let [segs (seq (content-mark-segs scene gid m))]
+        (let [len     (reduce + (map (fn [s] (apply - (reverse (:local s)))) segs))
+              shifted (mapv (fn [s] (let [[c d] (:local s)]
+                                      (assoc s :local [(+ off c) (+ off d)])))
+                            segs)]
+          (recur more (+ off len) (into out shifted)))
+        (recur more off out)))))
+
 (defn content-segments
   "The clip-segments that make up context `ctx` — what you draw and select
-   against. An annotation's marks reference clips, so that's just `resolve`. The
+   against. An annotation's marks reference clips, so that's just `resolve` — but
-   root timeline doesn't enumerate its clips (they're a parentless pool), so
+   with each piece kept distinct (see content-resolve), not flattened under the
-   there it's the pool laid at each clip's TIMELINE position (:start) with :src =
+   annotation's own mark id. The root timeline doesn't enumerate its clips (they're
-   its source range — so the assembled program tiles contiguously even though
+   a parentless pool), so there it's the pool laid at each clip's TIMELINE position
-   the underlying source frames are scattered (and fractional)."
+   (:start) with :src = its source range — so the assembled program tiles
+   contiguously even though the underlying source frames are scattered (and
+   fractional)."
   [scene ctx]
   (if (= :timeline (:type (grp scene ctx)))
     (->> (:groups scene)
@@ -241,7 +290,7 @@
                      (assoc seg :mark gid :local [st (+ st (- sb sa))])))))
          (sort-by (comp first :local))
          vec)
-    (resolve scene ctx)))
+    (content-resolve scene ctx)))
 
 (defn- src-intersect
   "Clip source ranges `rs` (each [a b)) to the coverage `cover` (each [c d))."
@@ -251,46 +300,20 @@
              :when (< lo hi)]
          [lo hi])))
 
-(defn nested-src
-  "Source ranges of annotation `gid` clipped to every ancestor annotation between
-   it and `ctx` — what's still visible once the reveal chain trims it, i.e. the
-   same content you'd see if you expanded into its parent. A direct child of `ctx`
-   is just its own resolved source (the timeline itself does the clipping later).
-   Empty ⇒ the annotation is out of range in this reveal chain."
-  [scene ctx gid]
-  (loop [p (:parent (grp scene gid)), rs (mapv :src (resolve scene gid))]
-    (if (or (nil? p) (= p ctx))
-      rs
-      (recur (:parent (grp scene p))
-             (src-intersect rs (mapv :src (resolve scene p)))))))
-
-(defn- clip-segs
-  "Clip resolved segments `ss` (each {:mark :src …}) to coverage `cover` ([c d)s),
-   keeping each seg's :mark (the mark-aware sibling of src-intersect)."
-  [ss cover]
-  (vec (for [{[a b] :src :as s} ss [c d] cover
-             :let [lo (max a c) hi (min b d)]
-             :when (< lo hi)]
-         (assoc s :src [lo hi]))))
-
-(defn nested-src-marks
-  "Like nested-src but preserves :mark on each surviving segment, so lane bars can
-   be grouped per mark (see lane-bars). Ordered as resolve lays the marks."
-  [scene ctx gid]
-  (loop [p (:parent (grp scene gid)), ss (resolve scene gid)]
-    (if (or (nil? p) (= p ctx))
-      ss
-      (recur (:parent (grp scene p)) (clip-segs ss (mapv :src (resolve scene p)))))))
-
 (defn lane-bars
   "Context-local display bars for annotation `gid`, grouped PER MARK: contiguous
    pieces coalesce WITHIN a mark but never across marks, so two abutting-but-
    distinct marks stay separate bars — the lane bar matches each mark's highlight
    1:1 instead of fusing neighbours. Each bar is `[lo hi mark-id]` (the mark-id
    lets the lane hit-test / highlight / edit one mark; consumers that only want
-   the range destructure `[lo hi]` and ignore it). `ctx-segs` = content-segments."
+   the range destructure `[lo hi]` and ignore it). `ctx-segs` = content-segments.
-  [scene ctx gid ctx-segs]
+
-  (->> (nested-src-marks scene ctx gid)
+   `resolve` already trims each mark through its whole ref chain — a nested mark
+   is a proxy-ref onto its parent's marks, so resolve(gid) ⊆ resolve(parent) ⊆ …
+   ⊆ ctx. So its :src is exactly what's visible here; projecting onto `ctx-segs`
+   is all the clipping needed (no ancestor re-walk — that was redundant)."
+  [scene gid ctx-segs]
+  (->> (resolve scene gid)
        (partition-by :mark)
        (mapcat (fn [ss]
                  (let [mid (:mark (first ss))]
@@ -303,8 +326,8 @@
    min piece-start / max piece-end, WITHOUT merge-bars' floor/ceil. Endpoint
    editing must use this (not a rounded lane bar) or the fixed end drifts a frame
    per re-roll. `ctx-segs` = content-segments of ctx."
-  [scene ctx gid mark-id ctx-segs]
+  [scene gid mark-id ctx-segs]
-  (let [pcs (->> (nested-src-marks scene ctx gid)
+  (let [pcs (->> (resolve scene gid)
                  (filter #(= mark-id (:mark %)))
                  (mapcat (fn [{[a b] :src}] (pieces ctx-segs a b))))]
     (when (seq pcs)
@@ -321,6 +344,59 @@
             own  (mapv :src (resolve scene gid))]
         (< (len (src-intersect own (mapv :src (resolve scene p)))) (len own))))))
 
+;; --- reference parent: which timeline a mark was authored in ---------------
+;; A mark's proxy DIRECTLY references a content unit of exactly one timeline — the
+;; one it was authored in. That timeline is the mark's "home"; the annotation
+;; holding the mark shows as a child there. This is one hop (a direct reference),
+;; NOT transitive resolution down to clips — so a grandchild is a child of its
+;; parent, not of the root. An annotation that collected marks from two contexts
+;; (transclusion) is a child of both. This is the "fk" the nesting rides on.
+
+(defn- ref-owner
+  "The timeline that OWNS content unit `t`: :root for a clip, else the annotation
+   whose proxy contains the mark `t` (t is one of that annotation's content units).
+   nil if `t` dangles."
+  [scene t]
+  (cond
+    (= :clip (:type (grp scene t))) :root
+    (find-mark scene t)
+    (let [[container _] (find-mark scene t)]
+      (if (= :proxy (:type (grp scene container)))
+        (some (fn [[gid g]]
+                (when (and (= :annotation (:type g))
+                           (some #(= container (get-in % [:start :ref])) (:marks g)))
+                  gid))
+              (:groups scene))
+        container))
+    :else nil))
+
+(defn mark-home
+  "The timeline mark `m` was authored in — the owner of the content unit its proxy
+   DIRECTLY references (one hop). :root for a clip-backed mark. The annotation that
+   holds `m` shows as a child of this timeline. nil if unresolvable."
+  [scene m]
+  (let [pid (get-in m [:start :ref])
+        t   (if (= :proxy (:type (grp scene pid)))
+              (get-in (first (:marks (grp scene pid))) [:start :ref])
+              pid)]
+    (ref-owner scene t)))
+
+(defn mark-homes
+  "The distinct timelines annotation `gid`'s marks are homed in — its reference
+   parent(s). Usually one; two (or more) when it collected marks from different
+   contexts (transclusion). Falls back to the structural `:parent` when the
+   annotation has no resolvable marks (a fresh draft, a fully broken one), so it
+   still shows somewhere."
+  [scene gid]
+  (let [homes (into #{} (keep #(mark-home scene %)) (:marks (grp scene gid)))]
+    (if (seq homes) homes #{(:parent (grp scene gid))})))
+
+(defn child-of?
+  "Is annotation `gid` a direct child of timeline `ctx` — a mark of its authored
+   there (homed in ctx)."
+  [scene ctx gid]
+  (contains? (mark-homes scene gid) ctx))
+
 ;; --- editing: split a local selection into a run of single-clip marks -----
 
 (defn selection->marks
@@ -526,6 +602,28 @@
 
 (defn clip-name [scene gid] (:name (grp scene gid)))
 
+;; --- context-independent labelling (for transcluded mark rows) ------------
+;; A mark collected into an annotation from another timeline (transclusion) has a
+;; ref whose clip isn't in the CURRENT context's content-segments, so the context
+;; label ("clip") + length (nil) both fail. These resolve the ref down to its clip
+;; instead — the mark's own timeline — so the row reads correctly from anywhere.
+
+(defn ref-length
+  "Own resolved length (frames) of ref target `ref`, context-independent."
+  [scene ref]
+  (length (target-segs scene ref)))
+
+(defn ref-track-name
+  "Name of the TRACK that ref target `ref` resolves onto (its first piece),
+   context-independent — the useful label for a transcluded mark whose clip isn't
+   in the current view. The clip's own :name is the shared source file (e.g.
+   \"Challengers.mov\") — identical for every clip of single-source footage — so
+   the track (A-roll / B-roll …) is what actually distinguishes them. nil if the
+   ref dangles."
+  [scene ref]
+  (when-let [t (:track (first (target-segs scene ref)))]
+    (get-in scene [:tracks t :name] (name t))))
+
 ;; --- links ----------------------------------------------------------------
 ;; A link is a ref-point {:ref id :at n} — the same shape as a mark endpoint, so
 ;; it resolves through the usual machinery — named inside an annotation's markdown
@@ -572,15 +670,22 @@
             [] pts)))
 
 (defn jump-targets
-  "One target per discontinuity for an annotation's jump popover — labelled from
+  "One target per discontinuity for an annotation's jump popover, labelled from the
-   the owning mark's clip ref + frame, the SAME basis the annotation editor uses
+   CONTENT SEGMENT the run lands on in `ctx` — its clip/track id + the frame within
-   (clip-label of :ref), so the jump label can never disagree with the mark row.
+   it. A mark's :start is its proxy-ref ({:ref proxy :at 0}), so display-point of it
-   Each: {:local <ctx frame to seek> :seg <clip ref> :f <mark-time frame>}."
+   would give the proxy gid (never in `segs` → a bare \"clip\") and frame 0; instead
+   we read the actual clip under the run's local position, the same segments the
+   editor labels against. Each: {:local <ctx frame to seek> :seg <content id> :f}."
   [scene ctx gid]
-  (mapv (fn [{:keys [id lo]}]
+  (let [csegs (content-segments scene ctx)]
-          (let [st (:start (some #(when (= id (:id %)) %) (:marks (grp scene gid))))]
+    (mapv (fn [{:keys [lo]}]
-            (assoc (display-point scene st) :local lo)))   ; same cell as the editor row
+            (let [seg (or (some (fn [{[c d] :local :as s} ] (when (and (<= c lo) (< lo d)) s)) csegs)
-        (runs scene ctx gid)))
+                          (some (fn [{[_ d] :local :as s} ] (when (= d lo) s)) csegs)
+                          (last csegs))]
+              {:local lo
+               :seg   (:mark seg)
+               :f     (js/Math.round (- lo (first (:local seg [0 0]))))}))
+          (runs scene ctx gid))))
 
 (defn linkables
   "Pickable link targets within `ctx`, grouped for the autocomplete: one group

tl/src/tl/subs.cljs

@@ -118,18 +118,32 @@
  ::all-annotations
  :<- [::scene] :<- [::context] :<- [::segments] :<- [::revealed]
  (fn [[scene ctx segs revealed] _]
-   (let [nested (frequencies (keep (fn [[_ g]] (when (= :annotation (:type g)) (:parent g)))
+   (let [ann?    (fn [gid] (= :annotation (:type (get-in scene [:groups gid]))))
-                                   (:groups scene)))
+         ;; each annotation → its reference PARENTS: the timeline(s) its marks were
-         ;; shown when every ancestor up to ctx is revealed: a direct child of ctx
+         ;; authored in (mark-homes). A normal annotation has one; a transcluded one
-         ;; always shows; a deeper annotation shows only if its parent is revealed
+         ;; (marks from two contexts) has two, so it shows as a child under BOTH.
-         ;; AND that parent is itself shown.
+         parents (into {} (for [[gid g] (:groups scene) :when (= :annotation (:type g))]
-         shown? (fn shown? [p] (or (= ctx p)
+                            [gid (scene/mark-homes scene gid)]))
-                                   (and (revealed p) (shown? (get-in scene [:groups p :parent])))))]
+         ;; child count per timeline (drives the "Show N" nested badge)
+         nested  (reduce (fn [acc ps] (reduce #(update %1 %2 (fnil inc 0)) acc ps)) {} (vals parents))
+         ;; reference-reveal hierarchy: shows when ctx is a reference parent, or a
+         ;; REVEALED reference-parent that itself shows. `seen` guards ref cycles.
+         shown?  (fn shown? [gid seen]
+                   (and (not (contains? seen gid))
+                        (boolean (some (fn [p] (or (= ctx p)
+                                                   (and (ann? p) (revealed p) (shown? p (conj seen gid)))))
+                                       (parents gid)))))]
      (->> (:groups scene)
           (keep (fn [[gid g]]
-                  (when (and (= :annotation (:type g)) (shown? (:parent g)))
+                  (when (= :annotation (:type g))
-                    (let [bars     (scene/lane-bars scene ctx gid segs)  ; one bar per mark; distinct marks never fuse
+                    ;; VISIBILITY IS BY REFERENCE: an annotation shows in ctx when a
-                          reason   (scene/broken-reason scene gid)
+                    ;; mark of its was AUTHORED in ctx (homed there) — one hop, not
+                    ;; transitive — so a mark made in ctx shows even if the annotation
+                    ;; is parented elsewhere (transclusion), while a grandchild does
+                    ;; not leak up and a sibling covering the same clips stays out.
+                    (let [bars (scene/lane-bars scene gid segs)]  ; one bar per mark; distinct marks never fuse
+                     (when (shown? gid #{})
+                      (let [reason   (scene/broken-reason scene gid)
                           oor      (boolean (scene/clip-loss? scene gid))
                           hidden   (get-in g [:meta :hidden])
                           note-ids  (->> (concat (:notes g) (mapcat :notes (:marks g)))
@@ -152,6 +166,10 @@
                                                        (some-> ref name)))))
                                          distinct)]
                       {:id gid :parent (:parent g)
+                       ;; the timeline(s) this annotation is a child of (mark-homes) —
+                       ;; the pane groups by this so a transcluded annotation appears
+                       ;; under every context it was authored in.
+                       :parents (parents gid)
                        :name (:name g) :color (or (:color g) "#4e8fc2")
                        :content (:content g) :children (count (:marks g))
                        :nested (get nested gid 0)
@@ -167,7 +185,7 @@
                        ;; jump targets labelled from the marks' clip refs (same as
                        ;; the editor) — not re-derived from a floored bar frame
                        :jumps jumps
-                       :start (or (ffirst bars) 0) :bars bars}))))
+                       :start (or (ffirst bars) 0) :bars bars}))))))
           (sort-by (juxt :broken :start))      ; broken annotations sink to the bottom
           vec))))
 

tl/src/tl/views.cljs

@@ -696,7 +696,7 @@
                   ;; EXACT context-local extent (never the rounded bar). The drag
                   ;; keeps the FIXED endpoint at this exact value so its mark
                   ;; re-derives identically — that's what stops the other end drifting.
-                  :let [ext (scene/mark-extent scene ctx (:id a) mid segs)]
+                  :let [ext (scene/mark-extent scene (:id a) mid segs)]
                   :when ext
                   :let [[lo hi] ext
                         active? (= mid active-mark)]]
@@ -1220,7 +1220,7 @@
                           (.stopPropagation e) (.preventDefault e) (reset! over? false)
                           (rf/dispatch [::events/reparent (keyword src) (:id a)]))))}))
 
-(defn- annotation-card [a scene ctx segs nmap authed? open by-parent]
+(defn- annotation-card [a scene ctx segs nmap authed? open by-parent seen]
   (r/with-let [over? (r/atom false) hov? (r/atom false)]
   (let [active? @(rf/subscribe [::subs/annotation-active? (:id a)])
         dragging @(rf/subscribe [::subs/dragging-ann])
@@ -1279,10 +1279,11 @@
            [:button.show-children {:on-click #(rf/dispatch [::events/toggle-children (:id a)])}
             (str (if shown? "▾ Hide " "▸ Show ") (:nested a)
                  (if (= 1 (:nested a)) " annotation" " annotations"))]))
-       (when-let [kids (seq (get by-parent (:id a)))]
+       (when-let [kids (seq (remove #(contains? seen (:id %)) (get by-parent (:id a))))]
          (into [:div.ann-children]
                (for [k kids]
-                 ^{:key (:id k)} [annotation-card k scene ctx segs nmap authed? open by-parent])))]))))
+                 ^{:key (:id k)}
+                 [annotation-card k scene ctx segs nmap authed? open by-parent (conj seen (:id a))])))]))))
 
 (defn commentary []
   (let [open (r/atom nil)]
@@ -1306,23 +1307,37 @@
             (when authed?
               [:button.edit-btn {:on-click #(rf/dispatch [::events/edit-here ctx])} "✎ Edit"])])
          (if (seq anns)
-           (let [by-parent (group-by :parent anns)]   ; nest revealed children under their parent
+           ;; group by REFERENCE parent(s): an annotation is listed under every
+           ;; timeline its marks were authored in (:parents), so a transcluded one
+           ;; shows under each context it belongs to, not just its structural parent.
+           (let [by-parent (reduce (fn [m a] (reduce #(update %1 %2 (fnil conj []) a) m (:parents a)))
+                                   {} anns)]
              (doall
               (for [a (get by-parent ctx)]
                 ^{:key (:id a)}
-                [annotation-card a scene ctx segs nmap authed? open by-parent])))
+                [annotation-card a scene ctx segs nmap authed? open by-parent #{}])))
            [:div.ann-empty "No annotations here."])]))))
 
 (defn- to-frame [v len]
   (let [n (js/parseInt v 10)] (-> (if (js/isNaN n) 0 n) (max 0) (min len))))
 
+;; A mark row's endpoint reads its name/length from the current context's segs;
+;; a TRANSCLUDED mark (collected from another timeline) has no segment here, so
+;; fall back to the track it resolves onto (its clip's source file name is shared
+;; and useless) — a stable identity, from anywhere.
+(defn- pt-name [scene segs seg]
+  (let [l (clip-label scene segs seg)]
+    (if (= l "clip") (or (scene/ref-track-name scene seg) "clip") l)))
+(defn- pt-len [scene segs seg]
+  (or (scene/seg-length segs seg) (scene/ref-length scene seg)))
+
 (defn- frame-chip
   "A filled endpoint: clip name + a mark-time frame input (edits `put` the group).
    The ✕ unsets just this endpoint so you can re-pick it (the other end is kept)."
   [scene segs put d i k {:keys [seg f]}]
-  (let [len (scene/seg-length segs seg)]
+  (let [len (pt-len scene segs seg)]
     [:div.pt-chip
-     [:span.pt-chip-name (clip-label scene segs seg)]
+     [:span.pt-chip-name (pt-name scene segs seg)]
      [:input.pt-frame {:type "number" :min 0 :max len :value f
                        :on-change #(put (assoc-in d [:marks i k :at] (to-frame (.. % -target -value) len)))}]
      [:span.pt-dur (str "/" len)]
@@ -1338,9 +1353,9 @@
    lane handles' job; this is the whole-frame numeric nudge within a clip. The ✕
    clears just this end to re-pick it (the other end stays put)."
   [scene segs gid mark-id pid which {:keys [seg f]}]
-  (let [len (scene/seg-length segs seg)]
+  (let [len (pt-len scene segs seg)]
     [:div.pt-chip
-     [:span.pt-chip-name (clip-label scene segs seg)]
+     [:span.pt-chip-name (pt-name scene segs seg)]
      [:input.pt-frame {:type "number" :min 0 :max len :value f
                        :on-change #(rf/dispatch [::events/set-proxy-frame pid which
                                                  (to-frame (.. % -target -value) len)])}]
@@ -1351,9 +1366,9 @@
                                      (rf/dispatch [::events/unset-proxy-endpoint gid mark-id pid which]))} "✕"]]))
 
 (defn- pending-frame-chip [scene segs {:keys [seg f]}]
-  (let [len (scene/seg-length segs seg)]
+  (let [len (pt-len scene segs seg)]
     [:div.pt-chip.pending
-     [:span.pt-chip-name (clip-label scene segs seg)]
+     [:span.pt-chip-name (pt-name scene segs seg)]
      [:input.pt-frame {:type "number" :value (js/Math.round f) :disabled true}]
      [:span.pt-dur (str "/" len)]]))
 

tl/test/tl/flow_test.cljs

@@ -0,0 +1,129 @@
+(ns tl.flow-test
+  "Integration tests that drive the ACTUAL re-frame events the UI dispatches
+   (dispatch-sync) and read the resulting app-db / scene back — so a bug that lives
+   in an event handler (not a pure scene fn) is caught. Side-effecting fx are
+   stubbed so the sync path stays pure; project id is nil so nothing hits the net."
+  (:require [cljs.test :refer-macros [deftest is testing]]
+            [re-frame.core :as rf]
+            [re-frame.db :as rdb]
+            [tl.events :as ev]
+            [tl.subs :as subs]
+            [tl.scene :as s]))
+
+;; stub the browser/player/network fx (views registers the real player fx; we don't
+;; require views here, and we never want the net in a test)
+(doseq [k [:player/pause :player/seek :http-xhrio :route :route/replace-project-state
+           :connect-scene :fetch-projects :poll-thumbnails :upload-project]]
+  (rf/reg-fx k (fn [_] nil)))
+
+;; single-source footage: four clips, ALL named "Challengers.mov" (this is why the
+;; media name is useless as a label — the track+occurrence is what distinguishes)
+(def clips-scene
+  {:tracks {:t0 {:name "A-roll"} :t1 {:name "B-roll"} :t2 {:name "C-roll"} :t3 {:name "D-roll"}}
+   :groups {:root   {:type :timeline :parent nil :marks [{:id :m/root :start 0 :end 400}]}
+            :clip-a {:type :clip :parent nil :name "Challengers.mov" :start 0   :marks [{:id :m/a :start 0   :end 100 :track :t0}]}
+            :clip-b {:type :clip :parent nil :name "Challengers.mov" :start 100 :marks [{:id :m/b :start 100 :end 200 :track :t1}]}
+            :clip-c {:type :clip :parent nil :name "Challengers.mov" :start 200 :marks [{:id :m/c :start 200 :end 300 :track :t2}]}
+            :clip-d {:type :clip :parent nil :name "Challengers.mov" :start 300 :marks [{:id :m/d :start 300 :end 400 :track :t3}]}}})
+
+(defn seed
+  "clips + annA (over clips A,B) + annB (over clips C,D) + annC (parented under A,
+   holding one mark authored inside A) — the state right before you drill into B."
+  []
+  (let [pA (s/make-proxy clips-scene :root 0 200)
+        pB (s/make-proxy clips-scene :root 200 400)
+        sc (-> clips-scene
+               (assoc-in [:groups :pA] pA)
+               (assoc-in [:groups :pB] pB)
+               (assoc-in [:groups :annA] {:type :annotation :parent :root :name "A" :color "#f00" :marks [(s/proxy-ref :mA :pA)]})
+               (assoc-in [:groups :annB] {:type :annotation :parent :root :name "B" :color "#0f0" :marks [(s/proxy-ref :mB :pB)]}))
+        pInA (s/make-proxy sc :annA 10 60)]
+    (-> sc (assoc-in [:groups :pInA] pInA)
+           (assoc-in [:groups :annC] {:type :annotation :parent :annA :name "C" :color "#00f"
+                                      :marks [(s/proxy-ref "ca" :pInA)]}))))
+
+(defn setup! [scene stack]
+  (reset! rdb/app-db {:scene scene :fps 24
+                      :view {:stack stack :playheads {} :revealed #{} :zoom 1 :row-h 20}
+                      :project {:id nil}}))
+
+(defn scene* [] (:scene @rdb/app-db))
+(defn bars-in [ctx gid]
+  (s/lane-bars (scene*) gid (s/content-segments (scene*) ctx)))
+
+(deftest tie-marks-to-annotation-in-another-context-then-drag
+  (testing "author a range while drilled into annB, tie it to annC (parented under
+            annA), then drag its handle — it must stay one proxy, stay visible in
+            annB, and NOT vanish when rerolled."
+    (setup! (seed) [:root])
+    ;; drill into annB (real stack-nav event)
+    (rf/dispatch-sync [::ev/expand :annB])
+    (is (= [:root :annB] (get-in @rdb/app-db [:view :stack])))
+    ;; new draft + select a range 50..150 (C-tail + D-head), exactly as a lane drag
+    (rf/dispatch-sync [::ev/open-draft])
+    (rf/dispatch-sync [::ev/draft-select-range 50 150])
+    (let [draft-gid (some (fn [[gid g]] (when (:draft g) gid)) (:groups (scene*)))]
+      (is draft-gid "a draft should exist after open-draft")
+      (is (= 1 (count (get-in (scene*) [:groups draft-gid :marks]))) "one proxy mark, not per-clip")
+      ;; tie the draft's marks to the existing annC (transclusion)
+      (rf/dispatch-sync [::ev/associate-marks draft-gid :annC])
+      (let [annC (get-in (scene*) [:groups :annC])
+            bmk  (last (:marks annC))
+            bid  (:id bmk)]
+        (is (nil? (get-in (scene*) [:groups draft-gid])) "draft is consumed")
+        (is (= 2 (count (:marks annC))) "annC now has its A-mark + the new B-mark")
+        (is (= :proxy (:type (get-in (scene*) [:groups (get-in bmk [:start :ref])])))
+            "the tied mark is a single proxy-ref, not expanded into per-clip marks")
+
+        ;; BUG 1 — labels. Viewed from annB: the new B-mark's endpoint is one of
+        ;; annB's own content units (labels via the context), while annC's A-mark is
+        ;; foreign here. Its fallback must be the TRACK ("A-roll"), never the shared
+        ;; source-file name "Challengers.mov".
+        (let [ctx-ids (into #{} (map :mark) (s/content-segments (scene*) :annB))
+              row-seg (fn [gid-mark] (get-in (s/mark-row (scene*) gid-mark) [:s :seg]))
+              amk     (first (:marks annC))]                ; the A-mark
+          (is (contains? ctx-ids (row-seg bmk)) "B-mark endpoint is one of annB's units → context-labelled")
+          (is (not (contains? ctx-ids (row-seg amk))) "A-mark is foreign in annB")
+          (is (= "A-roll" (s/ref-track-name (scene*) (row-seg amk))) "foreign label is the track, not Challengers.mov")
+          (is (not= "Challengers.mov" (s/ref-track-name (scene*) (row-seg amk)))))
+
+        ;; REFERENCE PARENTS — annC is a child of A (its A-mark) and B (its B-mark),
+        ;; and NOT of root (it's a grandchild there: one hop, not transitive to clips)
+        (is (= #{:annA :annB} (s/mark-homes (scene*) :annC)))
+        (is (s/child-of? (scene*) :annB :annC))
+        (is (not (s/child-of? (scene*) :root :annC)))
+
+        ;; LANE in annB: exactly one bar for annC's B-mark
+        (is (= 1 (count (bars-in :annB :annC))) "annC shows exactly one bar in annB")
+        (is (= [50 150] (subvec (first (bars-in :annB :annC)) 0 2)))
+
+        ;; ISSUE 1 — the PANE LIST (::all-annotations, grouped by :parents) must
+        ;; include annC under annB, and must not pull in non-children.
+        (let [anns  @(rf/subscribe [::subs/all-annotations])
+              c     (some #(when (= :annC (:id %)) %) anns)
+              under (fn [p] (->> anns (filter #(contains? (:parents %) p)) (map :id) set))]
+          (is c "annC is present in ::all-annotations while viewing annB")
+          (is (contains? (:parents c) :annB) "annC's reference parents include annB")
+          (is (contains? (under :annB) :annC) "the pane lists annC under annB")
+          (is (not (contains? (under :annB) :annA)) "annA is root's child, not annB's"))
+
+        ;; ISSUE 3 at ROOT — collapse; annC must NOT leak into the root list (it's a
+        ;; grandchild). ISSUE 2 — revealing annA must then surface annC as its child.
+        (rf/dispatch-sync [::ev/collapse])
+        (is (= [:root] (get-in @rdb/app-db [:view :stack])))
+        (let [ids (set (map :id @(rf/subscribe [::subs/all-annotations])))]
+          (is (contains? ids :annA) "annA (a root child) shows at root")
+          (is (not (contains? ids :annC)) "annC does NOT leak into root (grandchild)"))
+        (rf/dispatch-sync [::ev/toggle-children :annA])
+        (let [anns @(rf/subscribe [::subs/all-annotations])
+              c    (some #(when (= :annC (:id %)) %) anns)]
+          (is c "revealing annA surfaces annC as its child in the toggle")
+          (is (contains? (:parents c) :annA)))
+
+        ;; BUG 2 — back in annB, dragging the handle must not delete the mark
+        ;; (::reroll-proxy must roll against the VIEWED context, not annC's :parent).
+        (rf/dispatch-sync [::ev/expand :annB])
+        (rf/dispatch-sync [::ev/reroll-proxy :annC bid 50 140])
+        (let [bars (bars-in :annB :annC)]
+          (is (some #(= bid (nth % 2)) bars) "after the drag the B-mark still resolves in annB (no vanish)")
+          (is (= [50 140] (some (fn [[lo hi m]] (when (= m bid) [lo hi])) bars)) "handle moved end to 140"))))))

tl/test/tl/scene_test.cljs

@@ -221,14 +221,14 @@
                                       :marks [(s/proxy-ref :m/1 :p1)
                                               (s/proxy-ref :m/2 :p2)]}))
           segs  (s/content-segments scene :root)
-          bars  (s/lane-bars scene :root :ann segs)]
+          bars  (s/lane-bars scene :ann segs)]
       (is (= [[0 200 :m/1] [200 300 :m/2]] bars))            ; two marks → two bars, tagged + apart
       (is (= [[0 200] [200 300]] (mapv #(subvec % 0 2) bars))) ; ranges still destructure as [lo hi]
       ;; and a single cross-clip proxy on its own is one contiguous bar
       (let [one (-> base (with-group :p1 p1)
                     (with-group :ann {:type :annotation :parent :root
                                       :marks [(s/proxy-ref :m/1 :p1)]}))]
-        (is (= [[0 200 :m/1]] (s/lane-bars one :root :ann (s/content-segments one :root))))))))
+        (is (= [[0 200 :m/1]] (s/lane-bars one :ann (s/content-segments one :root))))))))
 
 (deftest proxy-survives-restore-roundtrip
   (testing "a proxy group (string :type/:parent, string mark ids/refs from JSON)
@@ -245,6 +245,120 @@
       (is (= [:clip-a :clip-b :clip-c] (map #(get-in % [:start :ref]) (:marks back))))  ; refs keyworded
       (is (= 170 (s/length (s/resolve scene :ann)))))))                                 ; resolves whole
 
+(deftest content-segments-in-a-drilled-proxy-annotation-keeps-clips-distinct
+  (testing "drilling INTO a proxy-backed range annotation exposes each underlying
+            clip as its OWN content-segment (distinct :mark, track, length) — NOT
+            all collapsed under the annotation's single mark id, which made every
+            clip read with the FIRST piece's name + length and blocked saving a
+            sub-range selection (the resolve/rebase collapse bug)"
+    (let [p     (s/make-proxy base :root 40 210)           ; A-tail=60, B=100, C-head=10
+          scene (-> base
+                    (with-group :prox p)
+                    (with-group :ann {:type :annotation :parent :root
+                                      :marks [(s/proxy-ref :m/px :prox)]}))
+          segs  (s/content-segments scene :ann)
+          ids   (mapv :mark segs)]
+      (is (= 170 (s/length segs)))
+      (is (= 3 (count segs)))
+      (is (= 3 (count (distinct ids))))                     ; pieces stay distinct…
+      (is (not-any? #{:m/px} ids))                          ; …and are NOT the annotation's mark
+      (is (= [:t0 :t1 :t2] (mapv :track segs)))             ; each keeps its own track
+      ;; per-piece lengths + the seg-length / seg-local lookups the editor & save
+      ;; check rely on — previously every one returned the first piece's numbers
+      (is (= [60 100 10] (mapv (fn [{[c d] :local}] (- d c)) segs)))
+      (is (= [60 100 10] (mapv #(s/seg-length segs %) ids)))
+      (is (= [0 60 160]  (mapv #(s/seg-local segs % 0) ids)))))
+  (testing "resolve (the LANE view) still collapses the proxy under the annotation's
+            one mark id — one bar per mark — so the two views stay distinct"
+    (let [p     (s/make-proxy base :root 40 210)
+          scene (-> base (with-group :prox p)
+                    (with-group :ann {:type :annotation :parent :root
+                                      :marks [(s/proxy-ref :m/px :prox)]}))]
+      (is (= [:m/px] (distinct (mapv :mark (s/resolve scene :ann))))))))
+
+(deftest transcluded-mark-labels-resolve-down-to-the-clip
+  (testing "a mark whose ref target isn't in the CURRENT context (collected into an
+            annotation from another timeline — transclusion) still gets a length +
+            a useful TRACK label by resolving the ref chain down to its clip, not by
+            a context lookup (which returns 'clip' / no length for a foreign ref).
+            The clip's :name is the shared source file, so the TRACK is the label."
+    (let [named (-> base
+                    (assoc-in [:groups :clip-a :name] "Challengers.mov"))   ; single-source
+          pA    (s/make-proxy named :root 0 100)          ; proxy over clip-a (track t0 = "A-roll")
+          aid   (:id (first (:marks pA)))                 ; A's sub-clip mark (refs clip-a)
+          pin   {:type :proxy :parent nil                 ; a mark authored INSIDE A
+                 :marks [{:id :sub-c :start {:ref aid :at 0} :end {:ref aid :at -1}}]}
+          scene (-> named
+                    (with-group :pA pA)
+                    (with-group :annA {:type :annotation :parent :root :marks [(s/proxy-ref :mA :pA)]})
+                    (with-group :pin pin))]
+      ;; the ref chain :sub-c → aid → clip-a bottoms out at a clip from anywhere
+      (is (= 100 (s/ref-length scene :sub-c)))              ; clip-a's length, no context
+      (is (= "A-roll" (s/ref-track-name scene :sub-c)))     ; the TRACK, not "Challengers.mov"
+      (is (= 100 (s/ref-length scene :pin)))                ; the whole proxy resolves the same
+      (is (= "A-roll" (s/ref-track-name scene :pin)))
+      (is (nil? (s/ref-track-name scene :nope))))))         ; a dangling ref → nil, not a throw
+
+(deftest transclusion-visibility-is-scoped-by-reference-not-clip-overlap
+  (testing "an annotation shows in a timeline when a mark is BUILT ON that timeline's
+            content (references its units), not merely when its clips overlap. So a
+            mark authored in B shows in B though its annotation is parented under A
+            (transclusion), a mark authored in A shows in A — and a sibling root
+            annotation that just covers the same clips does NOT leak into B."
+    (let [four (assoc-in base [:groups :clip-d]
+                         {:type :clip :parent nil :name "D" :start 300
+                          :marks [{:id :m/d :start 300 :end 400 :track :t0}]})
+          four (assoc-in four [:groups :root :marks] [{:id :m/root :start 0 :end 400}])
+          pA   (s/make-proxy four :root 0 200)      ; annA over clips A,B
+          pB   (s/make-proxy four :root 200 400)    ; annB over clips C,D
+          scene (-> four (with-group :pA pA) (with-group :pB pB)
+                    (with-group :annA {:type :annotation :parent :root :marks [(s/proxy-ref :mA :pA)]})
+                    (with-group :annB {:type :annotation :parent :root :marks [(s/proxy-ref :mB :pB)]}))
+          ;; annC (parented under A) has a mark authored in A AND a mark authored in B
+          pInA  (s/make-proxy scene :annA 10 60)    ; a range inside annA (clip A)
+          pInB  (s/make-proxy scene :annB 50 150)   ; a range inside annB (C-tail + D-head)
+          ;; annD is a SIBLING root annotation that merely covers clip C
+          pDup  (s/make-proxy scene :root 200 280)  ; clip C, referenced from root directly
+          scene (-> scene (with-group :pInA pInA) (with-group :pInB pInB) (with-group :pDup pDup)
+                    (with-group :annC {:type :annotation :parent :annA
+                                       :marks [(s/proxy-ref "ca" :pInA) (s/proxy-ref "cb" :pInB)]})
+                    (with-group :annD {:type :annotation :parent :root
+                                       :marks [(s/proxy-ref "d1" :pDup)]}))]
+      ;; annC has exactly 2 marks (one per authored range); the B one is a single
+      ;; proxy whose run spans C-tail + D-head — not expanded into per-clip marks
+      (is (= 2 (count (:marks (get-in scene [:groups :annC])))))
+      (is (= 2 (count (:marks pInB))))                        ; run held inside the ONE proxy
+      ;; annC's marks are homed in A and B → it is a child of BOTH, and NOT of root
+      ;; (it's a grandchild there — one-hop reference, not transitive to clips)
+      (is (= #{:annA :annB} (s/mark-homes scene :annC)))
+      (is (s/child-of? scene :annA :annC))
+      (is (s/child-of? scene :annB :annC))
+      (is (not (s/child-of? scene :root :annC)))              ; grandchild does NOT leak to root
+      ;; annD only covers clip C from root — homed at root, NOT a child of annB
+      (is (= #{:root} (s/mark-homes scene :annD)))
+      (is (not (s/child-of? scene :annB :annD)))              ; the over-show bug
+      (is (s/child-of? scene :root :annD))
+      ;; lane bars follow: annC's B-mark renders in B, its A-mark in A, none of annD in B
+      (is (= [[50 150 "cb"]] (s/lane-bars scene :annC (s/content-segments scene :annB))))
+      (is (seq (s/lane-bars scene :annC (s/content-segments scene :annA)))))))
+
+(deftest jump-targets-label-from-the-clip-not-the-proxy
+  (testing "a discontinuous annotation's jump popover labels each target from the
+            CLIP it lands on (+ the frame within it), not from the mark's proxy-ref
+            start — which would give the proxy gid (→ a bare 'clip') and frame 0"
+    (let [pa    (s/make-proxy base :root 0 50)      ; within clip A
+          pc    (s/make-proxy base :root 250 300)   ; within clip C (non-adjacent → 2 runs)
+          scene (-> base (with-group :pa pa) (with-group :pc pc)
+                    (with-group :ann {:type :annotation :parent :root
+                                      :marks [(s/proxy-ref :ma :pa) (s/proxy-ref :mc :pc)]}))
+          segs  (s/content-segments scene :root)
+          jumps (s/jump-targets scene :root :ann)]
+      (is (= 2 (count jumps)))                                  ; two discontinuous runs
+      (is (not-any? #{:pa :pc} (map :seg jumps)))               ; NOT the proxy gids ("clip 0f")
+      (is (every? (fn [j] (some #(= (:seg j) (:mark %)) segs)) jumps)) ; every :seg is a real content id → labelable
+      (is (= [:clip-a :clip-c] (mapv :seg jumps)))              ; the clips the runs land on
+      (is (= [0 50] (mapv :f jumps))))))                        ; frame within each clip (250 → C+50)
+
 ;; =========================================================================
 ;; Suite 3 — playhead & playback
 ;; =========================================================================