;; This Source Code Form is subject to the terms of the Mozilla Public ;; License, v. 2.0. If a copy of the MPL was not distributed with this ;; file, You can obtain one at http://mozilla.org/MPL/2.0/. ;; ;; Copyright (c) KALEIDOS INC Sucursal en España SL (ns app.main.data.shortcuts (:refer-clojure :exclude [meta reset!]) (:require ["@penpot/mousetrap$default" :as mousetrap] [app.common.data :as d] [app.common.logging :as log] [app.common.schema :as sm] [app.config :as cf] [cuerdas.core :as str] [potok.v2.core :as ptk])) (log/set-level! :warn) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def mac-command "\u2318") (def mac-option "\u2325") (def mac-delete "\u232B") (def mac-shift "\u21E7") (def mac-control "\u2303") (def mac-esc "\u238B") (def mac-enter "\u23CE") (def left-arrow "\u2190") (def up-arrow "\u2191") (def right-arrow "\u2192") (def down-arrow "\u2193") (def tab "tab") (defn c-mod "Adds the control/command modifier to a shortcuts depending on the operating system for the user" [shortcut] (if (cf/check-platform? :macos) (str "command+" shortcut) (str "ctrl+" shortcut))) (defn a-mod "Adds the alt/option modifier to a shortcuts depending on the operating system for the user" [shortcut] (str "alt+" shortcut)) (defn ca-mod [shortcut] (c-mod (a-mod shortcut))) (defn meta [key] ;; If the key is "+" we need to surround with quotes ;; otherwise will not be very readable (let [key (if (and (not (cf/check-platform? :macos)) (= key "+")) "\"+\"" key)] (str (if (cf/check-platform? :macos) mac-command "Ctrl+") key))) (defn shift [key] (str (if (cf/check-platform? :macos) mac-shift "Shift+") key)) (defn alt [key] (str (if (cf/check-platform? :macos) mac-option "Alt+") key)) (defn meta-shift [key] (-> key meta shift)) (defn meta-alt [key] (-> key meta alt)) (defn alt-shift [key] (-> key alt shift)) (defn supr [] (if (cf/check-platform? :macos) mac-delete "Del")) (defn esc [] (if (cf/check-platform? :macos) mac-esc "Escape")) (defn enter [] (if (cf/check-platform? :macos) mac-enter "Enter")) (defn split-sc [sc] (let [sc (cond-> sc (str/includes? sc "++") (str/replace "++" "+plus"))] (if (= (count sc) 1) [sc] (str/split sc #"\+| ")))) (defn command->tooltip "Converts a Mousetrap command string (e.g. \"command+shift+z\") to a human-readable display string in the same format used by :tooltip fields (e.g. \"⌘⇧Z\" on macOS or \"Ctrl+Shift+Z\" on Windows). Returns nil for empty or unbound commands." [command] (when (and command (not= command "")) (let [is-macos? (cf/check-platform? :macos) parts (str/split command #"\+") display-part (fn [p] (case p "ctrl" (if is-macos? mac-control "Ctrl+") "command" (if is-macos? mac-command "Ctrl+") "alt" (if is-macos? mac-option "Alt+") "shift" (if is-macos? mac-shift "Shift+") "up" up-arrow "down" down-arrow "left" left-arrow "right" right-arrow "del" (if is-macos? mac-delete "Del") "backspace" (if is-macos? mac-delete "Backspace") "escape" (if is-macos? mac-esc "Escape") "enter" (if is-macos? mac-enter "Enter") "space" "Space" "tab" tab (str/upper p)))] (str/join "" (map display-part parts))))) (defn apply-custom-overrides [shortcuts custom-overrides group-key] (let [group-overrides (get custom-overrides group-key)] (if (empty? group-overrides) shortcuts (reduce-kv (fn [acc sc-key new-command] (if (and (contains? acc sc-key) (not (:disabled (get acc sc-key)))) (-> acc (assoc-in [sc-key :original-command] (get-in acc [sc-key :command])) (assoc-in [sc-key :command] new-command) (update sc-key dissoc :show-command)) acc)) shortcuts group-overrides)))) (defn build-command-index [shortcuts] (reduce-kv (fn [acc sc-key sc-def] (let [commands (:command sc-def)] (if (vector? commands) (reduce #(assoc %1 %2 sc-key) acc commands) (assoc acc commands sc-key)))) {} shortcuts)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Events ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; --- EVENT: push (def ^:private schema:shortcuts [:map-of :keyword [:map [:command [:or :string [:vector :any]]] [:fn {:optional true} fn?] [:tooltip {:optional true} :string]]]) (def ^:private check-shortcuts (sm/check-fn schema:shortcuts)) (defn- wrap-cb [key cb] (fn [event] (log/debug :msg (str "Shortcut" key)) (when (unchecked-get event "preventDefault") (.preventDefault event)) (cb event))) (defn- bind! [shortcuts] (->> shortcuts (remove #(:disabled (second %))) (run! (fn [[key {:keys [command fn type overwrite]}]] (let [callback (wrap-cb key fn) commands (if (vector? command) (into-array command) #js [command])] (if (vector? type) (do (mousetrap/bind commands callback (nth type 0) overwrite) (mousetrap/bind commands callback (nth type 1) overwrite)) (let [undefined (js* "(void 0)")] (if type (mousetrap/bind commands callback type overwrite) (mousetrap/bind commands callback undefined overwrite))))))))) (defn- reset! ([] (mousetrap/reset)) ([shortcuts] (mousetrap/reset) (bind! shortcuts))) (def ^:private conj* (fnil conj (d/ordered-map))) (defn push-shortcuts [key shortcuts group-key & {:keys [merge-shortcuts]}] (assert (keyword? key) "expected a keyword for `key`") (let [shortcuts (check-shortcuts shortcuts)] (ptk/reify ::push-shortcuts ptk/UpdateEvent (update [_ state] (let [custom-overrides (get-in state [:profile :props :custom-shortcuts]) group-key (or group-key (:shortcuts-group-key state)) merge-sc (cond (= merge-shortcuts :auto) (let [[_ sc] (last (:shortcuts state))] sc) (map? merge-shortcuts) merge-shortcuts) effective (if merge-sc (merge merge-sc shortcuts) shortcuts) effective (apply-custom-overrides effective custom-overrides group-key)] (-> state (update :shortcuts conj* [key effective]) (assoc :shortcuts-group-key group-key)))) ptk/EffectEvent (effect [_ state _] (let [[_ stored] (last (:shortcuts state))] (reset! stored)))))) (defn pop-shortcuts [key] (ptk/reify ::pop-shortcuts ptk/UpdateEvent (update [_ state] (update state :shortcuts (fn [shortcuts] (dissoc shortcuts key)))) ptk/EffectEvent (effect [_ state _] (let [[_key shortcuts] (last (:shortcuts state)) custom-overrides (get-in state [:profile :props :custom-shortcuts]) group-key (:shortcuts-group-key state) effective (apply-custom-overrides shortcuts custom-overrides group-key)] (reset! effective))))) (defn rebind-shortcuts [] (ptk/reify ::rebind-shortcuts ptk/EffectEvent (effect [_ state _] (let [custom-overrides (get-in state [:profile :props :custom-shortcuts]) group-key (:shortcuts-group-key state) merged (reduce merge (map val (:shortcuts state))) effective (apply-custom-overrides merged custom-overrides group-key)] (reset! effective)))))