From 174bdc9daec07e06f5efbee4abb44bae91c3026f Mon Sep 17 00:00:00 2001 From: Tienson Qin Date: Tue, 14 Jul 2020 19:17:19 +0800 Subject: [PATCH] Minimal blog --- web/deps.edn | 1 + web/src/main/frontend/components/hiccup.cljs | 272 ++++++++++-------- web/src/main/frontend/components/page.cljs | 18 +- .../frontend/components/right_sidebar.cljs | 2 +- web/src/main/frontend/db.cljs | 84 +++++- web/src/main/frontend/extensions/code.cljs | 8 +- web/src/main/frontend/extensions/latex.cljs | 17 ++ web/src/main/frontend/extensions/slide.cljs | 34 ++- web/src/main/frontend/handler.cljs | 46 ++- web/src/main/frontend/handler/page.cljs | 162 +++++++++++ web/src/main/frontend/tools/html_export.cljs | 58 +++- web/src/main/frontend/ui.cljs | 10 +- 12 files changed, 527 insertions(+), 185 deletions(-) create mode 100644 web/src/main/frontend/handler/page.cljs diff --git a/web/deps.edn b/web/deps.edn index 016741fa3..10a81c007 100755 --- a/web/deps.edn +++ b/web/deps.edn @@ -17,6 +17,7 @@ cljs-drag-n-drop {:mvn/version "0.1.0"} borkdude/sci {:mvn/version "0.0.13-alpha.27"} hickory {:mvn/version "0.7.1"} + hiccups {:mvn/version "0.3.0"} } :aliases {:cljs {:extra-paths ["src/dev-cljs/"] diff --git a/web/src/main/frontend/components/hiccup.cljs b/web/src/main/frontend/components/hiccup.cljs index c297ff136..7d40dcf84 100644 --- a/web/src/main/frontend/components/hiccup.cljs +++ b/web/src/main/frontend/components/hiccup.cljs @@ -170,10 +170,13 @@ (declare block) (defn page-cp - [page] - (let [page (string/lower-case page)] + [{:keys [html-export?] :as config} page] + (let [page (string/lower-case page) + href (if html-export? + (util/encode-str page) + (str "/page/" (util/encode-str page)))] [:a.page-ref - {:href (str "/page/" (util/encode-str page)) + {:href href :on-click (fn [e] (util/stop e) (when (gobj/get e "shiftKey") @@ -198,7 +201,7 @@ (declare headings-container) (defn inline - [config item] + [{:keys [html-export?] :as config} item] (match item ["Plain" s] s @@ -227,10 +230,14 @@ {:__html (:html e)}}] ["Latex_Fragment" ["Displayed" s]] - (latex/latex (str (dc/squuid)) s false true) + (if html-export? + (latex/html-export s false true) + (latex/latex (str (dc/squuid)) s false true)) ["Latex_Fragment" ["Inline" s]] - (latex/latex (str (dc/squuid)) s false false) + (if html-export? + (latex/html-export s false true) + (latex/latex (str (dc/squuid)) s false false)) ["Target" s] [:a {:id s} s] @@ -261,8 +268,9 @@ :heading-ref {:heading heading}) (handler/show-right-sidebar)))} - (->elem :span.block-ref - (map-inline config (:heading/title heading)))] + (->elem + :span.block-ref + (map-inline config (:heading/title heading)))] [:span.text-gray-500 "))"]]))) ["Link" link] @@ -275,7 +283,6 @@ ;; FIXME: same headline, see more https://orgmode.org/manual/Internal-Links.html (= \* (first s)) (->elem :a {:href (str "#" (anchor-link (subs s 1)))} (map-inline config label)) - (re-find #"^https://" s) (->elem :a {:href s} (map-inline config label)) @@ -283,17 +290,16 @@ :else ;; page reference [:span.page-reference - [:span.text-gray-500 "[["] + (when-not html-export? [:span.text-gray-500 "[["]) (if (string/ends-with? s ".excalidraw") [:a.page-ref {:href (str "/draw?file=" (string/replace s (str config/default-draw-directory "/") "")) :on-click (fn [e] (util/stop e))} [:span (svg/excalidraw-logo) - (string/capitalize (draw/get-file-title s))] - ] - (page-cp s)) - [:span.text-gray-500 "]]"]]) + (string/capitalize (draw/get-file-title s))]] + (page-cp config s)) + (when-not html-export? [:span.text-gray-500 "]]"])]) :else (let [href (string-of-url url) @@ -514,7 +520,7 @@ {:bottom bottom}))}])) (declare heading-container) -(rum/defc heading-checkbox +(defn heading-checkbox [heading class] (let [marker (:heading/marker heading) [class checked?] (cond @@ -535,98 +541,105 @@ (handler/uncheck heading) (handler/check heading)))})))) -(rum/defc marker-switch - [heading marker] - (let [set-marker-fn (fn [marker] - (fn [e] - (util/stop e) - (handler/set-marker heading marker)))] - (case marker - "NOW" - [:a.marker-switch - {:title "Change from NOW to LATER" - :on-click (set-marker-fn "LATER")} - [:span "N"]] - "LATER" - [:a.marker-switch - {:title "Change from LATER to NOW" - :on-click (set-marker-fn "NOW")} - "L"] +(defn marker-switch + [{:heading/keys [pre-heading? marker] :as heading}] + (when-not pre-heading? + (when (contains? #{"NOW" "LATER" "TODO" "DOING"} marker) + (let [set-marker-fn (fn [marker] + (fn [e] + (util/stop e) + (handler/set-marker heading marker)))] + (case marker + "NOW" + [:a.marker-switch + {:title "Change from NOW to LATER" + :on-click (set-marker-fn "LATER")} + [:span "N"]] + "LATER" + [:a.marker-switch + {:title "Change from LATER to NOW" + :on-click (set-marker-fn "NOW")} + "L"] - "TODO" - [:a.marker-switch - {:title "Change from TODO to DOING" - :on-click (set-marker-fn "DOING")} - "T"] - "DOING" - [:a.marker-switch - {:title "Change from DOING to TODO" - :on-click (set-marker-fn "TODO")} - "D"] - nil))) + "TODO" + [:a.marker-switch + {:title "Change from TODO to DOING" + :on-click (set-marker-fn "DOING")} + "T"] + "DOING" + [:a.marker-switch + {:title "Change from DOING to TODO" + :on-click (set-marker-fn "TODO")} + "D"] + nil))))) -(rum/defcs priority-cp < - (rum/local false ::hover?) - [state heading priority] - (ui/tooltip - [:ul - (for [p (remove #(= priority %) ["A" "B" "C"])] - [:a.mr-2.text-base.tooltip-priority {:priority p - :on-click (fn [] (handler/set-priority heading p))}])] - [:a.opacity-50.hover:opacity-100 - {:class "priority" - :href (str "/page/" priority) - :style {:margin-right 3.5}} - (util/format "[#%s]" (str priority))])) +(defn marker-cp + [{:heading/keys [pre-heading? marker] :as heading}] + (when-not pre-heading? + (if (contains? #{"IN-PROGRESS" "WAIT" "WAITING"} marker) + [:span {:class (str "task-status " (string/lower-case marker)) + :style {:margin-right 3.5}} + (string/upper-case marker)]))) + +(defn priority-cp + [{:headings/keys [pre-heading? priority] :as heading}] + (when (and (not pre-heading?) priority) + (ui/tooltip + [:ul + (for [p (remove #(= priority %) ["A" "B" "C"])] + [:a.mr-2.text-base.tooltip-priority {:priority p + :on-click (fn [] (handler/set-priority heading p))}])] + [:a.opacity-50.hover:opacity-100 + {:class "priority" + :href (str "/page/" priority) + :style {:margin-right 3.5}} + (util/format "[#%s]" (str priority))]))) + +(defn heading-tags-cp + [{:headings/keys [pre-heading? tags] :as heading}] + (when (and (not pre-heading?) + (seq tags)) + (->elem + :span + {:class "heading-tags"} + (mapv (fn [{:keys [db/id tag/name]}] + (if (util/tag-valid? name) + [:a.tag.mx-1 {:key (str "tag-" id) + :href (str "/page/" name)} + (str "#" name)] + [:span.warning.mx-1 {:title "Invalid tag, tags only accept alphanumeric characters, \"-\", \"_\", \"@\" and \"%\"."} + (str "#" name)])) + tags)))) (defn build-heading-part - [config {:heading/keys [uuid title tags marker level priority anchor meta format content pre-heading?] - :as t}] + [{:keys [slide?] :as config} {:heading/keys [uuid title tags marker level priority anchor meta format content pre-heading?] + :as t}] (let [config (assoc config :heading t) slide? (boolean (:slide? config)) checkbox (when-not pre-heading? (heading-checkbox t (str "mr-1 cursor"))) - marker-switch (when-not pre-heading? - (when (contains? #{"NOW" "LATER" "TODO" "DOING"} marker) - (marker-switch t marker))) - marker-cp (when-not pre-heading? - (if (contains? #{"IN-PROGRESS" "WAIT" "WAITING"} marker) - [:span {:class (str "task-status " (string/lower-case marker)) - :style {:margin-right 3.5}} - (string/upper-case marker)])) - priority (when-not pre-heading? - (if priority - (priority-cp t priority))) - tags (when-not pre-heading? - (when-not (empty? tags) - (->elem - :span - {:class "heading-tags"} - (mapv (fn [{:keys [db/id tag/name]}] - (if (util/tag-valid? name) - [:a.tag.mx-1 {:key (str "tag-" id) - :href (str "/page/" name)} - (str "#" name)] - [:span.warning.mx-1 {:title "Invalid tag, tags only accept alphanumeric characters, \"-\", \"_\", \"@\" and \"%\"."} - (str "#" name)])) - tags))))] + marker-switch (marker-switch t) + marker-cp (marker-cp t) + priority (priority-cp t) + tags (heading-tags-cp t)] (when level (let [element (if (<= level 6) (keyword (str "h" level)) :div)] - (->elem element - (merge - {:id anchor} - (when marker - {:class (string/lower-case marker)})) - (remove-nils - (concat - [(when-not slide? checkbox) - (when-not slide? marker-switch) - marker-cp - priority] - (map-inline config title) - [tags]))))))) + (->elem + element + (merge + {:id anchor} + (when marker + {:class (string/lower-case marker)})) + (remove-nils + (concat + [(when-not slide? checkbox) + (when-not slide? marker-switch) + marker-cp + priority] + (map-inline config title) + [tags]))))))) (defn dnd-same-heading? [uuid] @@ -998,7 +1011,7 @@ (blocks config result)]])) (defn block - [config item] + [{:keys [html-export?] :as config} item] (try (match item ["Paragraph" l] @@ -1018,7 +1031,9 @@ ["Table" t] (table config t) ["Math" s] - (latex/latex (str (dc/squuid)) s true true) + (if html-export? + (latex/html-export s true true) + (latex/latex (str (dc/squuid)) s true true)) ["Example" l] [:pre.pre-wrap-white-space (join-lines l)] @@ -1027,10 +1042,16 @@ attr (if language {:data-lang language}) code (join-lines lines)] - (if (and (= language "clojure") (contains? (set options) ":results")) + (cond + html-export? + (code/html-export attr code) + + (and (= language "clojure") (contains? (set options) ":results")) [:div (code/highlight (str (dc/squuid)) attr code) (sci/eval-result code)] + + :else (code/highlight (str (dc/squuid)) attr code))) ["Quote" l] (->elem @@ -1046,7 +1067,9 @@ (reader/read-string content) ["Export" "latex" options content] - (latex/latex (str (dc/squuid)) content true false) + (if html-export? + (latex/html-export content true false) + (latex/latex (str (dc/squuid)) content true false)) ["Custom" "query" options result content] (custom-query config options content) @@ -1071,13 +1094,16 @@ :div {:class name} (blocks config l)) + ["Latex_Fragment" l] [:p.latex-fragment (inline config ["Latex_Fragment" l])] ["Latex_Environment" name option content] (let [content (latex-environment-content name option content)] - (latex/latex (str (dc/squuid)) content true true)) + (if html-export? + (latex/html-export content true true) + (latex/latex (str (dc/squuid)) content true true))) ["Footnote_Definition" name definition] (let [id (util/url-encode name)] [:div.footdef @@ -1117,26 +1143,30 @@ (:heading/uuid item)))))))) (defn build-slide-sections - [headings config] - (when (seq headings) - (let [headings (map #(dissoc % :heading/children) headings) - first-heading-level (:heading/level (first headings)) - sections (reduce - (fn [acc heading] - (let [heading (dissoc heading :heading/meta) - level (:heading/level heading) - heading-cp (rum/with-key - (heading-container config heading) - (str "slide-" (:heading/uuid heading)))] - (if (= first-heading-level level) - ;; new slide - (conj acc [[heading heading-cp]]) - (update acc (dec (count acc)) - (fn [sections] - (conj sections [heading heading-cp])))))) - [] - headings)] - sections))) + ([headings config] + (build-slide-sections headings config nil)) + ([headings config build-heading-fn] + (when (seq headings) + (let [headings (map #(dissoc % :heading/children) headings) + first-heading-level (:heading/level (first headings)) + sections (reduce + (fn [acc heading] + (let [heading (dissoc heading :heading/meta) + level (:heading/level heading) + heading-cp (if build-heading-fn + (build-heading-fn config heading) + (rum/with-key + (heading-container config heading) + (str "slide-" (:heading/uuid heading))))] + (if (= first-heading-level level) + ;; new slide + (conj acc [[heading heading-cp]]) + (update acc (dec (count acc)) + (fn [sections] + (conj sections [heading heading-cp])))))) + [] + headings)] + sections)))) (rum/defc headings-container < rum/static [headings config] @@ -1157,7 +1187,7 @@ (for [[page headings] headings] (let [page (db/entity (:db/id page))] [:div.my-2 {:key (str "page-" (:db/id page))} - (page-cp (:page/name page)) + (page-cp config (:page/name page)) (headings-container headings config)])) (headings-container headings config))])) diff --git a/web/src/main/frontend/components/page.cljs b/web/src/main/frontend/components/page.cljs index 789a81916..1492bee9b 100644 --- a/web/src/main/frontend/components/page.cljs +++ b/web/src/main/frontend/components/page.cljs @@ -2,6 +2,7 @@ (:require [rum.core :as rum] [frontend.util :as util :refer-macros [profile]] [frontend.handler :as handler] + [frontend.handler.page :as page-handler] [frontend.state :as state] [clojure.string :as string] [frontend.db :as db] @@ -170,10 +171,19 @@ svg/slideshow] (let [links (->> - [(when file - {:title "Re-index the page" + (when file + [{:title "Publish this page on Logseq" :options {:on-click (fn [] - (handler/re-index-file! file))}})] + (page-handler/publish-page! page-name))}} + {:title "Publish this page as a slide on Logseq" + :options {:on-click (fn [] + (page-handler/publish-page-as-slide! page-name))}} + {:title "Un-publish this page on Logseq" + :options {:on-click (fn [] + (page-handler/unpublish-page! page-name))}} + {:title "Re-index this page" + :options {:on-click (fn [] + (handler/re-index-file! file))}}]) (remove nil?))] (when (seq links) (ui/dropdown-with-links @@ -183,7 +193,7 @@ (svg/vertical-dots {:class (util/hiccup->class "opacity-50.hover:opacity-100")})]) links {:modal-class (util/hiccup->class - "origin-top-right.absolute.left-0.mt-2.rounded-md.shadow-lg.whitespace-no-wrap.w-48.dropdown-overflow-auto")})))]]) + "origin-top-right.absolute.right-0.mt-2.rounded-md.shadow-lg.whitespace-no-wrap.w-96.dropdown-overflow-auto")})))]]) (when (and file-path (not sidebar?) (not journal?) (not heading?)) [:div.text-sm.ml-1.mb-2 {:key "page-file"} diff --git a/web/src/main/frontend/components/right_sidebar.cljs b/web/src/main/frontend/components/right_sidebar.cljs index eb35bfeb6..bb076d15f 100644 --- a/web/src/main/frontend/components/right_sidebar.cljs +++ b/web/src/main/frontend/components/right_sidebar.cljs @@ -62,7 +62,7 @@ headings (if journal? (rest headings) headings) - sections (hiccup/build-slide-sections headings {:id "bingo" + sections (hiccup/build-slide-sections headings {:id "slide-reveal-js" :start-level 2 :slide? true :sidebar? true})] diff --git a/web/src/main/frontend/db.cljs b/web/src/main/frontend/db.cljs index 7272ae0b0..7c10fcb53 100644 --- a/web/src/main/frontend/db.cljs +++ b/web/src/main/frontend/db.cljs @@ -863,20 +863,59 @@ (sort-headings) (group-by-page)))) -(defn get-page-headings-old - [repo-url page] - (let [page (string/lower-case page) - page-id (:db/id (entity repo-url [:page/name page]))] - (some-> - (q repo-url [:page/headings page-id] - {:use-cache? false - :transform-fn #(page-headings-transform repo-url %)} - '[:find (pull ?heading [*]) - :in $ ?page-id - :where - [?heading :heading/page ?page-id]] - page-id) - react))) +;; (defn get-page-headings-old +;; [repo-url page] +;; (let [page (string/lower-case page) +;; page-id (:db/id (entity repo-url [:page/name page]))] +;; (some-> +;; (q repo-url [:page/headings page-id] +;; {:use-cache? false +;; :transform-fn #(page-headings-transform repo-url %)} +;; '[:find (pull ?heading [*]) +;; :in $ ?page-id +;; :where +;; [?heading :heading/page ?page-id]] +;; page-id) +;; react))) + +(defn get-page-directives + [page] + (when-let [page (entity [:page/name page])] + (:page/directives page))) + +(defn add-directives! + [page-format directives-content directives] + (let [directives (medley/map-keys name directives) + lines (string/split-lines directives-content) + directive-keys (keys directives) + prefix-f (case page-format + :org (fn [k] + (str "#+" (string/upper-case k) ": ")) + :markdown (fn [k] + (str (string/lower-case k) ": ")) + identity) + exists? (atom #{}) + lines (doall + (mapv (fn [line] + (let [result (filter #(and (string/starts-with? line (prefix-f %)) + %) + directive-keys)] + (if (seq result) + (let [k (first result)] + (swap! exists? conj k) + (str (prefix-f k) (get directives k))) + line))) lines)) + lines (concat + lines + (let [not-exists (remove + (fn [[k _]] + (contains? @exists? k)) + directives)] + (when (seq not-exists) + (mapv + (fn [[k v]] (str (prefix-f k) v)) + not-exists))))] + (string/join "\n" lines))) (defn get-page-headings ([page] @@ -896,6 +935,12 @@ nil) react)))) +(defn get-page-directives-content + [page] + (let [headings (get-page-headings page)] + (and (:heading/pre-heading? (first headings)) + (:heading/content (first headings))))) + (comment @@ -1115,6 +1160,17 @@ (catch js/Error e (js/console.log e)))) +(defn parse-directives + [content format] + (let [ast (mldoc/->edn content + (mldoc/default-config format)) + directives (let [directives (and (seq ast) + (= "Directives" (ffirst ast)) + (last (first ast)))] + (if (and directives (seq directives)) + directives))] + (into {} directives))) + ;; check journal formats and report errors (defn extract-headings-pages [file content utf8-content] diff --git a/web/src/main/frontend/extensions/code.cljs b/web/src/main/frontend/extensions/code.cljs index 02eae3020..bfbac4d83 100644 --- a/web/src/main/frontend/extensions/code.cljs +++ b/web/src/main/frontend/extensions/code.cljs @@ -33,4 +33,10 @@ (let [loading? (rum/react *loading?)] [:pre.pre-wrap-white-space.code [:code (assoc attr :id id) - code]])) + code]])) + +(defn html-export + [attr code] + [:pre + [:code attr + code]]) diff --git a/web/src/main/frontend/extensions/latex.cljs b/web/src/main/frontend/extensions/latex.cljs index 00c074732..ce9f782bd 100644 --- a/web/src/main/frontend/extensions/latex.cljs +++ b/web/src/main/frontend/extensions/latex.cljs @@ -3,6 +3,7 @@ [frontend.loader :as loader] [frontend.components.widgets :as widgets] [frontend.config :as config] + [frontend.util :as util] [goog.dom :as gdom])) ;; TODO: extracted to a rum mixin @@ -42,3 +43,19 @@ [element {:id id :class (if loading? "hidden" "initial")} s]))) + +(defn html-export + [s block? display?] + (let [element (if block? + :div.latex + :span.latex-inline)] + [element (cond + block? + (util/format "$$%s$$" s) + + :display? + (util/format "$$%s$$" s) + + :else + ;; inline + (util/format "$%s$" s))])) diff --git a/web/src/main/frontend/extensions/slide.cljs b/web/src/main/frontend/extensions/slide.cljs index ebbe11fba..1b1366f07 100644 --- a/web/src/main/frontend/extensions/slide.cljs +++ b/web/src/main/frontend/extensions/slide.cljs @@ -35,6 +35,24 @@ :transition "slide"}))] (.initialize deck))) +(defn slide-content + [loading? style sections] + [:div.reveal {:style style} + (when loading? + [:div.ls-center (widgets/loading "")]) + [:div.slides + (for [[idx sections] (medley/indexed sections)] + (if (> (count sections) 1) ; nested + [:section {:key (str "slide-section-" idx)} + (for [[idx2 [heading heading-cp]] (medley/indexed sections)] + [:section (-> {:key (str "slide-section-" idx "-" idx2)} + (with-properties heading)) + heading-cp])] + (let [[heading heading-cp] (first sections)] + [:section (-> {:key (str "slide-section-" idx)} + (with-properties heading)) + heading-cp])))]]) + (rum/defc slide < rum/reactive {:did-mount (fn [state] (if (loaded?) @@ -51,18 +69,4 @@ state)} [sections] (let [loading? (rum/react *loading?)] - [:div.reveal {:style {:height 400}} - (when loading? - [:div.ls-center (widgets/loading "")]) - [:div.slides - (for [[idx sections] (medley/indexed sections)] - (if (> (count sections) 1) ; nested - [:section {:key (str "slide-section-" idx)} - (for [[idx2 [heading heading-cp]] (medley/indexed sections)] - [:section (-> {:key (str "slide-section-" idx "-" idx2)} - (with-properties heading)) - heading-cp])] - (let [[heading heading-cp] (first sections)] - [:section (-> {:key (str "slide-section-" idx)} - (with-properties heading)) - heading-cp])))]])) + (slide-content loading? {:height 400} sections))) diff --git a/web/src/main/frontend/handler.cljs b/web/src/main/frontend/handler.cljs index 596a484e3..8ef40c26a 100644 --- a/web/src/main/frontend/handler.cljs +++ b/web/src/main/frontend/handler.cljs @@ -50,6 +50,18 @@ [key value] (swap! state/state assoc key value)) +(defn show-notification! + [content status] + (swap! state/state assoc + :notification/show? true + :notification/content content + :notification/status status) + (js/setTimeout #(swap! state/state assoc + :notification/show? false + :notification/content nil + :notification/status nil) + 5000)) + (defn get-github-token [] (get-in @state/state [:me :access-token])) @@ -303,17 +315,7 @@ {:db (d/db (db/get-conn repo-url false)) :files-db (d/db (db/get-files-conn repo-url))})))) -(defn show-notification! - [content status] - (swap! state/state assoc - :notification/show? true - :notification/content content - :notification/status status) - (js/setTimeout #(swap! state/state assoc - :notification/show? false - :notification/content nil - :notification/status nil) - 5000)) + (defn pull [repo-url token] @@ -751,7 +753,6 @@ ;; (prn "Get token failed, error: " error) (reset! uploading? false)))))) - (defn clear-store! [] (p/let [ks (.keys db/localforage-instance) @@ -938,10 +939,21 @@ after-headings))) (defn save-heading-if-changed! - [{:heading/keys [uuid content meta file page dummy? format repo pre-heading?] :as heading} value] + [{:heading/keys [uuid content meta file page dummy? format repo pre-heading? content] :as heading} value] (let [repo (or repo (state/get-current-repo)) heading (with-heading-meta repo heading) - format (or format (state/get-preferred-format))] + format (or format (state/get-preferred-format)) + [old-directives new-directives] (when pre-heading? + [(:page/directives (db/entity (:db/id page))) + (db/parse-directives value format)]) + permalink-changed? (when (and pre-heading? (:permalink old-directives)) + (not= (:permalink old-directives) + (:permalink new-directives))) + value (if permalink-changed? + (db/add-directives! format value {:old_permalink (:permalink old-directives)}) + value) + new-directives (if permalink-changed? + (assoc new-directives :old_permalink (:permalink old-directives)))] (when (not= (string/trim content) value) ; heading content changed (let [file (db/entity repo (:db/id file)) page (db/entity repo (:db/id page)) @@ -964,7 +976,9 @@ after-headings (rebuild-after-headings repo file (:end-pos meta) end-pos) modified-time (let [modified-at (tc/to-long (t/now))] [[:db/add (:db/id page) :page/last-modified-at modified-at] - [:db/add (:db/id file) :file/last-modified-at modified-at]])] + [:db/add (:db/id file) :file/last-modified-at modified-at]]) + page-directives (when pre-heading? + [(assoc page :page/directives new-directives)])] (profile "Save heading: " (transact-react-and-alter-file! @@ -972,6 +986,7 @@ (concat pages headings + page-directives after-headings modified-time) {:key :heading/change @@ -1598,6 +1613,7 @@ content (db/get-file path)] (alter-file repo path content {:re-render-root? true})))) + (comment (defn debug-latest-commits [] diff --git a/web/src/main/frontend/handler/page.cljs b/web/src/main/frontend/handler/page.cljs new file mode 100644 index 000000000..15368c7ed --- /dev/null +++ b/web/src/main/frontend/handler/page.cljs @@ -0,0 +1,162 @@ +(ns frontend.handler.page + (:require [clojure.string :as string] + [frontend.db :as db] + [frontend.state :as state] + [frontend.util :as util :refer-macros [profile]] + [frontend.tools.html-export :as html-export] + [frontend.config :as config] + [frontend.handler :as handler] + [clojure.walk :as walk])) + +(defn page-add-directives! + [page-name directives] + (when-let [directives-content (string/trim (db/get-page-directives-content page-name))] + (let [page (db/entity [:page/name page-name]) + file (db/entity (:db/id (:page/file page))) + file-path (:file/path file) + file-content (db/get-file file-path) + after-content (subs file-content (inc (count directives-content))) + page-format (db/get-page-format page-name) + new-directives-content (db/add-directives! page-format directives-content directives) + full-content (str new-directives-content "\n\n" (string/trim after-content))] + (handler/alter-file (state/get-current-repo) + file-path + full-content + {:reset? true + :re-render-root? true})))) + +(defn page-remove-directive! + [page-name k] + (when-let [directives-content (string/trim (db/get-page-directives-content page-name))] + (let [page (db/entity [:page/name page-name]) + file (db/entity (:db/id (:page/file page))) + file-path (:file/path file) + file-content (db/get-file file-path) + after-content (subs file-content (count directives-content)) + page-format (db/get-page-format page-name) + new-directives-content (let [lines (string/split-lines directives-content) + prefix (case page-format + :org (str "#+" (string/upper-case k) ": ") + :markdown (str (string/lower-case k) ": ") + "") + exists? (atom false) + lines (remove #(string/starts-with? % prefix) lines)] + (string/join "\n" lines)) + full-content (str new-directives-content "\n\n" (string/trim after-content))] + (handler/alter-file (state/get-current-repo) + file-path + full-content + {:reset? true + :re-render-root? true})))) + +(defn published-success-handler + [page-name] + (fn [result] + (let [permalink (:permalink result)] + (page-add-directives! page-name {"permalink" permalink}) + (let [win (js/window.open (str + config/website + "/@" + (:name (state/get-me)) + "/" + permalink))] + (.focus win))))) + +(defn published-failed-handler + [error] + (handler/show-notification! + "Publish failed, please give it another try." + :error)) + +(defn get-plugins + [headings] + (let [plugins (atom {}) + add-plugin #(swap! plugins assoc % true)] + (walk/postwalk + (fn [x] + (if (and (vector? x) + (>= (count x) 2)) + (let [[type option] x] + (case type + "Src" (when (:language option) + (add-plugin "highlight")) + "Export" (when (= option "latex") + (add-plugin "latex")) + "Latex_Fragment" (add-plugin "latex") + "Math" (add-plugin "latex") + "Latex_Environment" (add-plugin "latex") + nil) + x) + x)) + (map :heading/body headings)) + @plugins)) + +(defn publish-page-as-slide! + ([page-name] + (publish-page-as-slide! page-name (db/get-page-headings page-name))) + ([page-name headings] + (page-add-directives! page-name {"published" true + "slide" true}) + (let [directives (db/get-page-directives page-name) + plugins (get-plugins headings) + data {:title page-name + :permalink (:permalink directives) + :html (html-export/export-page page-name headings handler/show-notification!) + :tags (:tags directives) + :settings (merge + (assoc directives + :slide true + :published true) + plugins)}] + (util/post (str config/api "pages") + data + (published-success-handler page-name) + published-failed-handler)))) + +(defn publish-page! + [page-name] + (let [directives (db/get-page-directives page-name) + slide? (let [slide (:slide directives)] + (or (true? slide) + (= "true" slide))) + headings (db/get-page-headings page-name) + plugins (get-plugins headings)] + (if slide? + (publish-page-as-slide! page-name headings) + (do + (page-add-directives! page-name {"published" true}) + (let [data {:title page-name + :permalink (:permalink directives) + :html (html-export/export-page page-name headings handler/show-notification!) + :tags (:tags directives) + :settings (merge directives plugins)}] + (util/post (str config/api "pages") + data + (published-success-handler page-name) + published-failed-handler)))))) + +(defn unpublished-success-handler + [page-name] + (fn [result] + (handler/show-notification! + "Un-publish successfully!" + :success))) + +(defn unpublished-failed-handler + [error] + (handler/show-notification! + "Un-publish failed, please give it another try." + :error)) + +(defn unpublish-page! + [page-name] + (page-add-directives! page-name {"published" false}) + (let [directives (db/get-page-directives page-name) + permalink (:permalink directives)] + (if permalink + (util/delete (str config/api "pages/" permalink) + (unpublished-success-handler page-name) + unpublished-failed-handler) + (handler/show-notification! + "Can't find the permalink of this page!" + :error)))) diff --git a/web/src/main/frontend/tools/html_export.cljs b/web/src/main/frontend/tools/html_export.cljs index d79baec20..37bb05ed9 100644 --- a/web/src/main/frontend/tools/html_export.cljs +++ b/web/src/main/frontend/tools/html_export.cljs @@ -1,4 +1,12 @@ -(ns frontend.tools.html-export) +(ns frontend.tools.html-export + (:require-macros [hiccups.core :as hiccups :refer [html]]) + (:require [frontend.db :as db] + [frontend.components.hiccup :as hiccup] + [frontend.extensions.slide :as slide] + [hiccups.runtime :as hiccupsrt] + [clojure.walk :as walk] + [clojure.set :as set] + [medley.core :as medley])) ;; Consider generate a db index so that search can still works @@ -7,12 +15,44 @@ ;; It could be better that we can reuse some parts of this module in a nodejs tool, ;; so users don't have to use the web for exporting to htmls or publishing. -(defn get-export-pages - "Pages should be non-empty and has a directive `public` set to `true`." - [] - ) +(defn- build-heading + [config heading] + (let [body (:heading/body heading) + heading (hiccup/build-heading-part config heading)] + [:div.heading + heading + (when (seq body) + (for [child body] + (do + (hiccup/block config child))))])) -(defn get-index-page - "" - [] - ) +(defn export-page + [page-name headings show-notification!] + (let [{:keys [slide] :as directives} (db/get-page-directives page-name) + slide? slide + headings (if (:heading/pre-heading? (first headings)) + (rest headings) + headings)] + (if (seq headings) + (let [config {:html-export? true :slide? slide?} + hiccup (if slide? + (let [sections (hiccup/build-slide-sections headings + (merge + config + {:id "slide" + :start-level 2}) + build-heading)] + (slide/slide-content false "" sections)) + [:div.page + (for [heading headings] + (build-heading config heading))]) + remove-attrs #{:on-click :on-change} + hiccup (walk/postwalk (fn [f] + (if (and (map? f) + (seq (set/intersection remove-attrs (set (keys f))))) + + (medley/remove-keys remove-attrs f) + f)) + hiccup)] + (html hiccup)) + (show-notification! "The published content can't be empty." :error)))) diff --git a/web/src/main/frontend/ui.cljs b/web/src/main/frontend/ui.cljs index 0a6963876..bc39c348a 100644 --- a/web/src/main/frontend/ui.cljs +++ b/web/src/main/frontend/ui.cljs @@ -66,7 +66,7 @@ (cljs.core/random-uuid))))]) modal-class)) -(rum/defc button +(defn button [text & {:keys [background on-click href] :as option}] (let [class "inline-flex.items-center.px-3.py-2.border.border-transparent.text-sm.leading-4.font-medium.rounded-md.text-white.bg-indigo-600.hover:bg-indigo-700.focus:outline-none.focus:border-indigo-700.focus:shadow-outline-indigo.active:bg-indigo-700.transition.ease-in-out.duration-150.mt-1" @@ -144,12 +144,12 @@ (fn [state] (notification-content state content status))))) -(rum/defc checkbox +(defn checkbox [option] [:input.form-checkbox.h-4.w-4.transition.duration-150.ease-in-out (merge {:type "checkbox"} option)]) -(rum/defc badge +(defn badge [text option] [:span.inline-flex.items-center.px-2.5.py-0.5.rounded-full.text-xs.font-medium.leading-4.bg-purple-100.text-purple-800 option @@ -248,7 +248,7 @@ (def datepicker frontend.ui.date-picker/date-picker) -(rum/defc toggle +(defn toggle [on? on-click] [:a {:on-click on-click} [:span.relative.inline-block.flex-shrink-0.h-6.w-11.border-2.border-transparent.rounded-full.cursor-pointer.transition-colors.ease-in-out.duration-200.focus:outline-none.focus:shadow-outline @@ -258,7 +258,7 @@ {:class (if on? "translate-x-5" "translate-x-0") :aria-hidden "true"}]]]) -(rum/defc tooltip +(defn tooltip [label children] [:div.Tooltip {:style {:display "inline"}} [:div {:class "Tooltip__label"}