github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-10-29 22:10:34 +00:00
Code Issues Packages Projects Releases Wiki Activity

✨ Give each style of a copy text its own override

Browse Source 
A copy text had three override subgroups: its letters, any style, and
its structure (the number of paragraphs or runs). One style override
kept every other style of the main out (F72), letters and a style
together kept everything out (F73), a structure change kept the main's
styles out unless both texts had one style (F74), which the editors'
content never had (F79), and alignment, direction and vertical
alignment overrides were lost at the next sync (F76).

Now a copy text has :text-content-text for its letters and line breaks
and one group per style unit: family, weight (with style and variant),
size, line height, spacing, decoration, case, fills, typography,
alignment, direction and vertical alignment (cttx/style-units). An edit
sets the groups of what it changes: a letter both texts share that
changes its style, or a style that was not in the text before, so typed
letters touch no style. A token in the content sets the groups of the
styles it sets, and token sync of a text follows them.

Sync and the keep-touched variant switch share one merge
(cttx/merge-overrides): the letters of one side, and each unit from its
side placed on them. A unit with one value applies everywhere; else
letters both texts share (stretches of three or more) take the source's
style, and the rest follow the letter before them. The switch carries
an override only when the old and new mains agree on it (F77, F81), and
the copy then holds the groups its result differs in. A typography
reference stays only when every unit it sets comes from its side. The
variant id goes with the weight; where the family comes from the other
side, the frontend has to pick the family's closest variant.

app.common.types.text reads a content as letters, each with its run and
paragraph, and builds the content back from them; it gives the style of
one unit for a letter, compares styles by what they show, and finds the
letters two texts share with a letter diff (Myers). The component
contract memory describes the model.

Files older than this keep :text-content-attribute and
:text-content-structure, read as every group they may cover until the
migration recomputes them.

Tests whose expected values the model changes: text-sync-test (the
copy's weight, letters or new run no longer keep the main's size out;
the letters read whole), text-touched-test (its edits went to the
paragraph node, which shows nothing; they now edit the run),
variants-switch-test (the copies with two runs keep their letters
across a switch, and the size override the mains agree on), the
editor output table, case Y and the notation test (new groups). The 1j
pins of F72-F79 and F81 go; F79's direct test of equal-attrs? becomes a
sync of editor content. A new check holds the production override rule
to the 1j reference rule. New tests: the letter view, and a detached,
duplicated or reset copy text keeping or clearing its override groups.

Benchmark (lower quantile, ms; baseline / now / ratio):
  deepest-edit-through-three-levels    35.2 /  36.6 / 1.04
  edit-through-a-chain-of-dependents   68.9 /  67.2 / 0.98
  library-update-into-copies           83.1 /  72.5 / 0.87
  main-edit-into-10-copies              1.8 /   1.5 / 0.82
  main-edit-into-100-copies            15.4 /  14.9 / 0.97
  main-edit-into-1000-copies          153.1 / 153.4 / 1.00
  variant-switch-into-copies           32.1 /  27.1 / 0.85
The worlds hold no text. A main text edit synced into 100 copy texts
that changed their letters takes 40 ms, against 29 ms before: the merge
aligns the letters of each copy with the main's.

AI-assisted-by: claude-opus-5-5
This commit is contained in:
alonso.torres 2026-10-13 21:59:24 +02:00
parent 7ac68a551b
commit 45d6b112e4
17 changed files with 1149 additions and 487 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.serena/memories/common/component-data-model.md
View File

@ -18,7 +18,7 @@ Variant masters are main instances and component roots. Their descendants may th
## :touched flags
`:touched` is a set of override-group keywords such as `:geometry-group`, `:fill-group`, and `:text-content-group`. It means a copy diverged from its master for attrs in that sync group.
`:touched` is a set of override-group keywords such as `:geometry-group` and `:fill-group`. It means a copy diverged from its master for attrs in that sync group. A copy text adds `:content-group` plus one group for its letters (`:text-content-text`) and one per style unit (`:text-content-fills`, `-size`, ...; list and merge rules in `mem:common/component-sync-contract`, unit table `cttx/style-units`). Files older than the feature `components/text-overrides` used `:text-content-attribute`/`:text-content-structure` instead; the migration recomputes them against the near main.
The intended per-operation rules (which writes touch, what sync, reset, update-main, detach and switch do to touched groups) are in `mem:common/component-sync-contract`.

15
.serena/memories/common/component-sync-contract.md
View File

@ -5,7 +5,7 @@ Intended semantics of copies, `:touched` and component sync. This is the spec: w
## Definitions
- Near main: the shape a copy shape's `:shape-ref` points at (inside the main of the closest enclosing copy head). Sync, reset and the override rule compare against it.
- Touched group: a `ctk/sync-attrs` group in `:touched`, plus text subgroups `:text-content-text|attribute|structure` and `:swap-group`. Meaning: the user authored this group's value on this shape, so sync must not overwrite it. `:swap-group` on a copy sub-head: the user chose its component, so sync must not put the near main's back.
- Touched group: a `ctk/sync-attrs` group in `:touched`, plus the text groups (see Text overrides) and `:swap-group`. Meaning: the user authored this group's value on this shape, so sync must not overwrite it. `:swap-group` on a copy sub-head: the user chose its component, so sync must not put the near main's back.
- Authored write: a value the user set on that shape: sidebar edit, direct canvas transform of that shape, text content edit, explicit rename, applying a token to it.
- Derived write: a value computed from other shapes or from measurement: children placed by a transformed parent, constraint resize, layout reflow, text auto-grow, `:position-data`, automatic naming, token value propagation, library color/typography sync, repair, sync itself. Derived writes never touch.
- Expected geometry of a copy shape: the near main's geometry placed relative to the copy's parent and resized through the shape's constraints (`app.common.geom.shapes.constraints`), with layout-owned and grow-owned dimensions left to layout/measurement.
@ -19,7 +19,7 @@ Intended semantics of copies, `:touched` and component sync. This is the spec: w
## Per operation
- Edit on a copy shape (authored): sets the attr's group (text content: `:content-group` + diff subgroups), clears `:remote-synced`. Descendants moved/resized only because of it stay untouched.
- Edit on a copy shape (authored): sets the attr's group (text content: `:content-group` + the text groups it changes), clears `:remote-synced`. Descendants moved/resized only because of it stay untouched.
- Rename: an explicit rename touches `:name-group` on root or child. Automatic renames (text name following its content) are derived. Untouched names sync from the near main; a touched root name on update-main renames the component.
- Edit on a main: no touched change on the main; triggers sync.
- Sync main→copy: every untouched group gets the near main's value (geometry: expected geometry); touched groups keep their values; never sets or clears `:touched`. Main child added → added clean to copies. Main child deleted → copy child removed, overrides or not. Main reorder → copies follow. A swapped sub-head pairs with the main child it replaces (its `:shape-ref`) and takes only that child's placement (position, rotation, flips, constraints, `layout-item-*`); everything else syncs from its own component's main. A main child deleted → its swapped copies go with it. A swap made in the main reaches copies without `:swap-group` and spares those with it.
@ -30,10 +30,19 @@ Intended semantics of copies, `:touched` and component sync. This is the spec: w
- Instantiate / nest a copy: the new subtree has no touched groups.
- Duplicate a copy: the new subtree keeps the source's values and touched; if its nesting level changes, touched is inherited as in detach. Paste and move out of a copy follow the same rule.
- Swap without keep-touched: the new subtree is clean and keeps `swap-keep-attrs` values; the new head keeps the old shape's id. Inside a copy it keeps the old `:shape-ref` and gets `:swap-group` (none when the new component is the near main's); inside a main it is a plain nested copy.
- Variant switch with keep-touched: an attr is carried from the old copy only when its group is touched and the old and new mains hold the same value for it. Resulting touched = groups of carried attrs (+ `:swap-group` when the head is inside a copy). A value equal to the new main is not carried and not touched.
- Variant switch with keep-touched: an attr is carried from the old copy only when its group is touched and the old and new mains hold the same value for it. Resulting touched = groups of carried attrs (+ `:swap-group` when the head is inside a copy). A value equal to the new main is not carried and not touched. Texts: the same per text group (letters carried only when both mains have the same letters; a style group when both mains agree on it once placed on each other's letters).
- Delete component: copies keep their data. The deleted main cannot be edited, so it starts no sync, but changes from components nested in it still pass through: sync updates its stored shapes (`:objects` of the deleted component), its copies, and the components that nest it. Restore brings back an up-to-date main.
- Undo/redo: restores the exact prior state, `:touched` and `:remote-synced` included, of the op and the sync it caused together (same undo group, one step). Undo never needs a re-sync.
## Text overrides
- A text is letters (with line breaks) and a style per letter, all in `:content`. Its groups: `:text-content-text` (letters and line breaks) and one per style unit: `-family` (family, font id), `-weight` (weight, style, variant id), `-size`, `-line-height`, `-spacing`, `-decoration`, `-case`, `-fills`, `-typography` (typography reference), `-align`, `-direction` (paragraphs), `-valign` (root). Any of them implies `:content-group`. Splitting runs by styling is a style change, never a text override; an override covers the whole text, not single letters.
- Touch: compare old and new content. Letters differ -> `:text-content-text`. A style unit is touched when a shared letter changes its value or, if the letters changed, when a value appears that the text did not have (typed letters take a neighbour's style and touch nothing). A token on the copy touches the units of the attributes it sets.
- Merge (sync, and switch with the carried units): letters from the copy if overridden, else from the main. Each unit from the copy if overridden, else from the main (the source), placed on the result letters: (1) a source with one value across the text applies to every letter; (2) else letters both texts share (stretches of 3+ equal letters, by a letter diff) take the source's value; (3) else the value of the letter before, across line breaks; letters at the start take the first shared letter after them; with nothing shared, the source's first letter. Paragraph units follow the paragraph of the first shared letter, else the paragraph before. Adjacent runs with equal styles join.
- Typography reference: kept on the result only when every unit the typography sets comes from the same side as the reference; a run that loses it still follows typography updates through its main.
- Family and weight from different sides: sync keeps the weight side's variant id; the frontend then picks the closest variant of the family.
- Library color and typography syncs are derived writes: they never touch.
## Geometry ownership
- Copy root: position is its own; rotation/flip belong to it only when its `:geometry-group` is touched. Resizing it touches the root only.

166
common/src/app/common/logic/libraries.cljc
View File

@ -1713,9 +1713,16 @@
;; We don't update the flex-child attrs
(remove #(= :layout-grid-cells %)))
;; the styles of a text live in its content, so its tokens follow
;; the text override groups
text? (cfh/text-shape? dest-shape)
touched (cond-> touched
text? (-> set (into (txt/text-overrides touched))))
applied-tokens
(reduce (fn [applied-tokens attr]
(let [sync-group (or (ctk/resolve-sync-group (:type origin-shape) attr)
(let [sync-group (or (when text? (txt/style-unit-of attr))
(ctk/resolve-sync-group (:type origin-shape) attr)
(ctk/resolve-sync-group (:type dest-shape) attr))
token-attrs (cto/shape-attr->token-attrs attr)]
(if (and (or (not omit-touched?) (not (touched sync-group)))
@ -1755,60 +1762,15 @@
(defn- text-change-value
"The content of a copy text after a sync: its own letters and styles where
its touched groups say so, the rest from the main's content."
[touched-content ;; The :content of the copy text before updating
untouched-content ;; The :content of the main component
touched]
(let [main-comps-diff (txt/get-diff-type touched-content untouched-content)
diff-structure? (contains? main-comps-diff :text-content-structure)
touched-attrs (txt/get-first-paragraph-text-attrs touched-content)
;; Have touched content an uniform style?
thed-unif-style? (txt/equal-attrs? touched-content touched-attrs)
untouched-attrs (txt/get-first-paragraph-text-attrs untouched-content)
;; Have untouched content an uniform style?
untched-unif-style? (txt/equal-attrs? untouched-content untouched-attrs)]
(cond
;; Both text and attrs has been touched, keep the
;; touched-content
(and (touched :text-content-text) (touched :text-content-attribute))
touched-content
(touched :text-content-structure)
;; Special case for adding or removing paragraphs:
;; If the structure has been touched, but the attrs don't,
;; and both have uniform attributes, we keep the touched-content structure and
;; texts, updating its attrs to make them like the untouched-content
(if (and (not (touched :text-content-attribute)) thed-unif-style? untched-unif-style?)
(txt/copy-attrs-keys touched-content untouched-attrs)
;; In other case, we keep the touched content
touched-content)
(touched :text-content-text)
;; Keep the texts touched in touched-content, so copy the
;; texts from touched-content into untouched-content
(txt/copy-text-keys touched-content untouched-content)
(touched :text-content-attribute)
;; The untouched content has a different structure, but the touched content had't
;; touched the structure
(if diff-structure?
;; If both have uniform attributes, we keep the untouched-content structure and
;; texts, updating its attrs to make them like the touched-content
(if (and thed-unif-style? untched-unif-style?)
(txt/copy-attrs-keys untouched-content touched-attrs)
;; In other case, we keep the touched content
touched-content)
;; Keep the attrs touched in touched-content, so copy the
;; texts from untouched-content into touched-content
(txt/copy-text-keys untouched-content touched-content))
;; Nothing is touched
:else
untouched-content)))
(let [groups (txt/text-overrides touched)]
(if (empty? groups)
untouched-content
(txt/merge-overrides touched-content untouched-content groups))))
(defn- add-update-attr-operations
[attr dest-shape roperations uoperations attr-val]
@ -2008,89 +1970,18 @@
(defn- switch-text-change-value
[prev-content ; The :content of the text before the switch
current-content ; The :content of the text after the switch (a clean copy)
ref-content touched] ; The :content of the referenced text on the main component before the switch
(let [;; We need the differences between the contents on the main
;; components. current-content is the content of a clean copy,
;; so for all effects its the same as the content on its main
main-comps-diff (txt/get-diff-type ref-content current-content)
can-keep-text? (not (contains? main-comps-diff :text-content-text))
can-keep-attr? (not (contains? main-comps-diff :text-content-attribute))
main-diff-structure? (contains? main-comps-diff :text-content-structure)
current-attrs (txt/get-first-paragraph-text-attrs current-content)
;; Have current content an uniform style?
curr-unif-style? (txt/equal-attrs? current-content current-attrs)
prev-attrs (txt/get-first-paragraph-text-attrs prev-content)
;; Have prev content an uniform style?
prev-unif-style? (txt/equal-attrs? prev-content prev-attrs)
ref-attrs (txt/get-first-paragraph-text-attrs ref-content)
;; Have ref content an uniform style?
ref-unif-style? (txt/equal-attrs? ref-content ref-attrs)]
(cond
;; When the main components have a difference in structure
;; (different number of paragraph or text entries)
main-diff-structure?
;; Special case for adding or removing paragraphs:
;; If the structure has changed between ref-content and current-content,
;; but each one have uniform attributes, and the attrs on the main
;; components were equal, we keep the touched-content structure and
;; texts, updating its attrs to make them like the current-content
(if (and curr-unif-style?
ref-unif-style?
prev-unif-style?
(= ref-attrs current-attrs))
(txt/copy-attrs-keys current-content prev-attrs)
;; In any other case of structure change, we discard all
;; the overrides and keep the content of the current-shape
current-content)
;; When the main components are equal, we keep the updated
;; content from previous-shape as is
(and can-keep-text? can-keep-attr?)
prev-content
;; When we can't keep anything, we discard all the
;; overrides and keep the content of the current-shape
(and (not can-keep-text?) (not can-keep-attr?))
"The content of a copy text after a variant switch: each of its text
overrides that the old and the new main agree on is carried over the
new main's content."
[prev-content ;; The :content of the text before the switch
current-content ;; The :content of the text after the switch (a clean copy)
ref-content ;; The :content of the referenced text on the main component before the switch
touched]
(let [carried (set/difference (txt/text-overrides touched)
(txt/override-groups ref-content current-content))]
(if (empty? carried)
current-content
;; Special case for added or removed paragraphs:
;; If the structure has changed on current-content, but it has uniform attributes
;; and the previous-content also has uniform attributes, and we can keep the changes
;; on the text, we keep the touched-content structure and texts, updating
;; its attrs to make them like the current-content
(and (touched :text-content-structure)
curr-unif-style?
prev-unif-style?)
(if can-keep-text?
(txt/copy-attrs-keys prev-content current-attrs)
(txt/copy-attrs-keys current-content prev-attrs))
;; In any other case of structure change, we discard all
;; the overrides and keep the content of the current-shape
(touched :text-content-structure)
current-content
;; When there is a change on :text-content-text,
;; and and we can keep it, we copy the texts from
;; previous-shape over the attrs of current-shape
(and
(touched :text-content-text) can-keep-text?)
(txt/copy-text-keys prev-content current-content)
;; When there is a change on :text-content-attribute,
;; and we can keep it, we copy the texts from current-shape
;; over the attrs of previous-shape
(and
(touched :text-content-attribute) can-keep-attr?)
(txt/copy-text-keys current-content prev-content)
;; In any other case, we discard all the overrides
;; and keep the content of the current-shape
:else
current-content)))
(txt/merge-overrides prev-content current-content carried))))
(defn- switch-fixed-layout-geom-change-value
@ -2398,12 +2289,11 @@
updated-sync-groups (into #{}
(keep #(ctk/resolve-sync-group (:type previous-shape) %))
updated-attrs)
text-sub-touched #{:text-content-text :text-content-attribute :text-content-structure}
new-content (some #(when (= (:attr %) :content) (:val %)) roperations)
new-touched (set/union (or (:touched current-shape) #{})
updated-sync-groups
(when (contains? updated-sync-groups :content-group)
(set/intersection (or (:touched previous-shape) #{})
text-sub-touched)))
(when (and (cfh/text-shape? current-shape) (some? new-content))
(txt/override-groups (:content current-shape) new-content)))
roperations (into [{:type :set-touched :touched new-touched}] roperations)
uoperations (into (list {:type :set-touched :touched (:touched current-shape)}) uoperations)]
(cond-> changes

32
common/src/app/common/test_helpers/composable/comp/cases.cljc
View File

@ -654,11 +654,11 @@
(defn text-override-merges-with-main-text-change
"Case Y. A main text changes its characters or its font size; before that,
optionally, its copy changes one of them. Sync merges per text subgroup: the
copy keeps what it edited and takes the rest from the main. So the copy
shows its own characters if it edited them, else the main's, and the same
for the font size. An edited copy has `:content-group` and the subgroup of
its edit touched; an unedited one has nothing touched. The text starts with
optionally, its copy changes one of them. Sync merges per text override
group: the copy keeps what it edited and takes the rest from the main. So
the copy shows its own characters if it edited them, else the main's, and
the same for the font size. An edited copy has `:content-group` and the
group of its edit touched; an unedited one has nothing touched. The text starts with
the name generated from its content, so an edit of its characters renames
it, an automatic rename that must not touch `:name-group` (decision (d))."
[]
@ -666,7 +666,7 @@
(n/edit-text :copy-instance :font-size "32")])
main-edit (tm/one-of [(n/edit-text :main-instance :text "main text")
(n/edit-text :main-instance :font-size "24")])
subgroup {:text :text-content-text :font-size :text-content-attribute}]
subgroup {:text :text-content-text :font-size :text-content-size}]
{:setup setup/simple-text-component-with-copy
:operation (tm/in-sequence [(tm/optional copy-edit) main-edit])
:asserter (fn [s]
@ -728,8 +728,12 @@
main-node (tm/get-choice s main-edit)
same? (= (:edit copy-node) (:edit main-node))
main-text ((text-restyle main-node) setup/two-style-text)
merged ((text-restyle copy-node) main-text)
as-it-was ((text-restyle copy-node) setup/two-style-text)
merged (cond-> ((text-restyle copy-node) main-text)
;; the weight, from the main, keeps the
;; bold's variant id, for the frontend to
;; pick the copy's family's
(and (= :font-family (:edit copy-node)) (not same?))
(update-in [0 1 1] assoc :font-variant-id "bold"))
copy (setup/copy-instance s)
main (setup/main-instance s)
text-of #(n/text-span-value % :content)]
@ -742,22 +746,14 @@
(tm/applied? s push)
(do
(if same?
(t/is (= (thtx/normalize merged) (text-of main)))
;; the copy pushes all of its styles, since all
;; of them stayed as the copy left them
(tm/known-failure "F72" (thtx/normalize merged) (thtx/normalize as-it-was)
(text-of main)))
(t/is (= (thtx/normalize merged) (text-of main)))
(t/is (= (text-of main) (text-of copy)))
(t/is (empty? (:touched copy))))
:else
(do
(t/is (= (thtx/normalize main-text) (text-of main)))
(if same?
(t/is (= (thtx/normalize merged) (text-of copy)))
(tm/known-failure "F72" (thtx/normalize merged) (thtx/normalize as-it-was)
(text-of copy)))))))}))
(t/is (= (thtx/normalize merged) (text-of copy)))))))}))
;; ---------------------------------------------------------------------------
;; Swap outcomes

90
common/src/app/common/types/container.cljc
View File

@ -566,33 +566,48 @@
;; --- SHAPE UPDATE
(def ^:private token-attr->text-groups
"Token attribute set in the content of a text -> the text override groups
of the styles it sets."
{:font-family #{:text-content-family}
:font-weight #{:text-content-weight}
:font-size #{:text-content-size}
:line-height #{:text-content-line-height}
:letter-spacing #{:text-content-spacing}
:text-case #{:text-content-case}
:text-decoration #{:text-content-decoration}
:fill #{:text-content-fills}
:typography #{:text-content-family :text-content-weight :text-content-size
:text-content-line-height :text-content-spacing :text-content-case
:text-content-decoration}})
(defn- get-token-groups
"Get the sync attrs groups that are affected by changes in applied tokens.
If any token has been applied or unapplied in the shape, calculate the corresponding
attributes and get the groups. If some of the attributes are to be applied in the
content nodes of a text shape, also return the content groups (only for attributes,
so the text is not touched)."
attributes and get the groups. Tokens set in the content nodes of a text shape give
`:content-group` and the text override groups of the styles they set."
[shape new-applied-tokens]
(let [old-applied-tokens (d/nilv (:applied-tokens shape) #{})
changed-token-attrs (filter #(not= (get old-applied-tokens %) (get new-applied-tokens %))
ctt/all-keys)
shape-type (get shape :type)
text-shape? (= shape-type :text)
attrs-in-text-content? (some #(ctt/attrs-in-text-content %)
changed-token-attrs)
(let [old-applied-tokens (d/nilv (:applied-tokens shape) #{})
changed-token-attrs (filter #(not= (get old-applied-tokens %) (get new-applied-tokens %))
ctt/all-keys)
shape-type (get shape :type)
text-shape? (= shape-type :text)
in-content? #(and text-shape? (contains? ctt/attrs-in-text-content %))
changed-groups (into #{}
(comp (map ctt/token-attr->shape-attr)
(keep #(ctk/resolve-sync-group shape-type %)))
changed-token-attrs)
shape-groups (into #{}
(comp (remove in-content?)
(map ctt/token-attr->shape-attr)
(keep #(ctk/resolve-sync-group shape-type %)))
changed-token-attrs)
changed-groups (if (and text-shape?
(d/not-empty? changed-groups)
attrs-in-text-content?)
(conj changed-groups :content-group :text-content-attribute)
changed-groups)]
changed-groups))
text-groups (into #{}
(comp (filter in-content?)
(mapcat token-attr->text-groups))
changed-token-attrs)]
(cond-> shape-groups
(seq text-groups)
(into (conj text-groups :content-group)))))
(defn set-shape-attr
"Assign attribute to shape with touched logic.
@ -636,29 +651,34 @@
(not equal?)
(not (and ignore-geometry is-geometry?)))
content-diff-type
(when (and (= type :text) (= attr :content))
(cttx/get-diff-type (:content shape) val))
;; Depending on the origin of the attribute change, we need or not to
;; set the "touched" flag for the group the attribute belongs to.
;; In some cases we need to ignore touched only if the attribute is
;; geometric (position, width or transformation).
may-touch?
(and in-copy?
(not ignore?)
(not (and ignore-geometry is-geometry?)))
;; a text's content touches the groups of what the edit changes
;; in it, and none when it changes nothing a copy can override
content-groups
(when (and may-touch? group (not equal?))
(if (and (= type :text) (= attr :content))
(let [groups (cttx/changed-groups (:content shape) val)]
(cond-> groups (seq groups) (conj group)))
#{group}))
token-groups
(if (= attr :applied-tokens)
(if (and may-touch? (= attr :applied-tokens))
(get-token-groups shape val)
#{})
groups
(cond-> token-groups
(and group (not equal?))
(set/union #{group} content-diff-type))]
(set/union token-groups content-groups)]
(cond-> shape
;; Depending on the origin of the attribute change, we need or not to
;; set the "touched" flag for the group the attribute belongs to.
;; In some cases we need to ignore touched only if the attribute is
;; geometric (position, width or transformation).
(and in-copy?
(not-empty groups)
(not ignore?)
(not (and ignore-geometry is-geometry?)))
(not-empty groups)
(-> (update :touched (fn [touched]
(reduce #(ctk/set-touched-group %1 %2)
touched

655
common/src/app/common/types/text.cljc
View File

@ -445,6 +445,661 @@
[k (vec (map #(copy-attrs-keys %1 attrs) v))]
[k (get attrs k v)]))))
;; -- Letters and styles
;;
;; A text seen as letters with a style each, for the text overrides of
;; component copies (`mem:common/component-sync-contract`).
(def style-units
"Text override group -> the level of the content its attributes live on
(`:level`), its attributes (`:attrs`) and, when not all of them, those
that tell two styles apart (`:compare`): the variant id follows from the
family, weight and style. Line height lives on runs in the WASM editor
and on paragraphs in the others, so a run without it takes its
paragraph's."
{:text-content-family {:level :run :attrs [:font-family :font-id]}
:text-content-weight {:level :run :attrs [:font-weight :font-style :font-variant-id]
:compare [:font-weight :font-style]}
:text-content-size {:level :run :attrs [:font-size]}
:text-content-line-height {:level :run :attrs [:line-height]}
:text-content-spacing {:level :run :attrs [:letter-spacing]}
:text-content-decoration {:level :run :attrs [:text-decoration]}
:text-content-case {:level :run :attrs [:text-transform]}
:text-content-fills {:level :run :attrs [:fills :fill-color :fill-opacity :fill-color-ref-id
:fill-color-ref-file :fill-color-gradient]}
:text-content-typography {:level :run :attrs [:typography-ref-id :typography-ref-file]}
:text-content-align {:level :paragraph :attrs [:text-align]}
:text-content-direction {:level :paragraph :attrs [:text-direction]}
:text-content-valign {:level :root :attrs [:vertical-align]}})
(def text-groups
"The override groups of a copy text besides `:content-group`."
(conj (set (keys style-units)) :text-content-text))
(def ^:private attr->unit
(into {} (for [[unit {:keys [attrs]}] style-units attr attrs] [attr unit])))
(defn style-unit-of
"The style unit (a key of `style-units`) a text attribute belongs to."
[attr]
(get attr->unit attr))
(def min-shared-stretch
"The fewest equal letters in a row that two texts share."
3)
(def ^:private max-diff-edits
"Past this many edits the letter diff gives up on the letters between the
common start and end of two texts."
1000)
(defn split-letters
"The letters of the string `s`, a string each (code points, so that a
letter outside the basic plane stays whole)."
[s]
#?(:clj (into [] (map #(String. (Character/toChars %))) (iterator-seq (.iterator (.codePoints ^String s))))
:cljs (vec (js/Array.from s))))
(defn- lcs-pairs
"The pairs [i j] of equal items of the vectors `a` and `b` along a longest
common subsequence, in order (Myers' diff), or nil when it needs more
than `max-d` edits."
[a b max-d]
(let [n (count a)
m (count b)
off (+ n m 1)
v (#?(:clj long-array :cljs make-array) (+ (* 2 off) 1))
get-v (fn [k] (aget v (+ off k)))
snap (fn [d] (mapv #(get-v %) (range (- (inc d)) (+ d 2))))
prev-k (fn [value-at k d]
(if (or (= k (- d))
(and (not= k d) (< (value-at (dec k)) (value-at (inc k)))))
(inc k)
(dec k)))]
(aset v (+ off 1) 0)
(loop [d 0 trace []]
(when (<= d max-d)
(let [trace (conj trace (snap d))
done? (loop [k (- d)]
(when (<= k d)
(let [pk (prev-k get-v k d)
x (if (= pk (inc k)) (get-v pk) (inc (get-v pk)))
x (loop [x x]
(if (and (< x n) (< (- x k) m) (= (nth a x) (nth b (- x k))))
(recur (inc x))
x))]
(aset v (+ off k) x)
(if (and (>= x n) (>= (- x k) m))
true
(recur (+ k 2))))))]
(if-not done?
(recur (inc d) trace)
(loop [d d x n y m pairs '()]
(if (neg? d)
(vec pairs)
(let [snap (nth trace d)
get-s #(nth snap (+ % d 1))
k (- x y)
pk (prev-k get-s k d)
px (get-s pk)
py (- px pk)
pairs (loop [x x y y pairs pairs]
(if (and (> x px) (> y py) (> x 0) (> y 0))
(recur (dec x) (dec y) (conj pairs [(dec x) (dec y)]))
pairs))]
(recur (dec d) px py pairs))))))))))
(defn- shared-index
"Index in `b` -> index in `a`, a vector with nil for the letters of `b`
not shared (see `shared-letters`)."
[a b]
(let [a (vec a)
b (vec b)
n (count a)
m (count b)
prefix (loop [i 0]
(if (and (< i n) (< i m) (= (nth a i) (nth b i))) (recur (inc i)) i))
suffix (loop [i 0]
(if (and (< (+ prefix i) n) (< (+ prefix i) m)
(= (nth a (- n i 1)) (nth b (- m i 1))))
(recur (inc i))
i))
middle (lcs-pairs (subvec a prefix (- n suffix))
(subvec b prefix (- m suffix))
max-diff-edits)
pairs (-> []
(into (map (fn [k] [k k])) (range prefix))
(into (map (fn [[i j]] [(+ prefix i) (+ prefix j)])) middle)
(into (map (fn [t] [(+ (- n suffix) t) (+ (- m suffix) t)])) (range suffix)))
np (count pairs)
;; the pairs in [from, to) are one stretch
write (fn [out from to]
(if (>= (- to from) min-shared-stretch)
(reduce (fn [out k] (let [[i j] (nth pairs k)] (assoc! out j i))) out (range from to))
out))]
(loop [k 1 from 0 out (transient (vec (repeat m nil)))]
(cond
(zero? np) (persistent! out)
(= k np) (persistent! (write out from k))
:else (let [[i j] (nth pairs k)
[pi pj] (nth pairs (dec k))]
(if (and (= i (inc pi)) (= j (inc pj)))
(recur (inc k) from out)
(recur (inc k) k (write out from k))))))))
(defn shared-letters
"Index in `b` -> index in `a` of the letters (vectors of letters) the two
texts share: equal letters along a letter diff, in stretches of at least
`min-shared-stretch` in a row."
[a b]
(into {} (keep-indexed (fn [j i] (when (some? i) [j i]))) (shared-index a b)))
(defn- normalize-value
[value]
(let [value (if (number? value) (str value) value)]
(when-not (d/empty? value)
(or (when (and (string? value) (re-matches numeric-text-re value))
(some-> (d/parse-double value) (mth/precision 3)))
value))))
(def ^:private default-style-values
(update-vals (assoc default-text-attrs :vertical-align "top") normalize-value))
(defn- normalize-style-value
"A value of the text attribute `attr` in a form equal for values that show
the same: no value, an empty one and the default are nil, and numbers
(or numeric strings) are rounded."
[attr value]
(let [value (normalize-value value)]
(when (not= value (get default-style-values attr))
value)))
(defn- style-of
"The attributes `attrs` of a letter in the run `run` of the paragraph
`paragraph`, those the run lacks taken from the paragraph."
[paragraph run attrs]
(reduce (fn [acc attr]
(cond
(contains? run attr) (assoc acc attr (get run attr))
(contains? paragraph attr) (assoc acc attr (get paragraph attr))
:else acc))
{}
attrs))
(def ^:private run-attrs
(into [] (comp (filter #(= :run (:level %))) (mapcat :attrs)) (vals style-units)))
(defn- full-run-styles
"Per run of `letters`, `[style key]`: its style in every run unit, and
that style with its values normalized (`normalize-style-value`)."
[letters]
(let [paragraphs (:paragraphs letters)]
(mapv (fn [{:keys [paragraph node]}]
(let [style (style-of (nth paragraphs paragraph) node run-attrs)]
[style (into {}
(keep (fn [[attr value]]
(when-some [value (normalize-style-value attr value)]
[attr value])))
style)]))
(:runs letters))))
(defn content->letters
"The letters of `content` with their styles:
- `:runs`: one entry per run with letters and per paragraph with none,
`{:paragraph i :node run}`, the latter with `:empty? true`;
- `:letters`: one entry per letter, `{:letter s :paragraph i :run node
:ri k}` (`k` its index in `:runs`), and `{:letter \"\\n\" :paragraph
i}` before every paragraph but the first;
- `:paragraphs`: the paragraph nodes, without children; one with no
letters keeps its first run in `:empty-run` and its index in `:runs` in
`:empty-ri`;
- `:root` and `:paragraph-set`: those nodes, without children.
Nodes keep every attribute but `:children` and `:text`."
[content]
(let [paragraph-set (d/seek is-paragraph-set-node? (:children content))
paragraphs (vec (node-seq is-paragraph-node? content))]
(loop [i 0
runs (transient [])
letters (transient [])
paragraphs' (transient [])]
(if (= i (count paragraphs))
(let [letters {:root (dissoc content :children)
:paragraph-set (dissoc paragraph-set :children)
:paragraphs (persistent! paragraphs')
:runs (persistent! runs)
:letters (persistent! letters)}]
(assoc letters :run-styles (delay (full-run-styles letters))))
(let [paragraph (nth paragraphs i)
letters (cond-> letters (pos? i) (conj! {:letter "\n" :paragraph i}))
[runs letters]
(reduce (fn [[runs letters] run]
(let [split (split-letters (:text run ""))]
(if (empty? split)
[runs letters]
(let [node (dissoc run :text)
ri (count runs)]
[(conj! runs {:paragraph i :node node})
(reduce #(conj! %1 {:letter %2 :paragraph i :run node :ri ri})
letters
split)]))))
[runs letters]
(:children paragraph))
no-letters? (not (some #(seq (:text % "")) (:children paragraph)))
node (dissoc paragraph :children)]
(if no-letters?
(let [run (-> paragraph :children first (dissoc :text))]
(recur (inc i)
(conj! runs {:paragraph i :node run :empty? true})
letters
(conj! paragraphs' (assoc node :empty-run run :empty-ri (count runs)))))
(recur (inc i) runs letters (conj! paragraphs' node))))))))
(defn letters->content
"Build the content of `letters` (as `content->letters` gives them):
adjacent letters with equal runs join in one run."
[{:keys [root paragraph-set paragraphs letters]}]
(let [by-paragraph (group-by :paragraph (filter :run letters))
runs (fn [letters]
(->> letters
(reduce (fn [acc {:keys [letter run]}]
(let [[prev-run prev-letters] (peek acc)]
(if (and (some? prev-run)
(or (identical? prev-run run) (= prev-run run)))
(conj (pop acc) [prev-run (conj prev-letters letter)])
(conj acc [run [letter]]))))
[])
(mapv (fn [[run letters]] (assoc run :text (apply str letters))))))
paragraph (fn [i {:keys [empty-run] :as paragraph}]
(-> (dissoc paragraph :empty-run :empty-ri)
(assoc :children (if-let [letters (get by-paragraph i)]
(runs letters)
[(assoc empty-run :text "")]))))]
(assoc root :children [(assoc paragraph-set
:type "paragraph-set"
:children (into [] (map-indexed paragraph) paragraphs))])))
(defn letters-text
"The letters of `letters` (as `content->letters` gives them) as one
string, with line breaks."
[letters]
(apply str (map :letter (:letters letters))))
(defn unit-style
"The attributes of the style unit `unit` (a key of `style-units`) of a
letter entry of `letters`, a paragraph index for a paragraph unit, or
nothing for the root."
[letters unit at]
(let [{:keys [level attrs]} (get style-units unit)]
(case level
:root (select-keys (:root letters) attrs)
:paragraph (select-keys (get-in letters [:paragraphs at]) attrs)
:run (let [{:keys [paragraph run]} at
paragraph (get-in letters [:paragraphs paragraph])]
(style-of paragraph (or run (:empty-run paragraph)) attrs)))))
(defn same-style?
"Whether two styles of a unit (maps of its attributes) show the same."
[a b]
(let [attrs (into (set (keys a)) (keys b))]
(every? #(= (normalize-style-value % (get a %)) (normalize-style-value % (get b %))) attrs)))
(defn- style-key
"A style of `unit` in a form equal for styles that show the same."
[unit style]
(let [{:keys [attrs compare]} (get style-units unit)]
(into {}
(keep (fn [[attr value]]
(when-some [value (normalize-style-value attr value)]
[attr value])))
(select-keys style (or compare attrs)))))
(def ^:private typography-units
"The units a typography sets."
#{:text-content-family :text-content-weight :text-content-size
:text-content-line-height :text-content-spacing :text-content-case})
(defn text-overrides
"The text override groups in the touched groups `touched`. Files older
than the feature components/text-overrides hold `:text-content-attribute`
(any style) and `:text-content-structure` (letters and styles), which
stand for every group they may cover."
[touched]
(cond-> (into #{} (filter text-groups) touched)
(contains? touched :text-content-attribute)
(into (keys style-units))
(contains? touched :text-content-structure)
(into text-groups)))
(defn- letter-map
"Index in the letters of `dst` -> index in those of `src` (a vector, nil
for a letter not shared), of the letters the two texts share; every
letter when they have the same letters."
[src dst]
(let [a (mapv :letter (:letters src))
b (mapv :letter (:letters dst))]
(if (= a b)
(vec (range (count b)))
(shared-index a b))))
(defn- empty-paragraphs
[letters]
(keep-indexed (fn [i paragraph] (when (contains? paragraph :empty-run) i))
(:paragraphs letters)))
(defn- place-run-values
"The values of the runs of `src` (`values`, by run index; `keys` tell
them apart) placed on the letters of `dst`, given `lmap` (`letter-map`):
1. a value the same across `src` applies to every letter;
2. a letter both texts share takes its value in `src`;
3. any other letter takes the value of the letter before it, across line
breaks; letters at the start take the first shared letter after them,
and with nothing shared, the first letter of `src`.
Gives `:letters`, a value per letter of `dst` (nil for a line break),
and `:empty`, paragraph index -> value for its paragraphs with no
letters."
[src dst lmap values ks]
(let [runs (:runs src)
filled (into [] (remove #(:empty? (nth runs %))) (range (count runs)))
ris (if (seq filled) filled (range (count runs)))
letters (:letters dst)
n (count letters)]
(when (seq ris)
(if (<= (count (into #{} (map #(nth ks %)) ris)) 1)
(let [value (nth values (first ris))]
{:letters (mapv #(when (:run %) value) letters)
:empty (into {} (map (fn [i] [i value])) (empty-paragraphs dst))})
(let [src-letters (:letters src)
direct (fn [j] (some->> (get lmap j) (nth src-letters) :ri (nth values)))
fallback (or (some direct (range n)) (nth values (first ris)))
no-letters? (set (empty-paragraphs dst))]
(loop [j 0
prev nil
out (transient [])
empties (if (no-letters? 0) {0 fallback} {})]
(if (= j n)
{:letters (persistent! out) :empty empties}
(let [{:keys [run paragraph]} (nth letters j)]
(if (some? run)
(let [value (or (direct j) prev fallback)]
(recur (inc j) value (conj! out value) empties))
(recur (inc j) prev (conj! out nil)
(cond-> empties
(no-letters? paragraph) (assoc paragraph (or prev fallback)))))))))))))
(defn- paragraph-map
"Paragraph index in `dst` -> the paragraph of `src` that holds its first
shared letter, given `lmap` (`letter-map`)."
[src dst lmap]
(reduce (fn [acc [j {:keys [paragraph run]}]]
(if (or (nil? run) (contains? acc paragraph))
acc
(if-let [i (get lmap j)]
(assoc acc paragraph (:paragraph (nth (:letters src) i)))
acc)))
{}
(map-indexed vector (:letters dst))))
(defn- place-paragraph-values
"The values of the paragraphs of `src` (`values`, by paragraph; `keys`
tell them apart) placed on the paragraphs of `dst`: a value the same
across `src` applies to all; otherwise a paragraph takes the value of
the paragraph that holds its first shared letter, else the value of the
paragraph before it, else the first paragraph's of `src`."
[src dst lmap values ks]
(let [n (count (:paragraphs dst))]
(when (seq values)
(if (<= (count (distinct ks)) 1)
(vec (repeat n (first values)))
(let [pmap (if (= (letters-text src) (letters-text dst))
(zipmap (range n) (range n))
(paragraph-map src dst lmap))]
(first
(reduce (fn [[acc prev] i]
(let [value (or (some->> (get pmap i) (nth values)) prev (first values))]
[(conj acc value) value]))
[[] nil]
(range n))))))))
(defn- unit-values
"The styles of `unit` on `letters` (by run, by paragraph, or the root's),
and their keys (`style-key`)."
[letters unit]
(let [{:keys [level attrs compare]} (get style-units unit)]
(case level
:run (let [full @(:run-styles letters)]
[(mapv #(select-keys (first %) attrs) full)
(mapv #(select-keys (second %) (or compare attrs)) full)])
:paragraph (let [styles (mapv #(unit-style letters unit %) (range (count (:paragraphs letters))))]
[styles (mapv #(style-key unit %) styles)])
:root (let [style (unit-style letters unit nil)]
[style (style-key unit style)]))))
(defn- place-unit
"The values of `unit` of `src` (`src-values`, as `unit-values` gives them)
placed on `dst`; with `keys?`, the keys of its styles, else the styles."
[src dst lmap unit [styles ks] keys?]
(let [values (if keys? ks styles)]
(case (get-in style-units [unit :level])
:run (place-run-values src dst lmap values ks)
:paragraph (place-paragraph-values src dst lmap values ks)
:root values)))
(defn- write-style
"Set the attributes `attrs` of `node` to those of `style`; with `present?`
only those `node` already has."
[node style attrs present?]
(reduce (fn [node attr]
(cond
(and present? (not (contains? node attr))) node
(contains? style attr) (assoc node attr (get style attr))
:else (dissoc node attr)))
node
attrs))
(defn- drop-typography
"Remove the typography reference of `node`."
[node]
(cond-> node
(contains? node :typography-ref-id) (assoc :typography-ref-id nil)
(contains? node :typography-ref-file) (assoc :typography-ref-file nil)))
(defn- write-units
"`dst` (as `content->letters` gives it) with the placed styles of `units`
(unit -> what `place-unit` gives) written on its runs, paragraphs and
root; without typography references when `drop-typo?`. Run styles go on
the runs, and on the paragraphs that hold run styles (as the DOM and v1
editors write them); a line height goes on a run only when it has one,
and on a paragraph when it has one or no run of it has."
[dst placed drop-typo?]
(let [run-units (filterv #(= :run (get-in style-units [% :level])) (keys placed))
write-run (fn [node styles]
(cond-> (reduce (fn [node [unit style]]
(write-style node style (get-in style-units [unit :attrs])
(= unit :text-content-line-height)))
node
(map vector run-units styles))
drop-typo? drop-typography))
cache (volatile! {})
new-run (fn [ri node styles]
(let [k [ri styles]]
(or (get @cache k)
(let [run (write-run node styles)]
(vswap! cache assoc k run)
run))))
letters (into []
(map-indexed
(fn [j {:keys [run ri] :as entry}]
(if (some? run)
(assoc entry :run (new-run ri run (mapv #(get-in placed [% :letters j]) run-units)))
entry)))
(:letters dst))
first-letter (reduce (fn [acc [j {:keys [run paragraph]}]]
(cond-> acc
(and (some? run) (not (contains? acc paragraph)))
(assoc paragraph j)))
{}
(map-indexed vector (:letters dst)))
first-style (fn [i unit]
(if-some [j (get first-letter i)]
(get-in placed [unit :letters j])
(get-in placed [unit :empty i])))
lh-on-runs? (into #{}
(keep (fn [{:keys [paragraph node]}]
(when (contains? node :line-height) paragraph)))
(:runs dst))
paragraphs (into []
(map-indexed
(fn [i paragraph]
(let [styles (mapv #(first-style i %) run-units)
paragraph (reduce (fn [paragraph [unit style]]
(write-style paragraph style (get-in style-units [unit :attrs])
(or (not= unit :text-content-line-height)
(contains? lh-on-runs? i))))
paragraph
(map vector run-units styles))
paragraph (reduce (fn [paragraph [unit values]]
(if (= :paragraph (get-in style-units [unit :level]))
(write-style paragraph (nth values i)
(get-in style-units [unit :attrs]) false)
paragraph))
paragraph
placed)]
(cond-> paragraph
drop-typo? drop-typography
(contains? paragraph :empty-run) (update :empty-run write-run styles)))))
(:paragraphs dst))
root (reduce (fn [root [unit value]]
(if (= :root (get-in style-units [unit :level]))
(write-style root value (get-in style-units [unit :attrs]) false)
root))
(:root dst)
placed)]
(-> (assoc dst :letters letters :paragraphs paragraphs :root root)
(dissoc :run-styles))))
(defn- same-everywhere?
"Whether a unit has one value across two texts, given the keys of its
styles in each (as `unit-values` gives them), so placing it changes
nothing."
[src-ks dst-ks]
(if (map? src-ks)
(= src-ks dst-ks)
(= 1 (count (into (set src-ks) dst-ks)))))
(defn merge-overrides
"The content of a copy text whose content is `copy` and whose main's is
`main`, keeping from `copy` the text override groups `groups`
(`text-groups`) and taking the rest from `main`: the letters of one
side, and each style unit of its side placed on them (`place-run-values`,
`place-paragraph-values`). A typography reference stays only when every
unit the typography sets comes from its side."
[copy main groups]
(let [own-letters? (contains? groups :text-content-text)
[base other] (if own-letters? [copy main] [main copy])
from-copy? #(contains? groups %)
units (filter #(not= own-letters? (from-copy? %)) (keys style-units))
typography (from-copy? :text-content-typography)
drop-typo? (boolean (some #(not= typography (from-copy? %)) typography-units))]
(if (or (nil? base) (nil? other) (and (empty? units) (not drop-typo?)))
base
(let [src (content->letters other)
dst (content->letters base)
lmap (delay (letter-map src dst))
placed (into {}
(keep (fn [unit]
(let [src-values (unit-values src unit)]
(when-not (same-everywhere? (second src-values)
(second (unit-values dst unit)))
(when-some [values (place-unit src dst @lmap unit src-values false)]
[unit values])))))
units)]
(if (and (empty? placed) (not drop-typo?))
base
(letters->content (write-units dst placed drop-typo?)))))))
(defn- unit-differs?
"Whether the styles of `unit` of `b` differ from those of `a` placed on
the letters of `b`."
[a b lmap unit]
(let [placed (place-unit a b lmap unit (unit-values a unit) true)
[_ ks] (unit-values b unit)]
(case (get-in style-units [unit :level])
:run (or (not= (:letters placed)
(mapv #(some->> (:ri %) (nth ks)) (:letters b)))
(not= (:empty placed)
(into {} (map (fn [i] [i (nth ks (get-in b [:paragraphs i :empty-ri]))]))
(empty-paragraphs b))))
:paragraph (not= placed ks)
:root (not= placed ks))))
(defn override-groups
"The text override groups a copy whose content is `copy` must hold
against its main's content `main`: those where the copy differs from
the main placed on its letters (\"different means touched\")."
[main copy]
(let [main (content->letters main)
copy (content->letters copy)
lmap (delay (letter-map main copy))]
(cond-> (into #{}
(filter #(and (not (same-everywhere? (second (unit-values main %))
(second (unit-values copy %))))
(unit-differs? main copy @lmap %)))
(keys style-units))
(not= (letters-text main) (letters-text copy))
(conj :text-content-text))))
(defn- unit-changed?
"Whether an edit from `old` to `new` changes `unit`: a letter or
paragraph both share changes its style or, when the letters changed, a
style appears that `old` did not have."
[old new lmap same-letters? unit]
(let [level (get-in style-units [unit :level])
[_ old-ks] (unit-values old unit)
[_ new-ks] (unit-values new unit)]
(case level
:root
(not= old-ks new-ks)
:paragraph
(let [pmap (if same-letters?
(zipmap (range (count new-ks)) (range))
(paragraph-map old new lmap))]
(boolean
(or (some (fn [[j i]] (not= (nth old-ks i) (nth new-ks j))) pmap)
(and (not same-letters?)
(not-every? (set old-ks) new-ks)))))
:run
(boolean
(or (some (fn [[j i]]
(let [o (:ri (nth (:letters old) i))
n (:ri (nth (:letters new) j))]
(and (some? o) (some? n) (not= (nth old-ks o) (nth new-ks n)))))
(keep-indexed (fn [j i] (when (some? i) [j i])) lmap))
(if same-letters?
(some #(not= (nth old-ks (get-in old [:paragraphs % :empty-ri]))
(nth new-ks (get-in new [:paragraphs % :empty-ri])))
(empty-paragraphs new))
(not-every? (set old-ks) new-ks)))))))
(defn changed-groups
"The text override groups an edit of a copy text from the content `old`
to `new` sets: `:text-content-text` when the letters or line breaks
change, and each style unit the edit changes (`unit-changed?`). Letters
typed in the style of a neighbour change no style."
[old new]
(let [old (content->letters old)
new (content->letters new)
same-letters? (= (letters-text old) (letters-text new))
lmap (delay (letter-map old new))]
(cond-> (into #{}
(filter #(and (not (same-everywhere? (second (unit-values old %))
(second (unit-values new %))))
(unit-changed? old new @lmap same-letters? %)))
(keys style-units))
(not same-letters?)
(conj :text-content-text))))
(defn content-has-text?
[content search]

39
common/test/common_tests/logic/text_editor_output_test.cljc
View File

@ -10,18 +10,15 @@
renderer). The DOM editor is only on together with the WASM one, which
the viewport prefers, so no session runs it. Each fixture is the
`:content` of one commit, built key for key as the editor wrote it.
Replaying the commits on a copy gives the touched groups the workspace
showed, less `:name-group`, which the automatic rename of the frontend
adds (F27)."
Replaying the commits on a copy gives the touched groups they set, less
`:name-group`, which the automatic rename of the frontend adds (F27)."
(:require
[app.common.test-helpers.components :as thc]
[app.common.test-helpers.composable.core :as tm]
[app.common.test-helpers.compositions :as tho]
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
[app.common.test-helpers.shapes :as ths]
[app.common.test-helpers.texts :as thtx]
[app.common.types.text :as txt]
[clojure.test :as t]))
(t/use-fixtures :each thi/test-fixture)
@ -122,12 +119,10 @@
:v1 #{:content-group :text-content-text}}
:select-all-and-type {:wasm #{:content-group :text-content-text}
:v1 #{:content-group :text-content-text}}
;; the WASM editor commits the new paragraph and then each key in it
:enter-and-type {:wasm #{:content-group :text-content-text :text-content-structure}
:v1 #{:content-group :text-content-structure}}
;; the v1 editor also writes the run styles on the paragraph
:bold-a-word {:wasm #{:content-group :text-content-structure}
:v1 #{:content-group :text-content-attribute :text-content-structure}}})
:enter-and-type {:wasm #{:content-group :text-content-text}
:v1 #{:content-group :text-content-text}}
:bold-a-word {:wasm #{:content-group :text-content-weight}
:v1 #{:content-group :text-content-weight}}})
(defn- copy-text-after
"The copy text of a main written as `main`, once the copy gets `commits`."
@ -167,9 +162,19 @@
"a style change sets no text override")
nil)))))
(t/deftest a-text-in-one-style-from-either-editor-is-uniform
;; WASM: the paragraph has a direction its runs lack; v1: the paragraph has
;; typography refs (nil) its runs lack
(doseq [content [main-text v1-new-text]]
(tm/known-failure "F79" true false
(txt/equal-attrs? content (txt/get-first-paragraph-text-attrs content)))))
(t/deftest a-copy-that-bolds-a-word-takes-the-main-new-line
;; the main's new line follows the bold letter before it
(doseq [[editor commits] (:bold-a-word edits)]
(t/testing (str "bolded in the " editor " editor")
(let [file (-> (thf/sample-file :file1)
(tho/add-frame-with-text :main-root :main-child ""
:child-params {:content main-text})
(thc/make-component :component1 :main-root)
(thc/instantiate-component :component1 :copy-root
{:children-labels [:copy-child]}))
file' (-> (reduce #(thtx/set-content %1 :copy-child %2) file commits)
(thtx/set-content :main-child (text (paragraph (run "Hello world"))
(paragraph (run "Second line"))))
(tho/propagate-component-changes :component1))]
(t/is (= [[["Hello "] ["world" {:weight 700}]] [["Second line" {:weight 700}]]]
(thtx/text-of file' :copy-child)))))))

2
common/test/common_tests/logic/text_notation_test.cljc
View File

@ -80,5 +80,5 @@
(thtx/add-text-component-with-copy [[["Hello world"]]])
(thtx/set-text :copy-child [[["Hello world" {:color :red}]]]))]
(t/is (= [[["Hello world" {:color :red}]]] (thtx/text-of file :copy-child)))
(t/is (= #{:content-group :text-content-attribute}
(t/is (= #{:content-group :text-content-fills}
(:touched (ths/get-shape file :copy-child))))))

89
common/test/common_tests/logic/text_override_operations_test.cljc Normal file
View File

@ -0,0 +1,89 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns common-tests.logic.text-override-operations-test
"The text override groups of a copy through the operations that carry or
clear overrides: detach, duplicate and reset
(`mem:common/component-sync-contract`); update main is in case BA.
Texts are written in the
notation of `app.common.test-helpers.texts`."
(:require
[app.common.files.changes-builder :as pcb]
[app.common.logic.libraries :as cll]
[app.common.test-helpers.components :as thc]
[app.common.test-helpers.compositions :as tho]
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
[app.common.test-helpers.shapes :as ths]
[app.common.test-helpers.texts :as thtx]
[clojure.test :as t]))
(t/use-fixtures :each thi/test-fixture)
(def ^:private label [[["Add to cart"]]])
(def ^:private red-label [[["Add to cart" {:color :red}]]])
(def ^:private big-label [[["Add to cart" {:size 18}]]])
(defn- grow-main-label
"The main of :component1 changes its size, and its copies sync."
[file]
(-> file
(thtx/set-text :main-child big-label)
(tho/propagate-component-changes :component1)))
(t/deftest a-detached-nested-text-keeps-the-style-its-main-overrode
;; :card nests a copy of the label and colors its text red; detaching a
;; copy of :card makes its label a copy of the label component, which
;; keeps the red as an override and still takes the label's size
(let [file (-> (thf/sample-file :file1)
(thtx/add-text-component-with-copy label)
(tho/add-frame :card-root)
(thc/instantiate-component :component1 :card-label
{:parent-label :card-root
:children-labels [:card-label-text]})
(thc/make-component :card :card-root)
(thtx/set-text :card-label-text red-label)
(thc/instantiate-component :card :copy-card
{:children-labels [:copy-label :copy-label-text]}))
page (thf/current-page file)
file' (thf/apply-changes file
(cll/generate-detach-instance (-> (pcb/empty-changes nil)
(pcb/with-page page)
(pcb/with-objects (:objects page)))
page
{(:id file) file}
(thi/id :copy-card)))
text (ths/get-shape file' :copy-label-text)
file'' (grow-main-label file')]
(t/is (= (thi/id :main-child) (:shape-ref text)))
(t/is (= #{:content-group :text-content-fills} (:touched text)))
(t/is (= [[["Add to cart" {:size 18 :color :red}]]]
(thtx/text-of file'' :copy-label-text)))))
(t/deftest a-duplicated-copy-text-keeps-its-overrides
(let [file (-> (thf/sample-file :file1)
(thtx/add-text-component-with-copy label)
(thtx/set-text :copy-child red-label)
(tho/duplicate-shape :copy-root))
dup-id (->> (vals (:objects (thf/current-page file)))
(some #(when (and (= (thi/id :main-child) (:shape-ref %))
(not= (thi/id :copy-child) (:id %)))
(:id %))))
file' (grow-main-label file)
dup (ths/get-shape-by-id file' dup-id)]
(t/is (= #{:content-group :text-content-fills} (:touched dup)))
(t/is (= [[["Add to cart" {:size 18 :color :red}]]]
(thtx/view (:content dup))))))
(t/deftest a-reset-clears-the-text-overrides
(let [file (-> (thf/sample-file :file1)
(thtx/add-text-component-with-copy label)
(thtx/set-text :copy-child [[["Buy now" {:color :red}]]]))
file' (tho/reset-overrides file (ths/get-shape file :copy-root))]
(t/is (= #{:content-group :text-content-text :text-content-fills}
(:touched (ths/get-shape file :copy-child))))
(t/is (= label (thtx/text-of file' :copy-child)))
(t/is (empty? (:touched (ths/get-shape file' :copy-child))))))

11
common/test/common_tests/logic/text_override_rule_test.cljc
View File

@ -10,13 +10,22 @@
(:require
[app.common.test-helpers.ids-map :as thi]
[app.common.test-helpers.texts :as thtx]
[app.common.types.text :as txt]
[clojure.test :as t]))
(t/use-fixtures :each thi/test-fixture)
(defn- overrides
"The overrides of `copy` against `main` by the reference rule, checked
against the production one (`txt/override-groups`)."
[main copy]
(thtx/override-units (thtx/content main) (thtx/content copy)))
(let [main (thtx/content main)
copy (thtx/content copy)
units (thtx/override-units main copy)]
(t/is (= (into #{} (map #(keyword (str "text-content-" (name (get {:letters :text} % %))))) units)
(txt/override-groups main copy))
"the production rule agrees")
units))
(t/deftest shared-letters-come-in-stretches-of-three
(t/is (= {0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 10 10}

66
common/test/common_tests/logic/text_override_switch_test.cljc
View File

@ -12,7 +12,6 @@
are written in the notation of `app.common.test-helpers.texts`."
(:require
[app.common.test-helpers.components :as thc]
[app.common.test-helpers.composable.core :as tm]
[app.common.test-helpers.compositions :as tho]
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
@ -65,35 +64,14 @@
:new-line [[[["Add to cart"]] [["Free shipping"]]] #{:letters}]
:bold-word [[[["Add to "] ["cart" {:weight 700}]]] #{:weight}]})
(def ^:private known-failures
"Copy edit -> [bug, how the copy ends, the variants it fails against].
`:variant`: the copy takes the new variant's text whole; a text in the
notation: the copy ends with that text."
{:letters [["F81" :variant #{:bold-word}]]
:new-paragraph [["F79" :variant #{:size :color}]
["F81" :variant #{:bold-word}]]
:color [["F77" :variant #{:size}]
["F79" :variant #{:new-line}]
["F81" :variant #{:bold-word}]]
:family [["F77" :variant #{:size :color}]
["F79" :variant #{:new-line}]
["F81" :variant #{:bold-word}]]
:size [["F77" :variant #{:color}]
["F79" :variant #{:new-line}]
["F81" :variant #{:bold-word}]]
:weight [["F77" :variant #{:size :color}]
["F79" :variant #{:new-line}]]
:letters-and-color [["F77" [[["Buy now" {:size 24}]]] #{:size}]
["F79" :variant #{:new-line}]
["F81" :variant #{:bold-word}]]
:align [["F76" :variant (disj (set (keys variants)) :same)]]
:valign [["F76" :variant (disj (set (keys variants)) :same)]]})
(defn- known-failure
[copy-edit variant]
(some (fn [[bug ends variants]]
(when (contains? variants variant) [bug ends]))
(get known-failures copy-edit)))
(def ^:private by-the-rules
"Copy edit and variant -> what the copy holds, where the copy's edit
applied over the new variant's text is not what the rules give."
{;; the new line follows the bold "t" before it
[:new-paragraph :bold-word] [[["Add to "] ["cart" {:weight 700}]] [["Ends Sunday" {:weight 700}]]]
;; the bold keeps its variant id, for the frontend to pick Roboto's
[:family :bold-word] [[["Add to " {:family "Roboto"}]
["cart" {:family "Roboto" :weight 700 :font-variant-id "bold"}]]]})
(t/deftest whole-text-copy-edits-across-a-switch
(doseq [[copy-title overrides] copy-edits
@ -101,13 +79,9 @@
(t/testing (str "copy " copy-title ", variant " variant-title)
(let [copy-text (reduce (fn [text f] (f text)) small (vals overrides))
carried (remove (comp disagree key) overrides)
expected (thtx/normalize (reduce (fn [text [_ f]] (f text)) new carried))
actual (switch-text small copy-text new)]
(if-let [[bug ends] (known-failure copy-title variant-title)]
(tm/known-failure bug expected
(thtx/normalize (if (= ends :variant) new ends))
actual)
(t/is (= expected actual)))))))
expected (or (get by-the-rules [copy-title variant-title])
(reduce (fn [text [_ f]] (f text)) new carried))]
(t/is (= (thtx/normalize expected) (switch-text small copy-text new)))))))
;; ---- Cards
@ -118,23 +92,17 @@
;; all of it takes the weight of its first letter
(let [old [[["Add to cart" {:weight 600}]]]
new [[["Add to " {:weight 600}] ["cart" {:weight 700}]]]]
(tm/known-failure "F81"
[[["Buy now" {:weight 600}]]]
new
(switch-text old [[["Buy now" {:weight 600}]]] new))))
(t/is (= [[["Buy now" {:weight 600}]]]
(switch-text old [[["Buy now" {:weight 600}]]] new)))))
(t/deftest recolored-copy-keeps-its-color-from-small-to-large
(let [old [[["Add to cart" {:weight 600}]]]
new [[["Add to cart" {:weight 600 :size 24}]]]]
(tm/known-failure "F77"
[[["Add to cart" {:weight 600 :size 24 :color :red}]]]
new
(switch-text old [[["Add to cart" {:weight 600 :color :red}]]] new))))
(t/is (= [[["Add to cart" {:weight 600 :size 24 :color :red}]]]
(switch-text old [[["Add to cart" {:weight 600 :color :red}]]] new)))))
(t/deftest copy-that-bolds-a-word-keeps-it-from-small-to-large
(let [old [[["Hello world"]]]
new [[["Hello world" {:size 24}]]]]
(tm/known-failure "F77"
[[["Hello" {:weight 700 :size 24}] [" world" {:size 24}]]]
new
(switch-text old [[["Hello" {:weight 700}] [" world"]]] new))))
(t/is (= [[["Hello" {:weight 700 :size 24}] [" world" {:size 24}]]]
(switch-text old [[["Hello" {:weight 700}] [" world"]]] new)))))

191
common/test/common_tests/logic/text_override_sync_test.cljc
View File

@ -21,7 +21,6 @@
[app.common.logic.libraries :as cll]
[app.common.logic.shapes :as cls]
[app.common.test-helpers.components :as thc]
[app.common.test-helpers.composable.core :as tm]
[app.common.test-helpers.compositions :as tho]
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
@ -94,38 +93,13 @@
:valign #(thtx/set-valign % "center")
:typography #(thtx/apply-typography % :body body)})
(def ^:private style-edits
#{:color :family :size :weight :spacing :decoration :case :line-height
:align :direction :valign :typography})
(def ^:private known-failures
"Copy edit -> [bug, how the copy ends, the main edits it fails against].
`:as-it-was`: the sync leaves the copy as the copy edit left it.
`:main`: the copy takes the main's text whole."
(let [one-style (fn [own]
[["F72" :as-it-was (disj style-edits own)]
["F79" :as-it-was #{:new-paragraph}]])]
{:color (one-style :color)
:family (one-style :family)
:size (one-style :size)
:weight (one-style :weight)
:spacing (one-style :spacing)
:decoration (one-style :decoration)
:case (one-style :case)
:line-height (one-style :line-height)
:typography [["F72" :as-it-was #{:color :decoration :align :direction :valign}]
["F79" :as-it-was #{:new-paragraph}]]
:new-paragraph [["F79" :as-it-was style-edits]]
:letters-and-color [["F73" :as-it-was (disj style-edits :color)]]
:align [["F76" :main (set (keys main-edits))]]
:direction [["F76" :main (disj (set (keys main-edits)) :direction)]]
:valign [["F76" :main (set (keys main-edits))]]}))
(defn- known-failure
[copy-edit main-edit]
(some (fn [[bug ends main-edits]]
(when (contains? main-edits main-edit) [bug ends]))
(get known-failures copy-edit)))
(defn- weight-variant
"`expected` with the variant id of `weight-side`'s first run, when the
family comes from the other side: sync keeps the variant id with the
weight, and the frontend then picks the family's closest variant."
[expected weight-side]
(thtx/restyle expected :font-variant-id
(get-in (thtx/content weight-side) [:children 0 :children 0 :children 0 :font-variant-id])))
(t/deftest whole-text-copy-edits-against-main-edits
;; Whole-text edits commute with the rules: the copy keeps what it
@ -135,14 +109,10 @@
[main-title main-edit] main-edits]
(t/testing (str "copy " copy-title ", main " main-title)
(let [actual (sync-text base (copy-edit base) (main-edit base))
expected (thtx/normalize (copy-edit (main-edit base)))]
(if-let [[bug ends] (known-failure copy-title main-title)]
(tm/known-failure bug expected
(thtx/normalize (case ends
:as-it-was (copy-edit base)
:main (main-edit base)))
actual)
(t/is (= expected actual)))))))
expected (cond-> (copy-edit (main-edit base))
(and (= copy-title :weight) (#{:family :typography} main-title))
(weight-variant (copy-edit base)))]
(t/is (= (thtx/normalize expected) actual))))))
;; ---- One style no longer blocks the others
@ -151,30 +121,21 @@
copy [[["Add to cart" {:weight 600 :color :red}]]]
main' [[["Add to cart" {:weight 600 :family "Roboto" :size 18}]]]
actual (sync-text main copy main')]
(tm/known-failure "F72"
[[["Add to cart" {:family "Roboto" :weight 600 :size 18 :color :red}]]]
copy
actual)))
(t/is (= [[["Add to cart" {:family "Roboto" :weight 600 :size 18 :color :red}]]] actual))))
(t/deftest relabeled-and-recolored-copy-takes-the-main-size
(let [main [[["Add to cart" {:weight 600}]]]
copy [[["Buy now" {:weight 600 :color :red}]]]
main' [[["Add to cart" {:weight 600 :size 18}]]]
actual (sync-text main copy main')]
(tm/known-failure "F73"
[[["Buy now" {:weight 600 :size 18 :color :red}]]]
copy
actual)))
(t/is (= [[["Buy now" {:weight 600 :size 18 :color :red}]]] actual))))
(t/deftest centered-copy-stays-centered
(let [main [[["Free shipping"]]]
copy [[{:align "center"} ["Free shipping"]]]
main' [[["Free shipping" {:size 18}]]]
actual (sync-text main copy main')]
(tm/known-failure "F76"
[[{:align "center"} ["Free shipping" {:size 18}]]]
main'
actual)))
(t/is (= [[{:align "center"} ["Free shipping" {:size 18}]]] actual))))
(t/deftest copy-with-a-font-size-token-takes-the-main-color
(let [main [[["Add to cart" {:weight 600}]]]
@ -194,57 +155,43 @@
file' (-> file
(thtx/set-text :main-child [[["Add to cart" {:weight 600 :color :blue}]]])
(tho/propagate-component-changes :component1))]
(tm/known-failure "F72"
[[["Add to cart" {:weight 600 :size 16 :color :blue}]]]
[[["Add to cart" {:weight 600 :size 16}]]]
(thtx/text-of file' :copy-child))))
(t/is (= [[["Add to cart" {:weight 600 :size 16 :color :blue}]]]
(thtx/text-of file' :copy-child)))))
;; ---- Bolding a word
(def ^:private hello-bold [[["Hello" {:weight 700}] [" world"]]])
(t/deftest copy-that-bolds-a-word-takes-the-main-color
(tm/known-failure "F74"
[[["Hello" {:weight 700 :color :blue}] [" world" {:color :blue}]]]
hello-bold
(sync-text [[["Hello world"]]] hello-bold [[["Hello world" {:color :blue}]]])))
(t/is (= [[["Hello" {:weight 700 :color :blue}] [" world" {:color :blue}]]]
(sync-text [[["Hello world"]]] hello-bold [[["Hello world" {:color :blue}]]]))))
(t/deftest copy-that-bolds-a-word-takes-the-main-letters
;; "Hello" is shared, so it stays bold; " there" follows the space
(tm/known-failure "F74"
[[["Hello" {:weight 700}] [" there"]]]
hello-bold
(sync-text [[["Hello world"]]] hello-bold [[["Hello there"]]])))
(t/is (= [[["Hello" {:weight 700}] [" there"]]]
(sync-text [[["Hello world"]]] hello-bold [[["Hello there"]]]))))
(t/deftest copy-that-bolds-a-word-takes-the-main-family
(tm/known-failure "F74"
[[["Hello" {:family "Roboto" :weight 700}] [" world" {:family "Roboto"}]]]
hello-bold
(sync-text [[["Hello world"]]] hello-bold [[["Hello world" {:family "Roboto"}]]])))
;; the bold keeps its variant id, for the frontend to pick Roboto's bold
(t/is (= [[["Hello" {:family "Roboto" :weight 700 :font-variant-id "bold"}] [" world" {:family "Roboto"}]]]
(sync-text [[["Hello world"]]] hello-bold [[["Hello world" {:family "Roboto"}]]]))))
(t/deftest copy-that-bolds-a-word-the-main-replaces-loses-the-bold
;; "Goodbye" shares no stretch of 3 letters with "Hello", so it takes the
;; style of the first shared letter after it, the regular space
(tm/known-failure "F74"
[[["Goodbye world"]]]
hello-bold
(sync-text [[["Hello world"]]] hello-bold [[["Goodbye world"]]])))
(t/is (= [[["Goodbye world"]]]
(sync-text [[["Hello world"]]] hello-bold [[["Goodbye world"]]]))))
(t/deftest copy-that-bolds-a-word-the-main-changes-by-one-letter
;; "llo world" is shared; "Ha" at the start takes the bold "l" after it
(tm/known-failure "F74"
[[["Hallo" {:weight 700}] [" world"]]]
hello-bold
(sync-text [[["Hello world"]]] hello-bold [[["Hallo world"]]])))
(t/is (= [[["Hallo" {:weight 700}] [" world"]]]
(sync-text [[["Hello world"]]] hello-bold [[["Hallo world"]]]))))
(t/deftest copy-that-bolds-a-letter-of-a-short-label
;; a lone shared letter carries nothing: with no stretch of 3 shared, all
;; letters take the style of the copy's first letter
(let [copy [[["O"] ["K" {:weight 700}]]]]
(tm/known-failure "F74"
[[["Ok"]]]
copy
(sync-text [[["OK"]]] copy [[["Ok"]]]))))
(t/is (= [[["Ok"]]] (sync-text [[["OK"]]] copy [[["Ok"]]])))))
(t/deftest copy-that-bolds-a-word-keeps-its-weights-when-the-main-is-light
;; an override covers the whole text, so "world" stays regular
@ -259,19 +206,15 @@
;; the family has one value across the main, so it applies everywhere;
;; "Sale" shares nothing with "Price: $10" and takes the main's first
;; letter's weight
(tm/known-failure "F74"
[[["Sale" {:family "Roboto"}]]]
[[["Sale"]]]
(sync-text price [[["Sale"]]]
[[["Price: " {:family "Roboto"}] ["$10" {:family "Roboto" :weight 700}]]])))
(t/is (= [[["Sale" {:family "Roboto"}]]]
(sync-text price [[["Sale"]]]
[[["Price: " {:family "Roboto"}] ["$10" {:family "Roboto" :weight 700}]]]))))
(t/deftest copy-that-removes-a-run-takes-the-main-color
(let [copy [[["$10" {:weight 700}]]]]
(tm/known-failure "F74"
[[["$10" {:weight 700 :color :blue}]]]
copy
(sync-text price copy
[[["Price: " {:color :blue}] ["$10" {:weight 700 :color :blue}]]]))))
(t/is (= [[["$10" {:weight 700 :color :blue}]]]
(sync-text price copy
[[["Price: " {:color :blue}] ["$10" {:weight 700 :color :blue}]]])))))
(t/deftest copy-with-new-letters-in-a-run-takes-the-main-family
(t/is (= [[["Price: " {:family "Roboto"}] ["$20" {:family "Roboto" :weight 700}]]]
@ -287,35 +230,29 @@
(t/deftest copy-with-added-letters-takes-a-partial-color
;; "world" is shared, so it turns red; "!!!" follows the "d" before it
(tm/known-failure "F78"
[[["Hello "] ["world!!!" {:color :red}]]]
[[["Hello world!!!"]]]
(sync-text [[["Hello world"]]] [[["Hello world!!!"]]]
[[["Hello "] ["world" {:color :red}]]])))
(t/is (= [[["Hello "] ["world!!!" {:color :red}]]]
(sync-text [[["Hello world"]]] [[["Hello world!!!"]]]
[[["Hello "] ["world" {:color :red}]]]))))
(t/deftest copy-with-a-new-price-takes-the-main-bold-on-the-right-letters
;; "Price: $" is shared; "20" follows the bold "$"
(tm/known-failure "F78"
[[["Price" {:weight 700}] [": "] ["$20" {:weight 700}]]]
[[["Price: " {:weight 700}] ["$20"]]]
(sync-text price [[["Price: "] ["$20" {:weight 700}]]]
[[["Price" {:weight 700}] [": "] ["$10" {:weight 700}]]])))
(t/is (= [[["Price" {:weight 700}] [": "] ["$20" {:weight 700}]]]
(sync-text price [[["Price: "] ["$20" {:weight 700}]]]
[[["Price" {:weight 700}] [": "] ["$10" {:weight 700}]]]))))
(t/deftest copy-that-adds-a-line-to-a-two-style-title-takes-the-main-family
;; the new line follows the regular "sale" before it, across the break
(let [main [[["Summer " {:weight 700}] ["sale"]]]
copy [[["Summer " {:weight 700}] ["sale"]]
[["Ends Sunday"]]]]
(tm/known-failure "F74"
[[["Summer " {:family "Roboto" :weight 700}] ["sale" {:family "Roboto"}]]
[["Ends Sunday" {:family "Roboto"}]]]
copy
(sync-text main copy
[[["Summer " {:family "Roboto" :weight 700}] ["sale" {:family "Roboto"}]]]))))
(t/is (= [[["Summer " {:family "Roboto" :weight 700}] ["sale" {:family "Roboto"}]]
[["Ends Sunday" {:family "Roboto"}]]]
(sync-text main copy
[[["Summer " {:family "Roboto" :weight 700}] ["sale" {:family "Roboto"}]]])))))
(t/deftest copy-with-a-new-line-in-content-without-fills-takes-the-main-color
;; `txt/change-text` writes nodes with no :fills, and the merge only
;; writes the keys the copy's nodes have
;; `txt/change-text` writes nodes with no :fills; the main's still reach
;; them
(let [file (-> (sample-file)
(tho/add-frame-with-text :main-root :main-child "hello world")
(thc/make-component :component1 :main-root)
@ -336,10 +273,8 @@
(fn [node] (assoc node :fills blue))
%))))
(tho/propagate-component-changes :component1))]
(tm/known-failure "F75"
[[["hello world" {:color :blue}]] [["second line" {:color :blue}]]]
[[["hello world" {:fills nil}]] [["second line" {:fills nil}]]]
(thtx/text-of file' :copy-child))))
(t/is (= [[["hello world" {:color :blue}]] [["second line" {:color :blue}]]]
(thtx/text-of file' :copy-child)))))
;; ---- Typographies and library colors
@ -351,15 +286,11 @@
kept (thtx/apply-typography [[["Read the guide"]]] :body (assoc body :size 20))
main' (thtx/restyle main :color :blue)]
(t/testing "detached in the panel before resizing"
(tm/known-failure "F72"
(thtx/normalize (thtx/restyle copy :color :blue))
(thtx/normalize copy)
(sync-text main copy main')))
(t/is (= (thtx/normalize (thtx/restyle copy :color :blue))
(sync-text main copy main'))))
(t/testing "resized keeping the typography (plugin API)"
(tm/known-failure "F72"
(thtx/normalize (thtx/restyle copy :color :blue))
(thtx/normalize kept)
(sync-text main kept main')))))
(t/is (= (thtx/normalize (thtx/restyle copy :color :blue))
(sync-text main kept main'))))))
(t/deftest copy-that-detached-a-typography-takes-a-library-change-through-its-main
(let [body-attrs {:font-id "sourcesanspro" :font-family "sourcesanspro" :font-variant-id "regular"
@ -379,10 +310,8 @@
file' (-> file
(sync :typographies (thi/id :body))
(sync :components (thi/id :component1)))]
(tm/known-failure "F72"
[[["Read the guide" {:family "Roboto" :size 16}]]]
[[["Read the guide" {:size 16}]]]
(thtx/text-of file' :copy-child))))
(t/is (= [[["Read the guide" {:family "Roboto" :size 16}]]]
(thtx/text-of file' :copy-child)))))
(t/deftest untouched-copy-with-a-library-color-takes-the-main-size
;; the library color sync writes the copy's runs; it is derived, so the
@ -446,23 +375,21 @@
["changes the family"
[[["Hello world" {:family "Roboto"}]]]
[[["Hello" {:family "Roboto" :weight 700}] [" world!!!" {:family "Roboto"}]]]]
;; the bold keeps its variant id, for the frontend to pick Roboto's
[[["Hello" {:family "Roboto" :weight 700 :font-variant-id "bold"}] [" world!!!" {:family "Roboto"}]]]]
["applies a typography"
(thtx/apply-typography [[["Hello world"]]] :heading heading)
;; the weight is the copy's, so the typography goes
[[{:line-height 1.4}
["Hello" {:family "Inter" :weight 700 :size 24 :spacing 1 :case "uppercase"}]
["Hello" {:family "Inter" :weight 700 :font-variant-id "bold" :size 24 :spacing 1 :case "uppercase"}]
[" world!!!" {:family "Inter" :size 24 :spacing 1 :case "uppercase"}]]]]])
(t/deftest copy-that-bolds-a-word-and-adds-letters-against-main-edits
(doseq [[title main' expected] worked-example]
(t/testing (str "the main " title)
(let [actual (sync-text [[["Hello world"]]] worked-copy main')
expected (thtx/normalize expected)]
(if (= expected (thtx/normalize worked-copy))
(t/is (= expected actual))
(tm/known-failure "F73" expected (thtx/normalize worked-copy) actual))))))
(t/is (= (thtx/normalize expected)
(sync-text [[["Hello world"]]] worked-copy main'))))))
;; ---- The same as today

48
common/test/common_tests/logic/text_sync_test.cljc
View File

@ -15,6 +15,7 @@
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
[app.common.test-helpers.shapes :as ths]
[app.common.types.text :as txt]
[clojure.test :as t]))
(t/use-fixtures :each thi/test-fixture)
@ -173,8 +174,9 @@
;; ==== Get
copy-child' (ths/get-shape file' :copy-child)
line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
;; The attr doesn't change, because it was touched
(t/is (= "14" (:font-size line)))
;; Each style is an override of its own: the copy's weight does not
;; keep the main's size out
(t/is (= "32" (:font-size line)))
(t/is (= "hello world" (:text line)))))
(t/deftest sync-updated-attr-copy-when-changed-text
@ -269,8 +271,9 @@
;; ==== Get
copy-child' (ths/get-shape file' :copy-child)
line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
;; The attr doesn't change, because it was touched
(t/is (= "14" (:font-size line)))
;; Each style is an override of its own: the copy's weight does not
;; keep the main's size out
(t/is (= "32" (:font-size line)))
;; The text is updated because only attrs were touched
(t/is (= "Bye" (:text line)))))
@ -463,8 +466,9 @@
;; ==== Get
copy-child' (ths/get-shape file' :copy-child)
line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
;; The attr doesn't change, because it was touched
(t/is (= "14" (:font-size line)))
;; Letters and a style overridden keep the other styles following the
;; main
(t/is (= "32" (:font-size line)))
(t/is (= "Hi" (:text line)))))
(t/deftest sync-updated-both-copy-when-changed-text
@ -563,8 +567,9 @@
;; ==== Get
copy-child' (ths/get-shape file' :copy-child)
line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
;; The attr doesn't change, because it was touched
(t/is (= "14" (:font-size line)))
;; Letters and a style overridden keep the other styles following the
;; main
(t/is (= "32" (:font-size line)))
;; The text doesn't change, because it was touched
(t/is (= "Hi" (:text line)))))
@ -616,9 +621,10 @@
;; ==== Get
copy-child' (ths/get-shape file' :copy-child)
line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
;; The attr is updated because all the attrs on the structure are equal
;; The style follows the main, as the copy only changed its letters
(t/is (= "32" (:font-size line)))
(t/is (= "hello world" (:text line)))))
;; The copy keeps its letters
(t/is (= "hello worldhello world" (txt/content->text (:content copy-child'))))))
(t/deftest sync-updated-structure-same-attrs-copy-when-changed-text
(let [;; ==== Setup
@ -666,8 +672,8 @@
copy-child' (ths/get-shape file' :copy-child)
line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
(t/is (= "14" (:font-size line)))
;; The text doesn't change, because the structure was touched
(t/is (= "hello world" (:text line)))))
;; The copy keeps its letters
(t/is (= "hello worldhello world" (txt/content->text (:content copy-child'))))))
(t/deftest sync-updated-structure-same-attrs-copy-when-changed-both
(let [;; ==== Setup
@ -718,10 +724,10 @@
;; ==== Get
copy-child' (ths/get-shape file' :copy-child)
line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
;; The attr is updated because all the attrs on the structure are equal
;; The style follows the main, as the copy only changed its letters
(t/is (= "32" (:font-size line)))
;; The text doesn't change, because the structure was touched
(t/is (= "hello world" (:text line)))))
;; The copy keeps its letters
(t/is (= "hello worldhello world" (txt/content->text (:content copy-child'))))))
(t/deftest sync-updated-structure-diff-attrs-copy-when-changed-attribute
(let [;; ==== Setup
@ -772,8 +778,8 @@
;; ==== Get
copy-child' (ths/get-shape file' :copy-child)
line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
;; The attr doesn't change, because not all the attrs on the structure are equal
(t/is (= "14" (:font-size line)))
;; The copy's own letters and weight do not keep the main's size out
(t/is (= "32" (:font-size line)))
(t/is (= "hello world" (:text line)))))
(t/deftest sync-updated-structure-diff-attrs-copy-when-changed-text
@ -823,7 +829,7 @@
copy-child' (ths/get-shape file' :copy-child)
line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
(t/is (= "14" (:font-size line)))
;; The text doesn't change, because the structure was touched
;; The copy keeps its letters
(t/is (= "hello world" (:text line)))))
(t/deftest sync-updated-structure-diff-attrs-copy-when-changed-both
@ -876,9 +882,9 @@
;; ==== Get
copy-child' (ths/get-shape file' :copy-child)
line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
;; The attr doesn't change, because not all the attrs on the structure are equal
(t/is (= "14" (:font-size line)))
;; The text doesn't change, because the structure was touched
;; The copy's own letters and weight do not keep the main's size out
(t/is (= "32" (:font-size line)))
;; The copy keeps its letters
(t/is (= "hello world" (:text line)))))
(t/deftest sync-copy-touched-only-in-content-group

20
common/test/common_tests/logic/text_touched_test.cljc
View File

@ -30,13 +30,13 @@
changes (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
#{(:id copy-child)}
(fn [shape]
(assoc-in shape [:content :children 0 :children 0 :font-size] "32"))
(assoc-in shape [:content :children 0 :children 0 :children 0 :font-size] "32"))
(:objects page)
{})
file' (thf/apply-changes file changes)
copy-child' (ths/get-shape file' :copy-child)]
(t/is (= #{:content-group :text-content-attribute} (:touched copy-child')))))
(t/is (= #{:content-group :text-content-size} (:touched copy-child')))))
(t/deftest test-text-copy-changed-text
(let [;; ==== Setup
@ -51,7 +51,7 @@
changes (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
#{(:id copy-child)}
(fn [shape]
(assoc-in shape [:content :children 0 :children 0 :text] "Bye"))
(assoc-in shape [:content :children 0 :children 0 :children 0 :text] "Bye"))
(:objects page)
{})
@ -73,14 +73,14 @@
#{(:id copy-child)}
(fn [shape]
(-> shape
(assoc-in [:content :children 0 :children 0 :font-size] "32")
(assoc-in [:content :children 0 :children 0 :text] "Bye")))
(assoc-in [:content :children 0 :children 0 :children 0 :font-size] "32")
(assoc-in [:content :children 0 :children 0 :children 0 :text] "Bye")))
(:objects page)
{})
file' (thf/apply-changes file changes)
copy-child' (ths/get-shape file' :copy-child)]
(t/is (= #{:content-group :text-content-attribute :text-content-text} (:touched copy-child')))))
(t/is (= #{:content-group :text-content-size :text-content-text} (:touched copy-child')))))
(t/deftest test-text-copy-changed-structure-same-attrs
(let [;; ==== Setup
@ -103,7 +103,8 @@
file' (thf/apply-changes file changes)
copy-child' (ths/get-shape file' :copy-child)]
(t/is (= #{:content-group :text-content-structure} (:touched copy-child')))))
;; a new line in the style of the one before changes the letters only
(t/is (= #{:content-group :text-content-text} (:touched copy-child')))))
(t/deftest test-text-copy-changed-structure-diff-attrs
(let [;; ==== Setup
@ -120,7 +121,7 @@
(fn [shape]
(let [line (-> shape
(get-in [:content :children 0 :children 0])
(assoc :font-size "32"))]
(assoc-in [:children 0 :font-size] "32"))]
(update-in shape [:content :children 0 :children]
#(conj % line))))
(:objects page)
@ -128,5 +129,6 @@
file' (thf/apply-changes file changes)
copy-child' (ths/get-shape file' :copy-child)]
(t/is (= #{:content-group :text-content-structure} (:touched copy-child')))))
;; a new line in a new style changes the letters and that style
(t/is (= #{:content-group :text-content-text :text-content-size} (:touched copy-child')))))

97
common/test/common_tests/logic/variants_switch_test.cljc
View File

@ -24,6 +24,7 @@
[app.common.types.component :as ctk]
[app.common.types.modifiers :as ctm]
[app.common.types.path.segment :as segment]
[app.common.types.text :as txt]
[clojure.test :as t]))
(t/use-fixtures :each thi/test-fixture)
@ -378,6 +379,17 @@
(def text-path-1 [:content :children 0 :children 0 :children 1 :text])
(def text-lines-path [:content :children 0 :children 0 :children])
(defn- runs
"The letters and font size of the text `shape`, by font size."
[shape]
(reduce (fn [acc [letters size]]
(let [[prev-letters prev-size] (peek acc)]
(if (= prev-size size)
(conj (pop acc) [(str prev-letters letters) size])
(conj acc [letters size]))))
[]
(map (juxt :text :font-size) (txt/node-seq txt/is-text-node? (:content shape)))))
(defn- update-attr
[file label path value]
(let [page (thf/current-page file)
@ -961,16 +973,9 @@
(t/is (= (get-in copy-structure-clean-t font-size-path-1) "14"))
(t/is (= (get-in copy-structure-clean-t text-path-1) "new line 2"))
;; After the switch, first line:
;; * font size 14 (value of c02, because there was no override)
;; * text "new line 1" (the override is preserved)
;; Second line:
;; * font size 14 (value of c02, because there was no override)
;; * text "new line 2" (the override is preserved)
(t/is (= (get-in copy-structure-clean-t' font-size-path-0) "14"))
(t/is (= (get-in copy-structure-clean-t' text-path-0) "new line 1"))
(t/is (= (get-in copy-structure-clean-t' font-size-path-1) "14"))
(t/is (= (get-in copy-structure-clean-t' text-path-1) "new line 2"))
;; After the switch, the letters are preserved, and the size is c02's
;; (there was no override)
(t/is (= [["new line 1new line 2" "14"]] (runs copy-structure-clean-t')))
;;;;;;;;;;; Copy structure unif
;; Before the switch, first line:
@ -984,16 +989,8 @@
(t/is (= (get-in copy-structure-unif-t font-size-path-1) "25"))
(t/is (= (get-in copy-structure-unif-t text-path-1) "new line 2"))
;; After the switch, first line:
;; * font size 25 (the override is preserved)
;; * text "new line 1" (the override is preserved)
;; Second line:
;; * font size 25 (the override is preserved)
;; * text "new line 2" (the override is preserved)
(t/is (= (get-in copy-structure-unif-t' font-size-path-0) "25"))
(t/is (= (get-in copy-structure-unif-t' text-path-0) "new line 1"))
(t/is (= (get-in copy-structure-unif-t' font-size-path-1) "25"))
(t/is (= (get-in copy-structure-unif-t' text-path-1) "new line 2"))
;; After the switch, the letters and the size are preserved
(t/is (= [["new line 1new line 2" "25"]] (runs copy-structure-unif-t')))
;;;;;;;;;;; Copy structure mixed
;; Before the switch, first line:
@ -1090,16 +1087,9 @@
(t/is (= (get-in copy-structure-clean-t font-size-path-1) "14"))
(t/is (= (get-in copy-structure-clean-t text-path-1) "new line 2"))
;; After the switch, first line:
;; * font size 50 (value of c02, because there was no override)
;; * text "new line 1" (the override is preserved)
;; Second line:
;; * font size 50 (value of c02, because there was no override)
;; * text "new line 2" (the override is preserved)
(t/is (= (get-in copy-structure-clean-t' font-size-path-0) "50"))
(t/is (= (get-in copy-structure-clean-t' text-path-0) "new line 1"))
(t/is (= (get-in copy-structure-clean-t' font-size-path-1) "50"))
(t/is (= (get-in copy-structure-clean-t' text-path-1) "new line 2"))
;; After the switch, the letters are preserved and the size is c02's
;; (there was no override)
(t/is (= [["new line 1new line 2" "50"]] (runs copy-structure-clean-t')))
;;;;;;;;;;; Copy structure unif
;; Before the switch, first line:
@ -1113,16 +1103,9 @@
(t/is (= (get-in copy-structure-unif-t font-size-path-1) "25"))
(t/is (= (get-in copy-structure-unif-t text-path-1) "new line 2"))
;; After the switch, first line:
;; * font size 50 (the override is not preserved)
;; * text "new line 1" (the override is preserved)
;; Second line:
;; * font size 50 (the override is not preserved)
;; * text "new line 2" (the override is preserved)
(t/is (= (get-in copy-structure-unif-t' font-size-path-0) "50"))
(t/is (= (get-in copy-structure-unif-t' text-path-0) "new line 1"))
(t/is (= (get-in copy-structure-unif-t' font-size-path-1) "50"))
(t/is (= (get-in copy-structure-unif-t' text-path-1) "new line 2"))
;; After the switch, the letters are preserved and the size is c02's
;; (the variants differ in it)
(t/is (= [["new line 1new line 2" "50"]] (runs copy-structure-unif-t')))
;;;;;;;;;;; Copy structure mixed
;; Before the switch, first line:
@ -1136,13 +1119,9 @@
(t/is (= (get-in copy-structure-mixed-t font-size-path-1) "40"))
(t/is (= (get-in copy-structure-mixed-t text-path-1) "new line 2"))
;; After the switch, first line:
;; * font size 50 (the override is not preserved)
;; * text "hello world" (the override is not preserved)
;; No second line
(t/is (= (get-in copy-structure-mixed-t' font-size-path-0) "50"))
(t/is (= (get-in copy-structure-mixed-t' text-path-0) "hello world"))
(t/is (nil? (get-in copy-structure-mixed-t' font-size-path-1)))))
;; After the switch, the letters are preserved (the variants have the
;; same) and the size is c02's (the variants differ in it)
(t/is (= [["new line 1new line 2" "50"]] (runs copy-structure-mixed-t')))))
;; ============================================================
;; TEXT STRUCTURE OVERRIDES (different text)
@ -1261,13 +1240,11 @@
(t/is (= (get-in copy-structure-mixed-t font-size-path-1) "40"))
(t/is (= (get-in copy-structure-mixed-t text-path-1) "new line 2"))
;; After the switch, first line:
;; * font size 14 (the override is not preserved)
;; * text "bye" (the override is not preserved)
;; No second line
(t/is (= (get-in copy-structure-mixed-t' font-size-path-0) "14"))
(t/is (= (get-in copy-structure-mixed-t' text-path-0) "bye"))
(t/is (nil? (get-in copy-structure-mixed-t' font-size-path-1)))))
;; After the switch, the letters are c02's (the variants differ in them)
;; and the sizes are preserved (the variants agree on them): "bye"
;; shares no letters with the copy, so it takes the size of the copy's
;; first letter
(t/is (= [["bye" "35"]] (runs copy-structure-mixed-t')))))
;; ============================================================
;; TEXT STRUCTURE OVERRIDES (different text AND property)
@ -3254,10 +3231,9 @@
(t/is (mth/close? 28 (:height content)))))
(t/deftest test-switch-to-a-main-with-another-text-structure
;; The second variant's text has two lines where the first has one, so
;; the copy's text cannot keep its own structure. With uniform styles and
;; mains that agree on them, a style override is carried onto the new
;; variant's lines; when the mains disagree on the style, it is dropped.
;; The second variant's text has other letters, so the copy takes them.
;; A style override the mains agree on is carried onto them; when the
;; mains disagree on the style, it is dropped.
(let [setup (fn [main-font-size]
(-> (thf/sample-file :file1)
(thv/add-variant-with-text
@ -3274,10 +3250,7 @@
(copy-child :copy02)))
agree (switched (setup nil))
disagree (switched (setup "50"))]
(t/is (= "new line 1" (get-in agree text-path-0)))
(t/is (= "new line 2" (get-in agree text-path-1)))
(t/is (= "25" (get-in agree font-size-path-0)))
(t/is (= "25" (get-in agree font-size-path-1)))
(t/is (= [["new line 1new line 2" "25"]] (runs agree)))
;; the carried style stays an override
(t/is (contains? (:touched agree) :content-group))

4
common/test/common_tests/runner.cljc
View File

@ -78,6 +78,7 @@
[common-tests.logic.swap-keeps-id-test]
[common-tests.logic.text-editor-output-test]
[common-tests.logic.text-notation-test]
[common-tests.logic.text-override-operations-test]
[common-tests.logic.text-override-rule-test]
[common-tests.logic.text-override-switch-test]
[common-tests.logic.text-override-sync-test]
@ -116,6 +117,7 @@
[common-tests.types.shape-interactions-test]
[common-tests.types.shape-layout-test]
[common-tests.types.stroke-test]
[common-tests.types.text-letters-test]
[common-tests.types.text-test]
[common-tests.types.token-test]
[common-tests.types.tokens-lib-test]
@ -194,6 +196,7 @@
'common-tests.logic.swap-keeps-id-test
'common-tests.logic.text-editor-output-test
'common-tests.logic.text-notation-test
'common-tests.logic.text-override-operations-test
'common-tests.logic.text-override-rule-test
'common-tests.logic.text-override-switch-test
'common-tests.logic.text-override-sync-test
@ -232,6 +235,7 @@
'common-tests.types.shape-interactions-test
'common-tests.types.shape-layout-test
'common-tests.types.stroke-test
'common-tests.types.text-letters-test
'common-tests.types.text-test
'common-tests.types.token-test
'common-tests.types.tokens-lib-test

109
common/test/common_tests/types/text_letters_test.cljc Normal file
View File

@ -0,0 +1,109 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns common-tests.types.text-letters-test
"A text seen as letters with a style each (`cttx/content->letters`), and
the letters two texts share."
(:require
[app.common.test-helpers.texts :as thtx]
[app.common.types.text :as cttx]
[clojure.string :as str]
[clojure.test :as t]))
(defn- shared
[a b]
(cttx/shared-letters (cttx/split-letters a) (cttx/split-letters b)))
(t/deftest letters-of-a-string
(t/is (= ["a" "b"] (cttx/split-letters "ab")))
(t/is (= [] (cttx/split-letters "")))
(t/testing "a letter outside the basic plane stays whole"
(t/is (= ["a" "😀" "b"] (cttx/split-letters "a😀b")))))
(t/deftest shared-letters-come-in-stretches-of-three
(t/is (= (zipmap (range 11) (range 11))
(shared "Hello world" "Hello world!!!")))
(t/testing "the lone H is too short to count"
(t/is (= (zipmap (range 2 11) (range 2 11))
(shared "Hello world" "Hallo world"))))
(t/is (= {} (shared "OK" "Ok")))
(t/is (= {} (shared "Price: $10" "Sale")))
(t/testing "index in the second text -> index in the first"
(t/is (= {0 1 1 2 2 3} (shared "xabc" "abc")))
(t/is (= {2 0 3 1 4 2} (shared "abc" "xyabc"))))
(t/testing "stretches in the middle, with edits around them"
(t/is (= (merge (zipmap (range 3 10) (range 5 12))
(zipmap (range 12 20) (range 12 20)))
(shared "Hello world, see you" "Bye world, I see you"))))
(t/testing "line breaks are letters"
(t/is (= (zipmap (range 11) (range 11))
(shared "Summer sale" "Summer sale\nEnds Sunday")))))
(t/deftest shared-letters-of-long-texts
(let [words (str/join " " (map #(str "word" %) (range 2000)))]
(t/testing "an edit in the middle of a long text"
(let [edited (str/replace words "word1000 " "WORD ")]
(t/is (= (- (count edited) 4)
(count (shared words edited))))))
(t/testing "texts too different for the diff share their start and end"
(let [other (str "start " (apply str (repeat 1500 "x")) (apply str (repeat 1500 "y")) " end")
mixed (str "start " (apply str (repeat 1500 "y")) (apply str (repeat 1500 "x")) " end")]
(t/is (= (concat (range 6) (range (- (count other) 4) (count other)))
(sort (keys (shared other mixed)))))))))
(t/deftest letters-of-a-content
(let [letters (cttx/content->letters
(thtx/content [[["Hi" {:weight 700}] ["!"]] [[""]] [["Yo"]]]))]
(t/is (= "Hi!\n\nYo" (cttx/letters-text letters)))
(t/is (= [0 0 0 1 2 2 2] (map :paragraph (:letters letters))))
(t/is (= ["700" "700" "400" nil nil "400" "400"]
(map #(get-in % [:run :font-weight]) (:letters letters))))
(t/testing "a paragraph with no letters keeps its run"
(t/is (= [false true false] (map #(contains? % :empty-run) (:paragraphs letters))))
(t/is (nil? (some :children (:paragraphs letters)))))))
(t/deftest letters-build-the-content-back
(doseq [text [[[["Hello world"]]]
[[["Price: "] ["$10" {:weight 700}]]]
[{:valign "bottom"} [{:align "center"} ["Summer " {:weight 700}] ["sale"]] [[""]] [["Ends Sunday"]]]
[[["a😀b" {:color :red}]]]]]
(let [content (thtx/content text)]
(t/is (= content (cttx/letters->content (cttx/content->letters content)))
(pr-str text))))
(t/testing "runs with equal styles join"
(let [content (thtx/content [[["Hello "] ["world"]]])]
(t/is (= (thtx/content [[["Hello world"]]])
(cttx/letters->content (cttx/content->letters content)))))))
(t/deftest the-style-of-a-letter
(let [letters (cttx/content->letters
(thtx/content [{:valign "bottom"}
[{:align "center" :line-height 1.5} ["Hi" {:weight 700 :color :red}]]
[[""]]]))
hi (first (:letters letters))]
(t/is (= {:font-weight "700" :font-style "normal" :font-variant-id "bold"}
(cttx/unit-style letters :text-content-weight hi)))
(t/is (= {:fills [{:fill-color "#FF0000" :fill-opacity 1}]}
(cttx/unit-style letters :text-content-fills hi)))
(t/testing "a run without a line height takes its paragraph's"
(t/is (= {:line-height "1.5"} (cttx/unit-style letters :text-content-line-height hi))))
(t/testing "a paragraph with no letters gives its run's style"
(t/is (= {:font-weight "400" :font-style "normal" :font-variant-id "regular"}
(cttx/unit-style letters :text-content-weight {:paragraph 1}))))
(t/is (= {:text-align "center"} (cttx/unit-style letters :text-content-align 0)))
(t/is (= {:vertical-align "bottom"} (cttx/unit-style letters :text-content-valign nil)))))
(t/deftest styles-that-show-the-same
(t/is (cttx/same-style? {:font-size "14"} {:font-size 14}))
(t/is (cttx/same-style? {:font-size "14"} {}))
(t/is (cttx/same-style? {:line-height "1.3333333333333333"} {:line-height "1.33333"}))
(t/is (cttx/same-style? {:fills []} {}))
(t/is (cttx/same-style? {:typography-ref-id nil} {}))
(t/is (cttx/same-style? {:text-align "left"} {}))
(t/is (cttx/same-style? {:vertical-align "top"} {}))
(t/is (not (cttx/same-style? {:font-size "14"} {:font-size "18"})))
(t/is (not (cttx/same-style? {:font-variant-id "700"} {:font-variant-id "700italic"})))
(t/is (not (cttx/same-style? {:fills [{:fill-color "#000000" :fill-opacity 1}]} {}))))