noe/tl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

feat: timeline links, network error handling, Tailscale access, mobile fixes

Browse source 
Backend / dev:
- Bind dev server to 0.0.0.0 and allow Tailscale MagicDNS + tailnet-IP origins
  in ALLOWED_HOSTS / CORS / CSRF so the app is reachable over Tailscale
- Unified, idempotent dev launcher (Django + media + shadow watch), hot reload,
  no manual compiles

Frontend:
- Migrate fetches to re-frame :http-xhrio with failure handling; surface
  network / load / save errors where the user expects them
- Extract markdown + link formatting into tl.md: parse/serialize round-trip
  (recursive chip serialization fix), block markdown (headings/lists/paragraphs)
- Timeline-opening links: navigate the stack to any reachable timeline;
  autocomplete lists all timelines (root included, orphans dropped) with a live
  preview that pushes the stack and reverts on commit/cancel
- Annotation pane shows the current context's description with edit-in-context
  (drops into the parent timeline for marks, pops back when done) + root content
- Fixes: deep-link playhead seek, replay-from-end, mobile input zoom, notch
  safe-area insets, autofocus the content field, freeze form to snapshot context

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
Your Name 2026-06-29 19:24:40 -04:00
parent 3d3b031332
commit fc25dfc016
12 changed files with 548 additions and 224 deletions
Download patch file Download diff file Expand all files Collapse all files

2
README.md
View file

@ -17,7 +17,7 @@ python -m venv .venv && .venv/bin/pip install -r requirements.txt
.venv/bin/python manage.py migrate
DJANGO_SUPERUSER_PASSWORD=admin .venv/bin/python manage.py createsuperuser --noinput --username admin --email admin@example.com
.venv/bin/python manage.py seed_demo # demo project from tl/.../one_two_three.otio
.venv/bin/python manage.py runserver 9001
.venv/bin/python manage.py runserver 0.0.0.0:9001 # 0.0.0.0 so it's reachable over Tailscale/LAN
```
Admin: <http://127.0.0.1:9001/admin/> (admin / admin). Upload OTIO and inspect

15
server/settings.py
View file

@ -25,7 +25,8 @@ SECRET_KEY = 'django-insecure-it#u2wp)_qjx@cq61o*thw#*4_1*hk!%%lz#d+fww6^*l3j+zj
# SECURITY WARNING: don't run with debug turned on in production!
DEBUG = True
ALLOWED_HOSTS = ['localhost', '127.0.0.1', 'testserver']
# '.ts.net' matches any Tailscale MagicDNS name; the literal is the tailnet IP.
ALLOWED_HOSTS = ['localhost', '127.0.0.1', 'testserver', '.ts.net', '100.82.84.50']
# Application definition
@ -134,8 +135,18 @@ MEDIA_ROOT = BASE_DIR / 'media'
DATA_UPLOAD_MAX_MEMORY_SIZE = 100 * 1024 * 1024
# The shadow-cljs dev frontend talks to this API cross-origin, with the session
# cookie, so allow its origin + credentials.
# cookie, so allow its origin + credentials. Over Tailscale the frontend may be
# reached either by MagicDNS name (*.ts.net) or by the raw tailnet IP
# (100.64.0.0/10), both on :8280 — match both forms.
CORS_ALLOWED_ORIGINS = ['http://localhost:8280', 'http://127.0.0.1:8280']
CORS_ALLOWED_ORIGIN_REGEXES = [r'^http://[\w.-]+\.ts\.net:8280$',
r'^http://100\.\d{1,3}\.\d{1,3}\.\d{1,3}:8280$']
CORS_ALLOW_CREDENTIALS = True
# Cross-origin POSTs carry the session cookie, so Django's CSRF check needs the
# frontend origins trusted (Origin header must match for unsafe methods).
CSRF_TRUSTED_ORIGINS = ['http://localhost:8280', 'http://127.0.0.1:8280',
'https://*.ts.net', 'http://*.ts.net',
'http://100.*']
DEFAULT_AUTO_FIELD = 'django.db.models.BigAutoField'

36
tl/dev/dev.sh
View file

@ -1,19 +1,43 @@
#!/usr/bin/env bash
# Dev launcher: runs the shadow-cljs watch AND the range-capable media server
# together, and tears both down on exit (Ctrl-C kills the whole group).
# Dev launcher: backend + frontend + media, all hot-reloading, all bound to
# 0.0.0.0 so they're reachable over Tailscale/LAN (e.g. a phone). One Ctrl-C
# tears the whole process group down.
#
# npm run dev
# npm run dev (from tl/)
#
# Nothing here needs a manual `shadow-cljs compile` — `watch` recompiles and
# hot-reloads the frontend on every save. Django's runserver and the media
# server reload themselves too. Override ports with API_PORT / MEDIA_PORT.
set -euo pipefail
cd "$(dirname "$0")/.."
cd "$(dirname "$0")/.." # -> tl/
ROOT="$(cd .. && pwd)" # -> repo root, where Django's manage.py + .venv live
API_PORT="${API_PORT:-9001}"
PY="$ROOT/.venv/bin/python"
cleanup() { kill 0 2>/dev/null || true; }
trap cleanup EXIT INT TERM
echo "[dev] starting media server (port ${MEDIA_PORT:-8281}, range-capable, autoreload)"
# Free our dev ports from any stale listeners a previous run left behind, so the
# launcher is safe to re-run without "Address already in use".
free_port() {
local p="$1" pids
pids=$(ss -tlnpH "sport = :$p" 2>/dev/null | grep -oP 'pid=\K[0-9]+' | sort -u) || true
if [ -n "$pids" ]; then
echo "[dev] freeing port $p (killing $pids)"
kill $pids 2>/dev/null || true
sleep 0.5
fi
}
for p in "$API_PORT" 8280 "${MEDIA_PORT:-8281}"; do free_port "$p"; done
echo "[dev] Django API on 0.0.0.0:${API_PORT} (autoreload)"
( cd "$ROOT" && exec "$PY" manage.py runserver "0.0.0.0:${API_PORT}" ) &
echo "[dev] media server on 0.0.0.0:${MEDIA_PORT:-8281} (range-capable, autoreload)"
python3 dev/media_server.py &
echo "[dev] starting shadow-cljs watch app (port 8280)"
echo "[dev] shadow-cljs watch app on 0.0.0.0:8280 (hot reload)"
npx shadow-cljs watch app &
wait

33
tl/resources/public/css/app.css
View file

@ -13,6 +13,12 @@ body { overflow: hidden; }
font-family: sans-serif;
background: #0c0c0c;
color: #ddd;
/* viewport-fit=cover lets content slide under the notch / rounded corners /
home indicator; inset it back so the video isn't covered. box-sizing keeps
total height at 100dvh (timeline-pane is flex:1 and absorbs the padding). */
box-sizing: border-box;
padding: env(safe-area-inset-top) env(safe-area-inset-right)
env(safe-area-inset-bottom) env(safe-area-inset-left);
}
/* --- top region: video | annotation ------------------------------------ */
@ -83,6 +89,12 @@ body { overflow: hidden; }
.jump-pop button:hover { background: #2a4a6a; }
/* --- commentary head + actions ----------------------------------------- */
/* the current context's own description, atop the commentary */
.ctx-content { display: flex; align-items: flex-start; gap: 8px;
padding: 8px 10px; margin-bottom: 8px; border-bottom: 1px solid #222; }
.ctx-content .md, .ctx-content .muted { flex: 1; min-width: 0; }
.ctx-content .muted { font-style: italic; }
.ctx-content .edit-btn { flex-shrink: 0; }
.commentary-head { margin-bottom: 8px; }
.add-btn {
width: 100%; background: #1c2a38; color: #cfe3f5;
@ -137,7 +149,10 @@ body { overflow: hidden; }
color: #7aa6d6; margin-top: 4px; }
/* contenteditable content surface + inline link chips */
.content-editor { white-space: pre-wrap; word-break: break-word; outline: none; cursor: text; }
/* flex-shrink:0 so the surface grows with its content (and the .form scrolls)
instead of the flex column squashing it down to min-height. */
.content-editor { white-space: pre-wrap; word-break: break-word; outline: none; cursor: text;
flex-shrink: 0; height: auto; }
.content-editor:empty:before { content: attr(data-placeholder); color: #666; }
.link-chip { display: inline-flex; align-items: center; gap: 3px; vertical-align: baseline;
background: #173049; color: #9fd0ff; border: 1px solid #2f5d86; border-radius: 4px;
@ -182,6 +197,7 @@ body { overflow: hidden; }
overflow: hidden; text-overflow: ellipsis; }
.pt-dropdown li.hi { background: #2a4a6a; }
.pt-dropdown .cand-group { color: #789; font-size: 11px; }
.pt-dropdown .cand-kind { color: #7aa6d6; }
.pt-dropdown .link-f { color: #6f9; opacity: .7; }
.link-insert { display: flex; align-items: flex-start; gap: 6px; align-self: stretch; }
@ -307,7 +323,12 @@ body { overflow: hidden; }
/* --- landing pages (project list / create) ----------------------------- */
.home { min-height: 100vh; box-sizing: border-box; max-width: 680px; margin: 0 auto;
padding: 32px 20px; color: #ddd; font-family: sans-serif; background: #0c0c0c; }
padding: 32px 20px; color: #ddd; font-family: sans-serif; background: #0c0c0c;
/* keep clear of the notch / rounded corners / home indicator */
padding-top: calc(32px + env(safe-area-inset-top));
padding-right: calc(20px + env(safe-area-inset-right));
padding-bottom: calc(32px + env(safe-area-inset-bottom));
padding-left: calc(20px + env(safe-area-inset-left)); }
.home-head { display: flex; align-items: baseline; justify-content: space-between; margin-bottom: 20px; }
.home-head h1 { font-size: 22px; margin: 0; color: #cfe3f5; letter-spacing: 1px; }
.home a { color: #7aa6d6; text-decoration: none; }
@ -351,3 +372,11 @@ body { overflow: hidden; }
.script-empty { color: #888; font-size: 12px; padding: 20px; }
.script-badge { margin-left: 6px; color: #7aa6d6; font-size: 11px; }
.ann.selected { box-shadow: inset 3px 0 0 #5ab07a; }
/* iOS Safari zooms the whole page when you focus a control whose font-size is
< 16px. On touch devices bump every form control to 16px so tapping an input
never zooms; desktop keeps its denser sizing. !important to beat the various
per-control font-size rules above without re-listing each selector. */
@media (pointer: coarse) {
input, textarea, select, .content-editor { font-size: 16px !important; }
}

121
tl/src/tl/api.cljs
View file

@ -1,70 +1,70 @@
(ns tl.api
"Thin fetch wrapper around the Django backend. Functions dispatch re-frame
events on completion (qualified keywords, to avoid a require cycle with
tl.events). Same host as the page, port 9001, with the session cookie."
(:require [re-frame.core :as rf]))
"Request builders for the Django backend, shaped as data for re-frame's
:http-xhrio effect (day8.re-frame.http-fx). Same host as the page, port 9001,
with the session cookie. Event handlers add :on-success / :on-failure and
return these maps — nothing here performs the request. The websocket below is
the one piece that can't ride xhrio, so it still dispatches directly."
(:require [ajax.core :as ajax]
[re-frame.core :as rf]))
(def base
(str (.. js/window -location -protocol) "//" (.. js/window -location -hostname) ":9001"))
(defn- ->clj [x] (js->clj x :keywordize-keys true))
(def ^:private json-resp (ajax/json-response-format {:keywords? true}))
(defn- GET [path]
(-> (js/fetch (str base path) #js {:credentials "include"})
(.then (fn [r] (when (.-ok r) (.json r))))
(.then ->clj)))
(defn GET [path opts]
(merge {:method :get :uri (str base path)
:with-credentials true :response-format json-resp}
opts))
(defn- POST [path body on-done]
(-> (js/fetch (str base path)
#js {:method "POST" :credentials "include"
:headers #js {"Content-Type" "application/json"}
:body (js/JSON.stringify (clj->js body))})
(.then (fn [r] (.then (.json r) #(on-done (.-ok r) (->clj %)))))))
(defn GET-url
"GET an absolute URL (a media file, e.g. the OTIO json). No session cookie —
it's public media, and credentialed cross-origin would need extra CORS."
[url opts]
(merge {:method :get :uri url :response-format json-resp} opts))
(defn fetch-me! []
(-> (GET "/api/me/") (.then #(rf/dispatch [:tl.events/set-auth %]))))
(defn POST [path body opts]
(merge {:method :post :uri (str base path)
:with-credentials true :params body
:format (ajax/json-request-format) :response-format json-resp}
opts))
(defn login! [username password]
(POST "/api/login/" {:username username :password password}
(fn [ok body] (rf/dispatch (if ok [:tl.events/login-ok body]
[:tl.events/login-error (:detail body)])))))
(defn upload
"Multipart POST: the FormData rides as the raw body so cljs-ajax skips :format."
[path form-data opts]
(merge {:method :post :uri (str base path)
:with-credentials true :body form-data :response-format json-resp}
opts))
(defn logout! []
(POST "/api/logout/" {} (fn [_ body] (rf/dispatch [:tl.events/set-auth body]))))
(defn put-scene
"PUT a scene delta — {:changed _ :deleted _}, empty keys dropped — for project `id`."
[id {:keys [changed deleted]} opts]
(merge {:method :put :uri (str base "/api/projects/" id "/scene/")
:with-credentials true
:params (cond-> {}
(seq changed) (assoc :changed changed)
(seq deleted) (assoc :deleted deleted))
:format (ajax/json-request-format) :response-format json-resp}
opts))
(defn fetch-projects! []
(-> (GET "/api/projects/") (.then #(rf/dispatch [:tl.events/set-projects %]))))
(defn fetch-project-detail! [id]
(-> (GET (str "/api/projects/" id "/"))
(.then #(rf/dispatch [:tl.events/project-detail-refreshed %]))))
(defn load-project!
"Detail → OTIO file → scene, then hand it all to ::project-ready in one shot."
[id]
(-> (GET (str "/api/projects/" id "/"))
(.then (fn [detail]
(-> (js/fetch (:otio detail))
(.then #(.json %))
(.then (fn [otio]
(-> (GET (str "/api/projects/" id "/scene/"))
(.then (fn [scene]
(rf/dispatch [:tl.events/project-ready
detail (->clj otio) scene])))))))))))
(defn put-scene!
"Persist a delta — {changed deleted} — for the current project (fire & forget)."
[id changed deleted]
(when id
(js/fetch (str base "/api/projects/" id "/scene/")
#js {:method "PUT" :credentials "include"
:headers #js {"Content-Type" "application/json"}
:body (js/JSON.stringify
(clj->js (cond-> {}
(seq changed) (assoc :changed changed)
(seq deleted) (assoc :deleted deleted))))})))
(defn error-message
"Human message for an :http-xhrio failure map. Prefer the backend's {:detail};
status 0 means the request never reached the server (down / network / CORS) —
the common case behind an unreachable backend."
[{:keys [status response]} fallback]
(or (:detail response)
(case status
0 "Can't reach the server."
403 "Not allowed."
404 "Not found."
500 "Server error."
nil)
fallback))
;; --- realtime: live peer deltas over a websocket --------------------------
;; Not a fetch, so it can't ride :http-xhrio; it dispatches ::peer-delta itself.
(defn- ->clj [x] (js->clj x :keywordize-keys true))
(defonce ^:private socket (atom nil))
@ -78,17 +78,6 @@
url (str proto "//" (.. js/window -location -hostname) ":9001/ws/projects/" id "/")
s (js/WebSocket. url)]
(reset! socket s)
(set! (.-onerror s) (fn [_] (js/console.warn "scene sync socket error; peer updates paused")))
(set! (.-onmessage s)
(fn [e] (rf/dispatch [:tl.events/peer-delta (->clj (js/JSON.parse (.-data e)))]))))))
(defn create-project! [name otio clip]
(let [fd (js/FormData.)]
(.append fd "name" name)
(.append fd "otio" otio)
(.append fd "clip" clip)
(-> (js/fetch (str base "/api/projects/") #js {:method "POST" :credentials "include" :body fd})
(.then (fn [r] (.then (.json r) #(vector (.-ok r) (->clj %)))))
(.then (fn [[ok body]]
(if ok
(rf/dispatch [:tl.events/project-created body])
(rf/dispatch [:tl.events/project-create-error (:detail body)])))))))

8
tl/src/tl/db.cljs
View file

@ -1,12 +1,16 @@
(ns tl.db)
(def default-db
{:load {:status :idle} ; :idle | :loading | :ready | :error
{:load {:status :idle :error nil} ; :idle | :loading | :ready | :error
:page :list ; :list | :create | :editor
:auth {:authenticated false} ; from /api/me/
:projects nil ; project list (when signed in)
:project nil ; current project detail {:id :name :clip :otio}
:create-error nil
:create-error nil ; new-project upload failure
:login-error nil ; sign-in failure
:net-error nil ; backend unreachable (fetch-me / logout)
:projects-error nil ; project-list fetch failure
:save-error nil ; annotation save/delete failure
:fps (/ 24000 1001)
;; the whole scene graph (see tl.scene). Seeded from OTIO at load.

73
tl/src/tl/events.cljs
View file

@ -264,22 +264,49 @@
(fn [db [_ gid content]] (assoc-in db [:scene :groups gid :content] content)))
;; Linking is an edit-mode sub-task, like script highlighting: "Insert link"
;; remembers the playhead and arms the mode; while armed, clicking the timeline
;; or picking from the autocomplete inserts a link chip at the caret. Esc/Cancel
;; restores the playhead (the arrow-key previews were just seeks).
;; snapshots the playhead AND the stack, then arms the mode. While armed, the
;; autocomplete previews each candidate — frame candidates move the playhead,
;; timeline candidates navigate the stack to that timeline. Esc/Cancel and commit
;; both restore the snapshot (you return to where you were editing).
(rf/reg-event-db ::start-linking
(fn [db [_ gid]]
(let [ctx (peek (get-in db [:view :stack]))]
(assoc-in db [:view :linking]
{:gid gid :ctx ctx :playhead (scene/playhead (:view db) ctx)}))))
(rf/reg-event-db ::stop-linking (fn [db _] (assoc-in db [:view :linking] nil)))
(rf/reg-event-fx ::cancel-linking
(fn [{:keys [db]} _]
(let [{:keys [ctx playhead]} (get-in db [:view :linking])
sf (scene/local->source (scene/content-segments (:scene db) ctx) playhead)]
{:db (-> db (assoc-in [:view :linking] nil)
(assoc-in [:view :playheads ctx] playhead))
:player/seek (when sf (/ sf (:fps db)))})))
{:gid gid :ctx ctx :playhead (scene/playhead (:view db) ctx)
:stack (get-in db [:view :stack])}))))
(declare enter-ctx) ; defined below with the stack-nav events
(defn- restore-linking
"Drop link mode and return to the snapshotted stack + playhead, reseeking."
[{:keys [db]}]
(let [{:keys [ctx playhead stack]} (get-in db [:view :linking])
db (cond-> (assoc-in db [:view :linking] nil)
stack (assoc-in [:view :stack] stack)
playhead (assoc-in [:view :playheads ctx] playhead))
segs (scene/content-segments (:scene db) ctx)
sf (scene/local->source segs playhead)]
(sync-route {:db db :player/pause true :player/seek (when sf (/ sf (:fps db)))} db)))
(rf/reg-event-fx ::stop-linking (fn [cofx _] (restore-linking cofx)))
(rf/reg-event-fx ::cancel-linking (fn [cofx _] (restore-linking cofx)))
;; Open a timeline by its full stack path (root → … → it) — chip clicks and
;; timeline-candidate previews both go through here.
(rf/reg-event-fx ::open-stack
(fn [{:keys [db]} [_ path]] (enter-ctx db (constantly (vec path)))))
;; Preview a frame candidate while link mode is armed: a timeline preview may have
;; moved the stack, so snap back to the editing context before seeking the frame.
(rf/reg-event-fx ::preview-frame
(fn [{:keys [db]} [_ local]]
(let [stack (get-in db [:view :linking :stack])
ctx (peek stack)
db (-> db (assoc-in [:view :stack] stack)
(assoc-in [:view :playheads ctx] local))
segs (scene/content-segments (:scene db) ctx)
sf (scene/local->source segs local)]
{:db db :player/seek (when sf (/ sf (:fps db)))})))
(rf/reg-event-fx ::set-playhead
(fn [{:keys [db]} [_ ctx lf]]
@ -325,6 +352,21 @@
(rf/reg-event-db ::edit-draft (fn [db [_ gid]] (-> db (assoc-in [:scene :groups gid :draft] :edit)
(assoc-in [:view :pt] :new))))
;; 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.
(rf/reg-event-fx ::edit-here
(fn [{:keys [db]} [_ gid]]
(let [root? (nil? (get-in db [:scene :groups gid :parent]))
fx (if root? {:db db} (enter-ctx db pop))]
(update fx :db #(-> % (assoc-in [:scene :groups gid :draft] :edit)
(assoc-in [:view :pt] :new)
(assoc-in [:view :edit-return] (when-not root? gid)))))))
(rf/reg-event-fx ::finish-edit
(fn [{:keys [db]} _]
(if-let [g (get-in db [:view :edit-return])]
(enter-ctx (assoc-in db [:view :edit-return] nil) #(conj % g))
{:db db})))
(rf/reg-event-db ::draft-focus (fn [db [_ pt]] (assoc-in db [:view :pt] pt)))
;; cancelling a draft is local only; saving a real annotation / deleting one
;; pushes a delta to the backend (which merges + attributes it).
@ -338,10 +380,11 @@
(fn [{:keys [db]} [_ gid g orig]]
(let [g (editable-group g)
patch (group-patch orig g)
id (get-in db [:project :id])]
root? (nil? (:parent g)) ; the root timeline persists whole
id (get-in db [:project :id])] ; (no diff: it'd lose :type/:marks)
(cond-> {:db (-> db (assoc-in [:scene :groups gid] g) (assoc :save-error nil))}
(and id (= :annotation (:type g)) (seq patch))
(assoc :http-xhrio (api/put-scene id {:changed {gid patch}}
(and id (seq patch))
(assoc :http-xhrio (api/put-scene id {:changed {gid (if root? g patch)}}
{:on-success [::scene-saved]
:on-failure [::save-error]}))))))
(rf/reg-event-fx ::delete-annotation

135
tl/src/tl/md.cljs Normal file
View file

@ -0,0 +1,135 @@
(ns tl.md
"Markdown + link formatting for annotation content. Owns the on-the-wire string
form — plain text with `[label](mark:ref@at)` link tokens and a small inline
markdown subset (**bold**, *italic*, `code`) — and the round-trip around it:
parse-content content string -> [:text str] / [:link {…}] segments
link-token {:label :ref :at} -> a link token string
serialize-editor contenteditable DOM -> content string
inline plain text -> Hiccup (inline markdown)
No reagent, no scene graph, no DOM construction here — just the format. Link
*resolution* (which timeline frame a {:ref :at} points at) lives in tl.scene;
chip construction lives in tl.views."
(:require [clojure.string :as str]))
;; --- link tokens: [label](mark:ref@at) -----------------------------------
;; Two link kinds share the [label](scheme…) form:
;; frame [label](mark:ref@at) jump the playhead to a spot
;; timeline [label](timeline:gid) push that timeline onto the stack
(def ^:private link-re
"\\[([^\\]]*)\\]\\((?:mark:([^@)]+)@(-?\\d+)|timeline:([^)]+))\\)")
(defn link-token
"The token for a link map: {:kind :frame :label :ref :at} (the default) or
{:kind :timeline :label :ref}."
[{:keys [kind label ref at]}]
(if (= kind :timeline)
(str "[" label "](timeline:" (name ref) ")")
(str "[" label "](mark:" (name ref) "@" at ")")))
(defn parse-content
"Split content `s` into [:text str] / [:link {…}] segments. Each link carries
:kind — :frame (with :ref/:at) or :timeline (with :ref)."
[s]
(if (empty? s)
[]
(let [re (js/RegExp. link-re "g")]
(loop [out [] last 0]
(if-let [m (.exec re s)]
(let [idx (.-index m) pre (subs s last idx)
link (if (aget m 4)
{:kind :timeline :label (aget m 1) :ref (keyword (aget m 4))}
{:kind :frame :label (aget m 1) :ref (keyword (aget m 2))
:at (js/parseInt (aget m 3) 10)})]
(recur (cond-> out
(seq pre) (conj [:text pre])
:always (conj [:link link]))
(+ idx (.-length (aget m 0)))))
(let [tail (subs s last)]
(cond-> out (seq tail) (conj [:text tail]))))))))
;; --- contenteditable DOM -> content string -------------------------------
(defn- serialize-node [^js n]
(cond
(= 3 (.-nodeType n)) (.-textContent n)
(= "BR" (.-tagName n)) "\n"
(and (.-classList n) (.contains (.-classList n) "link-chip"))
(link-token (if (= "timeline" (.. n -dataset -kind))
{:kind :timeline :label (.. n -dataset -label) :ref (keyword (.. n -dataset -ref))}
{:kind :frame :label (.. n -dataset -label) :ref (keyword (.. n -dataset -ref))
:at (js/parseInt (.. n -dataset -at) 10)}))
;; A wrapper element (e.g. the <div> a browser inserts on Enter): recurse so
;; chips nested inside it still serialize to their token instead of being
;; flattened to text, and treat block wrappers as a line break.
:else (let [kids (apply str (map serialize-node (array-seq (.-childNodes n))))]
(if (#{"DIV" "P"} (.-tagName n)) (str "\n" kids) kids))))
(defn serialize-editor
"Serialize a contenteditable element back to its content string (text + link
tokens), preserving line breaks and chips wherever the browser nested them."
[^js el]
(apply str (map serialize-node (array-seq (.-childNodes el)))))
;; --- inline markdown: **bold**, *italic*, `code` -------------------------
(def ^:private inline-re #"(`[^`]+`|\*\*[^*]+\*\*|\*[^*]+\*)")
(defn- inline
"Render inline markdown in plain text `s` to a seq of strings / Hiccup spans."
[s]
(loop [s s, acc []]
(if-let [m (re-find inline-re s)]
(let [tok (if (vector? m) (first m) m)
i (str/index-of s tok)
before (subs s 0 i)
after (subs s (+ i (count tok)))
el (cond
(str/starts-with? tok "`") [:code (subs tok 1 (dec (count tok)))]
(str/starts-with? tok "**") [:strong (subs tok 2 (- (count tok) 2))]
:else [:em (subs tok 1 (dec (count tok)))])]
(recur after (conj acc before el)))
(conj acc s))))
;; --- block markdown: headings, lists, paragraphs + inline links ----------
(defn- spans
"Inline content of a line as a seq of Hiccup nodes: link chips (via `link-fn`),
inline markdown, and plain strings."
[s link-fn]
(mapcat (fn [[k v]] (if (= k :link) [(link-fn v)] (inline v)))
(parse-content s)))
(defn render
"Render annotation `content` (markdown blocks — ATX headings, `- `/`* ` lists,
paragraphs — with inline **bold**/*italic*/`code` and link tokens) to a Hiccup
[:div.md …] tree. `link-fn` turns a {:label :ref :at} link into a Hiccup chip;
it's injected because resolving a link to a timeline frame needs the scene."
[content link-fn]
(letfn [(flush-para [out para]
(cond-> out
(seq para) (conj (into [:p] (spans (str/join " " para) link-fn)))))]
(loop [ls (str/split-lines (or content "")), out [], para []]
(if (empty? ls)
(into [:div.md] (flush-para out para))
(let [t (str/trim (first ls))]
(cond
(str/blank? t)
(recur (rest ls) (flush-para out para) [])
(re-find #"^#{1,6}\s" t)
(let [n (count (re-find #"^#+" t))
txt (str/replace t #"^#+\s*" "")
tag (keyword (str "h" (min n 6)))]
(recur (rest ls) (conj (flush-para out para) (into [tag] (spans txt link-fn))) []))
(re-find #"^[-*]\s" t)
(let [[items more] (split-with #(re-find #"^\s*[-*]\s" %) ls)
lis (for [it items]
(into [:li] (spans (str/replace (str/trim it) #"^[-*]\s*" "") link-fn)))]
(recur more (conj (flush-para out para) (into [:ul] lis)) []))
:else
(recur (rest ls) out (conj para t))))))))

49
tl/src/tl/scene.cljs
View file

@ -378,27 +378,30 @@
(runs scene ctx gid))}))))]
(vec (concat (sort-by :name tracks) (sort-by :name anns)))))
(def ^:private link-re "\\[([^\\]]*)\\]\\(mark:([^@)]+)@(-?\\d+)\\)")
(defn path-to
"Stack path from :root down to `gid` following :parent links, or nil if an
ancestor is missing — an orphan whose parent context was deleted."
[scene gid]
(loop [g gid, acc ()]
(cond
(= g :root) (vec (cons :root acc))
(or (nil? g) (not (contains? (:groups scene) g))) nil
:else (recur (get-in scene [:groups g :parent]) (cons g acc)))))
(defn link-token
"The markdown token for a link {:label :ref :at}."
[{:keys [label ref at]}]
(str "[" label "](mark:" (name ref) "@" at ")"))
(defn parse-content
"Split markdown `s` into a vector of [:text str] / [:link {:label :ref :at}]."
[s]
(if (empty? s)
[]
(let [re (js/RegExp. link-re "g")]
(loop [out [] last 0]
(if-let [m (.exec re s)]
(let [idx (.-index m) pre (subs s last idx)]
(recur (cond-> out
(seq pre) (conj [:text pre])
:always (conj [:link {:label (aget m 1)
:ref (keyword (aget m 2))
:at (js/parseInt (aget m 3) 10)}]))
(+ idx (.-length (aget m 0)))))
(let [tail (subs s last)]
(cond-> out (seq tail) (conj [:text tail]))))))))
(defn timelines
"Every reachable timeline you can open as a context — root, plus named child
annotations whose parent chain still reaches root — each with the stack path
to reach it and its parent's name (:in) for disambiguation. Orphans (parent
deleted) are dropped."
[scene]
(->> (:groups scene)
(keep (fn [[gid g]]
(when (and (= :annotation (:type g)) (not (:draft g)))
(when-let [path (path-to scene gid)]
(let [parent (:parent g)]
{:gid gid :name (or (:name g) (name gid))
:in (if (or (nil? parent) (= :root parent))
"root" (get-in scene [:groups parent :name] (name parent)))
:path path})))))
(sort-by :name)
(into [{:gid :root :name "root" :in nil :path [:root]}])))

4
tl/src/tl/subs.cljs
View file

@ -19,6 +19,10 @@
(rf/reg-sub ::thumbnail-status (fn [db] (get-in db [:project :thumbnail_status])))
(rf/reg-sub ::create-error (fn [db] (:create-error db)))
(rf/reg-sub ::login-error (fn [db] (:login-error db)))
(rf/reg-sub ::net-error (fn [db] (:net-error db)))
(rf/reg-sub ::projects-error (fn [db] (:projects-error db)))
(rf/reg-sub ::save-error (fn [db] (:save-error db)))
(rf/reg-sub ::load-error (fn [db] (get-in db [:load :error])))
(rf/reg-sub ::authed? (fn [db] (boolean (get-in db [:auth :authenticated]))))
(rf/reg-sub ::username (fn [db] (get-in db [:auth :username])))
(rf/reg-sub ::fps (fn [db] (:fps db)))

260
tl/src/tl/views.cljs
View file

@ -4,6 +4,7 @@
[reagent.core :as r]
[re-frame.core :as rf]
[tl.subs :as subs]
[tl.md :as md]
[tl.scene :as scene]
[tl.routes :as routes]
[tl.events :as events]))
@ -101,20 +102,28 @@
(when discontinuity?
(seek-video! fps ns))
(rf/dispatch [::events/set-playhead ctx nl]))
(.pause v)) ; end → pause event disengages
(do (rf/dispatch [::events/set-playhead ctx (+ ls (- se ss))]) ; snap to the very end
(.pause v))) ; end → pause event disengages
(rf/dispatch [::events/set-playhead ctx (+ ls (- sf ss))])))))
(when @play (reset! raf (js/requestAnimationFrame play-tick)))))
(defn- engage-play!
"Drive the playhead from the (already-playing) video, in the current context,
from wherever currentTime is. Idempotent."
from wherever currentTime is. If playback had finished (playhead parked at the
end), restart from the top of this timeline instead. Idempotent."
[]
(let [segs @(rf/subscribe [::subs/segments])
ctx @(rf/subscribe [::subs/context])
fps @(rf/subscribe [::subs/fps])
ph @(rf/subscribe [::subs/playhead])
v @video-el]
(when (and v (seq segs) (not @play))
(reset! play {:ctx ctx :segs segs :fps fps :idx (seg-at-src segs (* (.-currentTime v) fps))})
(if (>= ph (scene/length segs))
(let [s0 (scene/local->source segs 0)] ; at the end → rewind to start
(rf/dispatch [::events/set-playhead ctx 0])
(seek-video! fps s0)
(reset! play {:ctx ctx :segs segs :fps fps :idx 0 :pending-ns s0}))
(reset! play {:ctx ctx :segs segs :fps fps :idx (seg-at-src segs (* (.-currentTime v) fps))}))
(rf/dispatch [::events/set-playing true])
(reset! raf (js/requestAnimationFrame play-tick)))))
@ -142,6 +151,16 @@
(defn video-monitor []
[:video {:src @(rf/subscribe [::subs/clip-url]) :controls true :preload "auto"
:plays-inline true :webkit-playsinline "true"
;; (Re)loading a clip resets the element to currentTime 0, so a restored
;; / deep-linked playhead would show in the UI but play from 0. Seek the
;; element to the current playhead once its metadata is ready.
:on-loaded-metadata
(fn [_]
(when-not @play
(let [segs @(rf/subscribe [::subs/segments])
fps @(rf/subscribe [::subs/fps])
ph @(rf/subscribe [::subs/playhead])]
(seek-video! fps (scene/local->source segs ph)))))
:on-play (fn [_] (engage-play!))
:on-pause (fn [_] (disengage!))
:ref (fn [n] (when n (reset! video-el n)))}])
@ -282,31 +301,40 @@
{:ref (keyword ref) :at (js/parseInt at 10)}))
(defn content-display
"Read-only render of markdown `content`: text plus clickable link chips."
"Read-only render of annotation `content`: markdown blocks (headings, lists,
paragraphs) with inline formatting plus clickable link chips."
[scene ctx content]
(into [:div.md]
(map (fn [[k v]]
(if (= k :text)
v
(let [lf (scene/link-local scene ctx (select-keys v [:ref :at]))]
(md/render content
(fn [{:keys [kind label ref at]}]
(if (= :timeline kind)
(let [path (scene/path-to scene ref)]
[:span.link-chip {:class (when-not path "broken")
:title (when-not path "timeline no longer here")
:on-click #(when path (rf/dispatch [::events/open-stack path]))}
"⤢ " label])
(let [lf (scene/link-local scene ctx {:ref ref :at at})]
[:span.link-chip {:class (when-not lf "broken")
:title (when-not lf "linked clip no longer in this timeline")
:on-click #(when lf (goto! lf))}
(when-not lf "⚠ ") (:label v)
(when lf [:span.link-f (str " " (js/Math.round lf) "f")])])))
(scene/parse-content content))))
(when-not lf "⚠ ") label
(when lf [:span.link-f (str " " (js/Math.round lf) "f")])])))))
(defn- build-chip [{:keys [label ref at]}]
(let [span (js/document.createElement "span")
lf (scene/link-local @(rf/subscribe [::subs/scene]) @(rf/subscribe [::subs/context])
{:ref ref :at at})]
(set! (.-className span) (if lf "link-chip" "link-chip broken"))
(defn- build-chip [{:keys [label ref at kind]}]
(let [span (js/document.createElement "span")
scene @(rf/subscribe [::subs/scene])
timeline? (= :timeline kind)
lf (when-not timeline?
(scene/link-local scene @(rf/subscribe [::subs/context]) {:ref ref :at at}))
ok (if timeline? (some? (scene/path-to scene ref)) lf)]
(set! (.-className span) (if ok "link-chip" "link-chip broken"))
(set! (.-contentEditable span) "false")
(when-not lf (set! (.-title span) "linked clip no longer in this timeline"))
(set! (.-textContent span) (str (when-not lf "⚠ ") label))
(when-not ok (set! (.-title span) (if timeline? "timeline no longer here"
"linked clip no longer in this timeline")))
(set! (.-textContent span) (str (cond timeline? "⤢ " (not ok) "⚠ ") label))
(aset (.-dataset span) "label" label)
(aset (.-dataset span) "ref" (name ref))
(aset (.-dataset span) "at" (str at))
(when kind (aset (.-dataset span) "kind" (name kind)))
(when-not timeline? (aset (.-dataset span) "at" (str at)))
(when lf
(let [f (js/document.createElement "span")]
(set! (.-className f) "link-f")
@ -316,24 +344,11 @@
(defn- populate! [^js el content]
(set! (.-innerHTML el) "")
(doseq [[k v] (scene/parse-content content)]
(doseq [[k v] (md/parse-content content)]
(.appendChild el (if (= k :text)
(.createTextNode js/document v)
(build-chip v)))))
(defn- serialize-editor [^js el]
(apply str
(map (fn [^js n]
(cond
(= 3 (.-nodeType n)) (.-textContent n)
(and (.-classList n) (.contains (.-classList n) "link-chip"))
(scene/link-token {:label (.. n -dataset -label)
:ref (keyword (.. n -dataset -ref))
:at (js/parseInt (.. n -dataset -at) 10)})
(= "BR" (.-tagName n)) "\n"
:else (str "\n" (.-textContent n))))
(array-seq (.-childNodes el)))))
(defn content-editor
"Contenteditable markdown surface for the draft's :content. Uncontrolled: we
populate it once from `initial`, then serialize back out on input. Exposes its
@ -341,7 +356,7 @@
chip at the caret."
[gid initial]
(r/with-let [el (atom nil) saved (atom nil)
emit #(rf/dispatch [::events/set-content gid (serialize-editor @el)])
emit #(rf/dispatch [::events/set-content gid (md/serialize-editor @el)])
save! (fn [] (let [s (.getSelection js/window)]
(when (and @el (= @el (.-activeElement js/document))
(pos? (.-rangeCount s)) (.contains @el (.-anchorNode s)))
@ -362,13 +377,20 @@
{:content-editable true :suppress-content-editable-warning true
:data-placeholder "Content (optional)"
:ref (fn [n] (when (and n (not= n @el))
(reset! el n) (populate! n initial) (reset! active-insert! insert!)))
(reset! el n) (populate! n initial) (reset! active-insert! insert!)
;; focus the content surface when the form opens (instead of
;; the marks picker), caret at the end so edits append.
(.focus n)
(let [r (doto (.createRange js/document)
(.selectNodeContents n) (.collapse false))
s (.getSelection js/window)]
(.removeAllRanges s) (.addRange s r))))
:on-input emit :on-key-up save! :on-mouse-up save! :on-blur save!
:on-click (fn [e] (when-let [chip (.closest (.-target e) ".link-chip")]
(when-let [lf (link-frame (.. chip -dataset -ref) (.. chip -dataset -at))]
(goto! lf))))}]))
(defn- point-candidates [scene ctx q]
(defn- point-candidates [scene ctx q timelines?]
(let [needle (str/lower-case q)
n (when (re-matches #"-?\d+" q) (js/parseInt q 10))]
(vec
@ -381,7 +403,15 @@
(:search item)))]
(when (str/includes? hay needle)
(assoc item :group (:name g)))))
(:items g)))))))))
(:items g)))))
;; timeline-open targets — any timeline, anywhere (only when inserting a link).
;; "timeline" is part of every haystack, so typing the category lists them all.
(when timelines?
(->> (scene/timelines scene)
(keep (fn [{:keys [gid name in path]}]
(when (str/includes? (str/lower-case (str "timeline " name " " in)) needle)
{:label name :kind :timeline :group (when in (str "in " in))
:point {:kind :timeline :ref gid} :path path})))))))))
(defn- point-label [cand off local]
(str (:label cand) " @" (js/Math.round local) "f"
@ -389,30 +419,39 @@
(str " +" off))))
(defn- pick-point [cand off]
(let [o (if (:abs cand) 0 (min (max 0 off) (max 0 (dec (or (:len cand) 1)))))
local (+ (:local cand) o)]
(assoc (cond-> (:point cand) (not (:abs cand)) (update :at + o))
:label (point-label cand o local)
:local local
:candidate cand
:offset o)))
(if (= :timeline (:kind cand))
(assoc (:point cand) :label (:label cand) :local (:local cand) :candidate cand :offset 0)
(let [o (if (:abs cand) 0 (min (max 0 off) (max 0 (dec (or (:len cand) 1)))))
local (+ (:local cand) o)]
(assoc (cond-> (:point cand) (not (:abs cand)) (update :at + o))
:label (point-label cand o local)
:local local
:candidate cand
:offset o))))
(defn point-picker
"Shared clip / annotation / frame autocomplete. `on-pick` receives the link
point plus :label and resolved ctx-local :local. Callers decide whether that
pick advances mark entry or just stages a link."
[{:keys [scene ctx value on-pick on-cancel placeholder auto-focus? class]}]
[{:keys [scene ctx value on-pick on-cancel placeholder auto-focus? class timelines?]}]
(r/with-let [text (r/atom (or (:label value) ""))
idx (r/atom 0)
off (r/atom (or (:offset value) 0))
picked (r/atom value)
open? (r/atom true)]
(let [cands (point-candidates scene ctx @text)
(let [cands (point-candidates scene ctx @text timelines?)
i (min @idx (max 0 (dec (count cands))))
cur (or (:candidate @picked) (get cands i))
maxo (max 0 (dec (or (:len cur) 1)))
o (min (max 0 @off) maxo)
frame? (and cur (not (:abs cur)) (pos? maxo))
preview! (fn [cand o2]
(when cand
(cond
(not timelines?) (goto! (:local (pick-point cand o2)))
(= :timeline (:kind cand)) (rf/dispatch [::events/open-stack (:path cand)])
:else (rf/dispatch [::events/preview-frame
(:local (pick-point cand o2))]))))
emit! (fn [cand o2]
(when cand
(let [p (pick-point cand o2)]
@ -420,11 +459,8 @@
(reset! text (:label p))
(reset! off (:offset p))
(reset! open? false)
(goto! (:local p))
(preview! cand o2)
(on-pick p))))
preview! (fn [cand o2]
(when cand
(goto! (:local (pick-point cand o2)))))
go! (fn [j]
(reset! picked nil)
(reset! idx j)
@ -442,7 +478,7 @@
(reset! idx 0)
(reset! off 0)
(reset! open? true)
(preview! (first (point-candidates scene ctx (.. % -target -value))) 0))
(preview! (first (point-candidates scene ctx (.. % -target -value) timelines?)) 0))
:on-key-down
(fn [e]
(case (.-key e)
@ -475,9 +511,11 @@
:on-mouse-down #(.preventDefault %)
:on-mouse-enter #(go! j)
:on-click #(emit! c 0)}
(when timelines? [:span.cand-kind (if (= :timeline (:kind c)) "⤢ " "↪ ")])
[:span.cand-label (:label c)]
(when (:group c) [:span.cand-group (str " " (:group c))])
[:span.link-f (str " " (js/Math.round (:local c)) "f")]])))])))
(when-not (= :timeline (:kind c))
[:span.link-f (str " " (js/Math.round (:local c)) "f")])])))])))
(defn- local->draft-point [segs local]
(some (fn [{m :mark [c d] :local}]
@ -494,7 +532,7 @@
(defn- link-picker [{:keys [scene ctx on-commit on-cancel]}]
(r/with-let [picked (r/atom nil)]
[:div.link-insert
[point-picker {:scene scene :ctx ctx :value @picked :auto-focus? true
[point-picker {:scene scene :ctx ctx :value @picked :auto-focus? true :timelines? true
:on-pick #(reset! picked %)
:on-cancel on-cancel}]
[:button.hl-ok {:type "button" :title "Insert link" :disabled (nil? @picked)
@ -541,6 +579,15 @@
(when-let [node (and active (.querySelector c (str "#ann-" (name active))))]
(set! (.-scrollTop c) (max 0 (- (.-offsetTop node) (/ (.-clientHeight c) 3))))))))
[:div.commentary {:ref (fn [n] (reset! el n))}
;; this context's own description (links resolve in its parent), with an
;; edit button — Edit drops into the parent timeline so marks are editable.
(let [cg (get-in scene [:groups ctx])]
[:div.ctx-content
(if (seq (:content cg))
[content-display scene (or (:parent cg) ctx) (:content cg)]
[:div.muted "No description yet."])
(when authed?
[:button.edit-btn {:on-click #(rf/dispatch [::events/edit-here ctx])} "✎ Edit"])])
(when authed?
[:div.commentary-head
[:button.add-btn {:on-click #(rf/dispatch [::events/open-draft])}
@ -585,75 +632,84 @@
(r/with-let [orig (dissoc @(rf/subscribe [::subs/draft-group]) :draft :gid)]
(let [d @(rf/subscribe [::subs/draft-group])
scene @(rf/subscribe [::subs/scene])
segs @(rf/subscribe [::subs/segments])
ctx @(rf/subscribe [::subs/context])
;; anchor the form to the draft's home context, not the live stack top:
;; a link-insert timeline preview moves the stack, but this annotation
;; still belongs to (:parent d), so its marks/pickers stay stable.
ctx (or (:parent d) (:gid d)) ; annotation: its parent; root: itself
segs (scene/content-segments scene ctx)
pt @(rf/subscribe [::subs/pt])
linking @(rf/subscribe [::subs/linking])
gid (:gid d)
new? (= :new (:draft d))
root? (nil? (:parent d)) ; the root timeline: content only
put (fn [g] (rf/dispatch [::events/put-group gid (dissoc g :gid)]))
rows (scene/marks->rows scene (:marks d))
valid? (and (not (str/blank? (:name d))) (seq (:marks d)))
valid? (or root? (and (not (str/blank? (:name d))) (seq (:marks d))))
save #(when valid?
(rf/dispatch [::events/save-group gid (dissoc d :draft :gid)
(when-not new? orig)]))]
(when-not new? orig)])
(rf/dispatch [::events/finish-edit]))]
[:form.form {:on-submit (fn [e] (.preventDefault e) (save))}
[:div.form-head (if new? "New annotation" "Edit annotation")]
[:div.form-row
[:input.form-name {:placeholder "Name" :value (:name d)
:on-change #(put (assoc d :name (.. % -target -value)))}]
[:input.form-color {:type "color" :value (:color d)
:on-change #(put (assoc d :color (.. % -target -value)))}]]
[:div.form-head (cond root? "Edit description" new? "New annotation" :else "Edit annotation")]
(when-not root?
[:div.form-row
[:input.form-name {:placeholder "Name" :value (:name d)
:on-change #(put (assoc d :name (.. % -target -value)))}]
[:input.form-color {:type "color" :value (:color d)
:on-change #(put (assoc d :color (.. % -target -value)))}]])
[:div.form-marks-label "Content"]
^{:key gid} [content-editor gid (:content orig)]
(if (and linking (= gid (:gid linking)))
[link-picker {:scene scene :ctx ctx
:on-commit #(commit-link! (select-keys % [:ref :at]) (:label %))
:on-commit #(commit-link! (select-keys % [:ref :at :kind]) (:label %))
:on-cancel #(rf/dispatch [::events/cancel-linking])}]
[:button.add-mark {:type "button" :on-click #(rf/dispatch [::events/start-linking gid])}
"🔗 Insert link"])
(when (and linking (= gid (:gid linking)))
[:div.form-hint "Click a clip or the frame-readout to link it, or pick above."])
[:div.form-marks-label "Marks"]
(doall
(for [[i row] (map-indexed vector rows)]
^{:key i}
[:div.mark-row
[frame-chip scene segs put d i :start (:s row)]
[:span.mark-arrow "→"]
[frame-chip scene segs put d i :end (:e row)]
[:button.row-x {:type "button" :title "Remove"
:on-click #(put (update d :marks (fn [ms] (vec (concat (subvec ms 0 i) (subvec ms (inc i)))))))} "✕"]]))
(when (map? pt)
[:div.mark-row
[:div.pt-chip [:span.pt-chip-name (str (clip-label scene segs (:seg pt))
" @" (:f pt) "f")]]
[:span.mark-arrow "→"]
[point-picker {:scene scene :ctx ctx :class "active" :auto-focus? true
:placeholder "click end clip..."
:on-pick #(let [end-local (if (and (zero? (:offset %))
(pos? (or (get-in % [:candidate :len]) 0)))
(+ (:local %) (get-in % [:candidate :len]))
(:local %))]
(when-let [p (local->draft-end-point segs end-local)]
(rf/dispatch [::events/draft-click-seg (:seg p) (:f p)])))}]])
(when (= pt :new)
[:div.mark-row
[point-picker {:scene scene :ctx ctx :class "active" :auto-focus? true
:placeholder "click a clip..."
:on-pick #(when-let [p (local->draft-point segs (:local %))]
(rf/dispatch [::events/draft-click-seg (:seg p) (:f p)]))}]])
[:div.form-hint "Click a clip in the timeline to set a start, then a clip for the end."]
[:div.form-marks-label "Script"]
[:button.add-mark {:type "button" :on-click #(rf/dispatch [::events/start-highlighting gid])}
(str "＋ Add script annotation"
(when-let [n (seq (:script d))] (str " (" (count n) ")")))]
(when-not root?
[:<>
[:div.form-marks-label "Marks"]
(doall
(for [[i row] (map-indexed vector rows)]
^{:key i}
[:div.mark-row
[frame-chip scene segs put d i :start (:s row)]
[:span.mark-arrow "→"]
[frame-chip scene segs put d i :end (:e row)]
[:button.row-x {:type "button" :title "Remove"
:on-click #(put (update d :marks (fn [ms] (vec (concat (subvec ms 0 i) (subvec ms (inc i)))))))} "✕"]]))
(when (map? pt)
[:div.mark-row
[:div.pt-chip [:span.pt-chip-name (str (clip-label scene segs (:seg pt))
" @" (:f pt) "f")]]
[:span.mark-arrow "→"]
[point-picker {:scene scene :ctx ctx :class "active" :auto-focus? true
:placeholder "click end clip..."
:on-pick #(let [end-local (if (and (zero? (:offset %))
(pos? (or (get-in % [:candidate :len]) 0)))
(+ (:local %) (get-in % [:candidate :len]))
(:local %))]
(when-let [p (local->draft-end-point segs end-local)]
(rf/dispatch [::events/draft-click-seg (:seg p) (:f p)])))}]])
(when (= pt :new)
[:div.mark-row
[point-picker {:scene scene :ctx ctx :class "active"
:placeholder "click a clip..."
:on-pick #(when-let [p (local->draft-point segs (:local %))]
(rf/dispatch [::events/draft-click-seg (:seg p) (:f p)]))}]])
[:div.form-hint "Click a clip in the timeline to set a start, then a clip for the end."]
[:div.form-marks-label "Script"]
[:button.add-mark {:type "button" :on-click #(rf/dispatch [::events/start-highlighting gid])}
(str "＋ Add script annotation"
(when-let [n (seq (:script d))] (str " (" (count n) ")")))]])
[:div.form-actions
[:button.save {:type "submit" :disabled (not valid?)} "Save"]
[:button.cancel {:type "button"
:on-click #(if new?
(rf/dispatch [::events/drop-group gid])
(rf/dispatch [::events/restore-group gid orig]))}
:on-click #(do (if new?
(rf/dispatch [::events/drop-group gid])
(rf/dispatch [::events/restore-group gid orig]))
(rf/dispatch [::events/finish-edit]))}
"Cancel"]]])))
;; --- chrome ---------------------------------------------------------------

36
tl/test/tl/scene_test.cljs
View file

@ -1,5 +1,6 @@
(ns tl.scene-test
(:require [cljs.test :refer-macros [deftest is testing]]
[tl.md :as md]
[tl.scene :as s]))
;; --- shared fixture -------------------------------------------------------
@ -327,15 +328,40 @@
(deftest parse-content-splits-text-and-links
(testing "content round-trips through link-token / parse-content"
(let [tok (s/link-token {:label "B-roll clip @10" :ref :clip-b :at 10})
(let [tok (md/link-token {:label "B-roll clip @10" :ref :clip-b :at 10})
s (str "see " tok " here")]
(is (= "[B-roll clip @10](mark:clip-b@10)" tok))
(is (= [[:text "see "]
[:link {:label "B-roll clip @10" :ref :clip-b :at 10}]
[:link {:kind :frame :label "B-roll clip @10" :ref :clip-b :at 10}]
[:text " here"]]
(s/parse-content s))))
(is (= [] (s/parse-content "")))
(is (= [[:text "plain note"]] (s/parse-content "plain note")))))
(md/parse-content s))))
(testing "labels with parens and @ survive the round-trip"
(let [link {:kind :frame :label "CU Tashi (1) @0f" :ref :t2-c5 :at 0}]
(is (= [[:link link]] (md/parse-content (md/link-token link))))))
(testing "timeline links carry just a ref and round-trip"
(let [tl {:kind :timeline :label "Match point" :ref :ann-1}]
(is (= "[Match point](timeline:ann-1)" (md/link-token tl)))
(is (= [[:link tl]] (md/parse-content (md/link-token tl))))))
(is (= [] (md/parse-content "")))
(is (= [[:text "plain note"]] (md/parse-content "plain note")))))
(deftest path-to-builds-stack-and-drops-orphans
(let [scene {:groups {:root {:type :timeline :parent nil}
:a {:type :annotation :parent :root}
:b {:type :annotation :parent :a}
:orphan {:type :annotation :parent :gone}}}]
(testing "path is root → … → target"
(is (= [:root] (s/path-to scene :root)))
(is (= [:root :a] (s/path-to scene :a)))
(is (= [:root :a :b] (s/path-to scene :b))))
(testing "an orphan (missing ancestor) has no path"
(is (nil? (s/path-to scene :orphan))))
(testing "timelines lists root + reachable annotations, not orphans"
(let [gids (set (map :gid (s/timelines scene)))]
(is (contains? gids :root))
(is (contains? gids :a))
(is (contains? gids :b))
(is (not (contains? gids :orphan)))))))
(deftest seg-point-and-link-local-round-trip
(testing "a clip-scoped point resolves back to the same ctx-local frame"