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

feat: add annotation search filters

Browse source
This commit is contained in:
Your Name 2026-07-05 18:17:09 -04:00
parent dfa92a478f
commit 649e36c14c
8 changed files with 222 additions and 45 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -365,6 +365,17 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
.ac .pt-dropdown li { display: flex; align-items: center; justify-content: space-between; gap: 6px; }
.tag-eye { font-size: 12px; flex: none; }
.pt-x:hover { text-decoration: underline; }
.annotation-filter {
display: flex; align-items: center; gap: 6px; flex-wrap: wrap;
padding: 6px 8px; border-bottom: 1px solid var(--ink); background: var(--paper);
}
.annotation-search {
flex: 1 1 220px; min-width: 0; box-sizing: border-box;
background: var(--paper); color: var(--ink); border: 1px solid var(--ink);
border-radius: 0; padding: 5px 7px; font-family: var(--geneva); font-size: 12px;
}
.annotation-filter .filter-btn { border-radius: 0; }
.annotation-filter .filter-btn.clear { margin-left: auto; }
.form-hint { font-size: 11px; color: var(--mute); }
.form-check { display: flex; align-items: center; gap: 6px; font-family: var(--chicago);

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

@ -332,12 +332,21 @@
(let [s (get-in db [:view :hidden-notes] #{})]
(assoc-in db [:view :hidden-notes] (if (contains? s gid) (disj s gid) (conj s gid))))))
;; per-tag annotation visibility (view-only, ephemeral): eye toggles in the tag
;; filter. A tag in :hidden-tags hides every annotation carrying it.
(rf/reg-event-db ::toggle-tag-filter
;; annotation-pane filters are inclusive: selected tags narrow the list to
;; matching annotations; active-only narrows to annotations under the playhead.
(rf/reg-event-db ::set-annotation-search
(fn [db [_ q]] (assoc-in db [:view :annotation-filter :query] q)))
(rf/reg-event-db ::toggle-annotation-tag-filter
(fn [db [_ tag]]
(let [s (get-in db [:view :hidden-tags] #{})]
(assoc-in db [:view :hidden-tags] (if (contains? s tag) (disj s tag) (conj s tag))))))
(let [s (get-in db [:view :annotation-filter :tags] #{})]
(assoc-in db [:view :annotation-filter :tags]
(if (contains? s tag) (disj s tag) (conj s tag))))))
(rf/reg-event-db ::toggle-active-annotations-filter
(fn [db _]
(update-in db [:view :annotation-filter :active-only?] not)))
(rf/reg-event-db ::clear-annotation-filter
(fn [db _] (assoc-in db [:view :annotation-filter]
{:query "" :tags #{} :active-only? false})))
;; click a highlight on the page → activate its note and focus that region's row
;; in the right pane

54
tl/src/tl/filter.cljs Normal file
View file

@ -0,0 +1,54 @@
(ns tl.filter
(:require [clojure.string :as str]))
(def ^:private prefix-aliases
{"timeline" :timeline
"annotation" :timeline
"title" :timeline
"script" :script
"note" :script
"notes" :script
"clip" :clip
"clips" :clip
"tag" :tag
"tags" :tag})
(defn parse-query [q]
(let [s (str/trim (or q ""))]
(if-let [[_ prefix body] (re-matches #"(?i)^([a-z]+)\s*:\s*(.*)$" s)]
(if-let [scope (prefix-aliases (str/lower-case prefix))]
{:scope scope :term (str/lower-case (str/trim body))}
{:scope :all :term (str/lower-case s)})
{:scope :all :term (str/lower-case s)})))
(defn- includes-term? [xs term]
(or (str/blank? term)
(some #(str/includes? (str/lower-case (str %)) term) xs)))
(defn- tag-match? [selected tags]
(or (empty? selected)
(let [tags (set tags)]
(or (some tags selected)
(and (contains? selected :untagged) (empty? tags))))))
(defn annotation-matches?
[{:keys [query tags active-only? active-ids]} ann]
(let [{:keys [scope term]} (parse-query query)
selected-tags (set tags)
active-ids (set active-ids)
fields {:timeline [(:name ann) (:content ann)]
:script (:script ann)
:clip (:clips ann)
:tag (:tags ann)}
haystack (case scope
:timeline (:timeline fields)
:script (:script fields)
:clip (:clip fields)
:tag (:tag fields)
(mapcat fields [:timeline :script :clip :tag]))]
(and (tag-match? selected-tags (:tags ann))
(or (not active-only?) (contains? active-ids (:id ann)))
(includes-term? haystack term))))
(defn filter-annotations [anns filters]
(filterv #(annotation-matches? filters %) anns))

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

@ -455,7 +455,8 @@
:drawing g ; pure strokes + seed, JSON round-trips as-is
(-> g
(update :marks #(mapv restore-mark (or % [])))
(update :notes #(when % (mapv keyword %))) ; annotation-level bindings
(cond-> (:notes g)
(update :notes #(mapv keyword %))) ; annotation-level bindings
migrate))])))
anns))

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

@ -1,6 +1,7 @@
(ns tl.subs
(:require [clojure.string :as str]
[re-frame.core :as rf]
[tl.filter :as filter]
[tl.scene :as scene]))
(rf/reg-sub ::status (fn [db] (get-in db [:load :status])))
@ -24,7 +25,9 @@
(rf/reg-sub ::script-jump (fn [db] (get-in db [:view :script-jump])))
(rf/reg-sub ::note-target (fn [db] (get-in db [:view :note-target])))
(rf/reg-sub ::hidden-notes (fn [db] (get-in db [:view :hidden-notes] #{})))
(rf/reg-sub ::hidden-tags (fn [db] (get-in db [:view :hidden-tags] #{})))
(rf/reg-sub ::annotation-filter
(fn [db] (merge {:query "" :tags #{} :active-only? false}
(get-in db [:view :annotation-filter]))))
(rf/reg-sub ::region-focus (fn [db] (get-in db [:view :region-focus])))
(rf/reg-sub ::linking (fn [db] (get-in db [:view :linking])))
(rf/reg-sub ::dragging-ann (fn [db] (get-in db [:view :dragging-ann])))
@ -105,11 +108,16 @@
(fn [[scene stack] _]
(mapv (fn [gid] {:id gid :name (or (get-in scene [:groups gid :name]) (name gid))}) stack)))
;; playhead inside a bar — HALF-OPEN [lo hi), so the boundary frame belongs to the
;; next bar only (no double-highlight, no drawing bleeding onto the next clip).
(defn- in-bars? [bars ph]
(some (fn [[lo hi]] (and (<= lo ph) (< ph hi))) bars))
;; child annotations of the current context, with their bars in local coords
(rf/reg-sub
::annotations
:<- [::scene] :<- [::context] :<- [::segments] :<- [::hidden-tags] :<- [::revealed]
(fn [[scene ctx segs hidden-tags revealed] _]
::all-annotations
:<- [::scene] :<- [::context] :<- [::segments] :<- [::revealed]
(fn [[scene ctx segs revealed] _]
(let [nested (frequencies (keep (fn [[_ g]] (when (= :annotation (:type g)) (:parent g)))
(:groups scene)))
;; shown when every ancestor up to ctx is revealed: a direct child of ctx
@ -119,16 +127,30 @@
(and (revealed p) (shown? (get-in scene [:groups p :parent])))))]
(->> (:groups scene)
(keep (fn [[gid g]]
(when (and (= :annotation (:type g)) (shown? (:parent g))
;; a hidden tag hides every annotation carrying it; the
;; :untagged sentinel hides annotations with no tags
(let [tags (get-in g [:meta :tags])]
(not (or (some hidden-tags tags)
(and (empty? tags) (contains? hidden-tags :untagged))))))
(when (and (= :annotation (:type g)) (shown? (:parent g)))
(let [bars (scene/lane-bars scene ctx gid segs) ; one bar per mark; distinct marks never fuse
reason (scene/broken-reason scene gid)
oor (boolean (scene/clip-loss? scene gid))
hidden (get-in g [:meta :hidden])]
hidden (get-in g [:meta :hidden])
note-ids (->> (concat (:notes g) (mapcat :notes (:marks g)))
distinct
(filterv #(= :script-note (get-in scene [:groups % :type]))))
note-text (mapcat (fn [ng]
(let [n (get-in scene [:groups ng])]
(cons (:name n)
(mapcat (juxt :text :content) (:regions n)))))
note-ids)
jumps (scene/jump-targets scene ctx gid)
clips (->> (:marks g)
(mapcat (fn [m] [(get-in m [:start :ref])
(get-in m [:end :ref])]))
(concat (map :seg jumps))
(keep (fn [ref]
(let [cg (get-in scene [:groups ref])]
(or (:name cg)
(get-in cg [:media :name])
(some-> ref name)))))
distinct)]
{:id gid :parent (:parent g)
:name (:name g) :color (or (:color g) "#4e8fc2")
:content (:content g) :children (count (:marks g))
@ -136,19 +158,33 @@
:draft (boolean (:draft g))
;; every script-note bound anywhere in this annotation
;; (annotation-level + per-mark), deduped, still-existing only
:notes (->> (concat (:notes g) (mapcat :notes (:marks g)))
distinct
(filterv #(= :script-note (get-in scene [:groups % :type]))))
:notes note-ids
:script (vec (remove nil? note-text))
:clips (vec clips)
:broken (boolean reason) :reason reason :oor oor
:hidden (boolean hidden)
:tags (vec (get-in g [:meta :tags]))
;; jump targets labelled from the marks' clip refs (same as
;; the editor) — not re-derived from a floored bar frame
:jumps (scene/jump-targets scene ctx gid)
:jumps jumps
:start (or (ffirst bars) 0) :bars bars}))))
(sort-by (juxt :broken :start)) ; broken annotations sink to the bottom
vec))))
(rf/reg-sub
::active-annotations-unfiltered
:<- [::all-annotations] :<- [::playhead]
(fn [[anns ph] _]
(into #{} (keep (fn [a] (when (in-bars? (:bars a) ph)
(:id a)))
anns))))
(rf/reg-sub
::annotations
:<- [::all-annotations] :<- [::annotation-filter] :<- [::active-annotations-unfiltered]
(fn [[anns filters active] _]
(filter/filter-annotations anns (assoc filters :active-ids active))))
;; every distinct tag used by any annotation in the project — feeds both the tag
;; adder's autocomplete and the timeline tag filter.
(rf/reg-sub
@ -161,11 +197,6 @@
(sort-by str/lower-case)
vec)))
;; playhead inside a bar — HALF-OPEN [lo hi), so the boundary frame belongs to the
;; next bar only (no double-highlight, no drawing bleeding onto the next clip).
(defn- in-bars? [bars ph]
(some (fn [[lo hi]] (and (<= lo ph) (< ph hi))) bars))
;; the annotation the playhead is currently inside (or the latest one passed) —
;; drives the rolling highlight/scroll in the commentary
(rf/reg-sub

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

@ -1679,24 +1679,40 @@
;; "Untagged" is just another item that maps to the :untagged sentinel.
(def ^:private untagged-label "Untagged")
(defn- tag-filter []
(defn- annotation-filter []
(r/with-let [open? (r/atom false)]
(let [tags @(rf/subscribe [::subs/project-tags])
hidden @(rf/subscribe [::subs/hidden-tags])
(let [project-tags @(rf/subscribe [::subs/project-tags])
{:keys [query tags active-only?]} @(rf/subscribe [::subs/annotation-filter])
chosen (set tags)
key-of #(if (= % untagged-label) :untagged %)]
(when (seq tags)
[:div.annotation-filter
[:input.annotation-search {:type "search"
:placeholder "Search all, or prefix timeline:, script:, clip:, tag:"
:value query
:on-change #(rf/dispatch [::events/set-annotation-search
(.. % -target -value)])}]
[:button.filter-btn {:class (when active-only? "active")
:title "Only show annotations active at the playhead"
:on-click #(rf/dispatch [::events/toggle-active-annotations-filter])}
"Active"]
(when (seq project-tags)
[:span.tag-filter
[:button.filter-btn {:class (when (seq hidden) "active") :title "Show / hide annotations by tag"
[:button.filter-btn {:class (when (seq chosen) "active")
:title "Filter annotations by tag"
:on-click #(swap! open? not)}
"▽ Tags" (when (seq hidden) (str " (" (count hidden) ")"))]
"Tags" (when (seq chosen) (str " (" (count chosen) ")"))]
(when @open?
[:<>
[:div.menu-backdrop {:on-click #(reset! open? false)}]
[:div.filter-pop
[autocomplete {:items (into [untagged-label] tags)
:placeholder "filter tags…" :clear-on-choose? false :auto-focus? true
:on-choose #(rf/dispatch [::events/toggle-tag-filter (key-of %)])
:item-suffix (fn [t] [:span.tag-eye (if (contains? hidden (key-of t)) "🙈" "👁")])}]]])]))))
[autocomplete {:items (into [untagged-label] project-tags)
:placeholder "include tags…" :clear-on-choose? false :auto-focus? true
:on-choose #(rf/dispatch [::events/toggle-annotation-tag-filter (key-of %)])
:item-suffix (fn [t] [:span.tag-eye (if (contains? chosen (key-of t)) "✓" "")])}]]])])
(when (or (seq query) (seq chosen) active-only?)
[:button.filter-btn.clear {:title "Clear filters"
:on-click #(rf/dispatch [::events/clear-annotation-filter])}
"Clear"])])))
(defn toolbar []
;; NB: subscribe the coarse ::at-start?/::at-end? edges, not the raw playhead —
@ -1727,7 +1743,6 @@
[:label.slider {:title "Vertical zoom"} "↕"
[:input {:type "range" :min 8 :max 120 :value row-h
:on-change #(rf/dispatch [::events/set-row-h (js/parseFloat (.. % -target -value))])}]]
[tag-filter]
[dark-toggle]]))
(defn- drag-top!
@ -2071,6 +2086,7 @@
::events/set-pane) :annotations])} "Annotations"]
[:button {:class (when (= pane :script) "active")
:on-click #(rf/dispatch [::events/set-pane :script])} "Script"]]
(when (= pane :annotations) [annotation-filter])
[:div.pane-body
(if (= pane :script)
[script-pane]

55
tl/test/tl/filter_test.cljs Normal file
View file

@ -0,0 +1,55 @@
(ns tl.filter-test
(:require [cljs.test :refer-macros [deftest is testing]]
[tl.filter :as f]))
(def anns
[{:id :a
:name "Kitchen argument"
:content "A tense exchange at breakfast"
:tags ["beat" "performance"]
:script ["INT. KITCHEN - MORNING" "I can't keep doing this."]
:clips ["kitchen_wide.mov" "closeup_alex.mov"]}
{:id :b
:name "Street pickup"
:content "Car arrives outside"
:tags ["blocking"]
:script ["EXT. STREET - NIGHT"]
:clips ["street_driving.mov"]}
{:id :c
:name "Untitled reaction"
:content "Silent look"
:tags []
:script []
:clips ["reaction_insert.mov"]}])
(deftest tag-filters-include-matches
(testing "no tag selection leaves the list unconstrained"
(is (= [:a :b :c] (mapv :id (f/filter-annotations anns {:tags #{}})))))
(testing "selecting a tag includes matching annotations instead of hiding them"
(is (= [:a] (mapv :id (f/filter-annotations anns {:tags #{"beat"}})))))
(testing "multiple selected tags are an OR"
(is (= [:a :b] (mapv :id (f/filter-annotations anns {:tags #{"beat" "blocking"}})))))
(testing "untagged is an explicit include bucket"
(is (= [:c] (mapv :id (f/filter-annotations anns {:tags #{:untagged}}))))))
(deftest active-only-intersects-other-filters
(testing "active-only shows only currently active annotations"
(is (= [:b] (mapv :id (f/filter-annotations anns {:active-only? true
:active-ids #{:b :z}})))))
(testing "active-only intersects with selected tags"
(is (= [] (mapv :id (f/filter-annotations anns {:tags #{"beat"}
:active-only? true
:active-ids #{:b}}))))))
(deftest search-scopes
(testing "plain text searches title/content/tags/script/clips"
(is (= [:a] (mapv :id (f/filter-annotations anns {:query "breakfast"}))))
(is (= [:b] (mapv :id (f/filter-annotations anns {:query "street_driving"}))))
(is (= [:a] (mapv :id (f/filter-annotations anns {:query "can't keep"})))))
(testing "prefixes are case-insensitive and restrict the search field"
(is (= [:a] (mapv :id (f/filter-annotations anns {:query "Timeline: kitchen"}))))
(is (= [:a] (mapv :id (f/filter-annotations anns {:query "script: kitchen"}))))
(is (= [:a] (mapv :id (f/filter-annotations anns {:query "clip: kitchen"}))))
(is (= [] (mapv :id (f/filter-annotations anns {:query "script: closeup"}))))
(is (= [:a] (mapv :id (f/filter-annotations anns {:query "clip: closeup"}))))
(is (= [:b] (mapv :id (f/filter-annotations anns {:query "tag: block"}))))))

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

@ -373,9 +373,9 @@
(deftest annotations-survive-json-roundtrip
(testing "restore-annotations is the exact inverse of the JSON wire trip — guards
against any keyword-valued field (id/ref/type/parent/track) being missed"
(let [anns {:ann-p {:v 1 :type :annotation :parent :root :name "p" :color "#abc" :content "hi"
(let [anns {:ann-p {:v s/schema-version :type :annotation :parent :root :name "p" :color "#abc" :content "hi"
:marks [{:id :m-1 :start {:ref :clip-a :at 0} :end {:ref :clip-a :at -1} :track :t0}]}
:ann-c {:v 1 :type :annotation :parent :ann-p :name "c"
:ann-c {:v s/schema-version :type :annotation :parent :ann-p :name "c"
:marks [{:id :m-2 :start {:ref :m-1 :at 0} :end {:ref :m-1 :at 5}}]}}]
(is (= anns (s/restore-annotations (json-roundtrip anns)))))))