(ns nexus.core (:require [clojure.walk :as walk])) (def ^:no-doc conjv (fnil conj [])) (defn action? [data] (and (vector? data) (keyword? (first data)))) (defn actions? [data] (and (sequential? data) (every? action? data))) (defn log-error [nexus ctx error] (when-let [on-error (:nexus/on-error nexus)] (try (on-error (dissoc ctx :stack :queue) error) (catch #?(:clj Exception :cljs :default) _ ;; Well, you had your chance! ))) error) (defn ^{:no-doc true :indent 1} try-f [ctx f & [data]] (try (cond-> ctx (ifn? f) f) (catch #?(:clj Exception :cljs :default) e (update ctx :errors conjv (->> (assoc data :err e :trace (:trace ctx)) (log-error (:nexus ctx) ctx)))))) (defn ^{:indent 1 :no-doc true} run-interceptors [ctx interceptors [before after k]] (letfn [(invoke [f state phase interceptor] (->> (select-keys interceptor [:id]) (into (cond-> {:phase phase} k (assoc k (get ctx k)))) (try-f state f)))] (loop [state (assoc ctx :queue interceptors :stack ())] (cond (:queue state) (let [interceptor (first (:queue state)) state (-> (update state :queue next) (update :stack conj interceptor))] (recur (invoke (get interceptor before) state (or (:phase interceptor) before) interceptor))) (:stack state) (let [interceptor (first (:stack state)) state (update state :stack next)] (recur (invoke (get interceptor after) state after interceptor))) :else state)))) (defn ^:no-doc interpolate-walk [placeholders interpolations dispatch-data x] (if (-> x meta :nexus/skip-interpolation) x (let [x' (if (coll? x) (walk/walk #(interpolate-walk placeholders interpolations dispatch-data %) identity x) x)] (if-let [f (when (vector? x') (get placeholders (first x')))] (let [resolution (apply f dispatch-data (next x'))] (swap! interpolations conj {:placeholder x' :resolution resolution}) resolution) x')))) (defn ^:no-doc interpolate-1 [{:nexus/keys [placeholders]} dispatch-data action] (let [interpolations (atom []) interpolated (interpolate-walk placeholders interpolations dispatch-data action)] (cond-> interpolated (not= interpolated action) (with-meta {:nexus/action action :nexus/interpolations @interpolations})))) (defn interpolate "Walks `actions`, and replaces any forms matching a registered placeholder with the value of calling the corresponding function with `dispatch-data`. Returns interpolated `actions`." {:arglists '[[nexus dispatch-data actions]]} [nexus dispatch-data actions] (mapv #(interpolate-1 nexus dispatch-data %) actions)) (defn expand-actions "Loops over `actions`, and expands each action to a list of actions with available implementations in `nexus`. Passes `state` to each implementation. Returns a map of `{:effects :errors}`." [nexus state actions & [dispatch-data]] (loop [ctx {} actions actions trace []] (if (empty? actions) ctx (let [[kind :as action] (interpolate-1 nexus dispatch-data (first actions)) next-actions (next actions)] (if-let [f (or (get-in nexus [:nexus/expansions kind]) (get-in nexus [:nexus/actions kind]))] (let [[actions err] (try [(apply f state (next action))] (catch #?(:clj Exception :cljs :default) e [nil e]))] (cond err (recur (->> {:action action :phase :expand-action :err err :trace (conj trace action)} (update ctx :errors conj)) next-actions trace) (nil? actions) (recur ctx next-actions trace) (not (actions? actions)) (recur (->> {:errors [{:action action :phase :expand-action :err (ex-info (str kind " should expand to a collection of actions") {:res actions})}]}) next-actions trace) :else (recur ctx (vec (concat actions next-actions)) (conj trace action)))) (recur (update ctx :effects conjv action) next-actions trace)))))) (defn ^:no-doc get-state [nexus ctx] (or (when-let [f (:nexus/system+dispatch-data->state nexus)] (f (:system ctx) (:dispatch-data ctx))) (when-let [f (:nexus/system->state nexus)] (f (:system ctx))))) (defn ^:no-doc reset-ctx-nesting [{:keys [queue stack trace]} ctx] (assoc ctx :queue queue :stack stack :trace trace)) (declare dispatch-actions) (defn ^:no-doc expand-and-dispatch-action [nexus dispatch! ctx action-f action] (try-f ctx (fn [ctx] (let [actions (apply action-f (:state ctx) (next action))] (cond (empty? actions) (assoc ctx :actions []) (not (actions? actions)) (update ctx :errors conjv (->> {:action action :phase :expand-action :trace (:trace ctx) :err (ex-info (str (first action) " should expand to a collection of actions") {:res actions :action action})} (log-error nexus ctx))) :else (->> (assoc ctx :actions actions) (dispatch-actions nexus dispatch!))))) {:action action :phase :expand-action})) (defn ^:no-doc ->execute-ctx [ctx] (update ctx :dispatch (fn [dispatch] (fn [actions & [dispatch-data]] (-> (dispatch actions dispatch-data (dissoc ctx :action :actions :effect :stack :queue)) (select-keys [:results :errors])))))) (defn execute-effect [nexus dispatch! ctx effect-f effect] (-> (assoc ctx :dispatch dispatch! :effect effect) (run-interceptors (conj (:nexus/interceptors nexus) {:phase :execute-effect :before-effect (fn [{:keys [system effect] :as ctx*}] (let [result (apply effect-f (->execute-ctx ctx*) system (next effect))] (-> (assoc ctx* :res result :state (get-state nexus ctx*)) (update :results conjv {:effect effect :res result}))))}) [:before-effect :after-effect :effect]) (dissoc :effect :res))) (defn ^:no-doc dispatch-action [nexus dispatch! ctx action] (run-interceptors (update (assoc ctx :action action) :trace conjv action) (conj (:nexus/interceptors nexus) {:phase :expand-action :before-action (fn [ctx*] (let [[action-k :as action] (interpolate-1 nexus (:dispatch-data ctx*) (:action ctx*))] (or (when-let [action-f (get-in nexus [:nexus/expansions action-k])] (-> (->> (expand-and-dispatch-action nexus dispatch! ctx* action-f action) (reset-ctx-nesting ctx*)) (assoc :action action))) (when-let [effect-f (get-in nexus [:nexus/effects action-k])] (->> (execute-effect nexus dispatch! ctx* effect-f action) (reset-ctx-nesting ctx*))) (update ctx* :errors conjv (->> {:phase :execute-effect :effect-k action-k :err (ex-info (str "No effect handler for " action-k) {:available-effects (keys (:nexus/effects nexus))})} (log-error nexus ctx*))))))}) [:before-action :after-action :action])) (defn dispatch-actions [nexus dispatch! {:keys [queue stack] :as ctx}] (-> (reduce (fn [ctx action] (dispatch-action nexus dispatch! ctx action)) (assoc ctx :state (get-state nexus ctx)) (:actions ctx)) (assoc :queue queue :stack stack))) (defn ^{:indent 3} dispatch [nexus system dispatch-data actions] (let [nexus (-> nexus (update :nexus/expansions #(or % (:nexus/actions nexus))) (update :nexus/interceptors vec)) dispatch! (fn dispatch! [actions & [disp-data parent-ctx]] (let [handler {:phase :action-dispatch :before-dispatch (partial dispatch-actions nexus dispatch!)}] (run-interceptors (assoc parent-ctx :nexus nexus :system system :dispatch-data (merge dispatch-data disp-data) :actions actions) (conj (:nexus/interceptors nexus) handler) [:before-dispatch :after-dispatch])))] (when (:nexus/expansions nexus) (assert (or (ifn? (:nexus/system->state nexus)) (ifn? (:nexus/system+dispatch-data->state nexus))) "Either :nexus/system+dispatch-data->state or :nexus/system->state must be a function")) (dissoc (dispatch! actions) :nexus :system :state :trace :queue :stack :dispatch :dispatch-data :action :actions))) (ns scratch.generated) (def data {:snippets [{:description "Connect a project to an installed language server.", :tags #{:eglot :development :built-in :language-server}, :command "eglot", :title "Let Eglot do the introductions", :author "hkjels", :language "elisp", :id "eglot", :url "https://www.gnu.org/software/emacs/manual/html_mono/eglot.html", :code ";; Emacs 29+, with clangd installed separately.\n(use-package eglot\n :ensure nil\n :hook ((c-mode . eglot-ensure)\n (c++-mode . eglot-ensure)))", :body ["Eglot is built into Emacs 29 and later. You still need to install a language server for your language, such as clangd for C and C++." "Open a source file and run M-x eglot. Emacs offers completion, diagnostics, and navigation using its ordinary editing commands." "Start interactively before adding the use-package declaration. That makes missing executables and project configuration problems easier to understand. The example starts Eglot in C and C++ buffers; adapt the hooks for your language." "Completion, project navigation, Flymake diagnostics, and Eldoc documentation use familiar built-in interfaces rather than a separate dashboard."]} {:description "See documentation for the thing at point.", :tags #{:eglot :development :documentation :built-in}, :tip? true, :command "eldoc-doc-buffer", :title "Documentation where you are", :author "hkjels", :language "elisp", :id "eldoc", :url "https://www.gnu.org/software/emacs/manual/html_node/emacs/Programming-Language-Doc.html", :code "(use-package eldoc\n :ensure nil\n :init (global-eldoc-mode 1))", :body ["Eldoc shows contextual documentation in the echo area when the current mode provides it. Global Eldoc mode enables it in supported buffers, including Emacs Lisp." "When the echo area is too small, run M-x eldoc-doc-buffer to open a dedicated documentation buffer. This command is available in Emacs 28 and later." "Eglot supplies Eldoc information for its managed buffers. Enabling Eldoc alone does not install a language server or invent documentation for modes without a provider."]} {:description "See buffer diagnostics without leaving Emacs.", :tags #{:diagnostics :eglot :development :built-in}, :tip? true, :command "flymake-show-buffer-diagnostics", :title "Catch the small mistakes early", :author "hkjels", :language "elisp", :id "flymake", :url "https://www.gnu.org/software/emacs/manual/html_mono/flymake.html", :code "(use-package flymake\n :ensure nil\n :hook (emacs-lisp-mode . flymake-mode))", :body ["Flymake displays diagnostics supplied by the current mode or another backend. The example enables the built-in Emacs Lisp backend; it does not assume that a checker is available for every programming language." "Run M-x flymake-show-buffer-diagnostics for a list, or use flymake-goto-next-error and flymake-goto-prev-error to move between findings." "Eglot already enables Flymake in buffers it manages. You do not need a second hook for those buffers, and other languages may need an appropriate backend or external checker."]} {:description "Read minibuffer candidates in a vertical list.", :tags #{:built-in :minibuffer :completion}, :tip? true, :command "icomplete-vertical-mode", :title "Give completion a little room", :author "hkjels", :language "elisp", :id "icomplete-vertical", :url "https://www.gnu.org/software/emacs/manual/html_node/emacs/Icomplete.html", :code "(use-package icomplete\n :ensure nil\n :config\n (icomplete-mode 1)\n (icomplete-vertical-mode 1))", :body ["Icomplete is a built-in minibuffer completion interface. Its vertical mode, available in Emacs 28 and later, puts candidates on separate lines instead of squeezing them into the prompt." "Try M-x after enabling these modes. The vertical list is also one of the inspirations for this site's command interface." "Use one completion display at a time. If you already use Vertico or another minibuffer completion frontend, disable it before trying Icomplete."]} {:description "Reopen a file at the position you last visited.", :tags #{:built-in :files}, :tip? true, :command "save-place-mode", :title "Pick up where you left off", :author "hkjels", :language "elisp", :id "keep-your-place", :url "https://www.gnu.org/software/emacs/manual/html_node/emacs/Saving-Emacs-Sessions.html", :code "(use-package saveplace\n :ensure nil\n :init (save-place-mode 1))", :body ["Emacs can remember your position in files between sessions. Add this use-package declaration to your init file, or try M-x save-place-mode." "It is a small convenience that becomes especially useful when you move between long notes, source files, and documentation."]} {:description "Understand a change before you commit it.", :tags #{:version-control :git}, :command "magit-status", :title "Magit", :author "hkjels", :language "elisp", :id "magit", :url "https://magit.vc/", :code "(use-package magit\n :ensure t\n :bind (\"C-x g\" . magit-status))", :body ["Magit is a text-first interface to Git. Its status buffer brings the working tree, staged changes, and recent history together." "Start with M-x magit-status. Stage a hunk rather than a whole file, review the diff, and make a small, purposeful commit." "Magit is an optional package, not part of Emacs itself. Configure a package archive you trust before using :ensure t; the declaration installs it if needed and binds C-x g to its status buffer."]} {:description "Repeat related commands without repeating the whole key sequence.", :tags #{:navigation :built-in}, :tip? true, :command "repeat-mode", :title "Give a command an encore", :author "hkjels", :language "elisp", :id "repeat-mode", :url "https://www.gnu.org/software/emacs/manual/html_node/emacs/Repeating.html", :code "(use-package repeat\n :ensure nil\n :init (repeat-mode 1))", :body ["Enable repeat-mode in Emacs 28 or later. Commands that provide a repeat map let you keep going with a single key." "Try C-x o to move to another window, then press o again. The echo area tells you which repeat keys are available. C-g leaves the repeat map."]} {:description "Keep minibuffer history between Emacs sessions.", :tags #{:history :built-in :minibuffer}, :tip? true, :command "savehist-mode", :title "Keep the minibuffer's memory", :author "hkjels", :language "elisp", :id "savehist", :url "https://www.gnu.org/software/emacs/manual/html_node/emacs/Saving-Emacs-Sessions.html", :code "(use-package savehist\n :ensure nil\n :init (savehist-mode 1))", :body ["Savehist remembers minibuffer histories across sessions. Commands, search terms, and other entries are easier to recall with M-p instead of typing them again." "The library is named savehist, not save-hist. It is built in, so no package installation is needed." "History is written locally to savehist-file. Treat that file as personal data: do not commit it or add sensitive histories such as credentials."]} {:description "Pause after a prefix key to see what you can press next.", :tags #{:discovery :which-key :built-in :keybindings}, :tip? true, :command "which-key-mode", :title "Let the next key come to you", :author "hkjels", :language "elisp", :id "which-key", :url "https://www.gnu.org/software/emacs/manual/html_node/emacs/Help.html", :code ";; Built into Emacs 30 and later.\n(use-package which-key\n :ensure nil\n :config (which-key-mode 1))", :body ["Which-key shows the available continuations when you pause after a prefix such as C-x or C-c. It makes unfamiliar bindings easier to discover without memorizing a wall of keys." "This example uses the version built into Emacs 30 and later. On an earlier Emacs, install which-key from a trusted package archive and change :ensure nil to :ensure t." "Try C-x and wait for the suggestions. C-g cancels the prefix; nothing is executed just by reading the list."]}], :constellation {:names ["tramp" "org" "magit" "dired" "eglot" "eshell" "consult" "vertico" "corfu" "embark" "calc" "avy" "orderless" "cape" "marginalia" "vterm" "info" "flymake" "abbrev" "ace-window" "aggressive-indent" "align" "ansi-color" "auctex" "auth-source" "auto-insert" "autorevert" "bbdb" "beacon" "bookmark" "browse-url" "calendar" "cider" "clojure-mode" "compile" "context-menu" "csv-mode" "cus-edit" "dabbrev" "dashboard" "denote" "desktop" "diff-hl" "diff-mode" "diminish" "dired-x" "direnv" "doom-modeline" "eat" "ediff" "edit-indirect" "editorconfig" "eldoc" "elfeed" "elisp-mode" "emms" "emmet-mode" "erc" "ert" "esh-mode" "eww" "expand-region" "fido-mode" "filecache" "find-dired" "flycheck" "foldout" "forge" "git-gutter" "git-link" "gnus" "grep" "gud" "help-mode" "helpful" "hippie-exp" "hideshow" "ibuffer" "icomplete" "ielm" "imenu" "ispell" "ivy" "json-mode" "ledger-mode" "log-edit" "lsp-mode" "lua-mode" "markdown-mode" "meow" "message" "multiple-cursors" "mwheel" "nov" "olivetti" "org-roam" "package" "paredit" "pdf-tools" "plantuml-mode" "project" "projectile" "transient" "rainbow-delimiters" "recentf" "repeat" "rg" "org-modern" "savehist" "saveplace" "shell" "hydra" "smartparens" "so-long" "subword" "tab-bar" "tempel" "term" "treesit" "undo-tree" "use-package" "vc" "visual-fill-column" "vundo" "web-mode" "which-key" "winner" "xref" "yaml-mode"]}, :site {:name "*scratch-buffer*", :repository "https://github.com/dnv-opensource/scratch-buffer", :teams-url "https://teams.microsoft.com/l/channel/19%3A7dq6Hv8b2Fr8JYVYSFY50MJU1p6_FD6SbLmnxyb-DYA1%40thread.tacv2/scratch-buffer?groupId=296cfa2f-d8b2-444d-b54d-93af378b33d7&tenantId=adf10e2b-b6e9-41d6-be2f-c12bb566019c", :description "A community for people who use Emacs, used to use Emacs, or are curious about it.", :status "An independent community initiative. Not an official DNV publication."}, :talks [], :today "2026-10-06", :search [{:path "/", :title "DNV Emacs User Group", :description "For people who use Emacs, used to use Emacs, or are curious about it.", :type "page", :text "dnv emacs user group for people who use emacs, used to use emacs, or are curious about it. a shared space for a very personal editor dnv emacs user group for people who use emacs, used to use emacs, or are curious about it. bring a question. share a small discovery. make yourself at home. by henrik kjerringvåg meet the group how to join find a command next up the next gathering starts with an idea. no meetings are scheduled yet. a short demo, a problem to solve, or a question is enough. suggest a meeting topic on github worth sharing let eglot do the introductions connect a project to an installed language server. by henrik kjerringvåg built-in / development / eglot / language-server documentation where you are see documentation for the thing at point. by henrik kjerringvåg built-in / development / documentation / eglot talks & material from the group small contributions make this place useful. published notes live in the repository. chat in teams, or continue a longer conversation in github discussions. no live activity feed is loaded. published content is included in this site build. open teams chat open discussions browse the repository 2 members, and room for you one small contribution. you’re in. an emacs tip. a typo fix. a useful question turned into a note. participation matters more than polish. join the user group hkjels bring a question. share a small discovery. make yourself at home."} {:path "/about/", :title "About the group", :description "An open door, not another tool to learn.", :type "page", :text "about the group an open door, not another tool to learn. people before configuration about the group an open door, not another tool to learn. by henrik kjerringvåg this is a place for people who use emacs, used to use emacs, or are curious about it. bring a question, a small discovery, or a configuration that finally makes sense. short demos, practical notes, and conversation are more useful than perfect presentations. beginners are welcome. you do not need a particular language, operating system, or level of experience. this website borrows a few ideas from emacs. a page is a buffer. the bottom bar is a mode-line. m-x is a quick way to find an action. you can also just use the links. github holds our published knowledge and membership records. pull requests make changes; discussions are for conversation. there is no separate account or private database here. a website, not an editor the fixed bottom bar tells you which page you are reading. select the buffer name to switch pages, or open m-x to find any action. nothing here requires emacs knowledge. see the keyboard and pointer guide . join with a small contribution . between gatherings the scratch-buffer teams chat is a place for quick questions and conversation. open teams chat public by design this site has no analytics, corporate directory integration, or custom login. member records are explicit and minimal. never publish confidential notes or credentials. an independent community initiative. not an official dnv publication. hkjels this is a place for people who use emacs, used to use emacs, or are curious about it. bring a question, a small discovery, or a configuration that finally makes sense. short demos, practical notes, and conversation are more useful than perfect presentations. beginners are welcome. you do not need a particular language, operating system, or level of experience. this website borrows a few ideas from emacs. a page is a buffer. the bottom bar is a mode-line. m-x is a quick way to find an action. you can also just use the links. github holds our published knowledge and membership records. pull requests make changes; discussions are for conversation. there is no separate account or private database here."} {:path "/meetings/", :title "Meetings", :description "Meetings", :type "page", :text "meetings meetings published knowledge meetings gatherings, short demos, and material worth returning to. no meetings are currently scheduled. suggest a short demo, a question, or something you would like to learn together. propose a meeting on github nothing published here yet. your first small contribution could change that. contribute something useful talks & material no talks have been published yet. a five-minute demo is enough to start. propose a talk on github "} {:path "/people/", :title "People", :description "People", :type "page", :text "people people a directory, not a contributor graph people 2 members. every record is a small act of participation. henrik kjerringvåg @hkjels emacs since 2018 built-in / clojure / embedded / fp / org-mode johan w. klüwer @johanwk emacs since 1993 ontology / org-mode / rdf / semantic-web / web-of-things join the group add a member entry and one small useful contribution: a tip, a package configuration, or a typo fix. open a pull request; once merged, you are a member. save this as members/your-github-handle.edn, replacing the placeholder with your own handle. {:github \"your-github-handle\"\n :joined \"2026-10\"} only your github handle and joining month are required. other profile fields are optional. everything published here is public. member record guide contribution guide "} {:path "/snippets/", :title "Snippets & tips", :description "Snippets & tips", :type "page", :text "snippets & tips snippets & tips published knowledge snippets & tips configurations, package recommendations, and small things worth trying. these configurations use use-package, built into emacs 29 and later; install it separately on older versions. :ensure nil uses a built-in package. :ensure t installs an external package from your configured archives, so choose archives you trust. let eglot do the introductions connect a project to an installed language server. by henrik kjerringvåg built-in / development / eglot / language-server documentation where you are see documentation for the thing at point. by henrik kjerringvåg built-in / development / documentation / eglot catch the small mistakes early see buffer diagnostics without leaving emacs. by henrik kjerringvåg built-in / development / diagnostics / eglot give completion a little room read minibuffer candidates in a vertical list. by henrik kjerringvåg built-in / completion / minibuffer pick up where you left off reopen a file at the position you last visited. by henrik kjerringvåg built-in / files magit understand a change before you commit it. by henrik kjerringvåg git / version-control give a command an encore repeat related commands without repeating the whole key sequence. by henrik kjerringvåg built-in / navigation keep the minibuffer's memory keep minibuffer history between emacs sessions. by henrik kjerringvåg built-in / history / minibuffer let the next key come to you pause after a prefix key to see what you can press next. by henrik kjerringvåg built-in / discovery / keybindings / which-key contribute something useful "} {:path "/help/", :title "A little help", :description "A little help", :type "page", :text "a little help a little help no emacs experience required a little help use the links. or take a shortcut. m-x is the command menu above the bottom bar. type a few letters, choose a result, and go. the page stays visible underneath. tap m-x again to close the menu without running a command. escape or ctrl + g does the same from the keyboard. alt + x open commands (m-x) ctrl + x, then b switch buffers ctrl + s search this site (outside editable fields) ↑ / ↓ select a completion enter run the selected command escape / ctrl + g close commands and return focus alt + p / alt + n previous / next command history tab / shift + tab move between controls on macos, use option for alt if your keyboard makes the shortcut available. browser and operating-system shortcuts can take priority; the m-x button always works. open commands search choose a theme install this site all pages dnv emacs user group about the group meetings people snippets & tips appearance light, dark, or your device’s theme. your explicit choice stays in this browser. system mode follows your device automatically. to pause or resume the home illustration, open m-x and choose toggle-animation. reduced-motion preferences always keep it still. offline & installation after the offline cache is ready, published pages and saved discussion snapshots can be read without a connection. posting and contribution links still need github. use install in the command menu where supported. otherwise, use your browser’s install menu, or share → add to home screen on iphone and ipad. "} {:path "/search/", :title "Search the site", :description "Search the site", :type "page", :text "search the site search the site across every published buffer search the site a command, an idea, a person. open site search interactive search needs javascript. you can browse all indexed content below, or use your browser’s find command. "} {:path "/snippets/eglot/", :title "Let Eglot do the introductions", :description "Connect a project to an installed language server.", :type "snippet", :text "let eglot do the introductions connect a project to an installed language server. snippet let eglot do the introductions connect a project to an installed language server. by henrik kjerringvåg built-in / development / eglot / language-server eglot is built into emacs 29 and later. you still need to install a language server for your language, such as clangd for c and c++. open a source file and run m-x eglot. emacs offers completion, diagnostics, and navigation using its ordinary editing commands. start interactively before adding the use-package declaration. that makes missing executables and project configuration problems easier to understand. the example starts eglot in c and c++ buffers; adapt the hooks for your language. completion, project navigation, flymake diagnostics, and eldoc documentation use familiar built-in interfaces rather than a separate dashboard. ;; emacs 29+, with clangd installed separately.\n(use-package eglot\n :ensure nil\n :hook ((c-mode . eglot-ensure)\n (c++-mode . eglot-ensure))) read the documentation hkjels eglot ;; emacs 29+, with clangd installed separately.\n(use-package eglot\n :ensure nil\n :hook ((c-mode . eglot-ensure)\n (c++-mode . eglot-ensure))) eglot is built into emacs 29 and later. you still need to install a language server for your language, such as clangd for c and c++. open a source file and run m-x eglot. emacs offers completion, diagnostics, and navigation using its ordinary editing commands. start interactively before adding the use-package declaration. that makes missing executables and project configuration problems easier to understand. the example starts eglot in c and c++ buffers; adapt the hooks for your language. completion, project navigation, flymake diagnostics, and eldoc documentation use familiar built-in interfaces rather than a separate dashboard. eglot development built-in language-server"} {:path "/snippets/eldoc/", :title "Documentation where you are", :description "See documentation for the thing at point.", :type "snippet", :text "documentation where you are see documentation for the thing at point. snippet documentation where you are see documentation for the thing at point. by henrik kjerringvåg built-in / development / documentation / eglot eldoc shows contextual documentation in the echo area when the current mode provides it. global eldoc mode enables it in supported buffers, including emacs lisp. when the echo area is too small, run m-x eldoc-doc-buffer to open a dedicated documentation buffer. this command is available in emacs 28 and later. eglot supplies eldoc information for its managed buffers. enabling eldoc alone does not install a language server or invent documentation for modes without a provider. (use-package eldoc\n :ensure nil\n :init (global-eldoc-mode 1)) read the documentation hkjels eldoc-doc-buffer (use-package eldoc\n :ensure nil\n :init (global-eldoc-mode 1)) eldoc shows contextual documentation in the echo area when the current mode provides it. global eldoc mode enables it in supported buffers, including emacs lisp. when the echo area is too small, run m-x eldoc-doc-buffer to open a dedicated documentation buffer. this command is available in emacs 28 and later. eglot supplies eldoc information for its managed buffers. enabling eldoc alone does not install a language server or invent documentation for modes without a provider. eglot development documentation built-in"} {:path "/snippets/flymake/", :title "Catch the small mistakes early", :description "See buffer diagnostics without leaving Emacs.", :type "snippet", :text "catch the small mistakes early see buffer diagnostics without leaving emacs. snippet catch the small mistakes early see buffer diagnostics without leaving emacs. by henrik kjerringvåg built-in / development / diagnostics / eglot flymake displays diagnostics supplied by the current mode or another backend. the example enables the built-in emacs lisp backend; it does not assume that a checker is available for every programming language. run m-x flymake-show-buffer-diagnostics for a list, or use flymake-goto-next-error and flymake-goto-prev-error to move between findings. eglot already enables flymake in buffers it manages. you do not need a second hook for those buffers, and other languages may need an appropriate backend or external checker. (use-package flymake\n :ensure nil\n :hook (emacs-lisp-mode . flymake-mode)) read the documentation hkjels flymake-show-buffer-diagnostics (use-package flymake\n :ensure nil\n :hook (emacs-lisp-mode . flymake-mode)) flymake displays diagnostics supplied by the current mode or another backend. the example enables the built-in emacs lisp backend; it does not assume that a checker is available for every programming language. run m-x flymake-show-buffer-diagnostics for a list, or use flymake-goto-next-error and flymake-goto-prev-error to move between findings. eglot already enables flymake in buffers it manages. you do not need a second hook for those buffers, and other languages may need an appropriate backend or external checker. diagnostics eglot development built-in"} {:path "/snippets/icomplete-vertical/", :title "Give completion a little room", :description "Read minibuffer candidates in a vertical list.", :type "snippet", :text "give completion a little room read minibuffer candidates in a vertical list. snippet give completion a little room read minibuffer candidates in a vertical list. by henrik kjerringvåg built-in / completion / minibuffer icomplete is a built-in minibuffer completion interface. its vertical mode, available in emacs 28 and later, puts candidates on separate lines instead of squeezing them into the prompt. try m-x after enabling these modes. the vertical list is also one of the inspirations for this site's command interface. use one completion display at a time. if you already use vertico or another minibuffer completion frontend, disable it before trying icomplete. (use-package icomplete\n :ensure nil\n :config\n (icomplete-mode 1)\n (icomplete-vertical-mode 1)) read the documentation hkjels icomplete-vertical-mode (use-package icomplete\n :ensure nil\n :config\n (icomplete-mode 1)\n (icomplete-vertical-mode 1)) icomplete is a built-in minibuffer completion interface. its vertical mode, available in emacs 28 and later, puts candidates on separate lines instead of squeezing them into the prompt. try m-x after enabling these modes. the vertical list is also one of the inspirations for this site's command interface. use one completion display at a time. if you already use vertico or another minibuffer completion frontend, disable it before trying icomplete. built-in minibuffer completion"} {:path "/snippets/keep-your-place/", :title "Pick up where you left off", :description "Reopen a file at the position you last visited.", :type "snippet", :text "pick up where you left off reopen a file at the position you last visited. snippet pick up where you left off reopen a file at the position you last visited. by henrik kjerringvåg built-in / files emacs can remember your position in files between sessions. add this use-package declaration to your init file, or try m-x save-place-mode. it is a small convenience that becomes especially useful when you move between long notes, source files, and documentation. (use-package saveplace\n :ensure nil\n :init (save-place-mode 1)) read the documentation hkjels save-place-mode (use-package saveplace\n :ensure nil\n :init (save-place-mode 1)) emacs can remember your position in files between sessions. add this use-package declaration to your init file, or try m-x save-place-mode. it is a small convenience that becomes especially useful when you move between long notes, source files, and documentation. built-in files"} {:path "/snippets/magit/", :title "Magit", :description "Understand a change before you commit it.", :type "snippet", :text "magit understand a change before you commit it. snippet magit understand a change before you commit it. by henrik kjerringvåg git / version-control magit is a text-first interface to git. its status buffer brings the working tree, staged changes, and recent history together. start with m-x magit-status. stage a hunk rather than a whole file, review the diff, and make a small, purposeful commit. magit is an optional package, not part of emacs itself. configure a package archive you trust before using :ensure t; the declaration installs it if needed and binds c-x g to its status buffer. (use-package magit\n :ensure t\n :bind (\"c-x g\" . magit-status)) read the documentation hkjels magit-status (use-package magit\n :ensure t\n :bind (\"c-x g\" . magit-status)) magit is a text-first interface to git. its status buffer brings the working tree, staged changes, and recent history together. start with m-x magit-status. stage a hunk rather than a whole file, review the diff, and make a small, purposeful commit. magit is an optional package, not part of emacs itself. configure a package archive you trust before using :ensure t; the declaration installs it if needed and binds c-x g to its status buffer. version-control git"} {:path "/snippets/repeat-mode/", :title "Give a command an encore", :description "Repeat related commands without repeating the whole key sequence.", :type "snippet", :text "give a command an encore repeat related commands without repeating the whole key sequence. snippet give a command an encore repeat related commands without repeating the whole key sequence. by henrik kjerringvåg built-in / navigation enable repeat-mode in emacs 28 or later. commands that provide a repeat map let you keep going with a single key. try c-x o to move to another window, then press o again. the echo area tells you which repeat keys are available. c-g leaves the repeat map. (use-package repeat\n :ensure nil\n :init (repeat-mode 1)) read the documentation hkjels repeat-mode (use-package repeat\n :ensure nil\n :init (repeat-mode 1)) enable repeat-mode in emacs 28 or later. commands that provide a repeat map let you keep going with a single key. try c-x o to move to another window, then press o again. the echo area tells you which repeat keys are available. c-g leaves the repeat map. navigation built-in"} {:path "/snippets/savehist/", :title "Keep the minibuffer's memory", :description "Keep minibuffer history between Emacs sessions.", :type "snippet", :text "keep the minibuffer's memory keep minibuffer history between emacs sessions. snippet keep the minibuffer's memory keep minibuffer history between emacs sessions. by henrik kjerringvåg built-in / history / minibuffer savehist remembers minibuffer histories across sessions. commands, search terms, and other entries are easier to recall with m-p instead of typing them again. the library is named savehist, not save-hist. it is built in, so no package installation is needed. history is written locally to savehist-file. treat that file as personal data: do not commit it or add sensitive histories such as credentials. (use-package savehist\n :ensure nil\n :init (savehist-mode 1)) read the documentation hkjels savehist-mode (use-package savehist\n :ensure nil\n :init (savehist-mode 1)) savehist remembers minibuffer histories across sessions. commands, search terms, and other entries are easier to recall with m-p instead of typing them again. the library is named savehist, not save-hist. it is built in, so no package installation is needed. history is written locally to savehist-file. treat that file as personal data: do not commit it or add sensitive histories such as credentials. history built-in minibuffer"} {:path "/snippets/which-key/", :title "Let the next key come to you", :description "Pause after a prefix key to see what you can press next.", :type "snippet", :text "let the next key come to you pause after a prefix key to see what you can press next. snippet let the next key come to you pause after a prefix key to see what you can press next. by henrik kjerringvåg built-in / discovery / keybindings / which-key which-key shows the available continuations when you pause after a prefix such as c-x or c-c. it makes unfamiliar bindings easier to discover without memorizing a wall of keys. this example uses the version built into emacs 30 and later. on an earlier emacs, install which-key from a trusted package archive and change :ensure nil to :ensure t. try c-x and wait for the suggestions. c-g cancels the prefix; nothing is executed just by reading the list. ;; built into emacs 30 and later.\n(use-package which-key\n :ensure nil\n :config (which-key-mode 1)) read the documentation hkjels which-key-mode ;; built into emacs 30 and later.\n(use-package which-key\n :ensure nil\n :config (which-key-mode 1)) which-key shows the available continuations when you pause after a prefix such as c-x or c-c. it makes unfamiliar bindings easier to discover without memorizing a wall of keys. this example uses the version built into emacs 30 and later. on an earlier emacs, install which-key from a trusted package archive and change :ensure nil to :ensure t. try c-x and wait for the suggestions. c-g cancels the prefix; nothing is executed just by reading the list. discovery which-key built-in keybindings"} {:path "/people/hkjels/", :title "Henrik Kjerringvåg", :description "Henrik Kjerringvåg", :type "person", :text "henrik kjerringvåg henrik kjerringvåg member record henrik kjerringvåg @hkjels joined 2026-10 emacs since 2018 interests built-in / clojure / embedded / fp / org-mode public github profile snippets let eglot do the introductions connect a project to an installed language server. by henrik kjerringvåg built-in / development / eglot / language-server documentation where you are see documentation for the thing at point. by henrik kjerringvåg built-in / development / documentation / eglot catch the small mistakes early see buffer diagnostics without leaving emacs. by henrik kjerringvåg built-in / development / diagnostics / eglot give completion a little room read minibuffer candidates in a vertical list. by henrik kjerringvåg built-in / completion / minibuffer pick up where you left off reopen a file at the position you last visited. by henrik kjerringvåg built-in / files magit understand a change before you commit it. by henrik kjerringvåg git / version-control give a command an encore repeat related commands without repeating the whole key sequence. by henrik kjerringvåg built-in / navigation keep the minibuffer's memory keep minibuffer history between emacs sessions. by henrik kjerringvåg built-in / history / minibuffer let the next key come to you pause after a prefix key to see what you can press next. by henrik kjerringvåg built-in / discovery / keybindings / which-key back to people hkjels org-mode clojure built-in embedded fp"} {:path "/people/johanwk/", :title "Johan W. Klüwer", :description "Johan W. Klüwer", :type "person", :text "johan w. klüwer johan w. klüwer member record johan w. klüwer @johanwk joined 2026-10 emacs since 1993 interests ontology / org-mode / rdf / semantic-web / web-of-things public github profile back to people johanwk ontology org-mode web-of-things semantic-web rdf"}], :pages [{:id "about", :author "hkjels", :title "About the group", :description "An open door, not another tool to learn.", :body ["This is a place for people who use Emacs, used to use Emacs, or are curious about it. Bring a question, a small discovery, or a configuration that finally makes sense." "Short demos, practical notes, and conversation are more useful than perfect presentations. Beginners are welcome. You do not need a particular language, operating system, or level of experience." "This website borrows a few ideas from Emacs. A page is a buffer. The bottom bar is a mode-line. M-x is a quick way to find an action. You can also just use the links." "GitHub holds our published knowledge and membership records. Pull requests make changes; Discussions are for conversation. There is no separate account or private database here."]} {:id "scratch", :author "hkjels", :title "DNV Emacs User Group", :description "For people who use Emacs, used to use Emacs, or are curious about it.", :body ["Bring a question. Share a small discovery. Make yourself at home."]}], :meetings [], :members [{:github "hkjels", :full-name "Henrik Kjerringvåg", :joined "2026-10", :emacs-since "2018", :interests #{:org-mode :clojure :built-in :embedded :fp}} {:github "johanwk", :full-name "Johan W. Klüwer", :joined "2026-10", :emacs-since "1993", :interests #{:ontology :org-mode :web-of-things :semantic-web :rdf}}]}) (ns scratch.router (:require [clojure.string :as str])) (def pages [{:id :scratch :path "/" :buffer "*scratch-buffer*" :title "DNV Emacs User Group"} {:id :about :path "/about/" :buffer "*about*" :title "About the group"} {:id :meetings :path "/meetings/" :buffer "*meetings*" :title "Meetings"} {:id :people :path "/people/" :buffer "*people*" :title "People"} {:id :snippets :path "/snippets/" :buffer "*snippets*" :title "Snippets & tips"} {:id :help :path "/help/" :buffer "*help*" :title "A little help"} {:id :search :path "/search/" :buffer "*search*" :title "Search the site"} {:id :messages :path "/messages/" :buffer "*Messages*" :title "Messages"}]) (def collections [[:meetings :meeting "/meetings/"] [:talks :talk "/meetings/talks/"] [:snippets :snippet "/snippets/"]]) (def redirects {"/join/" "/people/#join" "/packages/" "/snippets/" "/packages/eglot/" "/snippets/eglot/" "/packages/magit/" "/snippets/magit/" "/talks/" "/meetings/#talks"}) (defn normalize-base [base] (let [s (str/replace (or base "/") #"^/+|/+$" "")] (if (str/blank? s) "/" (str "/" s "/")))) (defn url [base path] (str (normalize-base base) (str/replace path #"^/" ""))) (defn normalize-path [path] (let [p (-> (or path "/") (str/split #"[?#]" 2) first (str/replace #"/index\.html$" "/"))] (if (= p "/") "/" (str (str/replace p #"/+$" "") "/")))) (defn local-path [base pathname] (let [base (normalize-base base) root (str/replace base #"/$" "")] (cond (= pathname root) "/" (str/starts-with? pathname base) (normalize-path (str "/" (subs pathname (count base)))) :else nil))) (defn destination [path] (let [[pathname fragment] (str/split (or path "/") #"#" 2) path (normalize-path pathname)] (or (get redirects path) (str path (when (seq fragment) (str "#" fragment)))))) (defn member-name [member] (or (:full-name member) (:github member))) (defn routes [data] (vec (concat pages (for [[collection kind prefix] collections record (get data collection)] {:id kind :kind kind :record-id (:id record) :path (str prefix (:id record) "/") :buffer (str "*" (name kind) "/" (:id record) "*") :title (:title record)}) (for [member (:members data)] {:id :person :kind :person :record-id (:github member) :path (str "/people/" (:github member) "/") :buffer (str "*person/" (:github member) "*") :title (member-name member)})))) (defn resolve-route [data path] (let [path (normalize-path (destination path))] (or (some #(when (= path (:path %)) %) (routes data)) {:id :not-found :path path :buffer "*Messages*" :title "Buffer not found"}))) (defn record [data route] (if (= :person (:kind route)) (some #(when (= (:github %) (:record-id route)) %) (:members data)) (some #(when (= (:id %) (:record-id route)) %) (get data (keyword (str (name (or (:kind route) :none)) "s")))))) (ns scratch.theme) (defn resolved [state] (let [{:keys [mode system-dark?]} (:theme state)] (if (= mode :system) (if system-dark? :dark :light) mode))) (ns scratch.meetings) (defn calendar? [meeting] (and (= :scheduled (:status meeting)) (not (:example? meeting)))) (defn calendar-path [meeting] (str "/meetings/" (:id meeting) "/event.ics")) (defn epoch [instant] #?(:clj (.toEpochMilli (java.time.Instant/parse instant)) :cljs (js/Date.parse instant))) (defn next-meeting [data] (let [now (epoch (or (:now data) (str (:today data) "T00:00:00Z")))] (first (sort-by :start-utc (filter #(and (calendar? %) (> (epoch (:end-utc %)) now)) (:meetings data)))))) (ns scratch.reading (:require [clojure.set :as set] [scratch.router :as router])) (defn related [data route record] (->> (for [[collection kind prefix] router/collections :when (#{:talks :snippets} collection) other (get data collection) :let [shared (set/intersection (or (:tags record) #{}) (or (:tags other) #{}))] :when (and (seq shared) (not (and (= kind (:kind route)) (= (:id other) (:id record)))) (not (and (= :meeting (:kind route)) (= kind :talk) (= (:meeting-id other) (:id record)))) (or (:example? record) (not (:example? other))))] (assoc other :kind kind :path (str prefix (:id other) "/") :shared-tags shared)) (sort-by (juxt #(-> % :shared-tags count -) :path)) (take 3) vec)) (ns scratch.commands (:require [clojure.string :as str] [scratch.router :as router] [scratch.meetings :as meetings] [scratch.theme :as theme])) (def registry [{:id :home :name "scratch-buffer" :description "Return to the beginning" :category :navigation :action [:buffer/open "/"]} {:id :about :name "about" :description "What this group is about" :category :navigation :action [:buffer/open "/about/"]} {:id :meetings :name "meetings" :description "Gatherings, talks, and material" :category :navigation :action [:buffer/open "/meetings/"]} {:id :snippets :name "snippets" :description "Configurations, packages, and tips" :category :navigation :action [:buffer/open "/snippets/"]} {:id :people :name "people" :description "The member directory and how to join" :category :navigation :action [:buffer/open "/people/"]} {:id :search :name "search" :description "Find something across all buffers" :category :interaction :action [:minibuffer/open :search]} {:id :switch-buffer :name "switch-buffer" :description "Choose a page to read" :category :interaction :action [:minibuffer/open :buffers]} {:id :previous-buffer :name "previous-buffer" :description "Return to the last buffer" :category :navigation :action [:buffer/previous]} {:id :describe-mode :name "describe-mode" :description "How this website works" :category :help :action [:buffer/open "/about/"]} {:id :describe-key :name "describe-key" :description "Keyboard shortcuts, without the mystery" :category :help :action [:buffer/open "/help/"]} {:id :join-user-group :name "join-user-group" :description "One small contribution is enough" :category :navigation :action [:buffer/open "/people/#join"]} {:id :submit-talk :name "submit-talk" :description "Start a talk proposal on GitHub" :category :community :contexts #{:meetings :meeting :talk} :action [:github/open :talks]} {:id :suggest-topic :name "suggest-topic" :description "Suggest a meeting topic on GitHub" :category :community :contexts #{:meetings :meeting} :action [:github/open :topics]} {:id :propose-meeting :name "propose-meeting" :description "Help arrange the next gathering" :category :community :contexts #{:meetings :meeting} :action [:github/open :topics]} {:id :ask-question :name "ask-question" :description "Ask the group on GitHub Discussions" :category :community :action [:github/open :questions]} {:id :teams :name "teams" :description "Open the scratch-buffer chat in Microsoft Teams" :category :community :action [:teams/open]} {:id :discuss-page :name "discuss-page" :description "Continue the conversation on GitHub" :category :community :contexts #{:meeting :talk :snippet} :action [:github/open :page]} {:id :copy-member-template :name "copy-member-template" :description "Copy the minimal EDN member entry" :category :community :contexts #{:people :person} :action [:member/copy-template]} {:id :add-to-calendar :name "add-to-calendar" :description "Download this meeting as a calendar event" :category :content :action [:meeting/download]} {:id :random-tip :name "random-tip" :description "Show a brief notification with an Emacs tip" :category :content :action [:tip/random]} {:id :toggle-theme :name "toggle-theme" :description "Switch between light and dark" :category :appearance :action [:theme/toggle]} {:id :set-theme :name "set-theme" :description "Choose system, light, or dark" :category :appearance :action [:minibuffer/open :themes]} {:id :toggle-animation :name "toggle-animation" :description "Pause or resume the home illustration" :category :appearance :action [:constellation/toggle]} {:id :source :name "source" :description "Read or contribute to this repository" :category :community :action [:github/open :source]} {:id :install :name "install" :description "Keep this site close at hand" :category :application :action [:pwa/install]}]) (defn words [s] (remove str/blank? (str/split (str/lower-case (str/trim s)) #"\s+"))) (defn subsequence? [needle haystack] (loop [n (seq needle) h (seq haystack)] (cond (nil? n) true (nil? h) false (= (first n) (first h)) (recur (next n) (next h)) :else (recur n (next h))))) (defn highlight-parts [query text] (let [lower (str/lower-case text) query (str/lower-case (str/trim query)) exact (reduce (fn [indices term] (loop [from 0 indices indices] (if-let [index (str/index-of lower term from)] (recur (+ index (count term)) (into indices (range index (+ index (count term))))) indices))) #{} (words query)) indices (if (and (seq query) (empty? exact) (subsequence? query lower)) (loop [needle (seq query) index 0 indices #{}] (if (empty? needle) indices (if (= (first needle) (nth lower index)) (recur (next needle) (inc index) (conj indices index)) (recur needle (inc index) indices)))) exact)] (mapv (fn [characters] {:text (apply str (map second characters)) :match? (contains? indices (ffirst characters))}) (partition-by #(contains? indices (first %)) (map-indexed vector text))))) (defn match-score [query candidate] (let [query (str/lower-case (str/trim query)) label (str/lower-case (:name candidate)) text (str label " " (str/lower-case (:description candidate)) " " (str/lower-case (or (:annotation candidate) "")))] (cond (str/blank? query) 0 (str/starts-with? label query) 0 (str/includes? label query) 1 (every? #(str/includes? text %) (words query)) 2 (subsequence? query label) 3 :else nil))) (defn match-commands [query candidates] (->> candidates (keep #(when-let [score (match-score query %)] (assoc % :score score))) (sort-by (juxt :score #(if (:contextual? %) 0 1))) vec)) (defn search [index query] (let [terms (words query)] (if (empty? terms) [] (->> index (filter #(every? (fn [word] (str/includes? (:text %) word)) terms)) (sort-by #(if (str/includes? (str/lower-case (:title %)) (str/lower-case (str/trim query))) 0 1)) (mapv #(assoc % :name (:title %) :description (:type %) :action [:buffer/open (:path %)])))))) (defn candidates [state] (let [{:keys [kind query]} (:minibuffer state)] (case kind :search (search (get-in state [:content :search]) query) :themes (match-commands query (mapv (fn [[id description]] {:id id :name (name id) :description description :action [:theme/set id]}) [[:system "Follow your device"] [:light "Paper & ink"] [:dark "After hours"]])) :buffers (match-commands query (mapv #(assoc % :name (:buffer %) :description (:title %) :action [:buffer/open (:path %)]) (router/routes (:content state)))) (match-commands query (mapv (fn [command] (let [record (router/record (:content state) (:route state)) animation (get-in state [:ui :constellation]) annotation (case (:id command) :toggle-theme (str "currently " (name (theme/resolved state))) :set-theme (str (name (get-in state [:theme :mode])) " mode") :toggle-animation (cond (:reduced? animation) "reduced motion" (not (:available? animation)) "still illustration" (:paused? animation) "paused" :else "enabled") :add-to-calendar (if (and (= :meeting (get-in state [:route :id])) (meetings/calendar? record)) (:title record) "open a scheduled meeting") :copy-member-template "two fields are enough" nil)] (assoc command :annotation annotation :contextual? (boolean (or ((or (:contexts command) #{}) (get-in state [:route :id])) (and (= :add-to-calendar (:id command)) (= :meeting (get-in state [:route :id])) (meetings/calendar? record))))))) registry))))) (ns scratch.github (:require [clojure.string :as str] [scratch.router :as router])) (def snapshot-path "/data/generated/discussions.json") (defn page-record [state] (or (router/record (:content state) (:route state)) (some #(when (= (:id %) (name (get-in state [:route :id]))) %) (get-in state [:content :pages])))) (defn discussion-number [state] (:discussion-number (page-record state))) (defn readable? [state] (not (#{:help :search :messages :not-found} (get-in state [:route :id])))) (defn avatar-path [member] (str "/assets/avatars/" (:github member) ".png")) (defn discussion-url [state kind] (let [repository (get-in state [:content :site :repository]) discussion (discussion-number state)] (case kind :source repository :page (str repository "/discussions" (when discussion (str "/" discussion))) (str repository "/discussions/new")))) (defn ensure! [condition message] (when-not condition (throw (ex-info message {})))) (defn timestamp? [value] (and (string? value) (re-matches #"\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2}(?:\.\d{3})?Z" value) #?(:clj (try (java.time.Instant/parse value) true (catch Exception _ false)) :cljs (not (js/isNaN (js/Date.parse value)))))) (defn text? [value] (and (string? value) (not (str/blank? value)))) (defn fields! [value fields] (ensure! (and (map? value) (= fields (set (keys value)))) "Invalid discussion snapshot fields.")) (defn validate-author! [author] (ensure! (or (nil? author) (map? author)) "Invalid discussion author.") (when author (fields! author #{:login :url}) (ensure! (and (text? (:login author)) (re-matches #"[A-Za-z0-9][A-Za-z0-9-]*(?:\[bot\])?" (:login author)) (string? (:url author)) (re-matches #"https://github\.com/(?:apps/)?[A-Za-z0-9][A-Za-z0-9-]*" (:url author))) "Invalid discussion author."))) (defn validate-comment! [thread-url reply? comment] (fields! comment (cond-> #{:url :body :created-at :author} (not reply?) (conj :replies))) (ensure! (and (string? (:body comment)) (timestamp? (:created-at comment)) (string? (:url comment)) (str/starts-with? (:url comment) (str thread-url "#discussioncomment-")) (re-matches #"\d+" (subs (:url comment) (count (str thread-url "#discussioncomment-"))))) "Invalid discussion comment.") (validate-author! (:author comment)) (when-not reply? (ensure! (vector? (:replies comment)) "Invalid discussion replies.") (doseq [reply (:replies comment)] (validate-comment! thread-url true reply)))) (defn validate-snapshot! [repository snapshot] (fields! snapshot #{:version :repository :generated-at :status :discussions}) (ensure! (and (= 1 (:version snapshot)) (= repository (:repository snapshot)) (#{"ready" "disabled" "unavailable"} (:status snapshot)) (vector? (:discussions snapshot)) (if (= "unavailable" (:status snapshot)) (nil? (:generated-at snapshot)) (timestamp? (:generated-at snapshot))) (or (= "ready" (:status snapshot)) (empty? (:discussions snapshot)))) "Invalid discussion snapshot metadata.") (let [numbers (map :number (:discussions snapshot))] (ensure! (= (count numbers) (count (set numbers))) "Duplicate discussion numbers.")) (doseq [thread (:discussions snapshot)] (fields! thread #{:number :title :url :body :created-at :updated-at :author :comments}) (ensure! (and (pos-int? (:number thread)) (text? (:title thread)) (string? (:body thread)) (= (:url thread) (str repository "/discussions/" (:number thread))) (timestamp? (:created-at thread)) (timestamp? (:updated-at thread)) (vector? (:comments thread))) "Invalid discussion thread.") (validate-author! (:author thread)) (doseq [comment (:comments thread)] (validate-comment! (:url thread) false comment)) (let [urls (map :url (mapcat #(cons % (:replies %)) (:comments thread)))] (ensure! (= (count urls) (count (set urls))) "Duplicate discussion comments."))) snapshot) (ns scratch.constellation) (def anchors (vec (for [ring (range 3) arm (range 6) :let [vertical (+ 100 (* 70 ring)) diagonal (+ 120 (* 80 ring)) dx (* 0.8660254038 diagonal) dy (* 0.5 diagonal) [x y] (case arm 0 [320 (- 280 vertical)] 1 [(+ 320 dx) (- 280 dy)] 2 [(+ 320 dx) (+ 280 dy)] 3 [320 (+ 280 vertical)] 4 [(- 320 dx) (+ 280 dy)] 5 [(- 320 dx) (- 280 dy)])]] {:arm arm :ring ring :x x :y y}))) (def slot-count (count anchors)) (defn initial [names] {:slots (mapv (fn [label] {:label label :incoming nil :revision 0}) (take slot-count names)) :queue (vec (drop slot-count names)) :cursor 0 :paused? false :reduced? false :available? false :visible? false :foreground? true}) (defn running? [state] (let [{:keys [paused? reduced? available? visible? foreground?]} (get-in state [:ui :constellation])] (and (= :scratch (get-in state [:route :id])) (not (get-in state [:minibuffer :open?])) available? visible? foreground? (not paused?) (not reduced?)))) (defn advance [model] (let [index (:cursor model) slot (get-in model [:slots index]) incoming (first (:queue model))] (when (or (:incoming slot) (nil? incoming)) (throw (ex-info "Package constellation cannot advance while its next slot is occupied or the queue is empty" {:slot index :queue-count (count (:queue model))}))) (-> model (assoc-in [:slots index :incoming] incoming) (update-in [:slots index :revision] inc) (update :queue #(vec (rest %))) (update :cursor #(mod (inc %) slot-count))))) (defn commit [model index revision] (when-not (and (integer? index) (<= 0 index) (< index (count (:slots model))) (integer? revision) (pos? revision)) (throw (ex-info "Invalid constellation completion" {:slot index :revision revision}))) (let [{:keys [label incoming] :as slot} (get-in model [:slots index])] ;; A canceled browser animation may deliver an old completion. (if (and incoming (= revision (:revision slot))) (-> model (assoc-in [:slots index :label] incoming) (assoc-in [:slots index :incoming] nil) (update :queue conj label)) model))) (defn label-size [label] (min 22 (/ 142 (* 0.62 (count label))))) (ns scratch.parentheses) (def radians (/ #?(:clj Math/PI :cljs js/Math.PI) 180)) (defn sin [angle] (#?(:clj Math/sin :cljs js/Math.sin) angle)) (defn cos [angle] (#?(:clj Math/cos :cljs js/Math.cos) angle)) (def beams (mapv (fn [index] {:index index :radius (+ 120 (* 9 index)) :tilt (+ 22 (* 7 (mod index 7))) :turn (- (* 35 index) 65) :phase (mod (* 137.5 index) 360) :tail-deg (+ 52 (* 11 (mod index 5))) :wave (+ 16 (* 5 (mod index 4))) :direction (if (even? index) 1 -1) :duration (+ 5800 (* 813 index))}) (range 12))) (def tail-stops [[0 0] [0.2 0.04] [0.45 0.18] [0.7 0.48] [1 1]]) (defn tail-start [{:keys [radius direction tail-deg]}] (let [angle (* (- direction) tail-deg radians)] [(* radius (cos angle)) (* radius (sin angle))])) (defn tail-path [{:keys [radius direction] :as beam}] (let [[x y] (tail-start beam)] (str "M" x " " y " A" radius " " radius " 0 0 " (if (pos? direction) 1 0) " " radius " 0"))) (defn plane [{:keys [tilt turn]}] (str "rotate(" turn ") scale(1 " (cos (* tilt radians)) ")")) (defn angle [{:keys [phase direction wave]} progress] (+ phase (* direction (+ (* 360 progress) (* wave (- (sin (* (+ (* 360 progress) phase) radians)) (sin (* phase radians)))))))) (defn frames [beam] (mapv (fn [step] (let [progress (/ step 48) theta (angle beam progress)] {:offset progress :transform (str "translateZ(0) rotate(" theta "deg)") :opacity (+ 0.38 (* 0.55 (/ (inc (sin (* theta radians))) 2)))})) (range 49))) (def initial-word {:index 0 :incoming nil :revision 0}) (defn advance-word [model names] (when (or (:incoming model) (empty? names)) (throw (ex-info "Orbital word cannot advance during a crossfade or without names" {}))) (-> model (assoc :incoming (mod (inc (:index model)) (count names))) (update :revision inc))) (defn commit-word [model revision] (when-not (and (integer? revision) (pos? revision)) (throw (ex-info "Invalid orbital word completion" {:revision revision}))) (if (and (:incoming model) (= revision (:revision model))) (assoc model :index (:incoming model) :incoming nil) model)) (ns scratch.state (:require [clojure.string :as str] [scratch.commands :as commands] [scratch.constellation :as constellation] [scratch.github :as github] [scratch.meetings :as meetings] [scratch.parentheses :as parentheses] [scratch.theme :as theme] [scratch.router :as router])) (def theme-modes #{:system :light :dark}) (defn initial [data base path] (let [route (router/resolve-route data path)] {:base base :route route :buffer {:current (:buffer route) :previous nil} :navigation {:positions {}} :minibuffer {:open? false :kind :commands :query "" :selection 0 :history [] :history-index -1 :draft ""} :theme {:mode :system :system-dark? false} :content data :github {:status :idle :snapshot nil :error nil :revision 0} :ui {:scroll "All" :notice nil :tip nil :tip-notice nil :tip-revision 0 :meeting-times {} :hero :constellation :constellation (constellation/initial (get-in data [:constellation :names])) :orbit-word parentheses/initial-word} :pwa {:offline? false :ready? false :installable? false}})) (def resolved-theme theme/resolved) (defn member-template [state] (str "{:github \"your-github-handle\"\n :joined \"" (subs (get-in state [:content :today]) 0 7) "\"}")) (defn result [state & effects] {:state state :effects (vec effects)}) (defn transition [state [action & args]] (let [[value options] args] (case action :buffer/open (let [destination (router/destination value) path (router/normalize-path destination) anchor (second (str/split destination #"#" 2)) route (router/resolve-route (:content state) path) old-path (get-in state [:route :path]) positions (assoc (get-in state [:navigation :positions]) old-path (or (:scroll options) 0)) scroll (if (:restore? options) (get positions path 0) 0) next-state (-> state (assoc :route route) (assoc-in [:navigation :positions] positions) (assoc-in [:buffer :current] (:buffer route)) (cond-> (not= old-path path) (assoc-in [:buffer :previous] old-path)) (assoc-in [:minibuffer :open?] false))] (result next-state [:history/navigate (router/url (:base state) destination) options] [:document/title (:title route)] [:dispatch [:github/load-snapshot]] [:navigation/settle scroll anchor])) :buffer/previous (if-let [path (get-in state [:buffer :previous])] (result state [:dispatch [:buffer/open path {:restore? true}]]) (result (assoc-in state [:ui :notice] "This is your first buffer. Choose a page with the buffer switcher."))) :minibuffer/open (result (-> state (assoc-in [:minibuffer :open?] true) (assoc-in [:minibuffer :kind] (or value :commands)) (assoc-in [:minibuffer :query] "") (assoc-in [:minibuffer :selection] 0) (assoc-in [:minibuffer :history-index] -1) (assoc-in [:minibuffer :draft] "")) [:focus/minibuffer]) :minibuffer/cancel (result (assoc-in state [:minibuffer :open?] false) [:focus/return]) :minibuffer/input (result (-> state (assoc-in [:minibuffer :query] value) (assoc-in [:minibuffer :selection] 0) (assoc-in [:minibuffer :history-index] -1))) :minibuffer/move (let [n (count (commands/candidates state)) selected (get-in state [:minibuffer :selection])] (result (assoc-in state [:minibuffer :selection] (if (pos? n) (mod (+ selected value) n) 0)) [:completion/scroll])) :minibuffer/select (result (assoc-in state [:minibuffer :selection] value)) :minibuffer/history (let [{:keys [history history-index query draft]} (:minibuffer state) index (max -1 (min (dec (count history)) (+ history-index value)))] (result (-> state (cond-> (= history-index -1) (assoc-in [:minibuffer :draft] query)) (assoc-in [:minibuffer :history-index] index) (assoc-in [:minibuffer :query] (if (= index -1) draft (get history index ""))) (assoc-in [:minibuffer :selection] 0)))) :minibuffer/execute (if-let [candidate (get (commands/candidates state) (get-in state [:minibuffer :selection]))] (result state [:dispatch [:command/execute candidate]]) (result (assoc-in state [:ui :notice] "No matching result. Try a different query."))) :command/execute (let [candidate (if (map? value) value (some #(when (= value (:id %)) %) commands/registry))] (if candidate (result (-> state (assoc-in [:minibuffer :open?] false) (update-in [:minibuffer :history] #(vec (take 30 (cons (:name candidate) (remove #{(:name candidate)} %)))))) [:focus/return] [:dispatch (:action candidate)]) (throw (ex-info "Unknown command" {:id value})))) :theme/set (if (theme-modes value) (result (assoc-in state [:theme :mode] value) [:theme/apply] [:theme/persist value]) (throw (ex-info "Invalid theme mode" {:mode value}))) :theme/toggle (result state [:dispatch [:theme/set (if (= :dark (resolved-theme state)) :light :dark)]]) :theme/system (result (assoc-in state [:theme :system-dark?] value) [:theme/apply]) :theme/restore (if (theme-modes value) (result (assoc-in state [:theme :mode] value) [:theme/apply]) (result (assoc-in state [:ui :notice] "The saved theme was invalid. Using your device theme.") [:theme/apply])) :github/open (if (get-in state [:pwa :offline?]) (result (assoc-in state [:ui :notice] "You are offline. Published buffers are cached; GitHub Discussions need a connection.")) (result state [:external/open (github/discussion-url state value)])) :github/load-snapshot (if (and (github/readable? state) (or (= :idle (get-in state [:github :status])) (and value (not= :loading (get-in state [:github :status]))))) (let [revision (inc (get-in state [:github :revision]))] (result (-> state (assoc-in [:github :status] :loading) (assoc-in [:github :error] nil) (assoc-in [:github :revision] revision)) [:github/fetch-snapshot (router/url (:base state) github/snapshot-path) revision])) (result state)) :github/snapshot-loaded (if (= value (get-in state [:github :revision])) (result (-> state (assoc-in [:github :status] :ready) (assoc-in [:github :error] nil) (assoc-in [:github :snapshot] (github/validate-snapshot! (get-in state [:content :site :repository]) options)))) (result state)) :github/snapshot-failed (if (= value (get-in state [:github :revision])) (do (when-not (github/text? options) (throw (ex-info "Missing discussion error message." {}))) (result (-> state (assoc-in [:github :status] :error) (assoc-in [:github :error] options)))) (result state)) :teams/open (if (get-in state [:pwa :offline?]) (result (assoc-in state [:ui :notice] "You are offline. Teams chat needs a connection.")) (result state [:external/open-tab (get-in state [:content :site :teams-url])])) :member/copy-template (result state [:clipboard/write (member-template state) :member-template]) :code/copy (do (when-not (and (string? value) (not (str/blank? value))) (throw (ex-info "Code to copy must be nonempty text" {}))) (result state [:clipboard/write value :code])) :meetings/local-times (result (assoc-in state [:ui :meeting-times] value)) :meetings/prepare (result state [:meetings/format-local]) :meeting/download (let [record (router/record (:content state) (:route state))] (if (and (= :meeting (get-in state [:route :id])) (meetings/calendar? record)) (result state [:download/file (router/url (:base state) (meetings/calendar-path record)) (str (:id record) ".ics")]) (result (assoc-in state [:ui :notice] "Open a scheduled meeting to add it to your calendar. Example meetings are not invitations.")))) :tip/random (if (seq (filter :tip? (get-in state [:content :snippets]))) (result state [:tip/choose]) (result (assoc-in state [:ui :notice] "No tips have been published yet."))) :tip/set (let [tip (get (vec (filter :tip? (get-in state [:content :snippets]))) value) revision (inc (get-in state [:ui :tip-revision]))] (when-not tip (throw (ex-info "Unknown tip" {:index value}))) (result (-> state (assoc-in [:ui :tip] value) (assoc-in [:ui :tip-revision] revision) (assoc-in [:ui :tip-notice] tip)) [:tip/expire-later revision])) :tip/expire (result (if (= value (get-in state [:ui :tip-revision])) (assoc-in state [:ui :tip-notice] nil) state)) :tip/dismiss (result (assoc-in state [:ui :tip-notice] nil) [:tip/cancel-expiry] [:tip/return-focus]) :tip/pause (result state [:tip/cancel-expiry]) :tip/resume (if (get-in state [:ui :tip-notice]) (result state [:tip/expire-later (get-in state [:ui :tip-revision])]) (result state)) :ui/scroll (result (assoc-in state [:ui :scroll] value)) :hero/select (if (#{:constellation :parentheses} value) (result (assoc-in state [:ui :hero] value) [:constellation/sync]) (throw (ex-info "Unknown home illustration" {:variant value}))) :constellation/advance (let [index (get-in state [:ui :constellation :cursor]) next-state (update-in state [:ui :constellation] constellation/advance) revision (get-in next-state [:ui :constellation :slots index :revision])] (result next-state [:constellation/fade index revision])) :constellation/commit (result (update-in state [:ui :constellation] #(constellation/commit % value options))) :orbit-word/advance (let [next-state (update-in state [:ui :orbit-word] #(parentheses/advance-word % (get-in state [:content :constellation :names])))] (result next-state [:orbit-word/fade (get-in next-state [:ui :orbit-word :revision])])) :orbit-word/commit (result (update-in state [:ui :orbit-word] #(parentheses/commit-word % value))) :constellation/toggle (let [next-state (update-in state [:ui :constellation :paused?] not) {:keys [paused? reduced? available?]} (get-in next-state [:ui :constellation])] (result (assoc-in next-state [:ui :notice] (cond reduced? "Reduced motion is enabled. The home illustration stays still." (not available?) "This browser shows a still home illustration." paused? "Home illustration paused." :else "Home illustration resumed.")) [:constellation/sync])) :constellation/reduced (result (assoc-in state [:ui :constellation :reduced?] value) [:constellation/sync]) :constellation/available (result (assoc-in state [:ui :constellation :available?] value) [:constellation/sync]) :constellation/visible (result (assoc-in state [:ui :constellation :visible?] value) [:constellation/sync]) :constellation/foreground (result (assoc-in state [:ui :constellation :foreground?] value) [:constellation/sync]) :ui/notice (result (assoc-in state [:ui :notice] value)) :ui/dismiss (result (assoc-in state [:ui :notice] nil)) :pwa/offline (result (assoc-in state [:pwa :offline?] value)) :pwa/ready (result (assoc-in state [:pwa :ready?] true)) :pwa/available (result (assoc-in state [:pwa :installable?] value)) :pwa/install (result state [:pwa/prompt]) (throw (ex-info "Unknown action" {:action action}))))) (ns scratch.view (:require [clojure.string :as str] [scratch.commands :as commands] [scratch.constellation :as constellation] [scratch.github :as github] [scratch.meetings :as meetings] [scratch.parentheses :as parentheses] [scratch.reading :as reading] [scratch.state :as state] [scratch.router :as router])) (defn link [state path label & [attrs]] [:a (merge {:href (router/url (:base state) path) :on {:click [[:link/follow path]]}} attrs) label]) (defn button [label action & [attrs]] [:button (merge {:type "button" :on {:click [action]}} attrs) label]) (defn code-block [text label] [:div {:class "code-block"} [:pre {:tabindex 0 :aria-label label} [:code text]] (button [:svg {:viewBox "0 0 24 24" :width 18 :height 18 :fill "none" :stroke "currentColor" :stroke-width 1.5 :stroke-linecap "round" :stroke-linejoin "round" :aria-hidden "true"} [:rect {:x 9 :y 9 :width 12 :height 12 :rx 2}] [:path {:d "M5 15H4a2 2 0 0 1-2-2V4a2 2 0 0 1 2-2h9a2 2 0 0 1 2 2v1"}]] [:code/copy text] {:class "code-copy dynamic-only" :aria-label "Copy code to clipboard" :title "Copy code to clipboard" :data-search-exclude "true"})]) (defn external [url label] [:a {:href url} label]) (defn teams-link [state label] [:a {:href (get-in state [:content :site :teams-url]) :target "_blank" :rel "noopener noreferrer" :aria-label (str label " (opens in a new tab)")} label]) (defn paragraphs [body] (map-indexed (fn [i p] [:p {:replicant/key i} p]) body)) (defn tags [record] (when (seq (:tags record)) [:p {:class "metadata"} (str/join " / " (sort (map name (:tags record))))])) (defn example-label [record] (when (:example? record) [:span {:class "example-label"} "Example, not live community data"])) (defn member-avatar [state member] [:span {:class "member-avatar" :aria-hidden "true"} [:span {:class "avatar-initial"} (str/upper-case (subs (:github member) 0 1))] (when-not (:example? member) [:img {:src (router/url (:base state) (github/avatar-path member)) :alt "" :width 48 :height 48 :loading "lazy" :decoding "async"}])]) (defn member-byline [state handle label] (let [member (or (some #(when (= handle (:github %)) %) (get-in state [:content :members])) (throw (ex-info "Unknown byline member" {:github handle})))] [:p {:class "member-byline"} (member-avatar state member) [:span label " " (link state (str "/people/" handle "/") (router/member-name member))]])) (defn bylines [state {:keys [author speaker]}] (when (or author speaker) [:div {:class "bylines"} (when author (member-byline state author "By")) (when (and speaker (not= author speaker)) (member-byline state speaker "Speaker"))])) (defn meeting-times [state record] [:div {:class "meeting-times"} [:p {:class "metadata meeting-clock"} [:time {:datetime (:start-utc record)} (str (or (:date-label record) (:date record)) " / " (:time record))] (str " / " (:timezone record) (when (:utc-offset record) (str " / " (:utc-offset record))) " / " (:duration-minutes record) " min")] (when-let [local (get-in state [:ui :meeting-times (:id record)])] [:p {:class "metadata meeting-local"} (str "Your time: " (:date local) " / " (:start local) " to " (when (not= (:date local) (:end-date local)) (str (:end-date local) " / ")) (:end local) " / " (:timezone local))])]) (defn calendar-link [state record] (when (meetings/calendar? record) [:a {:href (router/url (:base state) (meetings/calendar-path record)) :download (str (:id record) ".ics")} "Add to calendar"])) (defn related-reading [state record] (when-let [related (seq (reading/related (:content state) (:route state) record))] [:section {:class "related-reading" :data-search-exclude "true"} [:h2 "Related reading"] [:ul {:class "related-list"} (for [other related] [:li {:replicant/key (:path other)} (example-label other) (link state (:path other) (:title other)) [:span {:class "metadata"} (str (str/capitalize (name (:kind other))) " / " (str/join " / " (sort (map name (:shared-tags other)))))]])]])) (defn section-label [number label] [:h2 {:class "section-label"} [:span {:aria-hidden "true"} number] label]) (defn item-list [state records prefix] [:ul {:class "reading-list"} (for [record records] [:li {:replicant/key (:id record)} [:div (example-label record) [:h3 (link state (str prefix (:id record) "/") (:title record))] (when (:date record) [:p {:class "metadata"} (str (:date record) " / " (:time record) " / " (:timezone record))]) [:p (:description record)] (bylines state record) (tags record)]])]) (defn meeting-timeline [state records] [:ol {:class "meeting-timeline" :aria-label "Meeting timeline"} (for [record (sort-by (juxt :date :time :id) records)] [:li {:replicant/key (:id record) :class "meeting-entry"} [:div {:class "meeting-stamp"} [:time {:class "meeting-date" :datetime (:date record)} (:date record)] [:time {:class "meeting-time" :datetime (:start-utc record)} (:time record)] [:span {:class "meeting-timezone"} (:timezone record)] (when (:utc-offset record) [:span {:class "meeting-offset"} (:utc-offset record)])] [:span {:class "meeting-node" :aria-hidden "true"}] [:div {:class "meeting-content"} (example-label record) [:h3 (link state (str "/meetings/" (:id record) "/") (:title record))] [:p (:description record)] (bylines state record) (tags record)]])]) (defn package-constellation [state] (let [{:keys [slots paused? reduced?]} (get-in state [:ui :constellation]) names (get-in state [:content :constellation :names])] [:div {:id "package-constellation" :replicant/key :constellation :class "hero-illustration package-constellation" :aria-hidden "true" :data-name-count (count names) :data-paused paused? :data-reduced reduced?} [:div {:class "hero-stage constellation-stage"} [:svg {:class "hero-svg constellation-svg" :viewBox "0 0 640 560" :aria-hidden "true" :focusable "false"} [:g {:class "constellation-field"} [:path {:class "constellation-rays" :d "M320 40V520 M77.5 140L562.5 420 M77.5 420L562.5 140"}] (map-indexed (fn [index {:keys [label incoming revision]}] (let [{:keys [arm ring x y]} (get constellation/anchors index)] [:g {:class "constellation-slot" :replicant/key index :data-slot index :data-arm arm :data-ring ring :data-revision revision :transform (str "translate(" x " " y ")")} [:rect {:class "constellation-knockout" :x -76 :y -18 :width 152 :height 32}] [:text {:class "constellation-current" :text-anchor "middle" :dominant-baseline "middle" :font-size (constellation/label-size label) :opacity 1} label] (when incoming [:text {:class "constellation-incoming" :text-anchor "middle" :dominant-baseline "middle" :font-size (constellation/label-size incoming) :opacity 0} incoming])])) slots) [:path {:class "constellation-center" :d "M320 264V296 M306 272L334 288 M306 288L334 272"}]]]]])) (defn parenthesis-mobile [state] (let [{:keys [paused? reduced?]} (get-in state [:ui :constellation]) {:keys [index incoming revision]} (get-in state [:ui :orbit-word]) names (get-in state [:content :constellation :names])] [:div {:id "parenthesis-mobile" :replicant/key :parentheses :class "hero-illustration parenthesis-mobile" :aria-hidden "true" :data-paused paused? :data-reduced reduced?} [:div {:class "hero-stage"} [:svg {:class "hero-svg" :viewBox "0 0 640 560" :aria-hidden "true" :focusable "false"} [:defs [:filter {:id "orbital-glow" :x "-30%" :y "-30%" :width "160%" :height "160%"} [:feGaussianBlur {:stdDeviation 2}]] (for [beam parentheses/beams :let [[x y] (parentheses/tail-start beam)]] [:linearGradient {:replicant/key (:index beam) :id (str "orbital-tail-" (:index beam)) :gradientUnits "userSpaceOnUse" :x1 x :y1 y :x2 (:radius beam) :y2 0} (for [[offset opacity] parentheses/tail-stops] [:stop {:replicant/key offset :offset offset :stop-color "currentColor" :stop-opacity opacity}])])] [:g {:transform "translate(320 280)"} (for [{:keys [index radius phase] :as beam} parentheses/beams :let [path (parentheses/tail-path beam) stroke (str "url(#orbital-tail-" index ")")]] [:g {:replicant/key index :class "beam-plane" :transform (parentheses/plane beam)} [:g {:class "orbital-beam" :data-beam index :transform (str "rotate(" phase ")")} [:path {:class "beam-halo" :d path :stroke stroke :filter "url(#orbital-glow)"}] [:path {:class "beam-tail" :d path :stroke stroke}] [:circle {:class "beam-head" :cx radius :cy 0 :r 2.5}]]])] [:g {:class "orbit-word" :data-slot "word" :data-revision revision} [:text {:class "orbit-word-current" :x 320 :y 280 :text-anchor "middle" :dominant-baseline "middle" :font-size (constellation/label-size (get names index)) :opacity 1} (get names index)] (when incoming [:text {:class "orbit-word-incoming" :x 320 :y 280 :text-anchor "middle" :dominant-baseline "middle" :font-size (constellation/label-size (get names incoming)) :opacity 0} (get names incoming)])]]]])) (defn hero-illustration [state] (case (get-in state [:ui :hero]) :constellation (package-constellation state) :parentheses (parenthesis-mobile state))) (defn scratch [state] (let [data (:content state) page (some #(when (= "scratch" (:id %)) %) (:pages data)) upcoming (meetings/next-meeting data) members (remove :example? (:members data))] [:div [:div {:class "home-hero"} [:div {:class "home-intro"} [:p {:class "eyebrow"} "A shared space for a very personal editor"] [:h1 {:class "home-title"} "DNV Emacs" [:br] "User Group" [:span {:class "title-stop" :aria-hidden "true"} "."]] [:p {:class "lede"} (:description page)] [:p {:class "intro-note"} (first (:body page))] (bylines state page) [:div {:class "intro-links"} (link state "/about/" "Meet the group") (link state "/people/#join" "How to join") (button "Find a command" [:minibuffer/open :commands] {:class "dynamic-only"})]] (hero-illustration state)] [:section (section-label "01" "Next up") (if upcoming [:div {:class "next-meeting"} (meeting-times state upcoming) [:h3 (link state (str "/meetings/" (:id upcoming) "/") (:title upcoming))] [:p (:description upcoming)] (bylines state upcoming) (calendar-link state upcoming)] [:div {:class "next-meeting"} [:h3 "The next gathering starts with an idea."] [:p "No meetings are scheduled yet. A short demo, a problem to solve, or a question is enough."] (external (github/discussion-url state :topics) "Suggest a meeting topic on GitHub")])] [:section (section-label "02" "Worth sharing") (item-list state (take 2 (:snippets data)) "/snippets/") (link state "/meetings/#talks" "Talks & material")] [:section (section-label "03" "From the group") [:p "Small contributions make this place useful. Published notes live in the repository. Chat in Teams, or continue a longer conversation in GitHub Discussions."] [:p {:class "metadata"} "No live activity feed is loaded. Published content is included in this site build."] [:div {:class "intro-links"} (teams-link state "Open Teams chat") (external (github/discussion-url state :page) "Open Discussions") (external (github/discussion-url state :source) "Browse the repository")]] [:section {:class "join-note"} [:p {:class "eyebrow"} (if (seq members) (str (count members) (if (= 1 (count members)) " member" " members") ", and room for you") "A group is made by its people")] [:h2 "One small contribution." [:br] "You’re in."] [:p "An Emacs tip. A typo fix. A useful question turned into a note. Participation matters more than polish."] (link state "/people/#join" "Join the user group") (when (empty? members) [:p {:class "metadata"} (str "No real member records have been added yet." (when (some :example? (:members data)) " The directory includes a clearly marked example."))])]])) (defn join-section [state] (let [repo (get-in state [:content :site :repository])] [:section {:id "join" :class "join-section" :tabindex -1 :aria-labelledby "join-heading"} [:h2 {:id "join-heading"} "Join the group"] [:p "Add a member entry and one small useful contribution: a tip, a package configuration, or a typo fix. Open a pull request; once merged, you are a member."] [:p "Save this as members/your-github-handle.edn, replacing the placeholder with your own handle."] (code-block (state/member-template state) "Member entry template") [:p {:class "metadata"} "Only your GitHub handle and joining month are required. Other profile fields are optional. Everything published here is public."] [:div {:class "intro-links"} (external (str repo "/blob/main/members/README.md") "Member record guide") (external (str repo "/blob/main/CONTRIBUTING.md") "Contribution guide")]])) (defn about [state] (let [page (some #(when (= "about" (:id %)) %) (get-in state [:content :pages]))] [:div [:p {:class "eyebrow"} "People before configuration"] [:h1 (:title page)] [:p {:class "lede"} (:description page)] (bylines state page) (paragraphs (:body page)) [:h2 "A website, not an editor"] [:p "The fixed bottom bar tells you which page you are reading. Select the buffer name to switch pages, or open M-x to find any action. Nothing here requires Emacs knowledge."] [:p (link state "/help/" "See the keyboard and pointer guide") ". " (link state "/people/#join" "Join with a small contribution") "."] [:h2 "Between gatherings"] [:p "The scratch-buffer Teams chat is a place for quick questions and conversation."] (teams-link state "Open Teams chat") [:h2 "Public by design"] [:p "This site has no analytics, corporate directory integration, or custom login. Member records are explicit and minimal. Never publish confidential notes or credentials."] [:p {:class "community-note"} (get-in state [:content :site :status])]])) (defn people [state] (let [members (get-in state [:content :members]) real (remove :example? members)] [:div [:p {:class "eyebrow"} "A directory, not a contributor graph"] [:h1 "People"] [:p {:class "lede"} (str (count real) (if (= 1 (count real)) " member" " members") ". Every record is a small act of participation.")] [:ul {:class "people-list"} (for [member members] [:li {:replicant/key (:github member)} (member-avatar state member) [:div {:class "member-details"} (example-label member) [:h2 (link state (str "/people/" (:github member) "/") (router/member-name member))] (when (:full-name member) [:p {:class "metadata member-handle"} (str "@" (:github member))]) (when (:emacs-since member) [:p {:class "metadata"} (str "Emacs since " (:emacs-since member))]) [:p {:class "metadata"} (str/join " / " (sort (map name (:interests member))))] (when (:favorite-command member) [:p {:class "mono"} (str "M-x " (:favorite-command member))])]])] (join-section state)])) (defn person [state record] [:div [:p {:class "eyebrow"} "Member record"] [:h1 (router/member-name record)] (when (:full-name record) [:p {:class "metadata member-handle"} (str "@" (:github record))]) (example-label record) [:p {:class "metadata"} (str "Joined " (:joined record))] (when (:emacs-since record) [:p {:class "metadata"} "Emacs since " [:time {:datetime (:emacs-since record)} (:emacs-since record)]]) (when (:bio record) [:p {:class "lede"} (:bio record)]) (when (seq (:interests record)) [:section [:h2 "Interests"] [:p (str/join " / " (sort (map name (:interests record))))]]) (when (:favorite-command record) [:section [:h2 "A favorite command"] [:p {:class "mono"} (str "M-x " (:favorite-command record))]]) (if (:example? record) [:p "This is a fictional example record for contributors. It is not a person or a membership claim."] (external (str "https://github.com/" (:github record)) "Public GitHub profile")) (for [[collection _ prefix] router/collections :let [records (filter #(or (= (:github record) (:author %)) (= (:github record) (:speaker %))) (get-in state [:content collection]))] :when (seq records)] [:section {:replicant/key collection} [:h2 (str/capitalize (name collection))] (if (= collection :meetings) (meeting-timeline state records) (item-list state records prefix))]) [:p (link state "/people/" "Back to people")]]) (defn collection-view [state kind title description] (let [records (get-in state [:content kind]) prefix (str "/" (name kind) "/") scheduled? (when (= kind :meetings) (meetings/next-meeting (:content state)))] [:div [:p {:class "eyebrow"} "Published knowledge"] [:h1 title] [:p {:class "lede"} description] (when (= kind :snippets) [:p "These configurations use use-package, built into Emacs 29 and later; install it separately on older versions. " [:code ":ensure nil"] " uses a built-in package. " [:code ":ensure t"] " installs an external package from your configured archives, so choose archives you trust."]) (when (and (= kind :meetings) (not scheduled?)) [:div {:class "empty-note"} [:h2 "No meetings are currently scheduled."] [:p (if (some :example? records) "Example records are not invitations. Real meetings will include a date, time zone, and joining details." "Suggest a short demo, a question, or something you would like to learn together.")] (external (github/discussion-url state :topics) "Propose a meeting on GitHub")]) (if (seq records) (if (= kind :meetings) (meeting-timeline state records) (item-list state records prefix)) [:p "Nothing published here yet. Your first small contribution could change that."]) [:p (link state "/people/#join" "Contribute something useful")]])) (defn meetings-view [state] [:div (collection-view state :meetings "Meetings" "Gatherings, short demos, and material worth returning to.") [:section {:id "talks" :tabindex -1 :aria-labelledby "talks-heading"} [:h2 {:id "talks-heading"} "Talks & material"] (if (seq (get-in state [:content :talks])) (item-list state (get-in state [:content :talks]) "/meetings/talks/") [:p "No talks have been published yet. A five-minute demo is enough to start."]) (external (github/discussion-url state :talks) "Propose a talk on GitHub")]]) (defn detail [state record] [:div [:p {:class "eyebrow"} (name (:kind (:route state)))] [:h1 (:title record)] (example-label record) [:p {:class "lede"} (:description record)] (when (= :meeting (get-in state [:route :kind])) (meeting-times state record)) (when (:location record) [:p (:location record)]) (when (meetings/calendar? record) [:div {:class "intro-links meeting-actions"} (when (:join-url record) (external (:join-url record) "Join this meeting")) (calendar-link state record)]) (bylines state record) (tags record) (paragraphs (:body record)) (when-let [meeting (some #(when (= (:meeting-id record) (:id %)) %) (get-in state [:content :meetings]))] [:p "From " (link state (str "/meetings/" (:id meeting) "/") (:title meeting)) "."]) (when (:code record) (code-block (:code record) "Code example")) (when (:url record) [:p (external (:url record) "Read the documentation")]) (when (or (:notes-url record) (:recording-url record)) [:section {:class "meeting-material"} [:h2 "Meeting material"] [:div {:class "intro-links"} (when (:notes-url record) (external (:notes-url record) "Read meeting notes")) (when (:recording-url record) (external (:recording-url record) "Watch the recording"))]]) (when (= :meeting (get-in state [:route :kind])) (when-let [talks (seq (filter #(= (:id record) (:meeting-id %)) (get-in state [:content :talks])))] [:section [:h2 "Talks from this meeting"] (item-list state talks "/meetings/talks/")])) (related-reading state record)]) (defn discussion-time [timestamp] [:time {:datetime timestamp} (str (str/replace (subs timestamp 0 19) "T" " ") " UTC")]) (defn discussion-author [author] (if author (external (:url author) (:login author)) "Deleted GitHub account")) (defn discussion-comment [comment reply?] [:li {:replicant/key (:url comment)} [:article {:class (if reply? "discussion-reply" "discussion-comment")} [:p {:class "metadata"} (discussion-author (:author comment)) " / " (discussion-time (:created-at comment))] [:p {:class "discussion-body"} (:body comment)] (external (:url comment) "View comment on GitHub")] (when (seq (:replies comment)) [:ol {:class "discussion-replies"} (for [reply (:replies comment)] (discussion-comment reply true))])]) (defn discussion-content [thread] [:div {:class "discussion-content"} [:p {:class "metadata"} (discussion-author (:author thread)) " / " (discussion-time (:created-at thread))] [:p {:class "discussion-body"} (:body thread)] (if (seq (:comments thread)) [:div [:h4 "Comments"] [:ol {:class "discussion-comments"} (for [comment (:comments thread)] (discussion-comment comment false))]] [:p {:class "metadata"} "No comments in this snapshot."]) (external (:url thread) "Reply on GitHub")]) (defn discussion-section [state] (when (github/readable? state) (let [{:keys [status snapshot error]} (:github state) number (github/discussion-number state) thread (some #(when (= number (:number %)) %) (:discussions snapshot))] [:section {:class "discussion-note" :aria-labelledby "discussion-heading" :aria-busy (str (= :loading status)) :data-search-exclude "true"} [:h2 {:id "discussion-heading"} (if number "Discussion" "From GitHub Discussions")] [:p "Read the conversation here. Posting and replies happen on GitHub."] [:p {:class "static-only"} "Read-only snapshots load with JavaScript. You can also read directly on GitHub."] [:div {:class "dynamic-only"} [:p {:class "discussion-status metadata" :role "status" :aria-live "polite"} (case status :idle "Discussion snapshot will load when this buffer opens." :loading [:span [:span {:class "loading-indicator" :aria-hidden "true"}] "Loading discussion snapshot..."] :error error :ready (case (:status snapshot) "unavailable" "No discussion snapshot was included in this build." "disabled" "GitHub Discussions were not enabled when this snapshot was built." "ready" [:span "Read-only snapshot / Updated " (discussion-time (:generated-at snapshot))]))] (when (= :error status) (button "Retry loading discussions" [:github/load-snapshot true])) (when (and (= :ready status) (= "ready" (:status snapshot))) (if number (if thread [:div [:h3 (:title thread)] (discussion-content thread)] [:p "This thread is not in the published snapshot. It may be newer than the snapshot, or it may have been removed."]) (if (seq (:discussions snapshot)) [:div [:p {:class "metadata"} "Recent threads / Open a title to read its snapshot."] (for [thread (take 6 (:discussions snapshot))] [:details {:class "discussion-thread" :replicant/key (:number thread)} [:summary [:h3 (:title thread)]] (discussion-content thread)]) (when (> (count (:discussions snapshot)) 6) [:p {:class "metadata"} "Showing the six most recently updated threads. More discussions are available on GitHub."])] [:p "No discussions in this snapshot yet. Start a conversation on GitHub."])))] (external (github/discussion-url state :page) "Discuss this page on GitHub")]))) (defn help [state] [:div [:p {:class "eyebrow"} "No Emacs experience required"] [:h1 "A little help"] [:p {:class "lede"} "Use the links. Or take a shortcut."] [:p "M-x is the command menu above the bottom bar. Type a few letters, choose a result, and go. The page stays visible underneath."] [:p "Tap M-x again to close the menu without running a command. Escape or Ctrl + g does the same from the keyboard."] [:dl {:class "key-guide"} (for [[key description] [["Alt + x" "Open commands (M-x)"] ["Ctrl + x, then b" "Switch buffers"] ["Ctrl + s" "Search this site (outside editable fields)"] ["↑ / ↓" "Select a completion"] ["Enter" "Run the selected command"] ["Escape / Ctrl + g" "Close commands and return focus"] ["Alt + p / Alt + n" "Previous / next command history"] ["Tab / Shift + Tab" "Move between controls"]]] [:div {:replicant/key key} [:dt [:kbd key]] [:dd description]])] [:p "On macOS, use Option for Alt if your keyboard makes the shortcut available. Browser and operating-system shortcuts can take priority; the M-x button always works."] [:div {:class "intro-links dynamic-only"} (button "Open commands" [:minibuffer/open :commands]) (button "Search" [:minibuffer/open :search]) (button "Choose a theme" [:minibuffer/open :themes]) (button "Install this site" [:pwa/install])] [:h2 "All pages"] [:ul {:class "page-directory"} (for [page router/pages :when (not (#{:messages :help :search} (:id page)))] [:li {:replicant/key (:path page)} (link state (:path page) (:title page))])] [:h2 "Appearance"] [:p "Light, dark, or your device’s theme. Your explicit choice stays in this browser. System mode follows your device automatically."] [:p "To pause or resume the home illustration, open M-x and choose toggle-animation. Reduced-motion preferences always keep it still."] [:h2 "Offline & installation"] [:p "After the offline cache is ready, published pages and saved discussion snapshots can be read without a connection. Posting and contribution links still need GitHub."] [:p "Use Install in the command menu where supported. Otherwise, use your browser’s install menu, or Share → Add to Home Screen on iPhone and iPad."]]) (defn search-page [state] [:div [:p {:class "eyebrow"} "Across every published buffer"] [:h1 "Search the site"] [:p {:class "lede"} "A command, an idea, a person."] (button "Open site search" [:minibuffer/open :search] {:class "dynamic-only"}) [:p {:class "static-only"} "Interactive search needs JavaScript. You can browse all indexed content below, or use your browser’s Find command."] [:ul {:class "reading-list"} (for [entry (get-in state [:content :search])] [:li {:replicant/key (:path entry)} [:h2 (link state (:path entry) (:title entry))] [:p {:class "metadata"} (:type entry)] [:p (:description entry)]])]]) (defn buffer-view [state] (let [route (:route state)] (case (:id route) :scratch (scratch state) :about (about state) :people (people state) :person (person state (router/record (:content state) route)) :meetings (meetings-view state) :snippets (collection-view state :snippets "Snippets & tips" "Configurations, package recommendations, and small things worth trying.") :help (help state) :search (search-page state) :messages [:div [:p {:class "eyebrow mono"} "*Messages*"] [:h1 "Messages"] [:p (or (get-in state [:ui :notice]) "No messages. Everything is quiet.")] [:p (if (get-in state [:pwa :offline?]) "Offline. Showing cached published buffers and saved discussion snapshots. Posting on GitHub needs a connection." "Published content and read-only discussion snapshots are local to this site. Posting happens on GitHub.")] (link state "/" "Return to the beginning")] :not-found [:div [:p {:class "eyebrow mono"} "*Messages*"] [:h1 "That buffer isn’t here."] [:p "The link may be out of date, or the page may not have been published."] (link state "/" "Return to the beginning")] (detail state (router/record (:content state) route))))) (defn mode-line [state] [:footer {:class "mode-line" :aria-label "Mode-line"} [:span {:class "mode-brand"} "DNV"] (button (get-in state [:buffer :current]) [:minibuffer/open :buffers] {:class "mode-buffer dynamic-only" :aria-label (str "Switch buffer: " (get-in state [:buffer :current]))}) [:span {:class "mode-buffer static-only"} (get-in state [:buffer :current])] (link state "/about/" "Emacs User Group" {:class "mode-group"}) [:span {:class "mode-spacer"}] [:span {:class "mode-scroll" :aria-label "Scroll position"} (get-in state [:ui :scroll])] (button (name (get-in state [:theme :mode])) [:minibuffer/open :themes] {:class "mode-theme dynamic-only" :aria-label "Choose color theme"}) [:span {:class "mode-encoding"} "UTF-8"] (button [:span "M-x" [:span {:class "mode-command-label"} " Commands"]] (if (get-in state [:minibuffer :open?]) [:minibuffer/cancel] [:minibuffer/open :commands]) {:id "mx-button" :class "mode-command dynamic-only" :aria-label (if (get-in state [:minibuffer :open?]) "M-x: close commands" "M-x: open commands") :aria-expanded (boolean (get-in state [:minibuffer :open?])) :aria-controls (when (get-in state [:minibuffer :open?]) "minibuffer")}) (link state "/help/" "Help" {:class "static-only mode-command"})]) (defn highlighted [query text] ;; Replace query-dependent fragments without remounting their completion option. [:span {:replicant/key [query text]} (map (fn [part] (if (:match? part) [:strong {:class "completion-match"} (:text part)] (:text part))) (commands/highlight-parts query text))]) (defn minibuffer [state] (when (get-in state [:minibuffer :open?]) (let [{:keys [kind query selection]} (:minibuffer state) candidates (commands/candidates state) label (case kind :search "Search" :buffers "Switch buffer" :themes "Set theme" "M-x") active (when (seq candidates) (str "candidate-" selection))] [:section {:id "minibuffer" :class "minibuffer" :role "dialog" :aria-modal "false" :aria-label "Command interface"} [:div {:class "minibuffer-inner"} [:div {:class "minibuffer-prompt"} [:label {:for "command-input" :class "mono"} label] [:input {:id "command-input" :type "text" :value query :placeholder (if (= kind :search) "Search titles and body text…" "Type a few letters…") :autocomplete "off" :spellcheck false :role "combobox" :aria-expanded "true" :aria-autocomplete "list" :aria-controls "completions" :aria-activedescendant active :on {:input [[:minibuffer/input [:event/value]]]}}]] [:p {:class "completion-status" :role "status" :aria-live "polite"} (str (count candidates) (if (= 1 (count candidates)) " result" " results")) [:span {:class "completion-hint"} "↑ ↓ select · Enter run · Esc / M-x close"]] (if (seq candidates) [:ul {:id "completions" :class "completions" :role "listbox" :aria-label label} (map-indexed (fn [i candidate] [:li {:id (str "candidate-" i) :replicant/key (str (:name candidate) (:path candidate)) :role "option" :aria-selected (= i selection) :class (when (= i selection) "selected") :on {:pointermove [[:minibuffer/select i]] :click [[:command/execute candidate]]}} [:span {:class "candidate-name"} (highlighted query (:name candidate))] [:span {:class "candidate-description"} [:span {:class "candidate-summary"} (highlighted query (:description candidate))] (when (:annotation candidate) [:span {:class "candidate-annotation"} (highlighted query (:annotation candidate))])]]) candidates)] [:div {:id "completions" :role "listbox" :aria-label label :class "no-results"} [:p (if (str/blank? query) "Type to search all published content." (str "No result matching “" query "”."))]])]]))) (defn tip-notification [state] [:div {:role "status" :aria-live "polite" :aria-atomic "true"} (when-let [tip (get-in state [:ui :tip-notice])] [:aside {:class "tip-notification" :aria-label "Random Emacs tip" :on {:pointerenter [[:tip/pause]] :pointerleave [[:tip/resume]] :focusin [[:tip/pause]] :focusout [[:tip/resume]]}} [:p {:class "mono tip-command"} (str "M-x " (:command tip))] [:p (:description tip)] [:div {:class "intro-links"} (link state (str "/snippets/" (:id tip) "/") "Read this tip") (button "Dismiss" [:tip/dismiss])]])]) (defn view [state] [:div {:class "site"} [:a {:href "#buffer" :class "skip-link"} "Skip to content"] [:header {:class "site-header"} (link state "/" [:span [:span {:class "brand-mark" :aria-hidden "true"} "*_"] [:span {:class "brand-name mono"} "scratch-buffer"]] {:class "brand" :aria-label "scratch-buffer home"}) [:nav {:class "site-navigation" :aria-label "Main navigation"} (for [page (filter #(#{:about :meetings :people :snippets} (:id %)) router/pages)] (link state (:path page) (str/capitalize (name (:id page))) {:replicant/key (:path page) :aria-current (when (str/starts-with? (get-in state [:route :path]) (:path page)) "page")})) [:span {:class "nav-underline" :aria-hidden "true"}]]] [:main {:id "buffer" :tabindex -1} (when (get-in state [:pwa :offline?]) [:aside {:class "network-note" :role "status"} "Offline. Showing cached published buffers and saved discussion snapshots. Posting on GitHub and Teams chat need a connection."]) (when-let [notice (get-in state [:ui :notice])] [:aside {:class "notice" :role "status"} [:p notice] (button "Dismiss" [:ui/dismiss] {:class "dynamic-only"})]) [:article {:replicant/key (get-in state [:route :path]) :class "buffer-content"} (buffer-view state) (discussion-section state)] [:div {:class "page-colophon"} [:p (get-in state [:content :site :status])] [:div (link state "/help/" "Help & shortcuts") " · " (link state "/search/" "Search") " · " (teams-link state "Teams chat") " · " (external (github/discussion-url state :source) "Source")]]] (tip-notification state) (minibuffer state) (mode-line state)]) (ns scratch.motion (:require [scratch.constellation :as constellation] [scratch.parentheses :as parentheses])) (def cadence-ms 800) (def word-cadence-ms 4800) (def fade-ms 1200) (defonce runtime (atom nil)) (declare sync! schedule! queue-response!) (defn dispatch! [actions] ((:dispatch @runtime) actions)) (defn active? [] (and (:node @runtime) (constellation/running? @(:app @runtime)))) (defn cycle-ms [] (if (= :parentheses (get-in @(:app @runtime) [:ui :hero])) word-cadence-ms cadence-ms)) (defn completion [index revision] (if (= :word index) [:orbit-word/commit revision] [:constellation/commit index revision])) (defn cancel! [animation] (when animation (set! (.-onfinish animation) nil) (.cancel animation))) (defn animations [] (concat [(:breath @runtime) (:response @runtime)] (:beams @runtime) (mapcat (fn [[_ fade]] [(:out fade) (:in fade)]) (:fades @runtime)))) (defn stop-clock! [] (when-let [timer (:timer @runtime)] (js/clearTimeout timer) (swap! runtime assoc :timer nil :remaining (max 0 (- (:due @runtime) (js/performance.now)))))) (defn settle-fades! [] (let [fades (:fades @runtime)] (swap! runtime assoc :fades {}) (doseq [[_ fade] fades] (cancel! (:out fade)) (cancel! (:in fade))) (when (seq fades) (dispatch! (mapv (fn [[index fade]] (completion index (:revision fade))) fades))))) (defn schedule! [delay] (when (and (active?) (nil? (:timer @runtime))) (swap! runtime assoc :due (+ (js/performance.now) delay) :timer (js/setTimeout (fn [] (swap! runtime assoc :timer nil :remaining (cycle-ms)) (when (active?) (dispatch! [[(if (= :parentheses (get-in @(:app @runtime) [:ui :hero])) :orbit-word/advance :constellation/advance)]]) (schedule! (cycle-ms)))) delay)))) (defn fade! [index revision] (let [node (:node @runtime) word? (= :word index) slot (.querySelector node (str "[data-slot='" (if word? "word" index) "']")) current (.querySelector slot (if word? ".orbit-word-current" ".constellation-current")) incoming (.querySelector slot (if word? ".orbit-word-incoming" ".constellation-incoming"))] (when-not (and current incoming) (throw (ex-info "Hero crossfade is missing a rendered label" {:slot index}))) (let [options #js {:duration fade-ms :easing "cubic-bezier(.4,0,.2,1)" :fill "both"} out (.animate current #js [#js {:opacity 1} #js {:opacity 0}] options) in (.animate incoming #js [#js {:opacity 0} #js {:opacity 1}] options)] (swap! runtime assoc-in [:fades index] {:out out :in in :revision revision}) (set! (.-onfinish in) (fn [_] (when (= revision (get-in @runtime [:fades index :revision])) (swap! runtime update :fades dissoc index) (cancel! out) (cancel! in) (dispatch! [(completion index revision)]))))))) (defn clamp [low value high] (max low (min high value))) (defn respond! [] (when (active?) (let [stage (:stage @runtime) rect (.getBoundingClientRect stage) progress (clamp 0 (/ (- (.-top rect)) (.-height rect)) 1) [x y] (:pointer @runtime) from (.-transform (js/getComputedStyle stage)) target (str "perspective(850px) translate3d(" (* 5 x) "px," (+ (* 3 y) (* 6 progress)) "px,0) rotateX(" (- (* -12 y) (* 8 progress)) "deg) rotateY(" (+ (* 16 x) (* 6 progress)) "deg) rotateZ(" (* 6 progress) "deg)")] (cancel! (:response @runtime)) (swap! runtime assoc :response (.animate stage #js [#js {:transform from} #js {:transform target}] #js {:duration 650 :easing "cubic-bezier(.2,.9,.2,1.1)" :fill "both"}))))) (defn queue-response! [] (when (and (active?) (nil? (:response-frame @runtime))) (swap! runtime assoc :response-frame (js/requestAnimationFrame (fn [_] (swap! runtime assoc :response-frame nil) (respond!)))))) (defn unmount! [] (stop-clock!) (when-let [frame (:response-frame @runtime)] (js/cancelAnimationFrame frame)) (when-let [observer (:observer @runtime)] (.disconnect observer)) (when-let [stage (:stage @runtime)] (.removeEventListener stage "pointermove" (:pointer-move @runtime)) (.removeEventListener stage "pointerleave" (:pointer-leave @runtime))) (doseq [animation (animations)] (cancel! animation)) (swap! runtime assoc :node nil :stage nil :observer nil :breath nil :response nil :beams [] :running? false :response-frame nil :pointer [0 0] :remaining (cycle-ms)) (settle-fades!)) (defn mount! [node] (let [stage (.querySelector node ".hero-stage") svg (.querySelector node ".hero-svg") beams (if (.querySelector node ".orbital-beam") (mapv (fn [{:keys [index duration] :as beam}] (.animate (.querySelector node (str "[data-beam='" index "']")) (clj->js (parentheses/frames beam)) #js {:duration duration :iterations js/Infinity :easing "linear"})) parentheses/beams) []) breath (when (.querySelector node ".constellation-svg") (.animate svg #js [#js {:transform "perspective(850px) translateZ(0) rotateX(6deg) rotateY(-10deg) rotateZ(-4deg) scale(.985)"} #js {:transform "perspective(850px) translateZ(0) rotateX(-6deg) rotateY(10deg) rotateZ(4deg) scale(1.015)"} #js {:transform "perspective(850px) translateZ(0) rotateX(6deg) rotateY(-10deg) rotateZ(-4deg) scale(.985)"}] #js {:duration 16000 :iterations js/Infinity :easing "ease-in-out"})) observer (js/IntersectionObserver. (fn [entries _] (when (= node (:node @runtime)) (let [entry (aget entries 0) visible? (and (.-isIntersecting entry) (>= (.-intersectionRatio entry) 0.1))] (dispatch! [[:constellation/visible visible?]])))) #js {:threshold #js [0 0.1]}) pointer-move (fn [event] (when (and (active?) (= "mouse" (.-pointerType event))) (let [rect (.getBoundingClientRect stage)] (swap! runtime assoc :pointer [(clamp -1 (- (* 2 (/ (- (.-clientX event) (.-left rect)) (.-width rect))) 1) 1) (clamp -1 (- (* 2 (/ (- (.-clientY event) (.-top rect)) (.-height rect))) 1) 1)]) (queue-response!)))) pointer-leave (fn [_] (swap! runtime assoc :pointer [0 0]) (queue-response!))] (when breath (.pause breath)) (doseq [animation beams] (.pause animation)) (swap! runtime assoc :node node :stage stage :observer observer :breath breath :beams beams :pointer-move pointer-move :pointer-leave pointer-leave) (.addEventListener stage "pointermove" pointer-move #js {:passive true}) (.addEventListener stage "pointerleave" pointer-leave #js {:passive true}) (.observe observer stage) (dispatch! [[:constellation/visible false]]))) (defn sync! [] (when @runtime (let [state @(:app @runtime) available? (get-in state [:ui :constellation :available?]) node (when available? (.querySelector js/document ".hero-illustration"))] (when (not= node (:node @runtime)) (unmount!) (when node (mount! node))) (when node (let [running? (active?) {:keys [paused? reduced?]} (get-in @(:app @runtime) [:ui :constellation])] (when (not= running? (:running? @runtime)) (swap! runtime assoc :running? running?) (if running? (do (doseq [animation (animations) :when animation] (when (not= "finished" (.-playState animation)) (.play animation))) (schedule! (:remaining @runtime)) (queue-response!)) (do (stop-clock!) (doseq [animation (animations) :when animation] (.pause animation))))) (when (or paused? reduced?) (settle-fades!)) (when reduced? (cancel! (:breath @runtime)) (cancel! (:response @runtime)) (doseq [animation (:beams @runtime)] (cancel! animation)) (swap! runtime assoc :response nil))))))) (defn start! [app dispatch] (let [supported? (and js/IntersectionObserver (.-animate (.-prototype js/Element))) preference (.matchMedia js/window "(prefers-reduced-motion: reduce)")] (reset! runtime {:app app :dispatch dispatch :node nil :fades {} :pointer [0 0] :timer nil :remaining cadence-ms :running? false}) (add-watch app :constellation-lifecycle (fn [_ _ before after] (when (or (not= (get-in before [:route :id]) (get-in after [:route :id])) (not= (get-in before [:minibuffer :open?]) (get-in after [:minibuffer :open?]))) (js/requestAnimationFrame (fn [_] (sync!)))))) (.addEventListener preference "change" #(dispatch [[:constellation/reduced (.-matches %)]])) (.addEventListener js/document "visibilitychange" #(dispatch [[:constellation/foreground (not (.-hidden js/document))]])) (.addEventListener js/window "scroll" queue-response! #js {:passive true}) (.addEventListener js/window "resize" queue-response! #js {:passive true}) (dispatch [[:constellation/reduced (.-matches preference)] [:constellation/foreground (not (.-hidden js/document))] [:constellation/available (boolean supported?)]]))) (ns scratch.nav) (defn start! [app] (let [nav (.querySelector js/document ".site-navigation") line (.querySelector nav ".nav-underline") preference (.matchMedia js/window "(prefers-reduced-motion: reduce)")] (when (.-animate line) (let [animation (atom nil) frame (atom nil) pointer-preview? (atom true) move! (fn [] (let [target (or (.querySelector nav (if @pointer-preview? "a:hover" "a:focus-visible")) (.querySelector nav "a[aria-current]")) shown? (and target (pos? (.-length (.getClientRects nav)))) style (js/getComputedStyle line) opacity (.-opacity style) from (.-transform style) to (if shown? (let [box (.getBoundingClientRect target) parent (.getBoundingClientRect nav) padding (js/getComputedStyle target) left (js/parseFloat (.-paddingLeft padding)) right (js/parseFloat (.-paddingRight padding))] (str "translate3d(" (+ (- (.-left box) (.-left parent)) left) "px," (- (.-bottom box) (.-top parent) 6) "px,0) scaleX(" (- (.-width box) left right) ")")) from)] (when @animation (.cancel @animation)) (reset! animation (.animate line #js [#js {:transform (if (= "0" opacity) to from) :opacity opacity} #js {:transform to :opacity (if shown? 1 0)}] #js {:duration (if (.-matches preference) 0 200) :easing "cubic-bezier(.2,.8,.2,1)" :fill "both"})))) queue! (fn [& [event]] (case (when event (.-type event)) "pointerover" (reset! pointer-preview? true) "pointerleave" (reset! pointer-preview? false) "focusin" (when (.matches (.-target event) ":focus-visible") (reset! pointer-preview? false)) nil) (when-not @frame (reset! frame (js/requestAnimationFrame (fn [_] (reset! frame nil) (move!))))))] (.setAttribute (.-documentElement js/document) "data-nav-motion" "true") (doseq [event ["pointerover" "pointerleave" "focusin" "focusout"]] (.addEventListener nav event queue!)) (.addEventListener js/window "resize" queue! #js {:passive true}) (.addEventListener preference "change" queue!) (when js/ResizeObserver (.observe (js/ResizeObserver. queue!) nav)) (add-watch app :navigation-underline (fn [_ _ before after] (when (not= (get-in before [:route :path]) (get-in after [:route :path])) (queue!)))) (queue!))))) (ns scratch.effects (:require [scratch.router :as router] [scratch.github :as github] [scratch.motion :as motion] [scratch.state :as state])) (defonce return-focus (atom nil)) (defonce install-event (atom nil)) (defonce tip-timeout (atom nil)) (defn cancel-tip-expiry! [] (when-let [timer @tip-timeout] (js/clearTimeout timer) (reset! tip-timeout nil))) (defn event [ctx] (:replicant/dom-event (:dispatch-data ctx))) (defn focus! [id] (when-let [element (.getElementById js/document id)] (.focus element #js {:preventScroll true}))) (defn after-render [f] (js/requestAnimationFrame (fn [_] (f)))) (defn notice! [ctx message] ((:dispatch ctx) [[:ui/notice message]])) (defn scroll-position [] (let [height (- (.-scrollHeight (.-documentElement js/document)) js/window.innerHeight) y js/window.scrollY] (cond (< height 2) "All" (< y 2) "Top" (>= y (- height 2)) "Bot" :else (str (js/Math.round (* 100 (/ y height))) "%")))) (def handlers {:state/replace (fn [_ app value] (reset! app value)) :constellation/fade (fn [_ _ index revision] (motion/fade! index revision)) :orbit-word/fade (fn [_ _ revision] (motion/fade! :word revision)) :constellation/sync (fn [_ _] (motion/sync!)) :dispatch (fn [ctx _ action] ((:dispatch ctx) [(if (= :buffer/open (first action)) (update action 2 #(assoc % :scroll js/window.scrollY)) action)])) :link/follow (fn [ctx _ path] (let [e (event ctx)] (when (and e (= 0 (.-button e)) (not (or (.-altKey e) (.-ctrlKey e) (.-metaKey e) (.-shiftKey e)))) (.preventDefault e) ((:dispatch ctx) [[:buffer/open path {:scroll js/window.scrollY}]])))) :history/navigate (fn [_ _ path options] (when-not (:pop? options) (when (not= path (str js/location.pathname js/location.hash)) (if (:replace? options) (.replaceState js/history nil "" path) (.pushState js/history nil "" path))))) :document/title (fn [_ _ title] (set! (.-title js/document) (str title " · DNV *scratch-buffer*"))) :navigation/settle (fn [ctx _ y anchor] (reset! return-focus nil) (after-render #(do (if-let [target (when anchor (.getElementById js/document anchor))] (do (focus! anchor) (.scrollIntoView target #js {:block "start" :behavior "instant"})) (do (focus! "buffer") (js/window.scrollTo #js {:top y :behavior "instant"}))) ((:dispatch ctx) [[:ui/scroll (scroll-position)]])))) :focus/minibuffer (fn [_ _] (when-not @return-focus (reset! return-focus (.-activeElement js/document))) (focus! "command-input")) :focus/return (fn [_ _] (let [element @return-focus] (reset! return-focus nil) (when (and element (.-isConnected element)) (.focus element #js {:preventScroll true})))) :completion/scroll (fn [_ app] (after-render #(when-let [element (.getElementById js/document (str "candidate-" (get-in @app [:minibuffer :selection])))] (.scrollIntoView element #js {:block "nearest" :behavior "instant"})))) :theme/apply (fn [_ app] (.setAttribute (.-documentElement js/document) "data-theme" (name (get-in @app [:theme :mode]))) (when-let [meta (.querySelector js/document "meta[name='theme-color']")] (.setAttribute meta "content" (if (= :dark (state/resolved-theme @app)) "#172126" "#172e35")))) :theme/persist (fn [ctx _ mode] (try (.setItem js/localStorage "scratch-theme" (name mode)) (catch :default e (js/console.warn "Theme preference could not be saved." e) (notice! ctx "Your theme changed, but this browser could not save the preference.")))) :external/open (fn [_ _ url] (.assign js/location url)) :github/fetch-snapshot (fn [ctx app url revision] (let [controller (js/AbortController.) timer (js/setTimeout #(.abort controller) 12000)] (-> (js/fetch url #js {:credentials "omit" :cache "no-cache" :signal (.-signal controller)}) (.then (fn [response] (when-not (.-ok response) (throw (js/Error. (str "Discussion snapshot request failed (HTTP " (.-status response) ").")))) (.json response))) (.then (fn [data] (let [snapshot (github/validate-snapshot! (get-in @app [:content :site :repository]) (js->clj data :keywordize-keys true))] ((:dispatch ctx) [[:github/snapshot-loaded revision snapshot]])))) (.catch (fn [error] (js/console.warn "Could not load the discussion snapshot." error) ((:dispatch ctx) [[:github/snapshot-failed revision "Could not load the discussion snapshot. Retry, or read the conversation on GitHub."]]))) (.finally #(js/clearTimeout timer))))) :external/open-tab (fn [ctx _ url] ;; Keep a popup handle, then let a native link enforce no-referrer navigation. (if-let [tab (.open js/window "about:blank" "_blank")] (let [document (.-document tab) anchor (.createElement document "a")] (set! (.-opener tab) nil) (.setAttribute anchor "href" url) (.setAttribute anchor "rel" "noopener noreferrer") (.setAttribute anchor "referrerpolicy" "no-referrer") (.appendChild (.-body document) anchor) (.click anchor)) (do (js/console.warn "Opening an external tab was blocked.") (notice! ctx "Your browser blocked the new tab. Use the Teams chat link on this page.")))) :clipboard/write (fn [ctx _ text kind] (let [guidance (case kind :member-template "Open People to select and copy the template manually." :code "Select the code and copy it manually.") copied (case kind :member-template "Member template copied. Replace the placeholder with your GitHub handle." :code "Code copied to clipboard.")] (if (and (.-clipboard js/navigator) (.-writeText (.-clipboard js/navigator))) (-> (.writeText (.-clipboard js/navigator) text) (.then #(notice! ctx copied)) (.catch (fn [error] (js/console.warn "Could not copy to clipboard." error) (notice! ctx (str "Could not copy to clipboard. " guidance))))) (do (js/console.warn "Clipboard writing is unavailable.") (notice! ctx (str "Clipboard access is unavailable. " guidance)))))) :download/file (fn [_ _ url filename] (let [anchor (.createElement js/document "a")] (set! (.-href anchor) url) (set! (.-download anchor) filename) (set! (.-hidden anchor) true) (.appendChild (.-body js/document) anchor) (.click anchor) (.remove anchor))) :meetings/format-local (fn [ctx app] (if (and js/Intl (.-DateTimeFormat js/Intl)) (let [zone (.-timeZone (.resolvedOptions (js/Intl.DateTimeFormat.))) date (js/Intl.DateTimeFormat. "en-GB" #js {:timeZone zone :weekday "short" :day "numeric" :month "short" :year "numeric"}) time (js/Intl.DateTimeFormat. "en-GB" #js {:timeZone zone :hour "2-digit" :minute "2-digit" :hourCycle "h23"}) times (into {} (for [meeting (get-in @app [:content :meetings]) :when (not= zone (:timezone meeting)) :let [start (js/Date. (:start-utc meeting)) end (js/Date. (:end-utc meeting))]] [(:id meeting) {:date (.format date start) :start (.format time start) :end-date (.format date end) :end (.format time end) :timezone zone}]))] ((:dispatch ctx) [[:meetings/local-times times]])) (do (js/console.warn "Local time zone formatting is unavailable.") (notice! ctx "Your local time zone could not be shown. Meeting times use the published time zone.")))) :tip/choose (fn [ctx app] (let [n (count (filter :tip? (get-in @app [:content :snippets]))) current (get-in @app [:ui :tip]) index (if (and (> n 1) (some? current)) (mod (+ current 1 (rand-int (dec n))) n) (rand-int n))] ((:dispatch ctx) [[:tip/set index]]))) :tip/expire-later (fn [ctx _ revision] (cancel-tip-expiry!) (when-let [notification (.querySelector js/document ".tip-notification")] (when-not (.matches notification ":hover, :focus-within") (reset! tip-timeout (js/setTimeout (fn [] (reset! tip-timeout nil) ((:dispatch ctx) [[:tip/expire revision]])) 6000))))) :tip/cancel-expiry (fn [_ _] (cancel-tip-expiry!)) :tip/return-focus (fn [_ _] (focus! "mx-button")) :pwa/prompt (fn [ctx _] (if-let [prompt @install-event] (do (.prompt prompt) (-> (.-userChoice prompt) (.then (fn [choice] (reset! install-event nil) ((:dispatch ctx) [[:pwa/available false]]) (notice! ctx (if (= "accepted" (.-outcome choice)) "Installation requested. Your browser will finish adding the app." "Installation canceled. You can keep reading in this browser.")))) (.catch (fn [error] (js/console.error "Installation failed." error) (notice! ctx "Could not start installation. Try your browser’s install menu."))))) (notice! ctx (if (or (.-matches (.matchMedia js/window "(display-mode: standalone)")) (true? (.-standalone js/navigator))) "This site is already running as an installed app." "To install, use your browser’s Install app menu. On iPhone or iPad, use Share → Add to Home Screen. If unavailable, bookmark this site instead."))))}) (ns scratch.actions (:require [nexus.core :as nexus] [scratch.effects :as effects] [scratch.state :as state])) (def action-ids [:buffer/open :buffer/previous :minibuffer/open :minibuffer/cancel :minibuffer/input :minibuffer/move :minibuffer/select :minibuffer/history :minibuffer/execute :command/execute :theme/set :theme/toggle :theme/system :theme/restore :github/open :github/load-snapshot :github/snapshot-loaded :github/snapshot-failed :teams/open :tip/random :tip/set :tip/expire :tip/dismiss :tip/pause :tip/resume :ui/scroll :ui/notice :ui/dismiss :hero/select :member/copy-template :code/copy :meeting/download :meetings/prepare :meetings/local-times :constellation/advance :constellation/commit :constellation/toggle :constellation/reduced :constellation/available :constellation/visible :constellation/foreground :orbit-word/advance :orbit-word/commit :pwa/offline :pwa/ready :pwa/available :pwa/install]) (def nexus-config {:nexus/system->state deref :nexus/placeholders {:event/value (fn [data] (some-> (:replicant/dom-event data) .-target .-value))} :nexus/expansions (into {} (for [kind action-ids] [kind (fn [app-state & args] (let [{:keys [state effects]} (state/transition app-state (into [kind] args))] (into [[:state/replace state]] effects)))])) :nexus/effects effects/handlers :nexus/on-error (fn [_ error] (js/console.error "Action failed." (:err error)))}) (defn dispatch! [app data actions] (let [result (nexus/dispatch nexus-config app data actions)] (when (seq (:errors result)) (swap! app assoc-in [:ui :notice] "That action could not be completed. Try again, or use the ordinary page links.")) result)) (ns scratch.keyboard (:require [clojure.string :as str])) (defonce prefix-until (atom 0)) (defn editable? [e] (let [target (.-target e)] (or (.-isContentEditable target) (#{"INPUT" "TEXTAREA" "SELECT"} (.-tagName target))))) (defn handle! [app dispatch e] (let [key (str/lower-case (.-key e)) open? (get-in @app [:minibuffer :open?]) palette-input? (= "command-input" (.-id (.-target e))) control? (and (.-ctrlKey e) (not (or (.-altKey e) (.-metaKey e)))) meta? (and (.-altKey e) (not (or (.-ctrlKey e) (.-metaKey e)))) plain? (not (or (.-altKey e) (.-ctrlKey e) (.-metaKey e) (.-shiftKey e))) prefix? (> @prefix-until (.now js/Date)) action (cond (.-isComposing e) nil (and meta? (= key "x")) [:minibuffer/open :commands] (and open? (or (= key "escape") (and control? (= key "g")))) [:minibuffer/cancel] (and palette-input? open? (= key "arrowdown")) [:minibuffer/move 1] (and palette-input? open? (= key "arrowup")) [:minibuffer/move -1] (and palette-input? open? (= key "enter")) [:minibuffer/execute] (and palette-input? open? meta? (= key "p")) [:minibuffer/history 1] (and palette-input? open? meta? (= key "n")) [:minibuffer/history -1] (and prefix? plain? (= key "b") (not (editable? e))) [:minibuffer/open :buffers] (and control? (= key "s") (not (editable? e))) [:minibuffer/open :search] (and control? (= key "x") (not (editable? e))) :prefix :else nil)] (when prefix? (reset! prefix-until 0)) (when action (.preventDefault e) (if (= action :prefix) (reset! prefix-until (+ (.now js/Date) 1500)) (dispatch [action]))))) (ns scratch.pwa (:require [scratch.effects :as effects] [scratch.router :as router])) (defn watch-worker! [registration dispatch] (when-let [worker (.-installing registration)] (.addEventListener worker "statechange" (fn [_] (cond (= "redundant" (.-state worker)) (do (js/console.error "The offline edition could not be cached.") (dispatch [[:ui/notice "Offline reading could not be prepared. Published pages still work while connected."]])) (and (= "installed" (.-state worker)) (.-controller (.-serviceWorker js/navigator))) (dispatch [[:ui/notice "An updated site is ready. Close this site’s tabs and reopen it to use the new cached edition."]])))))) (defn start! [app dispatch] (dispatch [[:pwa/offline (not (.-onLine js/navigator))]]) (.addEventListener js/window "online" #(dispatch [[:pwa/offline false]])) (.addEventListener js/window "offline" #(dispatch [[:pwa/offline true]])) (.addEventListener js/window "beforeinstallprompt" (fn [event] (.preventDefault event) (reset! effects/install-event event) (dispatch [[:pwa/available true]]))) (.addEventListener js/window "appinstalled" (fn [_] (reset! effects/install-event nil) (dispatch [[:pwa/available false] [:ui/notice "Installed. See you in the next buffer."]]))) (when (.-serviceWorker js/navigator) (-> (.register (.-serviceWorker js/navigator) (router/url (:base @app) "/sw.js") #js {:scope (:base @app)}) (.then (fn [registration] (watch-worker! registration dispatch) (.addEventListener registration "updatefound" (fn [_] (watch-worker! registration dispatch))) (.-ready (.-serviceWorker js/navigator)))) (.then (fn [_] (dispatch [[:pwa/ready]]))) (.catch (fn [error] (js/console.error "Offline cache registration failed." error) (dispatch [[:ui/notice "Offline reading could not be prepared. Published pages still work while connected."]])))))) (ns scratch.app (:require [replicant.dom :as r] [scratch.actions :as actions] [scratch.effects :as effects] [scratch.keyboard :as keyboard] [scratch.motion :as motion] [scratch.nav :as nav] [scratch.pwa :as pwa] [scratch.router :as router] [scratch.state :as state] [scratch.view :as view])) (def base (.getAttribute (.querySelector js/document "meta[name='app-base']") "content")) (defonce app (let [now (.toISOString (js/Date.))] (atom (assoc-in (state/initial (assoc scratch.generated/data :today (subs now 0 10) :now now) base (or (router/local-path base js/location.pathname) js/location.pathname)) [:ui :hero] (rand-nth [:constellation :parentheses]))))) (defn dispatch [events] (actions/dispatch! app {} events)) (defn render! [] (r/render (.getElementById js/document "app") (view/view @app))) (defn update-scroll! [] (let [label (effects/scroll-position)] (when (not= label (get-in @app [:ui :scroll])) (dispatch [[:ui/scroll label]])))) (r/set-dispatch! #(actions/dispatch! app %1 %2)) (add-watch app :render (fn [_ _ _ _] (render!))) (render!) (.setAttribute (.-documentElement js/document) "data-enhanced" "true") (set! (.-scrollRestoration js/history) "manual") (let [media (.matchMedia js/window "(prefers-color-scheme: dark)")] (dispatch [[:theme/system (.-matches media)]]) (.addEventListener media "change" #(dispatch [[:theme/system (.-matches %)]]))) (try (when-let [theme (.getItem js/localStorage "scratch-theme")] (dispatch [[:theme/restore (keyword theme)]])) (catch :default e (js/console.warn "Theme preference unavailable." e) (dispatch [[:ui/notice "This browser cannot read saved preferences. Your device theme is in use."]]))) (.addEventListener js/window "popstate" (fn [_] (dispatch [[:buffer/open (str (or (router/local-path base js/location.pathname) "/") js/location.hash) {:pop? true :restore? true :scroll js/window.scrollY}]]))) (.addEventListener js/document "keydown" #(keyboard/handle! app dispatch %)) (.addEventListener js/window "scroll" update-scroll! #js {:passive true}) (.addEventListener js/window "resize" update-scroll! #js {:passive true}) (js/requestAnimationFrame (fn [_] (update-scroll!))) (dispatch [[:meetings/prepare] [:github/load-snapshot]]) (motion/start! app dispatch) (nav/start! app) (pwa/start! app dispatch) (when (or (seq js/location.hash) (not= js/location.pathname (router/url base (get-in @app [:route :path])))) (dispatch [[:buffer/open (str (or (router/local-path base js/location.pathname) "/") js/location.hash) {:replace? true}]])) (defonce console-welcome (do (js/console.info (str "\n" " \\ | /\n" " \\ | /\n" " ---- * ----\n" " / | \\\n" " / | \\_\n" "\n" "Welcome to *scratch-buffer*.\n" "A small website. A perfectly reasonable amount of Lisp.\n" "M-x is downstairs. Your yak can wait.\n")) true))