multiple values select enhancements

pull/10438/head
Tienson Qin 2023-09-25 21:33:16 +08:00
parent e907186002
commit 22d3d71040
6 changed files with 312 additions and 196 deletions

View File

@ -299,6 +299,7 @@
[state page-name icon title {:keys [fmt-journal? *configure-show? preview?]}]
(when title
(let [page (when page-name (db/entity [:block/name page-name]))
page (db/sub-block (:db/id page))
*hover? (::hover? state)
*title-value (get state ::title-value)
*edit? (get state ::edit?)
@ -316,44 +317,44 @@
old-name (or title page-name)
db-based? (config/db-based-graph? repo)
tags-property (db/entity [:block/name "tags"])]
[:div.ls-page-title.flex-1.flex-row.w-full.relative
[:div.ls-page-title.flex-1.flex-row.flex-wrap.w-full.relative
{:on-mouse-over #(reset! *hover? true)
:on-mouse-out #(when-not @*adding-tags?
(reset! *hover? false))}
[:h1.page-title.flex.cursor-pointer.gap-1.w-full
{:class (when-not whiteboard-page? "title")
:on-mouse-down (fn [e]
(when (util/right-click? e)
(state/set-state! :page-title/context {:page page-name})))
:on-click (fn [e]
(when-not (= (.-nodeName (.-target e)) "INPUT")
(.preventDefault e)
(if (gobj/get e "shiftKey")
(when-let [page (db/pull repo '[*] [:block/name page-name])]
(state/sidebar-add-block!
repo
(:db/id page)
:page))
(when (and (not hls-page?)
(not fmt-journal?)
(not config/publishing?)
(not (and (contains? (:block/type page) "property")
(contains? db-property/built-in-properties-keys-str page-name))))
(reset! *input-value (if untitled? "" old-name))
(reset! *edit? true)))))}
(when (not= icon "") [:span.page-icon icon])
[:div.page-title-sizer-wrapper.relative
(when @*edit?
(page-title-editor {:*title-value *title-value
:*edit? *edit?
:*input-value *input-value
:title title
:page-name page-name
:old-name old-name
:untitled? untitled?
:whiteboard-page? whiteboard-page?
:preview? preview?}))
[:div.flex.flex-row.flex-1.flex-wrap.items-center.gap-2
[:div.flex.flex-1.flex-row.flex-wrap.items-center.gap-4
[:h1.page-title.flex.cursor-pointer.gap-1
{:class (when-not whiteboard-page? "title")
:on-mouse-down (fn [e]
(when (util/right-click? e)
(state/set-state! :page-title/context {:page page-name})))
:on-click (fn [e]
(when-not (= (.-nodeName (.-target e)) "INPUT")
(.preventDefault e)
(if (gobj/get e "shiftKey")
(when-let [page (db/pull repo '[*] [:block/name page-name])]
(state/sidebar-add-block!
repo
(:db/id page)
:page))
(when (and (not hls-page?)
(not fmt-journal?)
(not config/publishing?)
(not (and (contains? (:block/type page) "property")
(contains? db-property/built-in-properties-keys-str page-name))))
(reset! *input-value (if untitled? "" old-name))
(reset! *edit? true)))))}
(when (not= icon "") [:span.page-icon icon])
[:div.page-title-sizer-wrapper.relative
(when @*edit?
(page-title-editor {:*title-value *title-value
:*edit? *edit?
:*input-value *input-value
:title title
:page-name page-name
:old-name old-name
:untitled? untitled?
:whiteboard-page? whiteboard-page?
:preview? preview?}))
[:span.title.block
{:on-click (fn []
(when (and (state/home?) (not preview?))
@ -367,13 +368,13 @@
untitled? [:span.opacity-50 (t :untitled)]
nested? (component-block/map-inline {} (gp-mldoc/inline->edn title (gp-mldoc/default-config
(:block/format page))))
:else title))]
(when (seq (:block/tags page))
[:div.page-tags
(pv/property-value page tags-property (map :block/uuid (:block/tags page))
{:show-add? true
:page-cp (fn [config page]
(component-block/page-cp (assoc config :tag? true) page))})])]]]
:else title))]]]
(when (seq (:block/tags page))
[:div.page-tags
(pv/property-value page tags-property (map :block/uuid (:block/tags page))
{:page-cp (fn [config page]
(component-block/page-cp (assoc config :tag? true) page))})])]
(when (and db-based? (not whiteboard-page?))
[:div.absolute.bottom-2.left-0
[:div.page-add-tags.flex.flex-row.items-center.flex-wrap.gap-2.ml-2

View File

@ -129,7 +129,7 @@ input.simple-input:focus {
}
/* TODO: */
.page-add-tags, .page-title {
.page-add-tags, .page-tags, .page-title, .property-select {
.cp__select-main {
width: fit-content;
margin: 0;

View File

@ -96,8 +96,17 @@
:initial-open? (when *add-new-item? @*add-new-item?)})))
(defn- select-page
[block property {:keys [classes multiple-values? on-chosen] :as opts}]
[block property {:keys [classes multiple-choices?] :as opts}]
(let [repo (state/get-current-repo)
tags-or-alias? (contains? #{"tags" "alias"} (:block/name property))
selected-choices (if tags-or-alias?
(->> (if (= "tags" (:block/name property))
(:block/tags block)
(:block/alias block))
(map (fn [e] (:block/original-name e))))
(->> (get-in block [:block/properties (:block/uuid property)])
(map (fn [id]
(:block/original-name (db/entity [:block/uuid id]))))))
pages (->>
(if (seq classes)
(mapcat
@ -109,59 +118,70 @@
(model/get-all-page-original-names repo))
distinct)
options (map (fn [p] {:value p}) pages)
opts {:items options
:dropdown? true
:input-default-placeholder (if multiple-values?
"Choose pages"
"Choose page")
:on-chosen (fn [chosen]
(let [page* (string/trim (if (string? chosen) chosen (:value chosen)))
[_ page inline-class] (or (seq (map string/trim (re-find #"(.*)#(.*)$" page*)))
[nil page* nil])
id (:block/uuid (db/entity [:block/name (util/page-name-sanity-lc page)]))
class? (= (:block/name property) "tags")]
(when (nil? id)
(let [inline-class-uuid
(when inline-class
(or (:block/uuid (db/entity [:block/name (util/page-name-sanity-lc inline-class)]))
(do (log/error :msg "Given inline class does not exist" :inline-class inline-class)
nil)))]
(page-handler/create! page {:redirect? false
:create-first-block? false
:tags (if inline-class-uuid
[inline-class-uuid]
opts (cond->
{:multiple-choices? multiple-choices?
:items options
:selected-choices selected-choices
:dropdown? true
:input-default-placeholder (if multiple-choices?
"Choose pages"
"Choose page")
:show-new-when-not-exact-match? true
:extract-chosen-fn :value
;; Provides additional completion for inline classes on new pages
:transform-fn (fn [results input]
(if-let [[_ new-page class-input] (and (empty? results) (re-find #"(.*)#(.*)$" input))]
(let [repo (state/get-current-repo)
class-names (map #(:block/original-name (db/entity repo [:block/uuid %])) classes)
descendent-classes (->> class-names
(mapcat #(db/get-namespace-pages repo %))
(map :block/original-name))]
(->> (concat class-names descendent-classes)
(filter #(string/includes? % class-input))
(mapv #(hash-map :value (str new-page "#" %)))))
results))
:input-opts (fn [_]
{:on-blur (fn []
(exit-edit-property)
(when-let [f (:on-chosen opts)] (f)))
:on-key-down
(fn [e]
(case (util/ekey e)
"Escape"
(do
(exit-edit-property)
(when-let [f (:on-chosen opts)] (f)))
nil))})}
multiple-choices?
(assoc :on-apply (fn [choices]
(let [values (set (map (fn [page]
(:block/uuid (db/entity [:block/name (util/page-name-sanity-lc page)]))) choices))]
(add-property! block (:block/original-name property) values)
(when-let [f (:on-chosen opts)] (f)))))
(not multiple-choices?)
(assoc :on-chosen (fn [chosen]
(let [page* (string/trim (if (string? chosen) chosen (:value chosen)))
[_ page inline-class] (or (seq (map string/trim (re-find #"(.*)#(.*)$" page*)))
[nil page* nil])
id (:block/uuid (db/entity [:block/name (util/page-name-sanity-lc page)]))
class? (= (:block/name property) "tags")]
(when (nil? id)
(let [inline-class-uuid
(when inline-class
(or (:block/uuid (db/entity [:block/name (util/page-name-sanity-lc inline-class)]))
(do (log/error :msg "Given inline class does not exist" :inline-class inline-class)
nil)))]
(page-handler/create! page {:redirect? false
:create-first-block? false
:tags (if inline-class-uuid
[inline-class-uuid]
;; Only 1st class b/c page normally has
;; one of and not all these classes
(take 1 classes))
:class? class?})))
(let [id' (or id (:block/uuid (db/entity [:block/name (util/page-name-sanity-lc page)])))]
(add-property! block (:block/original-name property) id'))
(when-let [f (:on-chosen opts)] (f))))
:show-new-when-not-exact-match? true
;; Provides additional completion for inline classes on new pages
:transform-fn (fn [results input]
(if-let [[_ new-page class-input] (and (empty? results) (re-find #"(.*)#(.*)$" input))]
(let [repo (state/get-current-repo)
class-names (map #(:block/original-name (db/entity repo [:block/uuid %])) classes)
descendent-classes (->> class-names
(mapcat #(db/get-namespace-pages repo %))
(map :block/original-name))]
(->> (concat class-names descendent-classes)
(filter #(string/includes? % class-input))
(mapv #(hash-map :value (str new-page "#" %)))))
results))
:input-opts (fn [_]
{:on-blur (fn []
(exit-edit-property)
(when-let [f (:on-chosen opts)] (f)))
:on-key-down
(fn [e]
(case (util/ekey e)
"Escape"
(do
(exit-edit-property)
(when-let [f (:on-chosen opts)] (f)))
nil))})}]
(take 1 classes))
:class? class?})))
(let [id' (or id (:block/uuid (db/entity [:block/name (util/page-name-sanity-lc page)])))]
(add-property! block (:block/original-name property) id'))
(when-let [f (:on-chosen opts)] (f))))))]
(select/select opts)))
;; (defn- move-cursor
@ -279,32 +299,41 @@
nil))))})
(defn- select
[block property opts]
[block property {:keys [multiple-choices?] :as opts}]
(let [items (->> (model/get-block-property-values (:block/uuid property))
(mapcat (fn [[_id value]]
(if (coll? value)
(map (fn [v] {:value v}) value)
[{:value value}])))
(distinct))
add-property-f #(add-property! block (:block/original-name property) %)]
(select/select {:items items
:dropdown? true
:on-chosen (fn [chosen]
(add-property-f (:value chosen))
(when-let [f (:on-chosen opts)] (f)))
:show-new-when-not-exact-match? true
:input-opts (fn [_]
{:on-blur (fn []
(exit-edit-property)
(when-let [f (:on-chosen opts)] (f)))
:on-key-down
(fn [e]
(case (util/ekey e)
"Escape"
(do
(exit-edit-property)
(when-let [f (:on-chosen opts)] (f)))
nil))})})))
add-property-f #(add-property! block (:block/original-name property) %)
on-chosen (fn [chosen]
(add-property-f (:value chosen))
(when-let [f (:on-chosen opts)] (f)))
selected-choices (get-in block [:block/properties (:block/uuid property)])]
(select/select (cond->
{:multiple-choices? multiple-choices?
:items items
:selected-choices selected-choices
:dropdown? true
:show-new-when-not-exact-match? true
:extract-chosen-fn :value
:input-opts (fn [_]
{:on-blur (fn []
(exit-edit-property)
(when-let [f (:on-chosen opts)] (f)))
:on-key-down
(fn [e]
(case (util/ekey e)
"Escape"
(do
(exit-edit-property)
(when-let [f (:on-chosen opts)] (f)))
nil))})}
multiple-choices?
(assoc :on-apply on-chosen)
(not multiple-choices?)
(assoc :on-chosen on-chosen)))))
(rum/defc property-block-value < rum/reactive
[repo block property value block-cp editor-box opts]
@ -371,12 +400,13 @@
[:div.flex.flex-1
(case type
(list :number :url)
[:div.h-6 (select block property select-opts)]
[:div.h-6 (select block property (assoc select-opts
:multiple-choices? multiple-values?))]
:page
[:div.h-6 (select-page block property (assoc select-opts
:classes (:classes schema)
:multiple? multiple-values?))]
:multiple-choices? multiple-values?))]
(let [config {:editor-opts (new-text-editor-opts repo block property value editor-id)}]
[:div
@ -420,7 +450,8 @@
(case type
:page
(when-let [page (db/entity [:block/uuid value])]
(page-cp {:disable-preview? true} page))
(page-cp {:disable-preview? true
:hide-close-button? true} page))
:template
(property-template-value {:blocks-container-id blocks-container-id
@ -476,38 +507,62 @@
(atom (boolean (:add-new-item? (nth (:rum/args state) 3))))
::show-add?
(atom (boolean (:show-add? (nth (:rum/args state) 3))))))}
[state block property v opts dom-id schema editor-id editor-args]
[state block property v {:keys [on-chosen] :as opts} dom-id schema editor-id editor-args]
(let [*show-add? (::show-add? state)
*add-new-item? (::add-new-item? state)
type (get schema :type :default)
row? (contains? #{:page :date :number :url} type)
items (if (coll? v) v (when v [v]))]
items (if (coll? v) v (when v [v]))
values-cp (for [[idx item] (medley/indexed items)]
(let [dom-id' (str dom-id "-" idx)
editor-id' (str editor-id "-" idx)]
(rum/with-key
(item-with-close block property item
(merge
opts
{:parent-dom-id dom-id
:idx idx
:dom-id dom-id'
:editor-id editor-id'
:editor-args editor-args
:row? row?
:*add-new-item? *add-new-item?
:show-close-button? (not row?)}))
dom-id')))]
[:div.relative
{:class (cond
row?
(cond-> "flex flex-1 flex-row items-center flex-wrap"
row?
(str " gap-2"))
"flex flex-1 flex-row items-center flex-wrap gap-2"
:else
"grid gap-1")
:on-mouse-over #(reset! *show-add? true)
:on-mouse-out #(reset! *show-add? false)}
(for [[idx item] (medley/indexed items)]
(let [dom-id' (str dom-id "-" idx)
editor-id' (str editor-id "-" idx)]
(rum/with-key
(item-with-close block property item
(merge
opts
{:parent-dom-id dom-id
:idx idx
:dom-id dom-id'
:editor-id editor-id'
:editor-args editor-args
:row? row?
:*add-new-item? *add-new-item?}))
dom-id')))
(when (seq items)
(if row?
(ui/dropdown
(fn [{:keys [toggle-fn]}]
[:div.cursor-pointer
{:on-mouse-down (fn [e]
(util/stop e)
(toggle-fn))
:class "flex flex-1 flex-row items-center flex-wrap gap-2"}
values-cp])
(fn [{:keys [toggle-fn]}]
(let [select-opts {:on-chosen (fn []
(when *add-new-item? (reset! *add-new-item? false))
(when on-chosen (on-chosen))
(toggle-fn))}]
[:div.property-select
(if (= type :page)
(select-page block property (assoc select-opts
:classes (:classes schema)
:multiple-choices? true))
(select block property (assoc select-opts
:multiple-choices? true)))]))
{:modal-class (util/hiccup->class
"origin-top-right.absolute.left-0.rounded-md.shadow-lg.mt-2")})
values-cp))
(cond
(rum/react *add-new-item?)

View File

@ -81,6 +81,11 @@
(remove nil?))
exact-match? (contains? (set (map (comp string/lower-case str extract-fn) search-result'))
(string/lower-case @input))
search-result' (if multiple-choices?
(sort-by (fn [item]
(not (contains? @*selected-choices (:value item))))
search-result')
search-result')
search-result (if (and show-new-when-not-exact-match?
(not exact-match?)
(not (string/blank? @input))

View File

@ -117,67 +117,53 @@
:block/type "property"})]
{:outliner-op :insert-blocks}))))
(defn set-block-property!
[repo block-id k-name v {:keys [old-value]}]
(defn- reset-block-property-multiple-values!
[repo block-id k-name values _opts]
(let [block (db/entity repo [:block/uuid block-id])
k-name (name k-name)
property (db/pull repo '[*] [:block/name (gp-util/page-name-sanity-lc k-name)])
v (if property v (or v ""))]
(when (some? v)
(let [property-uuid (or (:block/uuid property) (db/new-block-id))
{:keys [type cardinality]} (:block/schema property)
multiple-values? (= cardinality :many)
infer-schema (when-not type (infer-schema-from-input-string v))
values (remove nil? values)
property-uuid (or (:block/uuid property) (db/new-block-id))
{:keys [type cardinality]} (:block/schema property)
multiple-values? (= cardinality :many)]
(when (and multiple-values? (seq values))
(let [infer-schema (when-not type (infer-schema-from-input-string (first values)))
property-type (or type infer-schema :default)
schema (get builtin-schema-types property-type)
properties (:block/properties block)
value (get properties property-uuid)
v* (try
(convert-property-input-string property-type v)
(catch :default e
(notification/show! (str e) :error false)
nil))
tags-or-alias? (and (contains? #{"tags" "alias"} (string/lower-case k-name)) (uuid? v*))]
(if tags-or-alias?
(let [property-value-id (:db/id (db/entity [:block/uuid v*]))
attribute (case (string/lower-case k-name)
"alias"
:block/alias
"tags"
:block/tags)]
(db/transact! repo
[[:db/add (:db/id block) attribute property-value-id]]
{:outliner-op :save-block}))
(when-not (contains? (if (set? value) value #{value}) v*)
(if-let [msg (me/humanize (mu/explain-data schema v*))]
values' (try
(map #(convert-property-input-string property-type %) values)
(catch :default e
(notification/show! (str e) :error false)
nil))
tags-or-alias? (and (contains? #{"tags" "alias"} (string/lower-case k-name)) (uuid? (first values')))
attribute (when tags-or-alias? (case (string/lower-case k-name)
"alias"
:block/alias
"tags"
:block/tags))
old-values (if tags-or-alias?
(->> (get block attribute)
(map (fn [e] (:block/uuid e))))
(get properties property-uuid))]
(when (not= old-values values')
(if tags-or-alias?
(let [property-value-ids (map (fn [id] (:db/id (db/entity [:block/uuid id]))) values')]
(util/pprint [[:db/retract (:db/id block) :attribute]
{:block/uuid block-id
attribute property-value-ids}])
(db/transact! repo
[[:db/retract (:db/id block) attribute]
{:block/uuid block-id
attribute property-value-ids}]
{:outliner-op :save-block}))
(if-let [msg (some #(me/humanize (mu/explain-data schema %)) values')]
(let [msg' (str "\"" k-name "\"" " " (if (coll? msg) (first msg) msg))]
(notification/show! msg' :warning))
(do
(upsert-property! repo k-name {:type property-type}
{:property-uuid property-uuid})
(let [new-value (cond
(and multiple-values? old-value
(not= old-value :frontend.components.property/new-value-placeholder))
(if (coll? v*)
(vec (distinct (concat value v*)))
(let [v (mapv (fn [x] (if (= x old-value) v* x)) value)]
(if (contains? (set v) v*)
v
(conj v v*))))
multiple-values?
(let [f (if (coll? v*) concat conj)]
(f value v*))
:else
v*)
;; don't modify maps
new-value (if (or (sequential? new-value) (set? new-value))
(if (= :coll property-type)
(vec (remove string/blank? new-value))
(set (remove string/blank? new-value)))
new-value)
block-properties (assoc properties property-uuid new-value)
(let [block-properties (assoc properties property-uuid values')
refs (outliner-core/rebuild-block-refs block block-properties)]
(db/transact! repo
[[:db/retract (:db/id block) :block/refs]
@ -186,6 +172,77 @@
:block/refs refs}]
{:outliner-op :save-block}))))))))))
(defn set-block-property!
[repo block-id k-name v {:keys [old-value] :as opts}]
(let [block (db/entity repo [:block/uuid block-id])
k-name (name k-name)
property (db/pull repo '[*] [:block/name (gp-util/page-name-sanity-lc k-name)])
property-uuid (or (:block/uuid property) (db/new-block-id))
{:keys [type cardinality]} (:block/schema property)
multiple-values? (= cardinality :many)]
(if (and multiple-values? (coll? v))
(reset-block-property-multiple-values! repo block-id k-name v opts)
(let [v (if property v (or v ""))]
(when (some? v)
(let [infer-schema (when-not type (infer-schema-from-input-string v))
property-type (or type infer-schema :default)
schema (get builtin-schema-types property-type)
properties (:block/properties block)
value (get properties property-uuid)
v* (try
(convert-property-input-string property-type v)
(catch :default e
(notification/show! (str e) :error false)
nil))
tags-or-alias? (and (contains? #{"tags" "alias"} (string/lower-case k-name)) (uuid? v*))]
(if tags-or-alias?
(let [property-value-id (:db/id (db/entity [:block/uuid v*]))
attribute (case (string/lower-case k-name)
"alias"
:block/alias
"tags"
:block/tags)]
(db/transact! repo
[[:db/add (:db/id block) attribute property-value-id]]
{:outliner-op :save-block}))
(when-not (contains? (if (set? value) value #{value}) v*)
(if-let [msg (me/humanize (mu/explain-data schema v*))]
(let [msg' (str "\"" k-name "\"" " " (if (coll? msg) (first msg) msg))]
(notification/show! msg' :warning))
(do
(upsert-property! repo k-name {:type property-type}
{:property-uuid property-uuid})
(let [new-value (cond
(and multiple-values? old-value
(not= old-value :frontend.components.property/new-value-placeholder))
(if (coll? v*)
(vec (distinct (concat value v*)))
(let [v (mapv (fn [x] (if (= x old-value) v* x)) value)]
(if (contains? (set v) v*)
v
(conj v v*))))
multiple-values?
(let [f (if (coll? v*) concat conj)]
(f value v*))
:else
v*)
;; don't modify maps
new-value (if (or (sequential? new-value) (set? new-value))
(if (= :coll property-type)
(vec (remove string/blank? new-value))
(set (remove string/blank? new-value)))
new-value)
block-properties (assoc properties property-uuid new-value)
refs (outliner-core/rebuild-block-refs block block-properties)]
(db/transact! repo
[[:db/retract (:db/id block) :block/refs]
{:block/uuid (:block/uuid block)
:block/properties block-properties
:block/refs refs}]
{:outliner-op :save-block}))))))))))))
(defn- fix-cardinality-many-values!
[repo property-uuid]
(let [ev (->> (model/get-block-property-values property-uuid)
@ -261,14 +318,12 @@
_ (when (nil? property)
(upsert-property! repo k-name {:type property-type}
{:property-uuid property-uuid}))
{:keys [type cardinality]} (:block/schema property)
property (db/entity repo [:block/name (gp-util/page-name-sanity-lc k-name)])
{:keys [cardinality]} (:block/schema property)
txs (mapcat
(fn [id]
(when-let [block (db/entity [:block/uuid id])]
(when (and (some? v) (not= cardinality :many))
(let [schema (get builtin-schema-types property-type)
v* (try
(let [v* (try
(convert-property-input-string property-type v)
(catch :default e
(notification/show! (str e) :error false)
@ -308,7 +363,7 @@
[repo block-id key]
(let [k-name (if (uuid? key)
(:block/original-name (db/entity [:block/uuid key]))
(name key))]
(string/lower-case (name key)))]
(if (contains? #{"alias" "tags"} k-name)
(let [attribute (case k-name
"alias"
@ -317,8 +372,8 @@
:block/tags)
block (db/entity [:block/uuid block-id])]
(db/transact! repo
[[:db/retract (:db/id block) attribute]]
{:outliner-op :save-block}))
[[:db/retract (:db/id block) attribute]]
{:outliner-op :save-block}))
(batch-remove-property! repo [block-id] key))))
(defn delete-property-value!

View File

@ -18,7 +18,7 @@
(defn set-block-property!
[repo block-id key v & opts]
(if (config/db-based-graph? repo)
(if (nil? v)
(if (or (nil? v) (and (coll? v) (empty? v)))
(db-property-handler/remove-block-property! repo block-id key)
(db-property-handler/set-block-property! repo block-id key v opts))
(file-property/set-block-property! block-id key v)))