├── .gitignore ├── flsproject.fnl ├── run-test ├── .github └── CODEOWNERS ├── docs ├── edit-with-emacs-demo.gif ├── spacehammer-fsm-0.1.png ├── spacehammer-fsm.graffle ├── testing.org └── emacs.org ├── secrets.fnl ├── lib ├── globals.fnl ├── testing │ ├── test.lua │ ├── test-runner.fnl │ ├── assert.fnl │ └── init.fnl ├── utils.fnl ├── text.fnl ├── macros.fnl ├── advice │ ├── macros.fnl │ └── init.fnl ├── lifecycle.fnl ├── hyper.fnl ├── bind.fnl ├── atom.fnl ├── statemachine.fnl ├── functional.fnl ├── apps.fnl └── modal.fnl ├── init.lua ├── chrome.fnl ├── LICENSE ├── multimedia.fnl ├── apps.fnl ├── repl.fnl ├── slack.fnl ├── test ├── functional-test.fnl ├── statemachine-test.fnl └── advice-test.fnl ├── CHANGELOG.ORG ├── emacs.fnl ├── spacehammer.el ├── core.fnl ├── README.ORG ├── vim.fnl ├── config.example.fnl └── windows.fnl /.gitignore: -------------------------------------------------------------------------------- 1 | private 2 | Spoons 3 | -------------------------------------------------------------------------------- /flsproject.fnl: -------------------------------------------------------------------------------- 1 | {:extra-globals "hs"} 2 | -------------------------------------------------------------------------------- /run-test: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | exec hs ./lib/testing/test.lua "$(pwd)" "$@" 4 | -------------------------------------------------------------------------------- /.github/CODEOWNERS: -------------------------------------------------------------------------------- 1 | # Global codeowners 2 | * @agzam @jaidetree @Grazfather 3 | *.el @agzam 4 | -------------------------------------------------------------------------------- /docs/edit-with-emacs-demo.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/agzam/spacehammer/HEAD/docs/edit-with-emacs-demo.gif -------------------------------------------------------------------------------- /docs/spacehammer-fsm-0.1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/agzam/spacehammer/HEAD/docs/spacehammer-fsm-0.1.png -------------------------------------------------------------------------------- /docs/spacehammer-fsm.graffle: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/agzam/spacehammer/HEAD/docs/spacehammer-fsm.graffle -------------------------------------------------------------------------------- /secrets.fnl: -------------------------------------------------------------------------------- 1 | (fn read-secrets 2 | [] 3 | (let [run-str "/usr/local/MacGPG2/bin/gpg2 -q --for-your-eyes-only --no-tty -d ./.secrets.json.gpg" 4 | file (io.popen run-str) 5 | out (file:read "*l")] 6 | (file:close) 7 | (when out (hs.json.decode out)))) 8 | 9 | {:read read-secrets} 10 | -------------------------------------------------------------------------------- /lib/globals.fnl: -------------------------------------------------------------------------------- 1 | (local fennel (require :fennel)) 2 | (local {: map} (require :lib.functional)) 3 | 4 | (global pprint 5 | (fn pprint 6 | [...] 7 | " 8 | Similar to print but formats table arguments for human readability 9 | " 10 | (print 11 | (table.unpack 12 | (map #(match (type $1) 13 | "table" (fennel.view $1) 14 | _ $1) 15 | [...]))))) 16 | -------------------------------------------------------------------------------- /lib/testing/test.lua: -------------------------------------------------------------------------------- 1 | --test.lua 2 | -- A script to run fennel files as tests passed in as cli args 3 | 4 | -- Support upcoming 5.4 release and also use luarocks' local path 5 | package.path = package.path .. ";" .. os.getenv("HOME") .. "/.luarocks/share/lua/5.4/?.lua;" .. os.getenv("HOME") .. "/.luarocks/share/lua/5.4/?/init.lua" 6 | package.cpath = package.cpath .. ";" .. os.getenv("HOME") .. "/.luarocks/lib/lua/5.4/?.so" 7 | 8 | fennel = require("fennel") 9 | 10 | -- Support docstrings 11 | 12 | local searcher = fennel.makeSearcher({ 13 | useMetadata = true, 14 | }) 15 | 16 | local testRunner = require "lib.testing.test-runner" 17 | 18 | testRunner["load-tests"](_cli.args) 19 | -------------------------------------------------------------------------------- /init.lua: -------------------------------------------------------------------------------- 1 | hs.alert.show("Spacehammer config loaded") 2 | 3 | -- Support upcoming 5.4 release and also use luarocks' local path 4 | package.path = package.path .. ";" .. os.getenv("HOME") .. "/.luarocks/share/lua/5.4/?.lua;" .. os.getenv("HOME") .. "/.luarocks/share/lua/5.4/?/init.lua" 5 | package.cpath = package.cpath .. ";" .. os.getenv("HOME") .. "/.luarocks/lib/lua/5.4/?.so" 6 | package.path = package.path .. ";" .. os.getenv("HOME") .. "/.luarocks/share/lua/5.3/?.lua;" .. os.getenv("HOME") .. "/.luarocks/share/lua/5.3/?/init.lua" 7 | package.cpath = package.cpath .. ";" .. os.getenv("HOME") .. "/.luarocks/lib/lua/5.3/?.so" 8 | 9 | fennel = require("fennel") 10 | table.insert(package.loaders or package.searchers, fennel.searcher) 11 | 12 | require "core" 13 | -------------------------------------------------------------------------------- /chrome.fnl: -------------------------------------------------------------------------------- 1 | (require-macros :lib.macros) 2 | 3 | ;; setting conflicting Cmd+L (jump to address bar) keybinding to Cmd+Shift+L 4 | (fn open-location 5 | [] 6 | " 7 | Activate the Chrome > File > Open Location... action which moves focus to the 8 | address\\search bar. 9 | Returns nil 10 | " 11 | (when-let [app (: (hs.window.focusedWindow) :application)] 12 | (app:selectMenuItem ["File" "Open Location…"]))) 13 | 14 | (fn prev-tab 15 | [] 16 | " 17 | Send the key stroke cmd+shift+[ to move to the previous tab. 18 | This shortcut is shared by a lot of apps in addition to Chrome!. 19 | " 20 | (hs.eventtap.keyStroke [:cmd :shift] "[")) 21 | 22 | (fn next-tab 23 | [] 24 | " 25 | Send the key stroke cmd+shift+] to move to the next tab. 26 | This shortcut is shared by a lot of apps in addition to Chrome!. 27 | " 28 | (hs.eventtap.keyStroke [:cmd :shift] "]")) 29 | 30 | {:open-location open-location 31 | :prev-tab prev-tab 32 | :next-tab next-tab} 33 | -------------------------------------------------------------------------------- /lib/utils.fnl: -------------------------------------------------------------------------------- 1 | (fn global-filter 2 | [] 3 | " 4 | Filter that includes full-screen apps 5 | " 6 | (let [filter (hs.window.filter.new)] 7 | (filter:setAppFilter 8 | :Emacs 9 | {:allowRoles [:AXUnknown 10 | :AXStandardWindow 11 | :AXDialog 12 | :AXSystemDialog]}))) 13 | 14 | (fn get-or-add-logger [loggers id ?level] 15 | "If (. loggers id) exists, returns it; otherwise instantiates & stores a new one. 16 | If ?level is provided, sets it on the new or existing hs.logger instance. 17 | `loggers` is expected to be a weak-valued table." 18 | (case (. loggers id) 19 | log (do (when ?level (log.setLogLevel ?level)) 20 | log) 21 | _ (let [log (hs.logger.new id ?level)] 22 | (tset loggers id log) 23 | log))) 24 | 25 | ;; Weak-valued table to store instantiated loggers by ID. Can be called as a 26 | ;; function to create & store a new instance, optionally with provided log level 27 | (local logger (setmetatable {} {:__mode :v :__call get-or-add-logger})) 28 | 29 | {:global-filter global-filter 30 | : logger} 31 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2017 Ag Ibragimov 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /multimedia.fnl: -------------------------------------------------------------------------------- 1 | (fn m-key [key] 2 | " 3 | Simulates pressing a multimedia key on a keyboard 4 | Takes the key string and simulates pressing it for 5 ms then relesing it. 5 | Side effectful. 6 | Returns nil 7 | " 8 | (: (hs.eventtap.event.newSystemKeyEvent (string.upper key) true) :post) 9 | (hs.timer.usleep 5) 10 | (: (hs.eventtap.event.newSystemKeyEvent (string.upper key) false) :post)) 11 | 12 | (fn play-or-pause 13 | [] 14 | " 15 | Simulate pressing the play\\pause keyboard key 16 | " 17 | (m-key :play)) 18 | 19 | (fn prev-track 20 | [] 21 | " 22 | Simulate pressing the previous track keyboard key 23 | " 24 | (m-key :previous)) 25 | 26 | (fn next-track 27 | [] 28 | " 29 | Simulate pressing the next track keyboard key 30 | " 31 | (m-key :next)) 32 | 33 | (fn volume-up 34 | [] 35 | " 36 | Simulate pressing the volume up key 37 | " 38 | (m-key :sound_up)) 39 | 40 | (fn volume-down 41 | [] 42 | " 43 | Simulate pressing the volume down key 44 | " 45 | (m-key :sound_down)) 46 | 47 | {:play-or-pause play-or-pause 48 | :prev-track prev-track 49 | :next-track next-track 50 | :volume-up volume-up 51 | :volume-down volume-down} 52 | -------------------------------------------------------------------------------- /lib/testing/test-runner.fnl: -------------------------------------------------------------------------------- 1 | (local fennel (require :fennel)) 2 | (require :lib.globals) 3 | (local {: slice} (require :lib.functional)) 4 | 5 | (local homedir (os.getenv "HOME")) 6 | (local customdir (.. homedir "/.spacehammer")) 7 | (tset fennel :path (.. customdir "/?.fnl;" fennel.path)) 8 | (tset fennel :path (.. customdir "/?/init.fnl;" fennel.path)) 9 | 10 | ;; Setup some globals for test files and debugging 11 | 12 | 13 | (global {: after 14 | : before 15 | : describe 16 | : it} (require :lib.testing)) 17 | 18 | ;; Pull in some locals from the testing library as well 19 | 20 | (local {: init 21 | : collect-tests 22 | : run-all-tests} (require :lib.testing)) 23 | 24 | (fn load-tests 25 | [args] 26 | 27 | " 28 | Takes a list of args starting with a directory 29 | Runs each test file using fennel.dofile 30 | " 31 | (init) 32 | (let [[dir & test-files] (slice 2 args)] 33 | (each [i test-file (ipairs test-files)] 34 | (let [test-file-path (hs.fs.pathToAbsolute (.. dir "/" test-file))] 35 | (print "Running tests for" test-file-path) 36 | (fennel.dofile test-file-path)))) 37 | 38 | 39 | (collect-tests) 40 | (run-all-tests)) 41 | 42 | 43 | {: load-tests} 44 | -------------------------------------------------------------------------------- /lib/text.fnl: -------------------------------------------------------------------------------- 1 | (local {: map 2 | : reduce} (require :lib.functional)) 3 | 4 | " 5 | These functions will align items in a modal menu based on columns. 6 | This makes the modal look more organized because the keybindings, separator, and 7 | action are all vertically aligned based on the longest value of each column. 8 | " 9 | 10 | (fn max-length 11 | [items] 12 | " 13 | Finds the max length of each value in a column 14 | Takes a list of key value pair lists 15 | Returns the maximum length in characters. 16 | " 17 | (reduce 18 | (fn [max [key _]] (math.max max (length key))) 19 | 0 20 | items)) 21 | 22 | (fn pad-str 23 | [char max str] 24 | " 25 | Pads a string to the max length with the specified char concatted to str. 26 | Takes the char string to pad with typically \" \", the max size of the column, 27 | and the str to concat to. 28 | Returns the padded string 29 | 30 | Example: 31 | (pad-str \".\" 6 \"hey\") 32 | ;; => \"hey...\" 33 | " 34 | (let [diff (- max (# str))] 35 | (.. str (string.rep char diff)))) 36 | 37 | 38 | (fn align-columns 39 | [items] 40 | " 41 | Aligns the key column of the menu items by padding out each 42 | key string with a space to match the longest item key string. 43 | Takes a list of modal menu items 44 | Returns a list of vertically aligned row strings 45 | " 46 | (let [max (max-length items)] 47 | (map 48 | (fn [[key action]] 49 | (.. (pad-str " " max key) " " action)) 50 | items))) 51 | 52 | {:align-columns align-columns} 53 | -------------------------------------------------------------------------------- /apps.fnl: -------------------------------------------------------------------------------- 1 | (local {: global-filter} (require :lib.utils)) 2 | 3 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4 | ;; App switcher 5 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 6 | 7 | (fn calc-thumbnail-size 8 | [] 9 | " 10 | Calculates the height of thumbnail in pixels based on the screen size 11 | @TODO Make this advisable when #102 lands 12 | " 13 | (let [screen (hs.screen.mainScreen) 14 | {: h} (screen:currentMode)] 15 | (/ h 2))) 16 | 17 | (fn init 18 | [config] 19 | (global switcher 20 | (hs.window.switcher.new 21 | (or (?. config :modules :switcher :filter) (global-filter)) 22 | {:textSize 12 23 | :showTitles false 24 | :showThumbnails false 25 | :showSelectedTitle false 26 | :selectedThumbnailSize (calc-thumbnail-size) 27 | :backgroundColor [0 0 0 0]}))) 28 | 29 | (fn prev-app 30 | [] 31 | " 32 | Open the fancy hammerspoon window switcher and move the cursor to the previous 33 | app. 34 | Runs side-effects 35 | Returns nil 36 | " 37 | (switcher:previous)) 38 | 39 | (fn next-app 40 | [] 41 | " 42 | Open the fancy hammerspoon window switcher and move the cursor to next app. 43 | Runs side-effects 44 | Returns nil 45 | " 46 | (switcher:next)) 47 | 48 | 49 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 50 | ;; Exports 51 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 52 | 53 | {: init 54 | : prev-app 55 | : next-app} 56 | -------------------------------------------------------------------------------- /lib/macros.fnl: -------------------------------------------------------------------------------- 1 | (fn when-let 2 | [[var-name value] body1 ...] 3 | " 4 | Macro to set a local value and perform the body when the local value is truthy 5 | Takes a vector to assign a local var to a value and any number of body forms 6 | Returns the return value of the last body form executed 7 | 8 | Example: 9 | (when-let [x true] 10 | (hs.alert \"x is true\") 11 | \"hello world\") 12 | ;; => \"hello world\" 13 | " 14 | (assert body1 "expected body") 15 | `(let [,var-name ,value] 16 | (when ,var-name 17 | ,body1 ,...))) 18 | 19 | (fn if-let 20 | [[var-name value] body1 ...] 21 | " 22 | Macro to set a local value and perform a body form when the value is truthy 23 | or when it is falsey. 24 | Takes a vector pairing a variable name to a value and at least a body form to 25 | evaluate if the value is truthy, or another body form if value is falsey. 26 | Returns the return value of the body form that was evaulated. 27 | 28 | Example: 29 | (if-let [x 5] 30 | (hs.alert \"I fire because 5 is a truthy value\") 31 | (hs.alert \"I do not fire because 5 was truthy.\")) 32 | " 33 | (assert body1 "expected body") 34 | `(let [,var-name ,value] 35 | (if ,var-name 36 | ,body1 37 | ,...))) 38 | 39 | (fn time 40 | [body1 ...] 41 | " 42 | Macro to time the execution of code 43 | Takes multiple body forms 44 | - Evaluates the results once 45 | - Prints the time in seconds 46 | Returns the evaluation result 47 | 48 | Example: 49 | (time (add-monitor-items menu)) 50 | ;; => 51 | \"Executed in 3.44445559689e-05 seconds\" 52 | menu 53 | " 54 | (assert body1 "expected body") 55 | `(let [start# (os.clock) 56 | results# (do ,body1 ,...) 57 | end# (os.clock) 58 | diff# (- end# start#)] 59 | (print "Executed in" diff# " seconds.") 60 | results#)) 61 | 62 | {:when-let when-let 63 | :if-let if-let 64 | :time time} 65 | -------------------------------------------------------------------------------- /lib/testing/assert.fnl: -------------------------------------------------------------------------------- 1 | (local exports {}) 2 | 3 | (fn exports.eq? 4 | [actual expected message] 5 | (assert (= actual expected) (.. message " instead got " (hs.inspect actual)))) 6 | 7 | (fn exports.not-eq? 8 | [first second message] 9 | (assert (not= first second) (.. message " instead both were " (hs.inspect first)))) 10 | 11 | (fn exports.seq-eq? 12 | [actual expected message] 13 | (assert (= (length actual) (length expected)) (.. message " instead got different lengths: " (hs.inspect actual))) 14 | (assert (= (length actual) 15 | (accumulate [matches 0 16 | i a (ipairs actual)] 17 | (if (= a (. expected i)) 18 | (+ matches 1) 19 | matches))) (.. message " instead got " (hs.inspect actual)))) 20 | 21 | (fn every? 22 | [pred iter] 23 | (accumulate [result true 24 | k v (iter) 25 | &until (not result)] 26 | (and result (pred k v)))) 27 | 28 | (fn exports.table-eq? [actual expected message] 29 | ;; Ensure both are tables 30 | (if (and (= (type actual) :table) 31 | (= (type expected) :table)) 32 | ;; NOTE: We have to wrap the iterators in a function returning 33 | ;; them so all can use them in `each` 34 | (assert (and 35 | ;; Ensure all keys in actual are in expected 36 | (every? (fn [k v] (= v (. expected k))) #(pairs actual)) 37 | ;; Ensure all keys in expected are in actual, to ensure 38 | ;; expected isn't just a superset 39 | (every? (fn [k v] (= v (. actual k))) #(pairs expected))) 40 | (.. message " expected " (hs.inspect expected) " instead got " (hs.inspect actual))) 41 | (assert false (.. message " expected two tables but got " 42 | (type actual) " and " (type expected))))) 43 | 44 | (fn exports.ok? 45 | [actual message] 46 | (assert (= (not (not actual)) true) (.. message " instead got " (hs.inspect actual)))) 47 | 48 | exports 49 | -------------------------------------------------------------------------------- /repl.fnl: -------------------------------------------------------------------------------- 1 | (local coroutine (require :coroutine)) 2 | (local jeejah (require :jeejah)) 3 | (local {:merge merge} (require :lib.functional)) 4 | 5 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 6 | ;; nREPL support 7 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8 | 9 | ;; This module adds support to start an nREPL server. This allows a client to 10 | ;; connect to the running server and interact with it while it is running, which 11 | ;; can help avoid repeatedly reloading the config. 12 | ;; 13 | ;; Example usage: 14 | ;; 15 | ;; - To your ~/.spacehammer/config.fnl add: 16 | ;; (local repl (require :repl)) 17 | ;; (repl.run (repl.start)) 18 | ;; 19 | ;; repl.start takes an optional 'opts' table with the following fields: 20 | ;; - host: Define the host to listen on (default "localhost") 21 | ;; - port: Define the port to listen on (default 7888) 22 | ;; - fennel: Expect fennel code (as opposed to lua) (default true) 23 | ;; - serialize: Provide a function that converts objects to strings 24 | ;; (default hs.inspect) 25 | 26 | (fn fennel-middleware 27 | [f msg] 28 | (match msg.op 29 | "load-file" (let [f (assert (io.open msg.filename "rb"))] 30 | (tset msg 31 | :op "eval" 32 | :code (-> f 33 | (: :read "*all") 34 | (: :gsub "^#![^\n]*\n" ""))) 35 | (f:close)) 36 | _ (f msg))) 37 | 38 | (local default-opts 39 | {:port nil 40 | :fennel true 41 | :middleware fennel-middleware 42 | :serialize hs.inspect}) 43 | 44 | (local repl-coro-freq 0.05) 45 | 46 | (fn run 47 | [server] 48 | (let [repl-coro server 49 | repl-spin (fn [] (coroutine.resume repl-coro)) 50 | repl-chk (fn [] (not= (coroutine.status repl-coro) "dead"))] 51 | (hs.timer.doWhile repl-chk repl-spin repl-coro-freq))) 52 | 53 | (fn start 54 | [custom-opts] 55 | (let [opts (merge {} default-opts custom-opts) 56 | server (jeejah.start opts.port opts)] 57 | server)) 58 | 59 | (fn stop 60 | [server] 61 | (jeejah.stop server)) 62 | 63 | {: run 64 | : start 65 | : stop} 66 | -------------------------------------------------------------------------------- /slack.fnl: -------------------------------------------------------------------------------- 1 | (local windows (require :windows)) 2 | 3 | " 4 | Slack functions to make complex or less accessible features more vim like! 5 | " 6 | 7 | ;; Utils 8 | 9 | (fn scroll-to-bottom 10 | [] 11 | (windows.set-mouse-cursor-at :Slack) 12 | (hs.eventtap.scrollWheel [0 -20000] {})) 13 | 14 | (fn add-reaction 15 | [] 16 | (hs.eventtap.keyStroke [:cmd :shift] "\\")) 17 | 18 | (fn prev-element 19 | [] 20 | (hs.eventtap.keyStroke [:shift] :f6)) 21 | 22 | (fn next-element 23 | [] 24 | (hs.eventtap.keyStroke nil :f6)) 25 | 26 | (fn thread 27 | [] 28 | " 29 | Start a thread on the last message. It doesn't always work, because of 30 | stupid Slack App inconsistency with TabIndexes 31 | " 32 | (hs.eventtap.keyStroke [:shift] :f6) 33 | (hs.eventtap.keyStroke [] :right) 34 | (hs.eventtap.keyStroke [] :space)) 35 | 36 | (fn quick-switcher 37 | [] 38 | (windows.activate-app "/Applications/Slack.app") 39 | (let [app (hs.application.find :Slack)] 40 | (when app 41 | (hs.eventtap.keyStroke [:cmd] :t) 42 | (app:unhide)))) 43 | 44 | 45 | ;; scroll to prev/next day 46 | 47 | (fn prev-day 48 | [] 49 | (hs.eventtap.keyStroke [:shift] :pageup)) 50 | 51 | (fn next-day 52 | [] 53 | (hs.eventtap.keyStroke [:shift] :pagedown)) 54 | 55 | ;; Scrolling functions 56 | 57 | (fn scroll-slack 58 | [dir] 59 | (windows.set-mouse-cursor-at :Slack) 60 | (hs.eventtap.scrollWheel [0 dir] {})) 61 | 62 | (fn scroll-up 63 | [] 64 | (scroll-slack 3)) 65 | 66 | (fn scroll-down 67 | [] 68 | (scroll-slack -3)) 69 | 70 | 71 | ;; History 72 | 73 | (fn prev-history 74 | [] 75 | (hs.eventtap.keyStroke [:cmd] "[")) 76 | 77 | (fn next-history 78 | [] 79 | (hs.eventtap.keyStroke [:cmd] "]")) 80 | 81 | 82 | ;; Arrow keys 83 | 84 | (fn up 85 | [] 86 | (hs.eventtap.keyStroke nil :up)) 87 | 88 | (fn down 89 | [] 90 | (hs.eventtap.keyStroke nil :down)) 91 | 92 | {:add-reaction add-reaction 93 | :down down 94 | :next-day next-day 95 | :next-element next-element 96 | :next-history next-history 97 | :prev-day prev-day 98 | :prev-element prev-element 99 | :prev-history prev-history 100 | :quick-switcher quick-switcher 101 | :scroll-down scroll-down 102 | :scroll-to-bottom scroll-to-bottom 103 | :scroll-up scroll-up 104 | :thread thread 105 | :up up} 106 | -------------------------------------------------------------------------------- /lib/advice/macros.fnl: -------------------------------------------------------------------------------- 1 | " 2 | Macros to create advisable functions or register advice for advisable functions 3 | " 4 | 5 | (fn defn 6 | [fn-name args docstr body1 ...] 7 | " 8 | Define an advisable function, typically as a module-level function. 9 | Can be advised with the defadvice macro or add-advice function 10 | 11 | @example 12 | (defn greeting 13 | [name] 14 | \"Advisable greeting function\" 15 | (print \"Hello\" name)) 16 | " 17 | (assert (= (type docstr) :string) "A docstr required for advisable functions") 18 | (assert body1 "advisable function expected body") 19 | (let [fn-name-str (tostring fn-name)] 20 | `(local ,fn-name 21 | (let [adv# (require :lib.advice)] 22 | (adv#.make-advisable ,fn-name-str (fn ,args ,docstr ,body1 ,...)))))) 23 | 24 | (fn afn 25 | [fn-name args body1 ...] 26 | " 27 | Define an advisable function in as a function expression. These should be used 28 | with caution to support when an API function is created from another parent 29 | function call. 30 | 31 | @example 32 | (let [f (afn local-greeting 33 | [name] 34 | \"Advisable greeting but local to this scope\") 35 | (print \"Hello\" name)] 36 | (f)) 37 | " 38 | (assert body1 "advisable function expected body") 39 | (let [fn-name-str (tostring fn-name)] 40 | `(let [adv# (require :lib.advice)] 41 | (adv#.make-advisable ,fn-name-str (fn ,args ,body1 ,...))))) 42 | 43 | 44 | 45 | (fn defadvice 46 | [fn-name args advice-type f-or-key docstr body1 ...] 47 | " 48 | Define advice for an advisable function. Syntax sugar for calling 49 | (add-advice key-or-advisable-fn (fn [] ...)) 50 | 51 | @example 52 | (defadvice my-advice-fn 53 | [x y z] 54 | :override original-fn 55 | \"Override original-fn\" 56 | (* x y z)) 57 | " 58 | (assert (= (type docstr) :string) "A docstr is required for defining advice") 59 | (assert body1 "advisable function expected body") 60 | `(local ,fn-name 61 | (let [adv# (require :lib.advice) 62 | target-fn# (fn ,fn-name ,args ,docstr ,body1 ,...) 63 | advice-fn# (setmetatable 64 | {} 65 | {:__name ,(tostring fn-name) 66 | :__call (fn [_tbl# ...] 67 | (target-fn# (table.unpack [...])))})] 68 | (adv#.add-advice ,f-or-key ,advice-type advice-fn#) 69 | advice-fn#))) 70 | 71 | {: afn 72 | : defn 73 | : defadvice} 74 | -------------------------------------------------------------------------------- /lib/lifecycle.fnl: -------------------------------------------------------------------------------- 1 | (local {: do-action} (require :lib.bind)) 2 | (local {: logger} (require :lib.utils)) 3 | (local log (logger "lifecycle.fnl" "info")) 4 | 5 | 6 | " 7 | Functions for calling lifecycle methods of config.fnl local app configuration or 8 | lifecycle methods assigned to a specific modal menu in config.fnl. 9 | {:key \"emacs\" 10 | :launch (fn [] (hs.alert \"Launched emacs\")) 11 | :activate (fn [] (hs.alert \"Entered emacs\")) 12 | :deactivate (fn [] (hs.alert \"Leave emacs\")) 13 | :exit (fn [] (hs.alert \"Closed emacs\"))} 14 | Meant for internal use only. 15 | " 16 | 17 | (fn do-method 18 | [obj method-name] 19 | " 20 | Takes a app menu table from config.fnl 21 | Calls the lifecycle function if a function instance or resolves it to an 22 | action if an action string was provided like \"lib.lifecycle:do-method\" 23 | Takes a config.fnl app table and a method name string to try and call. 24 | Returns the return value of calling the provided lifecycle function. 25 | " 26 | (let [method (. obj method-name)] 27 | (match (type method) 28 | :function (method obj) 29 | :string (do-action method [obj]) 30 | _ (do 31 | (log.wf "Could not call lifecycle method %s on %s" 32 | method-name 33 | obj))))) 34 | 35 | (fn activate-app 36 | [menu] 37 | "Calls :activate method on an app in config.fnl when focused on by user" 38 | (when (and menu menu.activate) 39 | (do-method menu :activate))) 40 | 41 | (fn close-app 42 | [menu] 43 | "Calls the :close method on an app in config.fnl when closed by the user" 44 | (when (and menu menu.close) 45 | (do-method menu :close))) 46 | 47 | (fn deactivate-app 48 | [menu] 49 | "Calls the :deactivate method on a config.fnl app when user blurs the app" 50 | (when (and menu menu.deactivate) 51 | (do-method menu :deactivate))) 52 | 53 | (fn enter-menu 54 | [menu] 55 | "Calls the :enter lifecycle method on a modal menu table in config.fnl" 56 | (when (and menu menu.enter) 57 | (do-method menu :enter))) 58 | 59 | (fn exit-menu 60 | [menu] 61 | "Calls the :exit lifecycle method on a modal menu table defined in config.fnl" 62 | (when (and menu menu.exit) 63 | (do-method menu :exit))) 64 | 65 | (fn launch-app 66 | [menu] 67 | "Calls the :launch app table in config.fnl when user opens the app." 68 | (when (and menu menu.launch) 69 | (do-method menu :launch))) 70 | 71 | {:activate-app activate-app 72 | :close-app close-app 73 | :deactivate-app deactivate-app 74 | :enter-menu enter-menu 75 | :exit-menu exit-menu 76 | :launch-app launch-app} 77 | -------------------------------------------------------------------------------- /test/functional-test.fnl: -------------------------------------------------------------------------------- 1 | (local is (require :lib.testing.assert)) 2 | (local f (require :lib.functional)) 3 | 4 | 5 | (describe 6 | "Functional" 7 | (fn [] 8 | 9 | (it "Call when calls function if it exists" 10 | (fn [] 11 | (is.eq? (f.call-when (fn [] 2)) 2 "Unexpected result") 12 | (is.eq? (f.call-when nil) nil "Call-when did not return nil"))) 13 | 14 | (it "Call when passes args" 15 | (fn [] 16 | (is.eq? (f.call-when (fn [a] a) 3) 3 "Unexpected result"))) 17 | 18 | (it "Compose combines functions together in reverse order" 19 | (fn [] 20 | (is.eq? ((f.compose #(+ 1 $1) #(- $1 2) #(* 3 $1)) 2) 5 "Unexpected result"))) 21 | 22 | 23 | (it "Contains? returns true if list table contains a value" 24 | (fn [] 25 | (is.eq? (f.contains? :b [:a :b :c]) true "contains? did not return true") 26 | (is.eq? (f.contains? :d [:a :b :c]) false "contains? did not return false"))) 27 | 28 | (it "find returns an item from table list that matches predicate" 29 | (fn [] 30 | (is.eq? (f.find #(= $1 :b) [:a :b :c]) :b "find did not return :b"))) 31 | 32 | (it "Concat returns a table with combined elements" 33 | (fn [] 34 | (is.seq-eq? (f.concat [6 5 4] [3 2 1]) [6 5 4 3 2 1] "concat did not return combined values") 35 | (is.seq-eq? (f.concat [6 5] [4 3] [2 1]) [6 5 4 3 2 1] "concat did not return combined values"))) 36 | 37 | (it "Filter picks items from a list" 38 | (fn [] 39 | (is.seq-eq? (f.filter #(> $1 3) [1 2 3 4 5 6]) [4 5 6] "filter did not select items greater than 3"))) 40 | 41 | (it "Some returns true if predicate function finds match in table" 42 | (fn [] 43 | (is.eq? (f.some #(> $1 3) [1 2 3 4 5 6]) true "some did not find that table has elements greater than 3") 44 | (is.eq? (f.some #(> $1 3) [1 2 3]) false "some incorrectly found that table has elements greater than 3"))) 45 | 46 | (it "reduce applies a function to each k v of a sequence, accumulating an returning an end result" 47 | (fn [] 48 | (is.eq? (f.reduce #(.. $1 $2) "" [5 4 3 2 1]) "54321" "reduce did not concat list into string") 49 | (is.eq? (f.reduce #(if (> $1 $3) $1 $3) 0 [1 3 5 2 0]) 5 "reduce did not find max"))) 50 | 51 | (it "(merge) merges single table" 52 | (fn [] 53 | (is.table-eq? 54 | (f.merge {:a 1}) {:a 1} 55 | "merge did not work with one table")) 56 | 57 | (it "(merge) merges two tables" 58 | (fn [] 59 | (is.table-eq? 60 | (f.merge {:a 1} {:b 2}) {:a 1 :b 2} 61 | "merge did not work for two tables"))) 62 | 63 | (it "(merge) merges many tables" 64 | (fn [] 65 | (is.table-eq? 66 | (f.merge {:a 1} {:b 2} {:c 3}) {:a 1 :b 2 :c 3} 67 | "merge did not work for three tables"))) 68 | 69 | (it "(merge) merges tables with same key" 70 | (fn [] 71 | (is.table-eq? 72 | (f.merge {:a 2 :c 3} {:a 1 :b 2}) {:a 1 :b 2 :c 3} 73 | "merge did not work for tables with repeated keys"))) 74 | ))) 75 | -------------------------------------------------------------------------------- /lib/testing/init.fnl: -------------------------------------------------------------------------------- 1 | (var suites []) 2 | (var state {:suite nil 3 | :before [] 4 | :after [] 5 | :ran 0 6 | :failed 0 7 | :passed 0}) 8 | 9 | ;; 4-bit colors 10 | ;; https://i.stack.imgur.com/9UVnC.png 11 | 12 | (local colors {:red "31" 13 | :green "92"}) 14 | 15 | (fn describe 16 | [suite-name suite-f] 17 | (table.insert suites {:name suite-name 18 | :suite suite-f 19 | :before [] 20 | :after [] 21 | :tests []})) 22 | 23 | (fn it 24 | [description test-f] 25 | (if state.suite 26 | (table.insert state.suite.tests {:desc description 27 | :test test-f}) 28 | (error "Calling it outside of a describe test suite"))) 29 | 30 | (fn before 31 | [before-f] 32 | (if state.suite 33 | (table.insert state.suite.before before-f) 34 | (table.insert state.before before-f))) 35 | 36 | (fn after 37 | [after-f] 38 | (if state.suite 39 | (table.insert state.suite.after after-f) 40 | (table.insert state.after after-f))) 41 | 42 | (fn collect-tests 43 | [] 44 | (each [_i suite-map (ipairs suites)] 45 | (tset state :suite suite-map) 46 | (suite-map.suite)) 47 | suites) 48 | 49 | (fn color 50 | [text color] 51 | (assert (. colors color) (.. "Color " color " could not be found")) 52 | (.. "\27[" (. colors color) "m" text "\27[0m")) 53 | 54 | 55 | (fn green 56 | [text] 57 | (color text :green)) 58 | 59 | (fn red 60 | [text] 61 | (color text :red)) 62 | 63 | (fn try-test 64 | [f] 65 | (let [(ok err) (xpcall f (fn [err] 66 | (tset state :failed (+ state.failed 1)) 67 | (print (.. " " (red "[ FAIL ]") "\n")) 68 | (print (debug.traceback err) "\n")))] 69 | (if ok 70 | (do 71 | (print (.. " " (green "[ OK ]") "\n")) 72 | (tset state :passed (+ state.passed 1)))))) 73 | 74 | (fn init 75 | [] 76 | (set suites []) 77 | (set state {:suite nil 78 | :before [] 79 | :after [] 80 | :ran 0 81 | :failed 0 82 | :passed 0})) 83 | 84 | (fn run-all-tests 85 | [] 86 | (print "") 87 | (let [start (os.clock)] 88 | (each [_i before-f (ipairs state.before)] 89 | (before-f)) 90 | (each [_i suite-map (ipairs suites)] 91 | (print suite-map.name "\n") 92 | (each [_i before-f (ipairs suite-map.before)] 93 | (before-f)) 94 | (each [_ test-map (ipairs suite-map.tests)] 95 | (print (.. " " test-map.desc " ... \t")) 96 | (try-test test-map.test) 97 | (tset state :ran (+ state.ran 1))) 98 | (each [i after-f (ipairs suite-map.after)] 99 | (after-f))) 100 | (each [i after-f (ipairs state.after)] 101 | (after-f)) 102 | (let [end (os.clock) 103 | elapsed (- end start)] 104 | (print (.. "\n Ran " state.ran " tests " (green state.passed) " passed " (red state.failed) " failed in " elapsed " seconds")) 105 | (when (> state.failed 0) 106 | (error "Tests failed"))))) 107 | 108 | {: init 109 | : suites 110 | : after 111 | : before 112 | : it 113 | : describe 114 | : collect-tests 115 | : run-all-tests} 116 | -------------------------------------------------------------------------------- /lib/hyper.fnl: -------------------------------------------------------------------------------- 1 | (require-macros :lib.macros) 2 | (local {: find} (require :lib.functional)) 3 | 4 | 5 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 6 | ;; Hyper Mode 7 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8 | ;; - Bind a key or a combination of keys to trigger a hyper mode. 9 | ;; - Often this is cmd+shift+alt+ctrl 10 | ;; - Or a virtual F17 key if using something like Karabiner Elements 11 | ;; - The goal is to give you a whole keyboard worth of bindings that don't 12 | ;; conflict with any other apps. 13 | ;; - In config.fnl, put :hyper in a global key binding's mods list like [:hyper] 14 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 15 | 16 | (var hyper (hs.hotkey.modal.new)) 17 | (var enabled false) 18 | 19 | (fn enter-hyper-mode 20 | [] 21 | " 22 | Globally enables hyper mode 23 | Only performs a side effect of marking the mode as enabled and enabling the 24 | hotkey modal. 25 | " 26 | (set enabled true) 27 | (hyper:enter)) 28 | 29 | (fn exit-hyper-mode 30 | [] 31 | " 32 | Globally disables hyper mode 33 | Only performs a side effect of marking the mode as not enabled and exits 34 | hyper mode 35 | " 36 | (set enabled false) 37 | (hyper:exit)) 38 | 39 | (fn unbind-key 40 | [key] 41 | " 42 | Remove a binding from the hyper hotkey modal 43 | Performs a side effect when a binding matches a target key 44 | Side effect: Changes hotkey modal 45 | " 46 | (when-let [binding (find (fn [{:msg msg}] 47 | (= msg key)) 48 | hyper.keys)] 49 | (: binding :delete))) 50 | 51 | (fn bind 52 | [key f] 53 | " 54 | Bind a key on the hyper hotkey modal 55 | Takes a key string and a function to call when key is pressed 56 | Returns a function to remove the binding for this key. 57 | " 58 | (hyper:bind nil key nil f) 59 | (fn unbind 60 | [] 61 | (unbind-key key))) 62 | 63 | (fn bind-spec 64 | [{:key key 65 | :press press-f 66 | :release release-f 67 | :repeat repeat-f}] 68 | " 69 | Creates a hyper hotkey modal binding based on a binding spec table 70 | Takes a table: 71 | - key A hotkey 72 | - press A function to bind when the key is pressed down 73 | - release A function to bind when the key is released 74 | - repeat A function to bind when thek ey is repeated 75 | " 76 | (hyper:bind nil key press-f release-f repeat-f) 77 | (fn unbind 78 | [] 79 | (unbind-key key))) 80 | 81 | (fn init 82 | [config] 83 | " 84 | Initializes the hyper module 85 | - Binds the hyper keys defined in config.fnl 86 | - Uses config.fnl :hyper as the key to trigger hyper mode 87 | A default like :f17 or :f18 is recommended 88 | - Binds the config.hyper key to enter hyper mode on press and exit upon 89 | release. 90 | " 91 | (let [h (or config.hyper {})] 92 | (hs.hotkey.bind (or h.mods []) 93 | h.key 94 | enter-hyper-mode 95 | exit-hyper-mode))) 96 | 97 | (fn enabled? 98 | [] 99 | " 100 | An API function to check if hyper mode is enabled 101 | Returns true if hyper mode is enabled 102 | " 103 | (= enabled true)) 104 | 105 | 106 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 107 | ;; Exports 108 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 109 | 110 | {:init init 111 | :bind bind 112 | :bind-spec bind-spec 113 | :enabled? enabled?} 114 | -------------------------------------------------------------------------------- /CHANGELOG.ORG: -------------------------------------------------------------------------------- 1 | * [2025-12-19 Fri] 2 | ** brew tap https://github.com/agzam/homebrew-spacehammer 3 | 4 | * [2025-12-18 Thu] 5 | ** 1.6.0 version 6 | Crazy that we never had official versioning, even though the project existed for years. Let's finally tag a version. 7 | 8 | ** Pretty good performance improvements 9 | *** State machine optimizations 10 | - Modals appear/disappear faster 11 | - Less lag when switching between apps 12 | - Lower CPU usage during active use 13 | 14 | *** Reduced logging overhead 15 | *** Cached app lookup for reduced app switching latency 16 | *** Menu now renders slightly faster 17 | 18 | * [2023-04-13 Thu] 19 | ** Improved 20 | - Edit-with-Emacs. Simplified and fixed various bugs. Now works with multiple apps. 21 | * [2021-09-16 Thu] 22 | ** Added 23 | - [[docs/advice.org][Advising system]] 24 | - [[repl.fnl][REPL support]] 25 | - [[./docs/testing.org][Basic unit testing]] 26 | * [2020-09-20 Sun] 27 | ** Fixed 28 | - support for Hammerspoon 0.9.79 which uses Lua 5.4 see https://github.com/agzam/spacehammer/pull/70 for instructions 29 | * [2020-05-14 Thu] 30 | ** Changed 31 | - Edit-with-emacs feature now detects if there's a pre-selected text already and edits only that chunk 32 | * [2020-05-13 Wed] 33 | ** Fixed 34 | - Addressed workaround for regression in fennel 0.4.0 https://github.com/bakpakin/Fennel/issues/276 35 | * [2020-02-23 Sun] 36 | ** Added 37 | - Move to display feature. Windows modal: now would display a big number at the corner of each display, when a number on the keypad is pressed, current active app window will be moved onto that screen. Useful for multi-monitor setups. 38 | 39 | Note: if ~/.spacehammer/config.fnl is used, it 40 | needs to be updated in order for this feature to work. 41 | * [2020-02-04 Tue] 42 | ** Added 43 | - New, completely revamped modal engine - [[https://github.com/eccentric-j][@eccentric-j]] 44 | - Improved state-machine implementation - [[https://github.com/eccentric-j][@eccentric-j]] 45 | - ~/.spacehammer.d/config for localized customization - [[https://github.com/eccentric-j][@eccentric-j]] 46 | - Nicer HUD - [[https://github.com/eccentric-j][@eccentric-j]] 47 | - Lots of docstrings - [[https://github.com/eccentric-j][@eccentric-j]] 48 | ** Changed 49 | - Fixed compatibility issues. Currently supported Fennel version 0.3.2 - [[https://github.com/eccentric-j][@eccentric-j]] 50 | - =LEAD= keybinding is now by default set to =Option+SPC= (used to be =Cmd+SPC=) 51 | - App switcher keybinding is now by default set to =Option+n/p= (used to be =Cmde+n/p=) 52 | - Tab switcher keybinding is now by default set to =Option+j/k= (used to be =Cmd+j/k=) 53 | - Pressing =SPC= in a submodal, brings you to the previous level modal (used to open ~Alfred~) 54 | pressing =SPC= at the top level modal still takes you to ~Alfred~ 55 | * [2019-07-19 Fri] 56 | ** Changed 57 | + Modals 58 | + Configuration 59 | + Keybindingsn 60 | + App specific keybindings 61 | + App specific modals 62 | + Vim mode 63 | * [2019-06-25 Tue] 64 | ** Changed 65 | *** Emacs improvements 66 | + run-emacs-fn 67 | + full-screen 68 | + vertical-split-with-emacs 69 | * [2019-06-23 Sun] 70 | ** Added 71 | - Auxiliary Emacs package, spacehammer.el 72 | ** Changed 73 | - Fixes Local app-keys are leaking #15 74 | * [2019-05-07 Tue] 75 | ** Added 76 | - Added local modals 77 | - Grammarly + Emacs interaction 78 | * [2019-05-06 Mon] 79 | ** Changed 80 | - Rewrote everything in Fennel 81 | * [2017-10-14 Sat] 82 | ** Added 83 | - Improved modal system - simplifies adding and extending modals 84 | - Emacs module: Invoking Emacs to enable system-wide org-capture. Accompanying emacs-lisp code can be found [[https://github.com/agzam/dot-spacemacs/blob/master/layers/ag-org/funcs.el#L144][here]] 85 | * [2017-06-25 Sun] 86 | ** Added 87 | - Sierra compatibility 88 | /*Since Karabiner is not compatible anymore (starting with Sierra), had to find a way to get similar features*/ 89 | - ~keybdings~ module 90 | - App switcher - =Cmd+j/k= 91 | - Simple tab switcher for Chrome and iTerm2 - =Cmd+h/l= 92 | - Simple =Vi-mode= - =Alt+j/k/l/m= 93 | - App specific keybindings 94 | ** Changed 95 | - Changed Slack reaction key to =C-r=, so =Cmd+i= can be used to switch between current application windows 96 | -------------------------------------------------------------------------------- /lib/bind.fnl: -------------------------------------------------------------------------------- 1 | (local hyper (require :lib.hyper)) 2 | (local {: contains? 3 | : map 4 | : split} 5 | (require :lib.functional)) 6 | (local {: logger} (require :lib.utils)) 7 | 8 | (local log (logger "bind.fnl" "warning")) 9 | 10 | (fn do-action 11 | [action args] 12 | " 13 | Resolves an action string to a function in a module then runs that function. 14 | Takes an action string like \"lib.bind:do-action\" 15 | Performs side-effects. 16 | Returns the return value of the target function or nil if function could 17 | not be resolved. 18 | " 19 | (let [[file fn-name] (split ":" action) 20 | module (require file) 21 | f (. module fn-name)] 22 | (if f 23 | (f (table.unpack (or args []))) 24 | (do 25 | (log.wf "Could not dispatch action %s: Function \"%s\" was not found in module \"%s\".\nEnsure the correct action is referenced in config.fnl." 26 | action 27 | fn-name 28 | file))))) 29 | 30 | 31 | (fn create-action-fn 32 | [action] 33 | " 34 | Takes an action string 35 | Returns function to resolve and execute action. 36 | 37 | Example: 38 | (hs.timer.doAfter 1 (create-action-fn \"messages:greeting\")) 39 | ; Waits 1 second 40 | ; Looks for a function called greeting in messages.fnl 41 | " 42 | (fn [...] 43 | (do-action action [...]))) 44 | 45 | 46 | (fn action->fn 47 | [action] 48 | " 49 | Normalize an action like say from config.fnl into a function 50 | Takes an action either a string like \"lib.bind:action->fn\" or an actual 51 | function instance. 52 | Returns a function to perform that action or logs an error and returns 53 | an always true function if a function could not be found. 54 | " 55 | (match (type action) 56 | :function action 57 | :string (create-action-fn action) 58 | _ (do 59 | (log.wf "Could not create action handler for %s" 60 | (hs.inspect action)) 61 | (fn [] true)))) 62 | 63 | 64 | (fn bind-keys 65 | [items] 66 | " 67 | Binds keys defined in config.fnl to action functions. 68 | Takes a list of bindings from a config.fnl menu 69 | Performs side-effect of binding hotkeys to action functions. 70 | Returns a function to remove bindings. 71 | " 72 | (let [modal (hs.hotkey.modal.new [] nil)] 73 | (each [_ item (ipairs (or items []))] 74 | (let [{:key key 75 | :mods mods 76 | :action action 77 | :repeat repeat} item 78 | mods (or mods []) 79 | action-fn (action->fn action)] 80 | (if repeat 81 | (: modal :bind mods key action-fn nil action-fn) 82 | (: modal :bind mods key nil action-fn)))) 83 | (: modal :enter) 84 | (fn destroy-bindings 85 | [] 86 | (when modal 87 | (: modal :exit) 88 | (: modal :delete))))) 89 | 90 | (fn bind-global-keys 91 | [items] 92 | " 93 | Binds keys to actions globally like pressing cmd + space to open modal menu 94 | Takes a list of bindings from config.fnl 95 | Performs side-effect of creating the key binding to a function. 96 | Returns a function to unbind keys. 97 | " 98 | (map 99 | (fn [item] 100 | (let [{:key key} item 101 | mods (or item.mods []) 102 | action-fn (action->fn item.action)] 103 | (if (contains? :hyper mods) 104 | (hyper.bind key action-fn) 105 | (let [binding (hs.hotkey.bind mods key action-fn)] 106 | (fn unbind 107 | [] 108 | (: binding :delete)))))) 109 | items)) 110 | 111 | (fn unbind-global-keys 112 | [bindings] 113 | " 114 | Takes a list of functions to remove a binding created by bind-global-keys 115 | Performs a side effect to remove binding. 116 | Returns nil 117 | " 118 | (each [_ unbind (ipairs bindings)] 119 | (unbind))) 120 | 121 | (fn init 122 | [config] 123 | " 124 | Initializes our key bindings by binding the global keys 125 | Creates a list of unbind functions for global keys 126 | Returns a cleanup function to unbind all global key bindings 127 | " 128 | (let [keys (or config.keys []) 129 | bindings (bind-global-keys keys)] 130 | (fn cleanup 131 | [] 132 | (unbind-global-keys bindings)))) 133 | 134 | {:init init 135 | :action->fn action->fn 136 | :bind-keys bind-keys 137 | :do-action do-action} 138 | -------------------------------------------------------------------------------- /emacs.fnl: -------------------------------------------------------------------------------- 1 | (fn emacsclient-exe [] 2 | "Locate emacsclient executable." 3 | (-> "Emacs" 4 | hs.application.find 5 | (: :path) 6 | (: :gsub "Emacs.app" "bin/emacsclient"))) 7 | 8 | (fn capture [is-note] 9 | "Activates org-capture" 10 | (let [key (if is-note "\"z\"" "") 11 | current-app (hs.window.focusedWindow) 12 | pid (.. "\"" (current-app:pid) "\" ") 13 | title (.. "\"" (current-app:title) "\" ") 14 | run-str (.. 15 | (emacsclient-exe) 16 | " -c -F '(quote (name . \"capture\"))'" 17 | " -e '(spacehammer-activate-capture-frame " 18 | pid title key " )' &") 19 | timer (hs.timer.delayed.new .1 (fn [] (io.popen run-str)))] 20 | (timer:start))) 21 | 22 | (fn edit-with-emacs [] 23 | "Executes emacsclient, evaluating a special elisp function in spacehammer.el 24 | (it must be pre-loaded), passing PID, title and display-id of the caller." 25 | (let [current-app (: (hs.window.focusedWindow) :application) 26 | pid (.. "\"" (current-app:pid) "\"") 27 | title (.. "\"" (current-app:title) "\"") 28 | screen (.. "\"" (: (hs.screen.mainScreen) :id) "\"") 29 | run-str (.. 30 | (emacsclient-exe) 31 | " -e '(spacehammer-edit-with-emacs " 32 | pid " " title " " screen " )' &") 33 | prev (hs.pasteboard.changeCount) 34 | _ (hs.eventtap.keyStroke [:cmd] :c) 35 | next (hs.pasteboard.changeCount)] 36 | (when (= prev next) ; Pasteboard was not updated so no text was selected 37 | (hs.eventtap.keyStroke [:cmd] :a) ; select all and then copy 38 | (hs.eventtap.keyStroke [:cmd] :c)) 39 | (io.popen run-str) 40 | (hs.application.open :Emacs))) 41 | 42 | (fn run-emacs-fn 43 | [elisp-fn args] 44 | "Executes given elisp function in emacsclient. If args table present, passes 45 | them into the function." 46 | (let [args-lst (when args (.. " '" (table.concat args " '"))) 47 | run-str (.. (emacsclient-exe) 48 | " -e \"(funcall '" elisp-fn 49 | (if args-lst args-lst " &") 50 | ")\" &")] 51 | (io.popen run-str))) 52 | 53 | (fn full-screen 54 | [] 55 | "Switches to current instance of GUI Emacs and makes its frame fullscreen" 56 | (hs.application.launchOrFocus :Emacs) 57 | (run-emacs-fn 58 | (.. 59 | "(lambda ())" 60 | "(spacemacs/toggle-fullscreen-frame-on)" 61 | "(spacehammer/fix-frame)"))) 62 | 63 | (fn vertical-split-with-emacs 64 | [] 65 | "Creates vertical split with Emacs window sitting next to the current app" 66 | (let [windows (require :windows) 67 | cur-app (-?> (hs.window.focusedWindow) (: :application) (: :name)) 68 | rect-left [0 0 .5 1] 69 | rect-right [.5 0 .5 1] 70 | elisp (.. "(lambda ()" 71 | " (spacemacs/toggle-fullscreen-frame-off) " 72 | " (spacemacs/maximize-horizontally) " 73 | " (spacemacs/maximize-vertically))")] 74 | (run-emacs-fn elisp) 75 | (hs.timer.doAfter 76 | .2 77 | (fn [] 78 | (if (= cur-app :Emacs) 79 | (do 80 | (windows.rect rect-left) 81 | (windows.jump-to-last-window) 82 | (windows.rect rect-right)) 83 | (do 84 | (windows.rect rect-right) 85 | (hs.application.launchOrFocus :Emacs) 86 | (windows.rect rect-left))))))) 87 | 88 | (fn switch-to-app [pid] 89 | "Don't remove! - this is callable from Emacs See: `spacehammer/switch-to-app` 90 | in spacehammer.el " 91 | (let [app (hs.application.applicationForPID (tonumber pid))] 92 | (when app (app:activate)))) 93 | 94 | (fn switch-to-app-and-paste-from-clipboard [pid] 95 | "Don't remove! - this is callable from Emacs See: 96 | `spacehammer/finish-edit-with-emacs` in spacehammer.el." 97 | (let [app (hs.application.applicationForPID (tonumber pid))] 98 | (when app 99 | (app:activate) 100 | (hs.timer.doAfter 101 | 0.001 102 | (fn [] (app:selectMenuItem [:Edit :Paste])))))) 103 | 104 | (fn maximize 105 | [] 106 | "Maximizes Emacs GUI window after a short delay." 107 | (hs.timer.doAfter 108 | 1.5 109 | (fn [] 110 | (let [app (hs.application.find :Emacs) 111 | windows (require :windows)] 112 | (when app 113 | (app:activate) 114 | (windows.maximize-window-frame)))))) 115 | 116 | {:capture capture 117 | :edit-with-emacs edit-with-emacs 118 | :full-screen full-screen 119 | :maximize maximize 120 | :note (fn [] (capture true)) 121 | :switchToApp switch-to-app 122 | :switchToAppAndPasteFromClipboard switch-to-app-and-paste-from-clipboard 123 | :vertical-split-with-emacs vertical-split-with-emacs 124 | :run-emacs-fn run-emacs-fn} 125 | -------------------------------------------------------------------------------- /test/statemachine-test.fnl: -------------------------------------------------------------------------------- 1 | (local is (require :lib.testing.assert)) 2 | (local statemachine (require :lib.statemachine)) 3 | (local atom (require :lib.atom)) 4 | 5 | (fn make-fsm 6 | [] 7 | (statemachine.new 8 | ;; States that the machine can be in mapped to their actions and transitions 9 | {:state {:current-state :closed 10 | :context {:i 0 11 | :event nil}} 12 | 13 | :states {:closed {:toggle (fn closed->opened 14 | [state action extra] 15 | {:state {:current-state :opened 16 | :context {:i (+ state.context.i 1)}} 17 | :effect :opening})} 18 | :opened {:toggle (fn opened->closed 19 | [state action extra] 20 | {:state {:current-state :closed 21 | :context {:i (+ state.context.i 1)}} 22 | :effect :closing})}}})) 23 | 24 | (describe 25 | "State Machine" 26 | (fn [] 27 | 28 | (it "Should create a new fsm in the closed state" 29 | (fn [] 30 | (let [fsm (make-fsm)] 31 | (is.eq? (. (atom.deref fsm.state) :current-state) :closed "Initial state was not closed")))) 32 | 33 | (it "Should include some methods" 34 | (fn [] 35 | (let [fsm (make-fsm)] 36 | (is.eq? (type fsm.get-state) :function "No get-state method") 37 | (is.eq? (type fsm.send) :function "No send method ") 38 | (is.eq? (type fsm.subscribe) :function "No subscribe method")))) 39 | 40 | (it "Should transition to opened on toggle action" 41 | (fn [] 42 | (let [fsm (make-fsm)] 43 | (is.eq? (fsm.send :toggle) true "Dispatch did not return true for handled event") 44 | (is.eq? (. (atom.deref fsm.state) :current-state) :opened "State did not transition to opened")))) 45 | 46 | (it "Should transition from closed -> opened -> closed" 47 | (fn [] 48 | (let [fsm (make-fsm)] 49 | (fsm.send :toggle) 50 | (fsm.send :toggle) 51 | (is.eq? (. (atom.deref fsm.state) :current-state) :closed "State did not transition back to closed") 52 | (is.eq? (. (atom.deref fsm.state) :context :i) 2 "context.i should be 2 from 2 transitions")))) 53 | 54 | (it "Should not explode when dispatching an unhandled event" 55 | (fn [] 56 | (let [fsm (make-fsm)] 57 | (is.eq? (fsm.send :fail nil) false "The FSM exploded from dispatching a :fail event")))) 58 | 59 | (it "Subscribers should be called on events" 60 | (fn [] 61 | (let [fsm (make-fsm) 62 | i (atom.new 0)] 63 | (fsm.subscribe (fn [] (atom.swap! i (fn [v] (+ v 1))))) 64 | (fsm.send :toggle) 65 | (is.eq? (atom.deref i) 1 "The subscriber was not called")))) 66 | 67 | (it "Subscribers should be provided old and new context, action, effect, and extra" 68 | (fn [] 69 | (let [fsm (make-fsm)] 70 | (fsm.subscribe (fn [{: prev-state : next-state : action : effect : extra}] 71 | (is.not-eq? prev-state.context.i 72 | next-state.context.i "Subscriber did not get old and new state") 73 | (is.eq? action :toggle "Subscriber did not get correct action") 74 | (is.eq? effect :opening "Subscriber did not get correct effect") 75 | (is.eq? extra :extra "Subscriber did not get correct extra"))) 76 | (fsm.send :toggle :extra)))) 77 | 78 | (it "Subscribers should be able to unsubscribe" 79 | (fn [] 80 | (let [fsm (make-fsm)] 81 | (let [i (atom.new 0) 82 | unsub (fsm.subscribe (fn [] (atom.swap! i (fn [v] (+ v 1)))))] 83 | (fsm.send :toggle) 84 | (unsub) 85 | (fsm.send :toggle) 86 | (is.eq? (atom.deref i) 1 "The subscriber was called after unsubscribing"))))) 87 | 88 | (it "Effect handler should maintain cleanup function" 89 | (fn [] 90 | (let [fsm (make-fsm) 91 | effect-state (atom.new :unused) 92 | effect-handler (statemachine.effect-handler 93 | {:opening (fn [] 94 | (atom.swap! effect-state 95 | (fn [_ nv] nv) :opened) 96 | ; Returned cleanup func 97 | (fn [] 98 | (atom.swap! effect-state 99 | (fn [_ nv] nv) :cleaned)))}) 100 | unsub (fsm.subscribe effect-handler)] 101 | (fsm.send :toggle) 102 | (is.eq? (atom.deref effect-state) :opened "Effect handler should have been called") 103 | (fsm.send :toggle) 104 | (is.eq? (atom.deref effect-state) :cleaned "Cleanup function should have been called") 105 | ))))) 106 | -------------------------------------------------------------------------------- /lib/atom.fnl: -------------------------------------------------------------------------------- 1 | " 2 | Atoms are the functional-programming answer to a variable except better 3 | because you can subscribe to changes. 4 | 5 | Mechanically, an atom is a table with a current state property and a 6 | list of watchers. 7 | 8 | API is provided to calculate the next value of an atom's state based on 9 | previous value or replacing it. 10 | 11 | API is also provided to add watchers which takes a function to receive the 12 | current and next value. 13 | 14 | API is also provided to get the value of an atom. This is called dereferencing. 15 | 16 | Example: 17 | (local x (atom 5)) 18 | (print (hs.inspect x)) 19 | ;; => { 20 | ;; :state 5 21 | ;; :watchers {}} 22 | (print (deref x)) 23 | ;; => 5 24 | ;; (swap! x #(+ $1 1)) 25 | ;; (print (deref x)) 26 | ;; => 6 27 | ;; (add-watch x :my-watcher #(print \"new:\" $1 \" old: \" $2)) 28 | ;; (reset! x 7) 29 | ;; => new: 7 old: 6 30 | ;; (print (deref x)) 31 | ;; => 7 32 | ;; (remove-watch x :my-watcher) 33 | " 34 | (fn atom 35 | [initial] 36 | " 37 | Creates an atom instance 38 | Takes an initial value 39 | Returns atom table instance 40 | 41 | Example: 42 | (local x (atom 5)) 43 | " 44 | {:state initial 45 | :watchers {}}) 46 | 47 | (fn copy 48 | [tbl copies] 49 | " 50 | Copies a table into a new table 51 | Allows us to treat tables as immutable. Tracks visited so recursive 52 | references should be no problem here. 53 | Returns new table copy 54 | " 55 | (let [copies (or copies {})] 56 | (if (~= (type tbl) :table) tbl 57 | ;; is a table, but already visited 58 | (. copies tbl) (. copies tbl) 59 | ;; else - Is a table, not yet visited 60 | (let [copy-tbl {}] 61 | (tset copies tbl copy-tbl) 62 | (each [k v (pairs tbl)] 63 | (tset copy-tbl (copy k copies) (copy v copies))) 64 | (setmetatable copy-tbl (copy (getmetatable tbl) copies)) 65 | copy-tbl)))) 66 | 67 | (fn deref 68 | [atom] 69 | " 70 | Dereferences the atom instance to return the current value 71 | Takes an atom instance 72 | Returns the current state value of that atom. 73 | 74 | Example: 75 | (local x (atom 5)) 76 | (print (deref x)) ;; => 5 77 | 78 | " 79 | (. atom :state)) 80 | 81 | (fn notify-watchers 82 | [atom next-value prev-value] 83 | " 84 | When updating an atom, call each watcher with the next and previous value. 85 | Takes an atom instance, the next state value and the previous state value 86 | Performs side-effects to call watchers 87 | Returns nil. 88 | " 89 | (let [watchers (. atom :watchers)] 90 | (each [_ f (pairs watchers)] 91 | (f next-value prev-value)))) 92 | 93 | (fn add-watch 94 | [atom key f] 95 | " 96 | Adds a watcher function by a given key to an atom instance. Allows us to 97 | subscribe to an atom for changes. 98 | Takes an atom instance, a key string, and a function that takes a next and 99 | previous value. 100 | Performs a side-effect to add a watcher for the given key. Replace previous 101 | watcher on given key. 102 | Returns nil 103 | 104 | Example: 105 | (local x (atom 5)) 106 | (add-watch x :custom-watcher #(print $1 \" \" $2)) 107 | (swap! x - 1) 108 | ;; => 4 5 109 | " 110 | (tset atom :watchers key f)) 111 | 112 | (fn remove-watch 113 | [atom key] 114 | " 115 | Removes a watcher function by a given key 116 | Takes an atom instance and key to target a specific watcher. 117 | Performs a side-effect of changing an atom 118 | Returns nil 119 | 120 | Example: 121 | (local x (atom 5)) 122 | (add-watch x :custom-watcher #(print $1 \" \" $2)) 123 | (swap! x - 1) 124 | ;; => 4 5 125 | (remove-watxh x :custom-watcher) 126 | (swap! x - 1) 127 | ;; => x (nothing will be printed) 128 | (deref x) 129 | ;; => 4 130 | " 131 | (table.remove (. atom :watchers) key)) 132 | 133 | (fn swap! 134 | [atom f ...] 135 | " 136 | API to update an atom's state by performing a calculation against its current 137 | state value. 138 | Takes an atom instance and a function that takes the current value of the atom 139 | plus additional args and returns the new value. 140 | Performs a side-effect to update atom's state 141 | Returns the atom instance 142 | 143 | Example: 144 | (def x (atom 1)) 145 | (swap! x + 1) 146 | (deref x) 147 | ;; => 2 148 | " 149 | (let [prev-value (deref atom) 150 | ;; Don't copy - trust that transition functions return new 151 | ;; state This is a massive performance improvement for large 152 | ;; state objects 153 | next-value (f prev-value (table.unpack [...]))] 154 | (set atom.state next-value) 155 | (notify-watchers atom next-value prev-value) 156 | atom)) 157 | 158 | (fn reset! 159 | [atom v] 160 | " 161 | API to replace an atom's state value with a new value. 162 | Takes an atom instance and the new value 163 | Returns the updated atom instance 164 | 165 | Example: 166 | (local x (atom 1)) 167 | (reset! x 3) 168 | ;; => x 169 | (deref x) 170 | ;; => 3 171 | " 172 | (swap! atom (fn [] v))) 173 | 174 | {:atom atom 175 | :new atom 176 | :deref deref 177 | :notify-watchers notify-watchers 178 | :add-watch add-watch 179 | :remove-watch remove-watch 180 | :reset! reset! 181 | :swap! swap!} 182 | -------------------------------------------------------------------------------- /lib/statemachine.fnl: -------------------------------------------------------------------------------- 1 | " 2 | Provides the mechanism to generate a finite state machine. 3 | 4 | A finite state machine defines states and some way to transition between states. 5 | 6 | The 'new' function takes a template, which is a table with the following schema: 7 | { 8 | :state {:current-state :state1 9 | :context {}} 10 | :states {:state1 {} 11 | :state2 {} 12 | :state3 {:leave transition-fn-leave 13 | :exit transition-fn-exit}}} 14 | 15 | * The CONTEXT is any table that can be updated by TRANSITION FUNCTIONS. This 16 | allows the client to track their own state. 17 | * The STATES table is a map from ACTIONS to TRANSITION FUNCTIONS. 18 | * These functions must return a TRANSITION OBJECT containing the new 19 | :state and the :effect. 20 | * The :state contains a (potentially changed) :current-state and a new :context, 21 | which is updated in the state machine. 22 | * Functions can subscribe to all transitions, and are provided a TRANSITION 23 | RECORD, which contains: 24 | * :prev-state 25 | * :next-state 26 | * :action 27 | * :effect that was kicked off from the transition function 28 | * The subscribe method returns a function that can be called to unsubscribe. 29 | 30 | Additionally, we provide a helper function `effect-handler`, which is a 31 | higher-order function that returns a function suitable to be provided to 32 | subscribe. It takes a map of EFFECTs to handler functions. These handler 33 | functions should return their own cleanup. The effect-handler will automatically 34 | call this cleanup function after the next transition. For example, if you want 35 | to bind keys when a certain effect is kicked off, write a function that binds 36 | the keys and returns an unbind function. The unbind function will be called on 37 | the next transition. 38 | " 39 | 40 | 41 | (require-macros :lib.macros) 42 | (local atom (require :lib.atom)) 43 | (local {: call-when : merge} (require :lib.functional)) 44 | (local {: logger} (require :lib.utils)) 45 | 46 | (fn update-state 47 | [fsm state] 48 | (atom.swap! fsm.state (fn [_ state] state) state)) 49 | 50 | (fn get-transition-function 51 | [fsm current-state action] 52 | (. fsm.states current-state action)) 53 | 54 | (fn get-state 55 | [fsm] 56 | (atom.deref fsm.state)) 57 | 58 | (fn send 59 | [fsm action extra] 60 | " 61 | Based on the action and the fsm's current-state, set the new state and call 62 | all subscribers with the previous state, new state, action, and extra. 63 | " 64 | (let [state (get-state fsm) 65 | {: current-state } state] 66 | (if-let [tx-fn (get-transition-function fsm current-state action)] 67 | (let [transition (tx-fn state action extra) 68 | new-state (if transition transition.state state) 69 | effect (if transition transition.effect nil)] 70 | 71 | (update-state fsm new-state) 72 | ;; Call all subscribers - cache subscribers to avoid 73 | ;; multiple derefs 74 | (let [subs (atom.deref fsm.subscribers)] 75 | (each [_ sub (pairs subs)] 76 | (sub {:prev-state state 77 | :next-state new-state : action : effect : extra}))) 78 | true) 79 | (do 80 | (if fsm.log 81 | (fsm.log.df 82 | "Action :%s does not have a transition function in state :%s" 83 | action current-state)) 84 | false)))) 85 | 86 | (fn subscribe 87 | [fsm sub] 88 | " 89 | Adds a subscriber to the provided fsm. Returns a function to unsubscribe 90 | Naive: Because each entry is keyed by the function address it doesn't allow 91 | the same function to subscribe more than once. 92 | " 93 | (let [sub-key (tostring sub)] 94 | (atom.swap! fsm.subscribers (fn [subs sub] 95 | (merge {sub-key sub} subs)) sub) 96 | ; Return the unsub func 97 | (fn [] 98 | (atom.swap! 99 | fsm.subscribers 100 | (fn [subs key] (tset subs key nil) subs) sub-key)))) 101 | 102 | (fn effect-handler 103 | [effect-map] 104 | " 105 | Takes a map of effect->function and returns a function that handles these 106 | effects by calling the mapped-to function, and then calls that function's 107 | return value (a cleanup function) and calls it on the next transition. 108 | 109 | These functions must return their own cleanup function or nil. 110 | " 111 | ;; Create a one-time atom used to store the cleanup function 112 | (let [cleanup-ref (atom.new nil)] 113 | ;; Return a subscriber function 114 | (fn [{: _prev-state : next-state : _action : effect : extra}] 115 | ;; Whenever a transition occurs, call the cleanup function, if set 116 | (call-when (atom.deref cleanup-ref)) 117 | ;; Get a new cleanup function or nil and update cleanup-ref atom 118 | (atom.reset! 119 | cleanup-ref 120 | (call-when (. effect-map effect) next-state extra))))) 121 | 122 | (fn create-machine 123 | [template] 124 | (let [fsm {:state (atom.new {:current-state template.state.current-state 125 | :context template.state.context}) 126 | :states template.states 127 | :subscribers (atom.new {}) 128 | :log (if template.log (logger template.log "info"))}] 129 | ; Add methods 130 | {:state fsm.state 131 | :states fsm.states 132 | :subscribers fsm.subscribers 133 | :log fsm.log 134 | :get-state (partial get-state fsm) 135 | :send (partial send fsm) 136 | :subscribe (partial subscribe fsm)})) 137 | 138 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 139 | ;; Exports 140 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 141 | 142 | {: effect-handler 143 | : send 144 | : subscribe 145 | :new create-machine} 146 | -------------------------------------------------------------------------------- /lib/functional.fnl: -------------------------------------------------------------------------------- 1 | (local fu hs.fnutils) 2 | 3 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4 | ;; Simple Utils 5 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 6 | 7 | (fn call-when 8 | [f ...] 9 | "Execute function if it is not nil." 10 | (when (and f (= (type f) :function)) 11 | (f ...))) 12 | 13 | (fn compose 14 | [...] 15 | (let [fs [...] 16 | total (length fs)] 17 | (fn [v] 18 | (var res v) 19 | (for [i 0 (- total 1)] 20 | (let [f (. fs (- total i))] 21 | (set res (f res)))) 22 | res))) 23 | 24 | (fn contains? 25 | [x xs] 26 | "Returns true if key is present in the given collection, otherwise returns false." 27 | (and xs (fu.contains xs x))) 28 | 29 | (fn find 30 | [f tbl] 31 | "Executes a function across a table and return the first element where that 32 | function returns true. 33 | " 34 | (fu.find tbl f)) 35 | 36 | (fn get 37 | [prop-name tbl] 38 | (if tbl 39 | (. prop-name tbl) 40 | (fn [tbl] 41 | (. tbl prop-name)))) 42 | 43 | (fn has-some? 44 | [list] 45 | (and list (< 0 (length list)))) 46 | 47 | (fn identity 48 | [x] x) 49 | 50 | (fn join 51 | [sep list] 52 | (table.concat list sep)) 53 | 54 | (fn first 55 | [list] 56 | (. list 1)) 57 | 58 | (fn last 59 | [list] 60 | (. list (length list))) 61 | 62 | (fn logf 63 | [...] 64 | (let [prefixes [...]] 65 | (fn [x] 66 | (print (table.unpack prefixes) (hs.inspect x))))) 67 | 68 | (fn noop 69 | [] 70 | nil) 71 | 72 | (fn range 73 | [start end] 74 | (let [t []] 75 | (for [i start end] 76 | (table.insert t i)) 77 | t)) 78 | 79 | (fn slice-end-idx 80 | [end-pos list] 81 | (if (< end-pos 0) 82 | (+ (length list) end-pos) 83 | end-pos)) 84 | 85 | (fn slice-start-end 86 | [start end list] 87 | (let [end+ (if (< end 0) 88 | (+ (length list) end) 89 | end)] 90 | (var sliced []) 91 | (for [i start end+] 92 | (table.insert sliced (. list i))) 93 | sliced)) 94 | 95 | (fn slice-start 96 | [start list] 97 | (slice-start-end (if (< start 0) 98 | (+ (length list) start) 99 | start) (length list) list)) 100 | 101 | (fn slice 102 | [start end list] 103 | (if (and (= (type end) :table) 104 | (not list)) 105 | (slice-start start end) 106 | (slice-start-end start end list))) 107 | 108 | (fn split 109 | [separator str] 110 | "Converts string to an array of strings using specified separator." 111 | (fu.split str separator)) 112 | 113 | (fn tap 114 | [f x ...] 115 | (f x (table.unpack [...])) 116 | x) 117 | 118 | (fn count 119 | [tbl] 120 | "Returns number of elements in a table" 121 | (var ct 0) 122 | (fu.each 123 | tbl 124 | (fn [] 125 | (set ct (+ ct 1)))) 126 | ct) 127 | 128 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 129 | ;; Reduce Primitives 130 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 131 | 132 | (fn seq? 133 | [tbl] 134 | (~= (. tbl 1) nil)) 135 | 136 | (fn seq 137 | [tbl] 138 | (if (seq? tbl) 139 | (ipairs tbl) 140 | (pairs tbl))) 141 | 142 | (fn reduce 143 | [f acc tbl] 144 | (accumulate [acc acc 145 | k v (seq tbl)] 146 | (f acc v k))) 147 | 148 | 149 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 150 | ;; Reducers 151 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 152 | 153 | (fn for-each 154 | [f tbl] 155 | (fu.each tbl f)) 156 | 157 | (fn get-in 158 | [paths tbl] 159 | (reduce 160 | (fn [tbl path] 161 | (-?> tbl (. path))) 162 | tbl 163 | paths)) 164 | 165 | (fn map 166 | [f tbl] 167 | (reduce 168 | (fn [new-tbl v k] 169 | (table.insert new-tbl (f v k)) 170 | new-tbl) 171 | [] 172 | tbl)) 173 | 174 | (fn merge [& tbls] 175 | (reduce 176 | (fn [merged tbl] 177 | (each [k v (pairs tbl)] 178 | (tset merged k v)) 179 | merged) 180 | {} 181 | tbls)) 182 | 183 | (fn filter 184 | [f tbl] 185 | (reduce 186 | (fn [xs v k] 187 | (when (f v k) 188 | (table.insert xs v)) 189 | xs) 190 | [] 191 | tbl)) 192 | 193 | (fn concat 194 | [...] 195 | (reduce 196 | (fn [cat tbl] 197 | (each [_ v (ipairs tbl)] 198 | (table.insert cat v)) 199 | cat) 200 | [] 201 | [...])) 202 | 203 | (fn some 204 | [f tbl] 205 | (let [filtered (filter f tbl)] 206 | (<= 1 (length filtered)))) 207 | 208 | (fn conj 209 | [tbl e] 210 | "Return a new list with the element e added at the end" 211 | (concat tbl [e])) 212 | 213 | (fn butlast 214 | [tbl] 215 | "Return a new list with all but the last item" 216 | (slice 1 -1 tbl)) 217 | 218 | 219 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 220 | ;; Others 221 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 222 | 223 | (fn eq? 224 | [l1 l2] 225 | (if (and (= (type l1) (type l2) "table") 226 | (= (length l1) (length l2))) 227 | (fu.every l1 228 | (fn [v] (contains? v l2))) 229 | (= (type l1) (type l2)) 230 | (= l1 l2) 231 | false)) 232 | 233 | 234 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 235 | ;; Exports 236 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 237 | 238 | {: butlast 239 | : call-when 240 | : compose 241 | : concat 242 | : conj 243 | : contains? 244 | : count 245 | : eq? 246 | : filter 247 | : find 248 | : first 249 | : for-each 250 | : get 251 | : get-in 252 | : has-some? 253 | : identity 254 | : join 255 | : last 256 | : logf 257 | : map 258 | : merge 259 | : noop 260 | : reduce 261 | : seq 262 | : seq? 263 | : some 264 | : slice 265 | : split 266 | : tap} 267 | -------------------------------------------------------------------------------- /lib/advice/init.fnl: -------------------------------------------------------------------------------- 1 | " 2 | Advising API to register functions 3 | " 4 | 5 | (require-macros :lib.macros) 6 | (local fennel (require :fennel)) 7 | (local {: compose 8 | : filter 9 | : first 10 | : join 11 | : map 12 | : reduce 13 | : slice 14 | : split} (require :lib.functional)) 15 | 16 | (var advice {}) 17 | (var advisable []) 18 | 19 | (fn register-advisable 20 | [key f] 21 | (let [advice-entry (. advice key)] 22 | (when (and advice-entry 23 | advice-entry.original 24 | (not (= advice-entry.original f))) 25 | (error (.. "Advisable function " key " already exists"))) 26 | (if advice-entry 27 | (tset advice-entry 28 | :original f) 29 | (tset advice key 30 | {:original f 31 | :advice []})) 32 | (. advice key))) 33 | 34 | (fn get-or-create-advice-entry 35 | [key] 36 | " 37 | Gets or create an advice-entry without an original. This allows 38 | advice to be added before the advisable function is defined 39 | " 40 | (let [advice-entry (. advice key)] 41 | (if advice-entry 42 | advice-entry 43 | (do 44 | ;; Don't set original as that is used to determine when an 45 | ;; advisable function by that key was already defined 46 | (tset advice key {:advice []}) 47 | (. advice key))))) 48 | 49 | (fn advisable-keys 50 | [] 51 | (slice 0 advisable)) 52 | 53 | (fn get-module-name 54 | [] 55 | (->> (. (debug.getinfo 3 "S") :short_src) 56 | (split "/") 57 | (slice -1) 58 | (join "/") 59 | (split "%.") 60 | (first))) 61 | 62 | (fn advisor 63 | [type f orig-f] 64 | (if 65 | (= type :override) 66 | (fn [args] 67 | (f (table.unpack args))) 68 | 69 | (= type :around) 70 | (fn [args] 71 | (f orig-f (table.unpack args))) 72 | 73 | (= type :before) 74 | (fn [args] 75 | (f (table.unpack args)) 76 | (orig-f (table.unpack args))) 77 | 78 | (= type :before-while) 79 | (fn [args] 80 | (and (f (table.unpack args)) 81 | (orig-f (table.unpack args)))) 82 | 83 | (= type :before-until) 84 | (fn [args] 85 | (or (f (table.unpack args)) 86 | (orig-f (table.unpack args)))) 87 | 88 | (= type :after) 89 | (fn [args] 90 | (let [ret (orig-f (table.unpack args))] 91 | (f (table.unpack args)) 92 | ret)) 93 | 94 | (= type :after-while) 95 | (fn [args] 96 | (and (orig-f (table.unpack args)) 97 | (f (table.unpack args)))) 98 | 99 | (= type :after-until) 100 | (fn [args] 101 | (or (orig-f (table.unpack args)) 102 | (f (table.unpack args)))) 103 | 104 | (= type :filter-args) 105 | (fn [args] 106 | (orig-f (table.unpack (f (table.unpack args))))) 107 | 108 | (= type :filter-return) 109 | (fn [args] 110 | (f (orig-f (table.unpack args)))))) 111 | 112 | (fn apply-advice 113 | [entry args] 114 | (((compose 115 | (table.unpack (->> entry.advice 116 | (map (fn [{: f 117 | : type}] 118 | (fn [next-f] 119 | (advisor type f next-f))))))) 120 | (fn [...] (entry.original (table.unpack [...])))) 121 | args)) 122 | 123 | (fn count 124 | [tbl] 125 | (->> tbl 126 | (reduce (fn [acc _x _key] 127 | (+ acc 1)) 128 | 0))) 129 | 130 | (fn dispatch-advice 131 | [entry args] 132 | (if (> (count entry.advice) 0) 133 | (apply-advice entry args) 134 | (entry.original (table.unpack args)))) 135 | 136 | 137 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 138 | ;; Public API 139 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 140 | 141 | (fn make-advisable 142 | [fn-name f] 143 | " 144 | Registers a function name against the global advisable table that 145 | contains advice registered for a function. Advice can be defined 146 | before a function is defined making it a really safe way to extend 147 | behavior without exploding config options. 148 | 149 | It is recommended to use the `defn` or `afn` macros instead. 150 | 151 | Usage: 152 | (make-advisable :some-func (fn some-func [] \"Some return string\")) 153 | 154 | - Supports passing some-func directly into add-advice 155 | - Supports passing in some-func.key directly into add-advice 156 | - Supports passing in a string like :path/to/module/some-func to 157 | add-advice 158 | " 159 | (let [module (get-module-name) 160 | key (.. module "/" fn-name) 161 | advice-entry (register-advisable key f) 162 | ret {:key key 163 | :advice advice-entry}] 164 | (setmetatable ret 165 | {:__name fn-name 166 | :__call (fn [_tbl ...] 167 | (dispatch-advice advice-entry [...])) 168 | :__index (fn [tbl key] 169 | (. tbl key))}) 170 | (each [k v (pairs (or (. fennel.metadata f) []))] 171 | (fennel.metadata:set ret k v)) 172 | ret)) 173 | 174 | (fn add-advice 175 | [f advice-type advice-fn] 176 | " 177 | Register advice for an advisable function. It is recommended to use 178 | the `defadvice` macro instead. 179 | 180 | Takes a key string or a callable table with a key property, an 181 | advising type key string, and an advising function 182 | 183 | Returns nil, as it performs a side-effect 184 | " 185 | (let [key (or f.key f) 186 | advice-entry (get-or-create-advice-entry key)] 187 | (when advice-entry 188 | (table.insert advice-entry.advice {:type advice-type :f advice-fn})))) 189 | 190 | (fn remove-advice 191 | [f advice-type advice-fn] 192 | " 193 | Remove advice from a function 194 | " 195 | (let [key (or f.key f) 196 | advice-entry (. advice key)] 197 | (tset advice-entry :advice 198 | (->> advice-entry.advice 199 | (filter #(not (and (= $1.type advice-type) 200 | (= $1.f advice-fn)))))) 201 | nil)) 202 | 203 | (fn reset 204 | [] 205 | " 206 | Anticipated for internal, testing, and debugging 207 | Use with Caution 208 | " 209 | (set advice {}) 210 | (set advisable [])) 211 | 212 | (fn print-advisable-keys 213 | [] 214 | " 215 | Prints a list of advisable function keys 216 | " 217 | (print "\nAdvisable functions:\n") 218 | (each [_i key (ipairs (advisable-keys))] 219 | (print (.. " :" key)))) 220 | 221 | (fn get-advice 222 | [f-or-key] 223 | " 224 | Returns the advice list for a given function or advice entry key 225 | " 226 | (let [advice-entry (. advice (or f-or-key.key f-or-key))] 227 | (if advice-entry 228 | (map 229 | (fn [adv] 230 | {:f (tostring adv.f) :type adv.type}) 231 | (slice 0 advice-entry.advice)) 232 | []))) 233 | 234 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 235 | ;; Exports 236 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 237 | 238 | {: reset 239 | : make-advisable 240 | : add-advice 241 | : remove-advice 242 | : get-advice 243 | : print-advisable-keys} 244 | -------------------------------------------------------------------------------- /spacehammer.el: -------------------------------------------------------------------------------- 1 | ;;; spacehammer.el --- Spacehammer Elisp Helpers -*- lexical-binding: t; -*- 2 | ;; 3 | ;; Copyright (C) 2022 Ag Ibragimov and Collaborators 4 | ;; 5 | ;; Author: Ag Ibragimov 6 | ;; Maintainer: Ag Ibragimov 7 | ;; Version: 1.0.0 8 | ;; Keywords: extensions tools 9 | ;; Homepage: https://github.com/agzam/spacehammer 10 | ;; Package-Requires: ((emacs "27")) 11 | ;; 12 | ;; This file is not part of GNU Emacs. 13 | ;; 14 | ;;; Commentary: 15 | ;; 16 | ;; A few elisp helpers for Spacehammer 17 | ;; 18 | ;;; Code: 19 | 20 | (require 'cl-seq) 21 | 22 | (defun spacehammer-switch-to-app (pid) 23 | "Switch to app with the given PID." 24 | (unless (executable-find "hs") 25 | (user-error "Hammerspoon IPC command line (hs) not found.")) 26 | (when (and pid (eq system-type 'darwin)) 27 | (call-process (executable-find "hs") nil 0 nil "-c" 28 | (concat "require(\"emacs\").switchToApp (\"" pid "\")")))) 29 | 30 | (defvar spacehammer-edit-with-emacs-mode-map 31 | (let ((map (make-sparse-keymap))) 32 | (define-key map (kbd "C-c C-c") #'spacehammer-finish-edit-with-emacs) 33 | (define-key map (kbd "C-c C-k") #'spacehammer-cancel-edit-with-emacs) 34 | map)) 35 | 36 | (define-minor-mode spacehammer-edit-with-emacs-mode 37 | "Minor mode enabled on buffers opened by spacehammer/edit-by-emacs." 38 | :init-value nil 39 | :lighter " editwithemacs" 40 | :keymap spacehammer-edit-with-emacs-mode-map 41 | :group 'spacehammer) 42 | 43 | (defun spacehammer--turn-on-edit-with-emacs-mode () 44 | "Turn on `spacehammer-edit-with-emacs-mode' if the buffer derives from that mode." 45 | (when (string-match-p "* spacehammer-edit " (buffer-name (current-buffer))) 46 | (spacehammer-edit-with-emacs-mode t))) 47 | 48 | (define-global-minor-mode spacehammer-global-edit-with-emacs-mode 49 | spacehammer-edit-with-emacs-mode spacehammer--turn-on-edit-with-emacs-mode 50 | :group 'spacehammer) 51 | 52 | (defvar spacehammer-edit-with-emacs-hook nil 53 | "Hook for when edit-with-emacs buffer gets activated. 54 | 55 | Hook function must accept arguments: 56 | - `buffer-name' - the name of the edit buffer 57 | - `pid' - PID of the app that invoked Edit-with-Emacs 58 | - `title' - title of the app that invoked Edit-with-Emacs") 59 | 60 | (defvar spacehammer-before-finish-edit-with-emacs-hook nil 61 | "Fires when editing is done and the dedicated buffer is about be killed. 62 | 63 | Hook function must accept arguments: 64 | - `buffer-name' - the name of the edit buffer 65 | - `pid' - PID of the app that invoked Edit-with-Emacs") 66 | 67 | (defvar spacehammer-before-cancel-edit-with-emacs-hook nil 68 | "Fires when editing is canceled and the dedicated buffer is about to be killed. 69 | 70 | Hook function must accept arguments: 71 | - `buffer-name' - the name of the edit buffer 72 | - `pid' - PID of the app that invoked Edit-with-Emacs") 73 | 74 | (defvar spacehammer--caller-pid nil 75 | "Buffer local var to store the process id of the app that invoked 76 | the edit buffer") 77 | 78 | (defun spacehammer--find-buffer-by-name-prefix (prefix) 79 | "Find the first buffer with a name that starts with PREFIX." 80 | (let ((buffer-list (buffer-list))) 81 | (cl-find-if (lambda (buffer) 82 | (string-prefix-p prefix (buffer-name buffer))) 83 | buffer-list))) 84 | 85 | (defun spacehammer-edit-with-emacs (&optional pid title screen) 86 | "Edit anything with Emacs. 87 | The caller is responsible for setting up the arguments. 88 | PID - process ID of the caller app. 89 | TITLE - title of the window. 90 | SCREEN - the display from which the call initiates, see: 91 | www.hammerspoon.org/docs/hs.screen.html." 92 | (let* ((buf-name (concat "* spacehammer-edit " title " *")) 93 | ;; hook functions later could modify the buffer name, you can't expect to always 94 | ;; find the buffer originating from the same app using its full-name, but prefix 95 | ;; search would work 96 | (buffer (or (spacehammer--find-buffer-by-name-prefix buf-name) 97 | (get-buffer-create buf-name )))) 98 | (unless (bound-and-true-p spacehammer-global-edit-with-emacs-mode) 99 | (spacehammer-global-edit-with-emacs-mode +1)) 100 | (with-current-buffer buffer 101 | (put 'spacehammer--caller-pid 'permanent-local t) 102 | (setq-local spacehammer--caller-pid pid) 103 | (clipboard-yank) 104 | (deactivate-mark) 105 | (spacehammer-edit-with-emacs-mode +1)) 106 | (pop-to-buffer buffer) 107 | (run-hook-with-args 'spacehammer-edit-with-emacs-hook buf-name pid title))) 108 | 109 | (defun spacehammer-finish-edit-with-emacs () 110 | "Invoke this command when done editing." 111 | (interactive) 112 | (unless (executable-find "hs") 113 | (user-error "Hammerspoon IPC command line (hs) not found.")) 114 | (when (boundp 'spacehammer--caller-pid) 115 | (let ((pid (buffer-local-value 'spacehammer--caller-pid (current-buffer)))) 116 | (run-hook-with-args 117 | 'spacehammer-before-finish-edit-with-emacs-hook 118 | (buffer-name (current-buffer)) pid) 119 | (clipboard-kill-ring-save (point-min) (point-max)) 120 | (if (one-window-p) 121 | (kill-buffer) 122 | (kill-buffer-and-window)) 123 | (call-process 124 | (executable-find "hs") nil 0 nil "-c" 125 | (concat "require(\"emacs\").switchToAppAndPasteFromClipboard (\"" pid "\")"))))) 126 | 127 | (defun spacehammer-cancel-edit-with-emacs () 128 | "Invoke it to cancel previous editing session." 129 | (interactive) 130 | (when (boundp 'spacehammer--caller-pid) 131 | (let ((pid (buffer-local-value 'spacehammer--caller-pid (current-buffer)))) 132 | (run-hook-with-args 133 | 'spacehammer-before-cancel-edit-with-emacs-hook 134 | (buffer-name (current-buffer)) pid) 135 | (kill-buffer-and-window) 136 | (spacehammer-switch-to-app pid)))) 137 | 138 | ;;;; System-wide org capture 139 | (defvar spacehammer--capture-previous-app-pid nil 140 | "Last app that invokes `spacehammer-activate-capture-frame'.") 141 | 142 | (defun spacehammer-activate-capture-frame (&optional pid title keys) 143 | "Run ‘org-capture’ in capture frame. 144 | 145 | PID is a pid of the app (the caller is responsible to set that right) 146 | TITLE is a title of the window (the caller is responsible to set that right) 147 | KEYS is a string associated with a template (will be passed to `org-capture')" 148 | (setq spacehammer--capture-previous-app-pid pid) 149 | (select-frame-by-name "capture") 150 | (set-frame-position nil 400 400) 151 | (set-frame-size nil 1000 400 t) 152 | (switch-to-buffer (get-buffer-create "*scratch*")) 153 | (org-capture nil keys)) 154 | 155 | (defadvice org-switch-to-buffer-other-window 156 | (after supress-window-splitting activate) 157 | "Delete the extra window if we're in a capture frame." 158 | (if (equal "capture" (frame-parameter nil 'name)) 159 | (delete-other-windows))) 160 | 161 | (defadvice org-capture-finalize 162 | (after delete-capture-frame activate) 163 | "Advise capture-finalize to close the frame." 164 | (when (and (equal "capture" (frame-parameter nil 'name)) 165 | (not (eq this-command 'org-capture-refile))) 166 | (spacehammer-switch-to-app spacehammer--capture-previous-app-pid) 167 | (delete-frame))) 168 | 169 | (defadvice org-capture-refile 170 | (after delete-capture-frame activate) 171 | "`org-refile' should close the frame." 172 | (delete-frame)) 173 | 174 | (defadvice user-error 175 | (before before-user-error activate) 176 | "Failure to select capture template should close the frame." 177 | (when (eq (buffer-name) "*Org Select*") 178 | (spacehammer-switch-to-app spacehammer--capture-previous-app-pid))) 179 | 180 | (provide 'spacehammer) 181 | 182 | ;;; spacehammer.el ends here 183 | -------------------------------------------------------------------------------- /docs/testing.org: -------------------------------------------------------------------------------- 1 | #+title: Testing 2 | 3 | * How It Works 4 | 5 | The testing library provides basic unit-testing capabilities to Spacehammer by 6 | running scripts against the hammerspoon CLI =hs=. 7 | 8 | Run tests by invoking the following shell command within the =~/.hammerspoon= directory: 9 | 10 | #+begin_src bash :dir .. 11 | ./run-test test/*.fnl 12 | #+end_src 13 | 14 | Which will output something like the following: 15 | 16 | #+begin_example 17 | Running tests for /Users/j/.hammerspoon/test/functional-test.fnl 18 | Running tests for /Users/j/.hammerspoon/test/statemachine-test.fnl 19 | 20 | Functional 21 | 22 | Call when calls function if it exists ... 23 | [ OK ] 24 | 25 | Compose combines functions together in reverse order ... 26 | [ OK ] 27 | 28 | Contains? returns true if list table contains a value ... 29 | [ OK ] 30 | 31 | State Machine 32 | 33 | Should create a new fsm in the closed state ... 34 | [ OK ] 35 | 36 | Should transition to opened on open event ... 37 | [ OK ] 38 | 39 | Should transition back to opened on close event ... 40 | [ OK ] 41 | 42 | Should not explode when dispatching an unhandled event ... 43 | 05:27:10 ** Warning: statemach: Could not fail from closed state 44 | [ OK ] 45 | 46 | 47 | Ran 7 tests 7 passed 0 failed in 0.038301000000047 seconds 48 | #+end_example 49 | 50 | * Requirements 51 | 52 | Be sure to run the =hs.ipc.cliInstall= [[https://www.hammerspoon.org/docs/hs.ipc.html#cliInstall][command]] from hammerspoon. You may paste 53 | this or eval against the Hammerspoon console: 54 | 55 | #+begin_src lua 56 | hs.ipc.cliInstall() 57 | #+end_src 58 | 59 | * Testing API 60 | 61 | The current form of the testing API is inspired by JS libraries like [[https://mochajs.org/][mocha]] given 62 | how easy it is to implement. 63 | 64 | ** Describe 65 | 66 | Label a test suite 67 | 68 | Usage: 69 | 70 | #+begin_src fennel 71 | (describe 72 | "Functional Tools" 73 | (fn [] 74 | ;; Other describe calls or `it` tests can run here 75 | ) 76 | #+end_src 77 | 78 | Describe a suite of tests contained in its function body. The function 79 | body may contain other =describe= calls as well as =it= calls to perform tests. 80 | 81 | The aim is to help organize displayed test results, as its inner tests 82 | are indented underneath the describe text label when printing test results. 83 | 84 | ** It 85 | 86 | Perform a test that can either pass or fail. 87 | 88 | Usage: 89 | 90 | #+begin_src fennel 91 | (describe 92 | "Basic Fennel Tests" 93 | (fn [] 94 | (it "Should do math" 95 | (fn [] 96 | (is.eq? (+ 1 1) 2 "Did not result in 2"))))) 97 | #+end_src 98 | 99 | The bodies of =it= calls should run code and perform assertions, if no 100 | error is thrown, the test has passed. 101 | 102 | =it= calls cannot be nested, instead should have siblings within a 103 | =describe= suite. 104 | 105 | ** Before 106 | 107 | Run a function before tests run in a suite 108 | 109 | Usage: 110 | 111 | #+begin_src fennel 112 | (describe 113 | "Functional Tools" 114 | (fn [] 115 | (before (fn [] 116 | (print "Perform pre-test setup"))) 117 | 118 | (it "Should do math" 119 | (fn [] 120 | (is.eq? (+ 1 1) 2 "Did not result in 2"))))) 121 | #+end_src 122 | 123 | =before= is best used as a way to prepare data, or allocate resources 124 | tests may use before they're setup 125 | 126 | *** Does =before= run before each =it=? 127 | 128 | No. =before= runs once before all tests in a =describe= suite. 129 | 130 | #+begin_src fennel 131 | (describe 132 | "A Test Suite" 133 | (fn [] 134 | (before 135 | (fn [] 136 | (print "This only prints once. Before all tests in this suite."))) 137 | (after 138 | (fn [] 139 | (print "This only prints once. After all tests in this suite."))) 140 | 141 | (it "Addition" 142 | (fn [] 143 | (is.eq? (+ 1 1) 2 "Did not result in 2"))) 144 | 145 | (it "Subtraction" 146 | (fn [] 147 | (is.eq? (- 1 1) 0 "Did not result in 0"))))) 148 | #+end_src 149 | 150 | ** After 151 | 152 | Run a function after tests run in a suite 153 | 154 | Usage: 155 | 156 | #+begin_src fennel 157 | (describe 158 | "Functional Tools" 159 | (fn [] 160 | (after (fn [] 161 | (print "Perform post-test cleanup"))) 162 | 163 | (it "Should do math" 164 | (fn [] 165 | (is.eq? (+ 1 1) 2 "Did not result in 2"))))) 166 | #+end_src 167 | 168 | =after= is useful for cleaning up or resetting test state caused by 169 | running tests. 170 | 171 | * Assertions 172 | 173 | Currently, only two basic assertion functions are provided by 174 | [[../lib/testing/assert.fnl][assert.fnl]] 175 | 176 | Require them in test files like the following: 177 | 178 | #+begin_src fennel 179 | (local is (require :lib.testing.assert)) 180 | #+end_src 181 | 182 | ** is.eq? 183 | 184 | Asserts that the actual value is identical to the expected value or 185 | throws an error. 186 | 187 | Usage: 188 | 189 | #+begin_src fennel 190 | (is.eq? actual expected message) 191 | #+end_src 192 | 193 | Appends error messages with ~instead got ~ at the end of the 194 | supplied message arg. 195 | 196 | Example: 197 | 198 | #+begin_src fennel 199 | (is.eq? (+ 1 1) 2 "Math is wack") 200 | #+end_src 201 | 202 | ** is.ok? 203 | 204 | Asserts that the actual value is truthy or throws an error. 205 | 206 | Usage: 207 | 208 | #+begin_src fennel 209 | (is.ok? actual message) 210 | #+end_src 211 | 212 | Appends error messages with ~instead got ~ at the end of the 213 | supplied message arg. 214 | 215 | Example: 216 | 217 | #+begin_src fennel 218 | (is.ok? true "true was not truthy") ;; => PASS 219 | (is.ok? "hi" "hi was not truthy") ;; => PASS 220 | (is.ok? 5 "5 was not truthy") ;; => PASS 221 | 222 | ;; These will throw 223 | 224 | (is.ok? nil "nil was not truthy") ;; => FAIL 225 | (is.ok? false "false was not truthy") ;; => FAIL 226 | #+end_src 227 | 228 | 229 | * Known-Issues 230 | 231 | The testing capabilities are still early in development and subject to change in 232 | future iterations. 233 | 234 | ** Tests run inconsistently 235 | 236 | Because the =hs= cli command runs scripts against the Hammerspoon ipc server, 237 | tests may not run consistently until after a reload completes and Hammerspoon 238 | applies the changes. When this happens, try running the tests again. The 239 | solution for auto-running tests at the bottom can help mitigate these kinds of issues. 240 | 241 | ** State may persist between runs 242 | 243 | Another caveat due to the =hs= cli system is that tests are running against the 244 | global Hammerspoon state. If the library you are testing is changing 245 | global state, you may find data persists between re-runs of tests. 246 | 247 | If running into issues, try reloading Hammerspoon. When Hammerspoon 248 | reloads, the global state will reset and tests can run fresh. 249 | 250 | The =before= or =after= hook APIs are useful for resetting state before or 251 | after all tests run in a suite. 252 | 253 | ** Slow Performance 254 | 255 | Fennel tests do run a bit slowly, possibly due to sending code over 256 | ipc to the hammerspoon server to eval, also limited by fennel 257 | performance within lua. 258 | 259 | * Auto-running Tests 260 | 261 | Open to improvements here, but one option is to leverage the =npm= 262 | package [[https://www.npmjs.com/package/nodemon][nodemon]] to re-run tests when fennel files update. 263 | 264 | #+begin_src bash :results none 265 | npx nodemon -e ".fnl" -x "./run-test" --delay 2 -- test/*.fnl 266 | #+end_src 267 | 268 | The delay is 2 seconds in that example, which gives Hammerspoon time to restart 269 | the process. Adjust to what works best on your machine. 270 | 271 | ** Installation 272 | 273 | Run the following command, will only work if Node is installed: 274 | 275 | #+begin_src bash 276 | npm install nodemon 277 | #+end_src 278 | 279 | -------------------------------------------------------------------------------- /core.fnl: -------------------------------------------------------------------------------- 1 | (hs.ipc.cliInstall) ; ensure CLI installed 2 | 3 | (local fennel (require :fennel)) 4 | (require :lib.globals) 5 | (local {:contains? contains? 6 | :map map 7 | :merge merge 8 | :reduce reduce 9 | :split split 10 | :some some} (require :lib.functional)) 11 | (local {: logger} (require :lib.utils)) 12 | (local atom (require :lib.atom)) 13 | (require-macros :lib.macros) 14 | (require-macros :lib.advice.macros) 15 | 16 | ;; Add compatability with spoons as the spoon global may not exist at 17 | ;; this point until a spoon is loaded. It will exist if a spoon is 18 | ;; loaded from init.lua 19 | 20 | (global spoon (or _G.spoon {})) 21 | 22 | ;; Make ~/.spacehammer folder override repo files 23 | (local homedir (os.getenv "HOME")) 24 | (local customdir (.. homedir "/.spacehammer")) 25 | (set fennel.path (.. customdir "/?.fnl;" fennel.path)) 26 | 27 | (local log (logger "\tcore.fnl\t" "debug")) 28 | 29 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 30 | ;; defaults 31 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 32 | 33 | (set hs.hints.style :vimperator) 34 | (set hs.hints.showTitleThresh 4) 35 | (set hs.hints.titleMaxSize 10) 36 | (set hs.hints.fontSize 30) 37 | (set hs.window.animationDuration 0.2) 38 | 39 | " 40 | alert :: str, { style }, seconds -> nil 41 | Shortcut for showing an alert on the primary screen for a specified duration 42 | Takes a message string, a style table, and the number of seconds to show alert 43 | Returns nil. This function causes side-effects. 44 | " 45 | (global alert 46 | (afn 47 | alert 48 | [str style seconds] 49 | " 50 | Global alert function used for spacehammer modals and reload 51 | alerts after config reloads 52 | " 53 | (hs.alert.show str 54 | style 55 | (hs.screen.primaryScreen) 56 | seconds))) 57 | 58 | (global fw hs.window.focusedWindow) 59 | 60 | (global pprint (fn [x] (print (fennel.view x)))) 61 | 62 | (global get-config 63 | (afn get-config 64 | [] 65 | " 66 | Returns the global config object, or error if called early 67 | " 68 | (error "get-config can only be called after all modules have initialized"))) 69 | 70 | (fn file-exists? 71 | [filepath] 72 | " 73 | Determine if a file exists and is readable. 74 | Takes a file path string 75 | Returns true if file is readable 76 | " 77 | (let [file (io.open filepath "r")] 78 | (when file 79 | (io.close file)) 80 | (~= file nil))) 81 | 82 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 83 | ;; create custom config file if it doesn't exist 84 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 85 | 86 | (fn copy-file 87 | [source dest] 88 | " 89 | Copies the contents of a source file to a destination file. 90 | Takes a source file path and a destination file path. 91 | Returns nil 92 | " 93 | (let [default-config (io.open source "r") 94 | custom-config (io.open dest "a")] 95 | (each [line _ (default-config:lines)] 96 | (custom-config:write (.. line "\n"))) 97 | (custom-config:close) 98 | (default-config:close))) 99 | 100 | ;; If ~/.spacehammer/config.fnl does not exist 101 | ;; - Create ~/.spacehammer dir 102 | ;; - Copy default ~/.hammerspoon/config.example.fnl to ~/.spacehammer/config.fnl 103 | (let [example-path (.. hs.configdir "/config.example.fnl") 104 | target-path (.. customdir "/config.fnl")] 105 | (when (not (file-exists? target-path)) 106 | (log.d (.. "Copying " example-path " to " target-path)) 107 | (hs.fs.mkdir customdir) 108 | (copy-file example-path target-path))) 109 | 110 | 111 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 112 | ;; auto reload config 113 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 114 | 115 | (fn source-filename? 116 | [file] 117 | " 118 | Determine if a file is not an emacs backup file which starts with \".#\" 119 | Takes a file path string 120 | Returns true if it's a source file and not an emacs backup file. 121 | " 122 | (not (string.match file ".#"))) 123 | 124 | (fn source-extension? 125 | [file] 126 | " 127 | Determine if a file is a .fnl or .lua file 128 | Takes a file string 129 | Returns true if file extension ends in .fnl or .lua 130 | " 131 | (let [ext (split "%p" file)] 132 | (and 133 | (or (contains? "fnl" ext) 134 | (contains? "lua" ext)) 135 | (not (string.match file "-test%..*$"))))) 136 | 137 | 138 | (fn source-updated? 139 | [file] 140 | " 141 | Determine if a file is a valid source file that we can load 142 | Takes a file string path 143 | Returns true if file is not an emacs backup and is a .fnl or .lua type. 144 | " 145 | (and (source-filename? file) 146 | (source-extension? file))) 147 | 148 | (fn config-reloader 149 | [files] 150 | " 151 | If the list of files contains some hammerspoon or spacehammer source files: 152 | reload hammerspoon 153 | Takes a list of files from our config file watcher. 154 | Performs side effect of reloading hammerspoon. 155 | Returns nil 156 | " 157 | (when (some source-updated? files) 158 | (hs.console.clearConsole) 159 | (hs.reload))) 160 | 161 | (fn watch-files 162 | [dir] 163 | " 164 | Watches hammerspoon or spacehammer source files. When a file updates we reload 165 | hammerspoon. 166 | Takes a directory to watch. 167 | Returns a function to stop the watcher. 168 | " 169 | (let [watcher (hs.pathwatcher.new dir config-reloader)] 170 | (watcher:start) 171 | (fn [] 172 | (watcher:stop)))) 173 | 174 | ;; Create a global config-files-watcher. Calling it stops the default watcher 175 | (global config-files-watcher (watch-files hs.configdir)) 176 | 177 | (when (file-exists? (.. customdir "/config.fnl")) 178 | (global custom-files-watcher (watch-files customdir))) 179 | 180 | 181 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 182 | ;; Set utility keybindings 183 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 184 | 185 | 186 | ;; toggle hs.console with Ctrl+Cmd+~ 187 | (hs.hotkey.bind 188 | [:ctrl :cmd] "`" nil 189 | (fn [] 190 | (if-let 191 | [console (hs.console.hswindow)] 192 | (when (= console (hs.console.hswindow)) 193 | (hs.closeConsole)) 194 | (hs.openConsole)))) 195 | 196 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 197 | ;; Load custom init.fnl file (if it exists) 198 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 199 | 200 | (let [custom-init-file (.. customdir "/init.fnl")] 201 | (when (file-exists? custom-init-file) 202 | (fennel.dofile custom-init-file))) 203 | 204 | 205 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 206 | ;; Initialize core modules 207 | ;; - Requires each module 208 | ;; - Calls module.init and provides config.fnl table 209 | ;; - Stores global reference to all initialized resources to prevent garbage 210 | ;; collection. 211 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 212 | 213 | (local config (require :config)) 214 | 215 | ;; Initialize our modules that depend on config 216 | (local modules [:lib.hyper 217 | :vim 218 | :windows 219 | :apps 220 | :lib.bind 221 | :lib.modal 222 | :lib.apps]) 223 | 224 | (defadvice get-config-impl 225 | [] 226 | :override get-config 227 | "Returns global config obj" 228 | config) 229 | 230 | ;; Create a global reference so services like hs.application.watcher 231 | ;; do not get garbage collected. 232 | (global resources 233 | (->> modules 234 | (map (fn [path] 235 | (let [module (require path)] 236 | {path (module.init config)}))) 237 | (reduce #(merge $1 $2) {}))) 238 | 239 | ;; override log level for named loggers in config 240 | (each [logger-id level (pairs (or config.log-levels {}))] 241 | (logger logger-id level)) 242 | -------------------------------------------------------------------------------- /docs/emacs.org: -------------------------------------------------------------------------------- 1 | * Edit with Emacs 2 | 3 | [[./edit-with-emacs-demo.gif/]] 4 | 5 | Any text, in just about any app can be edited using Emacs. The idea is simple - you press a dedicated key-combo (default: =Cmd+Ctrl+O=), Spacehammer copies the existing text & calls ~emacsclient~, which invokes a function that opens a buffer and pastes the text into it. Once you finish editing, you press =C-c C-c=, Emacs grabs the text, switches back to where you were before and pastes the new text in there. It works surprisingly well. 6 | 7 | You can for example: 8 | - open Browser's Dev Tools; 9 | - press =Cmd+Ctrl+O=, 10 | - then in Emacs, switch to js-mode, have all the bells and whistles: syntax-highlighting, autocomplete, etc.; 11 | - write some javascript; 12 | - finish editing, press =C-c C-c= 13 | and it would paste that code back into the Dev Tools console. 14 | ** Prerequisites 15 | The Hammerspoon IPC utility *must be installed and available in the $PATH.* 16 | Spacehammer should automatically install it. However, for various reasons (usually related to permissions), sometimes, it may fail to do so. If that's the case, after starting Hammerspoon, pull up its console (click on the 🔨 icon in the menu), then run the cliInstall command, giving it a folder to which the user has access, and *important!* is in $PATH. If Hammerspoon is installed via Homebrew, it is typically the "/opt/homebrew" directory. 17 | 18 | ~hs.ipc.cliInstall("/opt/homebrew")~ 19 | 20 | ** Setup and customization 21 | 22 | Note that Emacs *has to be running in daemon mode*, [[https://www.gnu.org/software/emacs/manual/html_node/emacs/Emacs-Server.html][see documentation]]. 23 | 24 | After Spacehammer invokes ~emacsclient~, it calls multiple elisp functions. Those functions are in the =~/.hammerspoon/spacehammer.el= Emacs package. That package needs to be pre-loaded into Emacs. 25 | 26 | *** Package installation 27 | The package currently is not published on MELPA or other repositories, so you'd have to use your preferred package manager or whichever way you usually utilize to load things into Emacs. 28 | 29 | *** Vanilla Emacs 30 | Simply load the package either directly from GitHub (see the recipe below), or load =~/.hammerspoon/spacehammer.el= locally. Exact syntax may differ and depends on the package manager used. 31 | 32 | *** Doom 33 | Doom Emacs users can either: 34 | - modify their main packages.el and custom.el 35 | - or create a custom module 36 | 37 | **** packages.el 38 | There are two options: 39 | 40 | ***** Load the package from GitHub: 41 | 42 | #+begin_src elisp 43 | (when (eq system-type 'darwin) 44 | (package! spacehammer :recipe (:host github 45 | :repo "agzam/spacehammer" 46 | :files ("*.el")))) 47 | #+end_src 48 | 49 | ***** Or symlink to the folder: 50 | Since you already have the package file in =~/.hammerspoon/=, instead of loading it from GitHub, you may choose to load it directly. This is also a preferred method since it ensures that the elisp code always remains compatible with any changes made to the fennel/lua code. 51 | 52 | If you're adding it as part of your custom module that you load in =~/.doom/init.el= (for example) like this: 53 | 54 | #+begin_src elisp 55 | (doom! 56 | :custom 57 | my-module) 58 | #+end_src 59 | then you just need to symlink to it: 60 | 61 | #+begin_src sh 62 | mkdir -p ~/.doom.d/modules/custom/my-module/spacehammer 63 | 64 | ln -s ~/.hammerspoon/spacehammer.el \ 65 | ~/.doom.d/modules/custom/my-module/spacehammer/spacehammer.el 66 | #+end_src 67 | 68 | Here's how the dir structure would look like: 69 | 70 | #+begin_src 71 | ~/.doom.d 72 | └── modules 73 | └── custom 74 | └── my-module 75 | └── spacehammer 76 | │ └── spacehammer.el -> (symlinked to ~/.hammerspoon/spacehammer.el) 77 | └── packages.el 78 | └── config.el 79 | #+end_src 80 | 81 | And the packages.el would be like this: 82 | 83 | #+begin_src elisp 84 | (when (eq system-type 'darwin) 85 | (package! spacehammer 86 | :recipe (:local-repo "spacehammer" :files ("*.el")))) 87 | #+end_src 88 | 89 | If you don't want to add it to a custom module, everything above can be applied at the level of =~/doom.d=, instead of =my-module= 90 | 91 | **** config.el 92 | That's where you would tweak your editing experience, use hooks provided by ~spacehammer.el~, etc. Here's an example config: 93 | 94 | #+begin_src elisp 95 | 96 | (use-package! spacehammer 97 | :defer t 98 | :commands spacehammer-edit-with-emacs 99 | :config 100 | (add-hook! 'spacehammer-edit-with-emacs-hook 101 | #'spacehammer-edit-with-emacs-h) 102 | (add-hook! 'spacehammer-before-finish-edit-with-emacs-hook 103 | #'spacehammer-before-finish-edit-with-emacs-h) 104 | 105 | ;; control where the window for edit buffer appears 106 | (add-to-list 107 | 'display-buffer-alist 108 | '("\\* spacehammer-edit.*" 109 | (display-buffer-reuse-window 110 | display-buffer-in-direction) 111 | (direction . right) 112 | (window . root) 113 | (window-width . 0.30)))) 114 | 115 | ;; functions typically would go into autoload.el 116 | 117 | ;;;###autoload 118 | (defun spacehammer-edit-with-emacs-h (buffer-name pid title) 119 | ;; in this example, we're tying the Edit buffer to a file, so LSP works properly 120 | (with-current-buffer (get-buffer buffer-name) 121 | ;; need to set a filename, LSP can't work otherwise 122 | (set-visited-file-name (format "/tmp/%s_%s_%s" buffer-name pid title)) 123 | 124 | ;; set it as unmodified, so it doesn't complain about unsaved file 125 | (set-buffer-modified-p nil) 126 | 127 | ;; you can use any mode, even set a different mode for each app, based on its `title' 128 | (markdown-mode) 129 | 130 | ;; changing major mode usually blows all buffer local vars, and we need them, so it 131 | ;; keeps working properly with multiple apps 132 | (setq-local spacehammer--caller-pid pid) 133 | 134 | ;; if you're using Evil, you probably want to start typing right away 135 | (evil-insert +1))) 136 | 137 | 138 | ;;;###autoload 139 | (defun spacehammer-before-finish-edit-with-emacs-h (bufname pid) 140 | ;; since we tied the buffer to a file (for lsp), let's make sure it doesn't complain 141 | ;; about unsaved content when we're done editing 142 | (with-current-buffer bufname 143 | (set-buffer-modified-p nil))) 144 | 145 | #+end_src 146 | 147 | 148 | *** Spacemacs 149 | 150 | Spacemacs users can either: 151 | - add the package recipe to ~dotspacemacs-additional-packages~; 152 | - or create a custom Spacemacs layer; 153 | 154 | Creating a custom layer is easy, you need a ~packages.el~ file in a directory for your layer (to learn more, check [[https://github.com/syl20bnr/spacemacs/blob/develop/doc/LAYERS.org][Spacemacs documentation]]) 155 | 156 | **** Spacemacs layer minimal example 157 | Let's say you call the layer ~my-layer~, then the directory structure would look like the following: 158 | 159 | #+begin_src 160 | ├── my-layer 161 | │   └── packages.el 162 | #+end_src 163 | 164 | You place ~my-layer~ in ~dotspacemacs-configuration-layer-path~ directory of your Spacemacs config. 165 | 166 | Here's a minimal example of ~packages.el~ that includes spacehammer.el: 167 | 168 | - First, you need to add spacehammer to the list of packages included in the layer 169 | #+begin_src emacs-lisp 170 | (defconst my-layer-packages 171 | '((spacehammer 172 | :location (recipe ; Basically this telling Emacs 173 | :fetcher file ; where to look for the package file (spacehammer.el) 174 | :path "~/.hammerspoon/")))) 175 | 176 | 177 | ;; Sometimes (depending on the Emacs version and other things) that approach may not 178 | ;; work. Emacs will complain about not being able to load the package. In that 179 | ;; case, you can symlink the file and the directory structure for the layer has 180 | ;; to be like this: 181 | 182 | ;; . 183 | ;; ├── local 184 | ;; │   └── spacehammer 185 | ;; │   └── spacehammer.el -> ~/.hammerspoon/spacehammer.el 186 | ;; └── packages.el 187 | 188 | ;; and the recipe would have to be something like this: 189 | 190 | (defconst my-layer-packages 191 | '((spacehammer :location local))) 192 | 193 | ;; if you'd like to use the same Spacemacs config on different machines that 194 | ;; aren't Macs, and you don't want it to complain about not finding the package 195 | ;; (since Hammerspoon is not there): 196 | 197 | (defconst my-layer-packages `(,(when (eq system-type 'darwin) 198 | '(spacehammer :location local)))) 199 | #+end_src 200 | 201 | - Next thing you need is to add an init function like so: 202 | 203 | #+begin_src emacs-lisp 204 | (defun my-layer/init-spacehammer () 205 | (use-package spacehammer 206 | :demand t)) 207 | #+end_src 208 | 209 | - Add your layer to ~dotspacemacs-configuration-layers~ in your Spacemacs config 210 | - Either restart Emacs or run ~M-x dotspacemacs/sync-configuration-layers~ == 211 | 212 | -------------------------------------------------------------------------------- /README.ORG: -------------------------------------------------------------------------------- 1 | #+title: [[http://www.hammerspoon.org/][Hammerspoon]] Modal Toolkit inspired by [[http://spacemacs.org/][Spacemacs]]|[[https://github.com/doomemacs/doomemacs][Doom]] 2 | 3 | ** Rationale 4 | Keyboard-oriented workflows are often far more efficient and less frustrating than similar mouse-driven techniques. The typical strategy is to use a multitude of keyboard shortcuts. Obviously, that approach is not very scalable. You start adding keyboard shortcuts for various actions - soon you will be blocked by conflicting shortcuts. 5 | 6 | Command composability idea of ~Vim~, although does require some initial learning and getting used to, allows you to expand your keyboard-oriented workflow with a minimal effort to memorize keys. There's so much you can do with the home-row keys (~h/j/k/l)~ alone. 7 | 8 | However, that "one-dimensional" approach used in vanilla Vim/Neovim, where a single modal (Normal/Insert/Selection modes) is used, has limitations. Fortunately, the basic idea of modality can be expanded further. The [[http://spacemacs.org/][Spacemacs]] project is an excellent example of where that was done. In Spacemacs|Doom there is a single primary "modifier" key - ~SPACE~. To trigger an action, user is required to press a mnemonically recognizable combination e.g., ~SPC w m~ - to maximize current window. 9 | 10 | Spacehammer project explores these ideas to allow you to take your keyboard-driven workflow to the next level. Jumping between apps, controlling the size and the position of their windows, searching for things, etc. - everything follows simple, mnemonic semantics. It lets you keep your fingers on the home row and liberates you from having to memorize a myriad of keystrokes, or require you to drag your hand to reach for mouse/touchpad/arrow keys - that inevitably slows you down. 11 | 12 | *** Fennel 13 | Spacehammer initially was written in Lua - most Hammerspoon configs are, later completely re-written in [[https://fennel-lang.org/][Fennel]] - a tiny Lisp that compiles to Lua. There is nothing wrong with Lua - Lisp simply has too many benefits to ignore (sadly often overlooked by majority of programmers). 14 | 15 | ** Installation 16 | #+begin_src bash 17 | brew tap agzam/spacehammer 18 | brew install spacehammer 19 | #+end_src 20 | 21 | If you have your custom config somewhere already: 22 | 23 | #+begin_src bash 24 | HOMEBREW_SPACEHAMMER_CONFIG=git@github.com:username/my-config.git \ 25 | brew install spacehammer 26 | #+end_src 27 | 28 | ** LEAD keybinding 29 | 30 | =LEAD= is the main and major keybinding (not a key - we can't just use ~SPC~) that invokes the main Spacehammer modal. By default it is set to =Option+SPC=, but it can be customized in =~/.spacehammer/config.fnl= by changing the =:mods= and =:key= bindings for the =lib.modal:activate-modal= action string. You might want to set it, for example, to =Ctrl+Shift+SPC=. 31 | 32 | If you want to use =Cmd+SPC= as =LEAD= you will have to rebind it in your system, since it is normally used for Spotlight. 33 | 34 | *** Unbinding =Cmd+SPC= in system preferences. 35 | 36 | Go to your Preferences/Keyboard, find =Cmd+SPC= keybinding and change it to something else. Unfortunately, often simply disabling it isn't enough. Set it to be something else e.g., =Ctrl+Cmd+Shift+\= or whatever, it really doesn't matter since you can then un-check the checkbox to disable it. 37 | 38 | ** Features 39 | *** =LEAD w= - Window management 40 | - =hjkl= - moving windows around halves of the screen 41 | - =Ctrl + hjkl= - for jumping between application windows (handy for side by side windows) 42 | - =w= - jump to previous window 43 | - =n/p= - moving current window to prev/next monitor 44 | - =Option + hjkl= - moving in increments (works across monitors) 45 | - =Shift + hjkl= - re-sizing active window 46 | - =g= - re-sizing with [[http://www.hammerspoon.org/docs/hs.grid.html][hs.grid]] 47 | - =m= - maximize active window 48 | - =c= - center active window 49 | - =u= - undo last window operation (similar to Spacemacs's =SPC w u=) 50 | 51 | *** =LEAD a= - Apps (quick jump) 52 | - =e= - Emacs 53 | - =g= - Chrome 54 | - =i= - iTerm 55 | - =s= - Slack 56 | 57 | you can add more, also try =LEAD j j= 58 | 59 | *** =LEAD SPC= - open Alfred search bar 60 | pressing =SPC= in the main modal takes you to Alfred search popup, pressing =SPC= in other modals returns to previous modal. 61 | 62 | *** =LEAD m= - multimedia controls 63 | Why not use media-keys? 64 | 65 | a) because different external keyboards impose their own ways to control media. 66 | 67 | b) because Spacehammer allows you to keep fingers on the home row. 68 | 69 | By default =LEAD m a= - =jump to music app= is configured to work with Spotify, but you can change that in =~/.spacehammer/config.fnl= 70 | 71 | *** Edit anything [with Emacs] 72 | You can edit any text in any app =Cmd+Ctrl+O=. Currently, it supports only Emacs. Read more [[docs/emacs.org][here]]. 73 | 74 | ** Other features 75 | *** Alternative App Switcher =Option n/p= 76 | *** Simple tab switcher for Chrome and iTerm =Option j/k= 77 | *** Slack Desktop App enhancements 78 | - Scroll through current Slack thread =Ctrl-j/Ctrl-k= (slow) or =Ctrl-e/Ctrl-y= (fast) 79 | - Jump to the end of the thread with =Cmd-g= 80 | - Add emoji to the last message - =Cmd-r= (Slack's default =Cmd-Shift+\= is quite inconvenient) 81 | - Jump back and forth through history - =Ctrl-o/Ctrl-i= 82 | 83 | ** Customizing 84 | *** Update menus, menu items, bindings, and app-specific features 85 | All menu, app, and key bindings are defined in =~/.spacehammer/config.fnl=. 86 | That is your custom config and will be safe from any upstream changes to the default config.fnl. 87 | /The reason to keep it in its own directory is so that it can be maintained in version-control in your own repo/. 88 | 89 | *** Modal Menu Items 90 | Menu items are listed when you press =LEAD= and they can be nested. 91 | 92 | Items map a key binding to an action, either a function or ="module:function-name"= string. 93 | 94 | Menu items may either define an action or a table list of items. 95 | 96 | For menu items that should be repeated, add =repeatable: true= to the item table. 97 | The repeatable flag keeps the menu option after the action has been triggered. 98 | Repeating a menu item is ideal for actions like window layouts where you may wish to move the window from the left third to the right third. 99 | 100 | #+begin_src fennel 101 | (local launch-alfred {:title "Alfred" 102 | :key :SPACE 103 | :action (fn [] (hs.appplication.launchOrFocus "Alfred"))}) 104 | (local slack-jump {:title "Slack" 105 | :key :s 106 | :action "slack:quick-switcher"}) 107 | (local window-inc {:title "Window Halves" 108 | :mods [:cmd] 109 | :key :l 110 | :action "windows:resize-inc-right"}) 111 | (local submenu {:title "Submenu" 112 | :key :t 113 | :items [{:key :m 114 | :title "Show a message" 115 | :action (fn [] (alert "I'm a submenu action"))}]}) 116 | (local config {:items [launch-alfred 117 | slack-jump 118 | window-inc 119 | submenu]}) 120 | #+end_src 121 | 122 | **** Lifecycle methods 123 | Menu items may also define =:enter= and =:exit= functions or action strings. The parent menu item will call the =enter= function when it is opened and =exit= when it is closed. This may be used to manage more complex or dynamic menus. 124 | 125 | **** Global keys 126 | Global keys are used to set up universal hot-keys for the actions you specify. 127 | Unlike menu items they do not require a title attribute. 128 | Additionally you may specify =:repeat true= to repeat the action while the key is held down. 129 | 130 | If you place =:hyper= as a mod, it will use a hyper mode that can be configured by the =hyper= config attribute. 131 | This can be used to help create bindings that won't interfere with other apps. 132 | For instance you may make your hyper trigger the virtual =:F18= key and use a program like [[https://github.com/tekezo/Karabiner-Elements][karabiner-elements]] to map caps-lock to =F18=. 133 | 134 | #+begin_src fennel 135 | (local config {:hyper {:key :F18} 136 | :keys [{:mods [:cmd] 137 | :key :space 138 | :action "lib.modal:activate-modal"} 139 | {:mods [:cmd] 140 | :key :h 141 | :action "chrome:prev-tab" 142 | :repeat true} 143 | {:mods [:hyper] 144 | :key :f 145 | :action (fn [] (alert "Haha you pressed f!"))}]}) 146 | #+end_src 147 | 148 | **** App specific customizations 149 | Configure separate menu options and key bindings while specified apps are active. 150 | Additionally, several lifecycle functions or action strings may be provided for each app. 151 | 152 | - ~:activate~ When an application receives keyboard focus 153 | - ~:deactivate~ When an application loses keyboard focus 154 | - ~:launch~ When an application is launched 155 | - ~:close~ When an application is terminated 156 | 157 | #+begin_src fennel 158 | (local emacs-config 159 | {:key "Emacs" 160 | :activate "vim:disable" 161 | :deactivate "vim:enable" 162 | :launch "emacs:maximize" 163 | :items [] 164 | :keys []}) 165 | 166 | (local config {:apps [emacs-config]}) 167 | #+end_src 168 | 169 | *** Replacing spacehammer behavior 170 | The =~/.spacehammer= directory is added to the module search paths. 171 | If you wish to change the behavior of a feature, such as vim mode, you can create =~/.spacehammer/vim.fnl= to override the default implementation. 172 | 173 | ** Using it with a window manager 174 | 175 | It is possible to use Spacehammer with a WM. Here's [[https://github.com/agzam/.spacehammer/blob/master/config.fnl#L120-L151][an example]] of using it with [[https://github.com/koekeishiya/yabai/][Yabai]] 176 | -------------------------------------------------------------------------------- /vim.fnl: -------------------------------------------------------------------------------- 1 | (local atom (require :lib.atom)) 2 | (local {: get-in} (require :lib.functional)) 3 | (local {: logger} (require :lib.utils)) 4 | 5 | (local statemachine (require :lib.statemachine)) 6 | (local {:bind-keys bind-keys} (require :lib.bind)) 7 | (local log (logger "vim.fnl" "warning")) 8 | 9 | " 10 | Create a vim mode for any text editor! 11 | - Modal editing like NORMAL, VISUAL, and INSERT mode. 12 | - vim key navigation like hjkl 13 | - Displays a box to display which mode you are in 14 | - Largely experimental 15 | 16 | TODO: Create another state machine system to support key chords for bindings 17 | like gg -> scroll to top of document. 18 | - Should work a lot like the menu modal state machine where you can 19 | endlessly enter recursive submenus 20 | " 21 | 22 | (var fsm nil) 23 | 24 | ;; Box shapes for displaying current mode 25 | (local shape {:x 900 26 | :y 900 27 | :h 40 28 | :w 180}) 29 | (local text (hs.drawing.text shape "")) 30 | (local box (hs.drawing.rectangle shape)) 31 | 32 | (text:setBehaviorByLabels [:canJoinAllSpaces 33 | :transient]) 34 | 35 | (box:setBehaviorByLabels [:canJoinAllSpaces 36 | :transient]) 37 | 38 | (text:setLevel :overlay) 39 | (box:setLevel :overlay) 40 | 41 | 42 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 43 | ;; Action dispatch functions 44 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 45 | 46 | (fn disable 47 | [] 48 | (when fsm 49 | (fsm.send :disable))) 50 | 51 | (fn enable 52 | [] 53 | (when fsm 54 | (fsm.send :enable))) 55 | 56 | (fn normal 57 | [] 58 | (when fsm 59 | (fsm.send :normal))) 60 | 61 | (fn visual 62 | [] 63 | (when fsm 64 | (fsm.send :visual))) 65 | 66 | (fn insert 67 | [] 68 | (when fsm 69 | (fsm.send :insert))) 70 | 71 | 72 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 73 | ;; Helpers, Utils & Config 74 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 75 | 76 | (var ignore-fx false) 77 | 78 | (fn keystroke 79 | [target-mods target-key] 80 | (set ignore-fx true) 81 | (hs.eventtap.keyStroke (or target-mods []) target-key 10000) 82 | (hs.timer.doAfter 0.1 (fn [] (set ignore-fx false)))) 83 | 84 | (fn key-fn 85 | [target-mods target-key] 86 | (fn [] (keystroke target-mods target-key))) 87 | 88 | (local bindings 89 | {:normal [{:key :h 90 | :action (key-fn [] :left) 91 | :repeat true} 92 | {:key :j 93 | :action (key-fn [] :down) 94 | :repeat :true} 95 | {:key :k 96 | :action (key-fn [] :up) 97 | :repeat true} 98 | {:key :l 99 | :action (key-fn [] :right) 100 | :repeat true} 101 | {:mods [:shift] 102 | :key :i 103 | :action (fn [] 104 | (insert) 105 | (keystroke [:ctrl] :a))} 106 | {:key :i 107 | :action insert} 108 | {:key :a 109 | :action (fn [] 110 | (insert) 111 | (keystroke nil :right))} 112 | {:mods [:shift] 113 | :key :a 114 | :action (fn [] 115 | (insert) 116 | (keystroke [:ctrl] :e))} 117 | {:key :v 118 | :action visual} 119 | {:mods [:shift] 120 | :key :v 121 | :action (fn [] 122 | (keystroke [:cmd] :left) 123 | (keystroke [:shift :cmd] :right) 124 | (visual))} 125 | {:key :/ 126 | :action (key-fn [:cmd] :f)} 127 | {:key :x 128 | :action (key-fn nil :forwarddelete)} 129 | {:key :o 130 | :action (fn [] 131 | (keystroke [:cmd] :right) 132 | (keystroke [:alt] :return) 133 | (insert))} 134 | {:mods [:shift] 135 | :key :o 136 | :action (fn [] 137 | (keystroke [:cmd] :left) 138 | (keystroke [:alt] :return) 139 | (keystroke nil :left) 140 | (insert))} 141 | {:key :p 142 | :action (key-fn [:cmd] :v)} 143 | {:key :0 144 | :action (key-fn [:cmd] :left)} 145 | {:mods [:shift] 146 | :key :4 147 | :action (key-fn [:cmd] :right)} 148 | {:mods [:ctrl] 149 | :key :u 150 | :action (key-fn nil :pageup)} 151 | {:mods [:ctrl] 152 | :key :d 153 | :action (key-fn nil :pagedown)} 154 | {:mods [:shift] 155 | :key :g 156 | :action (key-fn [:cmd] :down)} 157 | {:key :b 158 | :action (key-fn [:alt] :left)} 159 | {:key :w 160 | :action (fn [] 161 | (keystroke [:alt] :right) 162 | (keystroke nil :right))} 163 | {:key :u 164 | :action (key-fn [:cmd] :z)} 165 | {:mods [:ctrl] 166 | :key :r 167 | :action (key-fn [:cmd :shift] :z)} 168 | {:key :c 169 | :action (fn [] 170 | (keystroke [] :forwarddelete) 171 | (insert))} 172 | {:mods [:shift] 173 | :key :d 174 | :action (fn [] 175 | (keystroke [:cmd] :left) 176 | (keystroke [:shift :cmd] :right) 177 | (keystroke nil :delete) 178 | (keystroke nil :delete))} 179 | {:mods [:shift] 180 | :key :c 181 | :action (fn [] 182 | (keystroke [:cmd] :left) 183 | (keystroke [:shift :cmd] :right) 184 | (keystroke nil :delete) 185 | (insert))} 186 | {:key :s 187 | :action (fn [] 188 | (keystroke nil :forwarddelete) 189 | (insert))} 190 | {:mods [:ctrl] 191 | :key :h 192 | :action "windows:jump-window-left"} 193 | {:mods [:ctrl] 194 | :key :j 195 | :action "windows:jump-window-below"} 196 | {:mods [:ctrl] 197 | :key :k 198 | :action "windows:jump-window-above"} 199 | {:mods [:ctrl] 200 | :key :l 201 | :action "windows:jump-window-right"}] 202 | :insert [{:key :ESCAPE 203 | :action normal}] 204 | :visual [{:key :ESCAPE 205 | :action (fn [] 206 | (keystroke nil :left) 207 | (normal))} 208 | {:key :h 209 | :action (key-fn [:shift] :left)} 210 | {:key :j 211 | :action (key-fn [:shift] :down)} 212 | {:key :k 213 | :action (key-fn [:shift] :up)} 214 | {:key :l 215 | :action (key-fn [:shift] :right)} 216 | {:key :y 217 | :action (key-fn [:cmd] :c)} 218 | {:key :x 219 | :action (key-fn nil :delete)} 220 | {:key :c 221 | :action (fn [] 222 | (keystroke [] :delete) 223 | (insert))} 224 | {:key :b 225 | :action (key-fn [:shift :alt] :left)} 226 | {:key :w 227 | :action (fn [] 228 | (keystroke [:shift :alt] :right) 229 | (keystroke [:shift] :right))} 230 | {:key :0 231 | :action (key-fn [:shift :cmd] :left)} 232 | {:mods [:shift] 233 | :key :4 234 | :action (key-fn [:shift :cmd] :right)}]}) 235 | 236 | (fn create-screen-watcher 237 | [f] 238 | (let [watcher (hs.screen.watcher.newWithActiveScreen f)] 239 | (watcher:start) 240 | (fn destroy [] 241 | (watcher:stop)))) 242 | 243 | (fn state-box 244 | [label] 245 | (let [frame (: (hs.screen.mainScreen) :fullFrame) 246 | x frame.x 247 | y frame.y 248 | width frame.w 249 | height frame.h 250 | coords {:x (+ x (- width shape.w)) 251 | :y (+ y (- height shape.h)) 252 | :h shape.h 253 | :w shape.w}] 254 | (box:setFillColor {:hex "#000" 255 | :alpha 0.8}) 256 | (box:setFill true) 257 | (text:setTextColor {:hex "#FFF" 258 | :alpha 1.0}) 259 | (text:setFrame coords) 260 | (box:setFrame coords) 261 | (text:setText label) 262 | (if (= label :Normal) 263 | (text:setTextColor {:hex "#999" 264 | :alpha 0.8}) 265 | (= label :Insert) 266 | (text:setTextColor {:hex "#0F0" 267 | :alpha 0.8}) 268 | (= label :Visual) 269 | (text:setTextColor {:hex "#F0F" 270 | :alpha 0.8})) 271 | (text:setTextStyle {:alignment :center}) 272 | (box:show) 273 | (text:show)) 274 | box) 275 | 276 | 277 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 278 | ;; Side Effects 279 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 280 | 281 | (fn enter-normal-mode 282 | [_state _extra] 283 | (state-box "Normal") 284 | (bind-keys bindings.normal)) 285 | 286 | (fn enter-insert-mode 287 | [_state _extra] 288 | (state-box "Insert") 289 | (bind-keys bindings.insert)) 290 | 291 | (fn enter-visual-mode 292 | [_state _extra] 293 | (state-box "Visual") 294 | (bind-keys bindings.visual)) 295 | 296 | (fn disable-vim-mode 297 | [state extra] 298 | (box:hide) 299 | (text:hide)) 300 | 301 | (local vim-effect 302 | (statemachine.effect-handler 303 | {:enter-normal-mode enter-normal-mode 304 | :enter-insert-mode enter-insert-mode 305 | :enter-visual-mode enter-visual-mode 306 | :disable-vim-mode disable-vim-mode})) 307 | 308 | 309 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 310 | ;; Transitions 311 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 312 | 313 | (fn disabled->normal 314 | [state _data] 315 | (when (get-in [:context :config :vim :enabled] state) 316 | {:state {:current-state :normal 317 | :context state.context} 318 | :effect :enter-normal-mode})) 319 | 320 | (fn normal->insert 321 | [state _data] 322 | {:state {:current-state :insert 323 | :context state.context} 324 | :effect :enter-insert-mode}) 325 | 326 | (fn normal->visual 327 | [state _data] 328 | {:state {:current-state :visual 329 | :context state.context} 330 | :effect :enter-visual-mode}) 331 | 332 | (fn ->disabled 333 | [state _data] 334 | {:state {:current-state :disabled 335 | :context state.context} 336 | :effect :disable-vim-mode}) 337 | 338 | (fn insert->normal 339 | [state _data] 340 | {:state {:current-state :normal 341 | :context state.context} 342 | :effect :enter-normal-mode}) 343 | 344 | (fn visual->normal 345 | [state _data] 346 | {:state {:current-state :normal 347 | :context state.context} 348 | :effect :enter-normal-mode}) 349 | 350 | 351 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 352 | ;; States 353 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 354 | 355 | (local states 356 | {:disabled {:enable disabled->normal} 357 | :normal {:insert normal->insert 358 | :visual normal->visual 359 | :disable ->disabled} 360 | :insert {:normal insert->normal 361 | :disable ->disabled} 362 | :visual {:normal visual->normal 363 | :disable ->disabled}}) 364 | 365 | 366 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 367 | ;; Watchers & Logging 368 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 369 | 370 | (fn log-updates 371 | [fsm] 372 | (atom.add-watch fsm.state :logger 373 | (fn [state] 374 | (log.f "Vim mode: %s" state.current-state)))) 375 | 376 | (fn watch-screen 377 | [fsm _active-screen-changed] 378 | (let [state (atom.deref fsm.state)] 379 | (when (~= state.current-state :disabled) 380 | (state-box state.current-state)))) 381 | 382 | ;; (fn log-key 383 | ;; [event] 384 | ;; (let [key-code (: event :getKeyCode) 385 | ;; flags (: event :getFlags) 386 | ;; key-char (. hs.keycodes.map key-code)] 387 | ;; (values false {}))) 388 | 389 | ;; (let [types hs.eventtap.event.types 390 | ;; tap (hs.eventtap.new [types.keyDown] 391 | ;; log-key)] 392 | ;; (: tap :start)) 393 | 394 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 395 | ;; Initialize 396 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 397 | 398 | (fn init 399 | [config] 400 | " 401 | Initialize vim mode only enables it if {:vim {:enabled true}} is in config.fnl 402 | Takes config.fnl table 403 | Performs side-effects: 404 | - Creates a state machine to track which mode we are in and switch bindings 405 | accordingly 406 | - Creates a screen watcher so it can move the mode UI to the currently active 407 | screen. 408 | Returns function to cleanup watcher resources 409 | " 410 | (let [template {:state {:current-state :disabled 411 | :context {:config config}} 412 | :states states} 413 | _fsm (statemachine.new template) 414 | stop-screen-watcher (create-screen-watcher 415 | (partial watch-screen _fsm))] 416 | (set fsm _fsm) 417 | (fsm.subscribe vim-effect) 418 | (log-updates fsm) 419 | (when (get-in [:vim :enabled] config) 420 | (enable)) 421 | (fn [] 422 | (stop-screen-watcher)))) 423 | 424 | 425 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 426 | ;; Exports 427 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 428 | 429 | {: init 430 | : disable 431 | : enable} 432 | -------------------------------------------------------------------------------- /config.example.fnl: -------------------------------------------------------------------------------- 1 | (require-macros :lib.macros) 2 | (require-macros :lib.advice.macros) 3 | (local windows (require :windows)) 4 | (local emacs (require :emacs)) 5 | (local slack (require :slack)) 6 | (local vim (require :vim)) 7 | 8 | (local {:concat concat 9 | :logf logf} (require :lib.functional)) 10 | 11 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12 | ;; WARNING 13 | ;; Make sure you are customizing ~/.spacehammer/config.fnl and not 14 | ;; ~/.hammerspoon/config.fnl 15 | ;; Otherwise you will lose your customizations on upstream changes. 16 | ;; A copy of this file should already exist in your ~/.spacehammer directory. 17 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 18 | 19 | 20 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 21 | ;; Table of Contents 22 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 23 | 24 | ;; [x] w - windows 25 | ;; [x] |-- w - Last window 26 | ;; [x] |-- cmd + hjkl - jumping 27 | ;; [x] |-- hjkl - halves 28 | ;; [x] |-- alt + hjkl - increments 29 | ;; [x] |-- shift + hjkl - resize 30 | ;; [x] |-- n, p - next, previous screen 31 | ;; [x] |-- shift + n, p - up, down screen 32 | ;; [x] |-- g - grid 33 | ;; [x] |-- m - maximize 34 | ;; [x] |-- c - center 35 | ;; [x] |-- u - undo 36 | ;; 37 | ;; [x] a - apps 38 | ;; [x] |-- e - emacs 39 | ;; [x] |-- g - chrome 40 | ;; [x] |-- f - firefox 41 | ;; [x] |-- i - iTerm 42 | ;; [x] |-- s - Slack 43 | ;; [x] |-- b - Brave 44 | ;; 45 | ;; [x] j - jump 46 | ;; 47 | ;; [x] m - media 48 | ;; [x] |-- h - previous track 49 | ;; [x] |-- l - next track 50 | ;; [x] |-- k - volume up 51 | ;; [x] |-- j - volume down 52 | ;; [x] |-- s - play\pause 53 | ;; [x] |-- a - launch player 54 | ;; 55 | ;; [x] x - emacs 56 | ;; [x] |-- c - capture 57 | ;; [x] |-- z - note 58 | ;; [x] |-- f - fullscreen 59 | ;; [x] |-- v - split 60 | ;; 61 | ;; [x] alt-n - next-app 62 | ;; [x] alt-p - prev-app 63 | 64 | 65 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 66 | ;; Initialize 67 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 68 | 69 | 70 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 71 | ;; Actions 72 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 73 | 74 | (fn activator 75 | [app-name] 76 | " 77 | A higher order function to activate a target app. It's useful for quickly 78 | binding a modal menu action or hotkey action to launch or focus on an app. 79 | Takes a string application name 80 | Returns a function to activate that app. 81 | 82 | Example: 83 | (local launch-emacs (activator \"Emacs\")) 84 | (launch-emacs) 85 | " 86 | (fn activate [] 87 | (windows.activate-app app-name))) 88 | 89 | 90 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 91 | ;; General 92 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 93 | 94 | ;; If you would like to customize this we recommend copying this file to 95 | ;; ~/.spacehammer/config.fnl. That will be used in place of the default 96 | ;; and will not be overwritten by upstream changes when spacehammer is updated. 97 | (local music-app "Spotify") 98 | 99 | (local return 100 | {:key :space 101 | :title "Back" 102 | :action :previous}) 103 | 104 | 105 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 106 | ;; Windows 107 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 108 | 109 | (local window-jumps 110 | [{:mods [:cmd] 111 | :key "hjkl" 112 | :title "Jump"} 113 | {:mods [:cmd] 114 | :key :h 115 | :action "windows:jump-window-left" 116 | :repeatable true} 117 | {:mods [:cmd] 118 | :key :j 119 | :action "windows:jump-window-above" 120 | :repeatable true} 121 | {:mods [:cmd] 122 | :key :k 123 | :action "windows:jump-window-below" 124 | :repeatable true} 125 | {:mods [:cmd] 126 | :key :l 127 | :action "windows:jump-window-right" 128 | :repeatable true}]) 129 | 130 | (local window-halves 131 | [{:key "hjkl" 132 | :title "Halves"} 133 | {:key :h 134 | :action "windows:resize-half-left" 135 | :repeatable true} 136 | {:key :j 137 | :action "windows:resize-half-bottom" 138 | :repeatable true} 139 | {:key :k 140 | :action "windows:resize-half-top" 141 | :repeatable true} 142 | {:key :l 143 | :action "windows:resize-half-right" 144 | :repeatable true}]) 145 | 146 | (local window-increments 147 | [{:mods [:alt] 148 | :key "hjkl" 149 | :title "Increments"} 150 | {:mods [:alt] 151 | :key :h 152 | :action "windows:resize-inc-left" 153 | :repeatable true} 154 | {:mods [:alt] 155 | :key :j 156 | :action "windows:resize-inc-bottom" 157 | :repeatable true} 158 | {:mods [:alt] 159 | :key :k 160 | :action "windows:resize-inc-top" 161 | :repeatable true} 162 | {:mods [:alt] 163 | :key :l 164 | :action "windows:resize-inc-right" 165 | :repeatable true}]) 166 | 167 | (local window-resize 168 | [{:mods [:shift] 169 | :key "hjkl" 170 | :title "Resize"} 171 | {:mods [:shift] 172 | :key :h 173 | :action "windows:resize-left" 174 | :repeatable true} 175 | {:mods [:shift] 176 | :key :j 177 | :action "windows:resize-down" 178 | :repeatable true} 179 | {:mods [:shift] 180 | :key :k 181 | :action "windows:resize-up" 182 | :repeatable true} 183 | {:mods [:shift] 184 | :key :l 185 | :action "windows:resize-right" 186 | :repeatable true}]) 187 | 188 | (local window-move-screens 189 | [{:key "n, p" 190 | :title "Move next\\previous screen"} 191 | {:mods [:shift] 192 | :key "n, p" 193 | :title "Move up\\down screens"} 194 | {:key :n 195 | :action "windows:move-south" 196 | :repeatable true} 197 | {:key :p 198 | :action "windows:move-north" 199 | :repeatable true} 200 | {:mods [:shift] 201 | :key :n 202 | :action "windows:move-west" 203 | :repeatable true} 204 | {:mods [:shift] 205 | :key :p 206 | :action "windows:move-east" 207 | :repeatable true}]) 208 | 209 | (local window-bindings 210 | (concat 211 | [return 212 | {:key :w 213 | :title "Last Window" 214 | :action "windows:jump-to-last-window"}] 215 | window-jumps 216 | window-halves 217 | window-increments 218 | window-resize 219 | window-move-screens 220 | [{:key :m 221 | :title "Maximize" 222 | :action "windows:maximize-window-frame"} 223 | {:key :c 224 | :title "Center" 225 | :action "windows:center-window-frame"} 226 | {:key :g 227 | :title "Grid" 228 | :action "windows:show-grid"} 229 | {:key :u 230 | :title "Undo" 231 | :action "windows:undo"}])) 232 | 233 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 234 | ;; Apps Menu 235 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 236 | 237 | (local app-bindings 238 | [return 239 | {:key :e 240 | :title "Emacs" 241 | :action (activator "Emacs")} 242 | {:key :g 243 | :title "Chrome" 244 | :action (activator "Google Chrome")} 245 | {:key :f 246 | :title "Firefox" 247 | :action (activator "Firefox")} 248 | {:key :i 249 | :title "iTerm" 250 | :action (activator "iterm")} 251 | {:key :s 252 | :title "Slack" 253 | :action (activator "Slack")} 254 | {:key :b 255 | :title "Brave" 256 | :action (activator "brave browser")} 257 | {:key :m 258 | :title music-app 259 | :action (activator music-app)}]) 260 | 261 | (local media-bindings 262 | [return 263 | {:key :s 264 | :title "Play or Pause" 265 | :action "multimedia:play-or-pause"} 266 | {:key :h 267 | :title "Prev Track" 268 | :action "multimedia:prev-track"} 269 | {:key :l 270 | :title "Next Track" 271 | :action "multimedia:next-track"} 272 | {:key :j 273 | :title "Volume Down" 274 | :action "multimedia:volume-down" 275 | :repeatable true} 276 | {:key :k 277 | :title "Volume Up" 278 | :action "multimedia:volume-up" 279 | :repeatable true} 280 | {:key :a 281 | :title (.. "Launch " music-app) 282 | :action (activator music-app)}]) 283 | 284 | (local emacs-bindings 285 | [return 286 | {:key :c 287 | :title "Capture" 288 | :action (fn [] (emacs.capture))} 289 | {:key :z 290 | :title "Note" 291 | :action (fn [] (emacs.note))} 292 | {:key :v 293 | :title "Split" 294 | :action "emacs:vertical-split-with-emacs"} 295 | {:key :f 296 | :title "Full Screen" 297 | :action "emacs:full-screen"}]) 298 | 299 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 300 | ;; Main Menu & Config 301 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 302 | 303 | (local menu-items 304 | [{:key :space 305 | :title "Alfred" 306 | :action (activator "Alfred 4")} 307 | {:key :w 308 | :title "Window" 309 | :enter "windows:enter-window-menu" 310 | :exit "windows:exit-window-menu" 311 | :items window-bindings} 312 | {:key :a 313 | :title "Apps" 314 | :items app-bindings} 315 | {:key :j 316 | :title "Jump" 317 | :action "windows:jump"} 318 | {:key :m 319 | :title "Media" 320 | :items media-bindings} 321 | {:key :x 322 | :title "Emacs" 323 | :items emacs-bindings}]) 324 | 325 | (local common-keys 326 | [{:mods [:alt] 327 | :key :space 328 | :action "lib.modal:activate-modal"} 329 | {:mods [:alt] 330 | :key :n 331 | :action "apps:next-app"} 332 | {:mods [:alt] 333 | :key :p 334 | :action "apps:prev-app"} 335 | {:mods [:cmd :ctrl] 336 | :key "`" 337 | :action hs.toggleConsole} 338 | {:mods [:cmd :ctrl] 339 | :key :o 340 | :action "emacs:edit-with-emacs"}]) 341 | 342 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 343 | ;; App Specific Config 344 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 345 | 346 | (local browser-keys 347 | [{:mods [:cmd :shift] 348 | :key :l 349 | :action "chrome:open-location"} 350 | {:mods [:alt] 351 | :key :k 352 | :action "chrome:next-tab" 353 | :repeat true} 354 | {:mods [:alt] 355 | :key :j 356 | :action "chrome:prev-tab" 357 | :repeat true}]) 358 | 359 | (local browser-items 360 | (concat 361 | menu-items 362 | [{:key "'" 363 | :title "Edit with Emacs" 364 | :action "emacs:edit-with-emacs"}])) 365 | 366 | (local brave-config 367 | {:key "Brave Browser" 368 | :keys browser-keys 369 | :items browser-items}) 370 | 371 | (local chrome-config 372 | {:key "Google Chrome" 373 | :keys browser-keys 374 | :items browser-items}) 375 | 376 | (local firefox-config 377 | {:key "Firefox" 378 | :keys browser-keys 379 | :items browser-items}) 380 | 381 | (local emacs-config 382 | {:key "Emacs" 383 | :activate (fn [] (vim.disable)) 384 | :deactivate (fn [] (vim.enable)) 385 | :launch "emacs:maximize" 386 | :items [] 387 | :keys []}) 388 | 389 | (local grammarly-config 390 | {:key "Grammarly" 391 | :items (concat 392 | menu-items 393 | [{:mods [:ctrl] 394 | :key :c 395 | :title "Return to Emacs" 396 | :action "grammarly:back-to-emacs"}]) 397 | :keys ""}) 398 | 399 | (local hammerspoon-config 400 | {:key "Hammerspoon" 401 | :items (concat 402 | menu-items 403 | [{:key :r 404 | :title "Reload Console" 405 | :action hs.reload} 406 | {:key :c 407 | :title "Clear Console" 408 | :action hs.console.clearConsole}]) 409 | :keys []}) 410 | 411 | (local slack-config 412 | {:key "Slack" 413 | :keys [{:mods [:cmd] 414 | :key :g 415 | :action "slack:scroll-to-bottom"} 416 | {:mods [:ctrl] 417 | :key :r 418 | :action "slack:add-reaction"} 419 | {:mods [:ctrl] 420 | :key :h 421 | :action "slack:prev-element"} 422 | {:mods [:ctrl] 423 | :key :l 424 | :action "slack:next-element"} 425 | {:mods [:ctrl] 426 | :key :t 427 | :action "slack:thread"} 428 | {:mods [:ctrl] 429 | :key :p 430 | :action "slack:prev-day"} 431 | {:mods [:ctrl] 432 | :key :n 433 | :action "slack:next-day"} 434 | {:mods [:ctrl] 435 | :key :e 436 | :action "slack:scroll-up" 437 | :repeat true} 438 | {:mods [:ctrl] 439 | :key :y 440 | :action "slack:scroll-down" 441 | :repeat true} 442 | {:mods [:ctrl] 443 | :key :i 444 | :action "slack:next-history" 445 | :repeat true} 446 | {:mods [:ctrl] 447 | :key :o 448 | :action "slack:prev-history" 449 | :repeat true} 450 | {:mods [:ctrl] 451 | :key :j 452 | :action "slack:down" 453 | :repeat true} 454 | {:mods [:ctrl] 455 | :key :k 456 | :action "slack:up" 457 | :repeat true}]}) 458 | 459 | (local apps 460 | [brave-config 461 | chrome-config 462 | firefox-config 463 | emacs-config 464 | grammarly-config 465 | hammerspoon-config 466 | slack-config]) 467 | 468 | (local config 469 | {:title "Main Menu" 470 | :items menu-items 471 | :keys common-keys 472 | :enter (fn [] (windows.hide-display-numbers)) 473 | :exit (fn [] (windows.hide-display-numbers)) 474 | :apps apps 475 | :hyper {:key :F18} 476 | :modules {:windows {:center-ratio "80:50"}}}) 477 | 478 | 479 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 480 | ;; Exports 481 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 482 | 483 | config 484 | -------------------------------------------------------------------------------- /lib/apps.fnl: -------------------------------------------------------------------------------- 1 | " 2 | Creates a finite state machine to handle app-specific events. 3 | A user may specify app-specific key bindings or menu items in their config.fnl 4 | 5 | Uses a state machine to better organize logic for entering apps we have config 6 | for, versus switching between apps, versus exiting apps, versus activating apps. 7 | 8 | This module works mechanically similar to lib/modal.fnl. 9 | " 10 | (local atom (require :lib.atom)) 11 | (local statemachine (require :lib.statemachine)) 12 | (local {: call-when 13 | : merge 14 | : noop} 15 | (require :lib.functional)) 16 | (local {:action->fn action->fn 17 | :bind-keys bind-keys} 18 | (require :lib.bind)) 19 | (local lifecycle (require :lib.lifecycle)) 20 | (local {: logger} (require :lib.utils)) 21 | 22 | 23 | (local log (logger "apps.fnl" "warning")) 24 | 25 | (local actions (atom.new nil)) 26 | ;; Create a dynamic var to hold an accessible instance of our finite state 27 | ;; machine for apps. 28 | (var fsm nil) 29 | ;; App lookup cache: maps app-name -> app-config for O(1) lookups 30 | (var app-cache {}) 31 | 32 | 33 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 34 | ;; Utils 35 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 36 | 37 | (fn build-app-cache 38 | [apps] 39 | " 40 | Builds a lookup table mapping app keys to app configs for O(1) lookups. 41 | Takes a list of app configs from config.fnl 42 | Returns a table with app.key as keys and app config as values 43 | " 44 | (let [cache {}] 45 | (each [_ app (ipairs apps)] 46 | (when app.key 47 | (tset cache app.key app))) 48 | cache)) 49 | 50 | (fn get-app-by-key 51 | [app-name] 52 | " 53 | Fast O(1) lookup of app config by app name using cache. 54 | Takes an app name string 55 | Returns the app config or nil if not found 56 | " 57 | (. app-cache app-name)) 58 | 59 | (fn gen-key 60 | [] 61 | " 62 | Generates a unique, random, base64 encoded string 7 chars long. 63 | Takes no arguments. 64 | Side effectful. 65 | Returns unique 7 char, randomized string. 66 | " 67 | (var nums "") 68 | (for [i 1 7] 69 | (set nums (.. nums (math.random 0 9)))) 70 | (string.sub (hs.base64.encode nums) 1 7)) 71 | 72 | (fn emit 73 | [action data] 74 | " 75 | Broadcasts an action from our state machine so modals can transition. 76 | Takes action name and data to transition another finite state machine. 77 | Side-effect: Updates the actions atom. 78 | Returns nil. 79 | " 80 | (atom.swap! actions (fn [] [action data]))) 81 | 82 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 83 | ;; Action dispatch functions 84 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 85 | 86 | (fn enter 87 | [app-name] 88 | " 89 | Action to focus or activate an app. App must have either menu options 90 | or key bindings defined in config.fnl. 91 | 92 | Takes the name of the app we entered. 93 | Transitions to the entered finite-state-machine state. 94 | Returns nil. 95 | " 96 | (fsm.send :enter-app app-name)) 97 | 98 | (fn leave 99 | [app-name] 100 | " 101 | The user has deactivated/blurred an app we have config defined. 102 | Takes the name of the app the user deactivated. 103 | Transition the state machine to idle from active app state. 104 | Returns nil. 105 | " 106 | (fsm.send :leave-app app-name)) 107 | 108 | (fn launch 109 | [app-name] 110 | " 111 | The user launched an app we have config defined for. 112 | Takes name of the app launched. 113 | Calls the launch lifecycle method defined for an app in config.fnl 114 | Returns nil. 115 | " 116 | (fsm.send :launch-app app-name)) 117 | 118 | (fn close 119 | [app-name] 120 | " 121 | The user closed an app we have config defined for. 122 | Takes name of the app closed. 123 | Calls the exit lifecycle method defined for an app in config.fnl 124 | Returns nil. 125 | " 126 | (fsm.send :close-app app-name)) 127 | 128 | 129 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 130 | ;; Set Key Bindings 131 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 132 | 133 | (fn bind-app-keys 134 | [items] 135 | " 136 | Binds config.fnl app keys to actions 137 | Takes a list of local app bindings 138 | Returns a function to call without arguments to remove bindings. 139 | " 140 | (bind-keys items)) 141 | 142 | 143 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 144 | ;; State Transitions 145 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 146 | 147 | (fn ->enter 148 | [state action app-name] 149 | " 150 | Transitions the app state machine from the general, shared key bindings to an 151 | app we have local keybindings for. 152 | Kicks off an effect to bind app-specific keys. 153 | Takes the current app state machine state table 154 | Returns update modal state machine state table. 155 | " 156 | (let [{: apps 157 | : app} state.context 158 | next-app (get-app-by-key app-name)] 159 | {:state {:current-state :in-app 160 | :context {:apps apps 161 | :app next-app 162 | :prev-app app}} 163 | :effect :enter-app-effect})) 164 | 165 | 166 | (fn in-app->leave 167 | [state action app-name] 168 | " 169 | Transitions the app state machine from an app the user was using with local 170 | keybindings to another app that may or may not have local keybindings. 171 | Because a 'enter (new) app' action is fired before a 'leave (old) app', we 172 | know that this will be called AFTER the enter transition has updated the 173 | state, so we should not update the state. 174 | Takes the current app state machine state table, 175 | Kicks off an effect to run leave-app effects and unbind the old app's keys 176 | Returns the old state. 177 | " 178 | {:state state 179 | :effect :leave-app-effect}) 180 | 181 | (fn launch-app 182 | [state action app-name] 183 | " 184 | Using the state machine we also react to launching apps by calling the :launch 185 | lifecycle method on apps defined in a user's config.fnl. This way they can run 186 | hammerspoon functions when an app is opened like say resizing emacs on launch. 187 | Takes the current app state machine state table. 188 | Kicks off an effect to bind app-specific keys & fire launch app lifecycle 189 | Returns a new state. 190 | " 191 | (let [{: apps 192 | : app} state.context 193 | next-app (get-app-by-key app-name)] 194 | {:state {:current-state :in-app 195 | :context {:apps apps 196 | :app next-app 197 | :prev-app app}} 198 | :effect :launch-app-effect})) 199 | 200 | (fn ->close 201 | [state action app-name] 202 | " 203 | Using the state machine we also react to launching apps by calling the :close 204 | lifecycle method on apps defined in a user's config.fnl. This way they can run 205 | hammerspoon functions when an app is closed. For instance re-enabling vim mode 206 | when an app is closed that was incompatible 207 | Takes the current app state machine state table 208 | Kicks off an effect to bind app-specific keys 209 | Returns the old state 210 | " 211 | {:state state 212 | :effect :close-app-effect}) 213 | 214 | 215 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 216 | ;; Finite State Machine States 217 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 218 | 219 | " 220 | State machine transition definitions 221 | Defines the two states our app state machine can be in: 222 | 1. General, non-specific app where no table defined in config.fnl exists 223 | 2. In a specific app where a table is defined to customize local keys, 224 | modal menu items, or lifecycle methods to trigger other hammerspoon functions 225 | Maps each state to a table of actions mapped to handlers responsible for 226 | returning the next state the statemachine is in. 227 | " 228 | 229 | (local states 230 | {:general-app {:enter-app ->enter 231 | :leave-app noop 232 | :launch-app launch-app 233 | :close-app ->close} 234 | :in-app {:enter-app ->enter 235 | :leave-app in-app->leave 236 | :launch-app launch-app 237 | :close-app ->close}}) 238 | 239 | 240 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 241 | ;; Watchers, Dispatchers, & Logging 242 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 243 | 244 | " 245 | Assign some simple keywords for each hs.application.watcher event type. 246 | " 247 | (local app-events 248 | {hs.application.watcher.activated :activated 249 | hs.application.watcher.deactivated :deactivated 250 | hs.application.watcher.hidden :hidden 251 | hs.application.watcher.launched :launched 252 | hs.application.watcher.launching :launching 253 | hs.application.watcher.terminated :terminated 254 | hs.application.watcher.unhidden :unhidden}) 255 | 256 | 257 | (fn watch-apps 258 | [app-name event app] 259 | " 260 | Hammerspoon application watcher callback 261 | Looks up the event type based on our keyword mappings and dispatches the 262 | corresponding action against the state machine to manage side-effects and 263 | update their state. 264 | 265 | Takes the name of the app, the hs.application.watcher event-type, an the 266 | hs.application.instance that triggered the event. 267 | Returns nil. Relies on side-effects. 268 | " 269 | (let [event-type (. app-events event)] 270 | (if (= event-type :activated) 271 | (enter app-name) 272 | (= event-type :deactivated) 273 | (leave app-name) 274 | (= event-type :launched) 275 | (launch app-name) 276 | (= event-type :terminated) 277 | (close app-name)))) 278 | 279 | (fn active-app-name 280 | [] 281 | " 282 | Internal API function to return the name of the frontmost app 283 | Returns the name of the app if there is a frontmost app or nil. 284 | " 285 | (let [app (hs.application.frontmostApplication)] 286 | (if app 287 | (: app :name) 288 | nil))) 289 | 290 | (fn start-logger 291 | [fsm] 292 | " 293 | Debugging handler to add a watcher to the apps finite-state-machine 294 | state atom to log changes over time. 295 | " 296 | (atom.add-watch 297 | fsm.state :log-state 298 | (fn log-state 299 | [state] 300 | (log.df "app is now: %s" (and state.context.app state.context.app.key))))) 301 | 302 | (fn watch-actions 303 | [{: prev-state : next-state : action : effect : extra}] 304 | " 305 | Internal API function to emit app-specific state machine events and transitions to 306 | other state machines. Like telling our modal state machine the user has 307 | entered into emacs so display the emacs-specific menu modal. 308 | Subscribes to the apps state machine. 309 | Takes a transition record from the FSM. 310 | Returns nil. 311 | " 312 | ;; Only emit if we have an app context (app could be nil for unconfigured apps) 313 | (when next-state.context 314 | (emit action next-state.context.app))) 315 | 316 | 317 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 318 | ;; API Methods 319 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 320 | 321 | (fn get-app 322 | [] 323 | " 324 | Public API method to get the user's config table for the current app defined 325 | in their config.fnl. 326 | Takes no arguments. 327 | Returns the current app config table or nil if no config was defined for the 328 | current app. 329 | " 330 | (when fsm 331 | (let [state (atom.deref fsm.state)] 332 | state.context.app))) 333 | 334 | (fn subscribe 335 | [f] 336 | " 337 | Public API to subscribe to the stream atom of app specific actions. 338 | Allows the menu modal FSM to subscribe to app actions to know when to switch 339 | to an app specific menu or revert back to default main menu. 340 | Takes a function to call on each action update. 341 | Returns a function to remove the subscription to actions stream. 342 | " 343 | (let [key (gen-key)] 344 | (atom.add-watch actions key f) 345 | (fn unsubscribe 346 | [] 347 | (atom.remove-watch actions key)))) 348 | 349 | (fn enter-app-effect 350 | [context] 351 | " 352 | Binds keys and lifecycle for the new current app. 353 | Returns a cleanup function to cleanup these bindings. 354 | " 355 | (when context.app 356 | (lifecycle.activate-app context.app) 357 | (let [unbind-keys (when context.app.keys 358 | (bind-app-keys context.app.keys))] 359 | (fn [] 360 | (when unbind-keys 361 | (unbind-keys)))))) 362 | 363 | (fn launch-app-effect 364 | [context] 365 | " 366 | Binds keys and lifecycle for the next current app. 367 | Returns a cleanup function to cleanup these bindings. 368 | " 369 | (when context.app 370 | (lifecycle.launch-app context.app) 371 | (let [unbind-keys (when context.app.keys 372 | (bind-app-keys context.app.keys))] 373 | (fn [] 374 | (when unbind-keys 375 | (unbind-keys)))))) 376 | 377 | (fn app-effect-handler 378 | [effect-map] 379 | " 380 | Takes a map of effect->function and returns a function that handles these 381 | effects by calling the mapped-to function, and then calls that function's 382 | return value (a cleanup function) and calls it on the next transition. 383 | 384 | Unlike the fsm's effect-handler, these are app-aware and only call the cleanup 385 | function for that particular app. 386 | 387 | These functions must return their own cleanup function or nil. 388 | " 389 | ;; Create a one-time atom used to store the cleanup function map 390 | (let [cleanup-ref (atom.new {})] 391 | ;; Return a subscriber function 392 | (fn [{: prev-state : next-state : action : effect : extra}] 393 | ;; Call the cleanup function for this app if it's set 394 | ;; Only access cleanup-ref if extra (app-name) is not nil 395 | (when extra 396 | (call-when (. (atom.deref cleanup-ref) extra))) 397 | (let [cleanup-map (atom.deref cleanup-ref) 398 | effect-func (. effect-map effect)] 399 | ;; Update the cleanup entry for this app with a new func or nil 400 | ;; Only update if extra (app-name) is not nil 401 | (when extra 402 | (atom.reset! cleanup-ref 403 | (merge cleanup-map 404 | {extra (call-when effect-func next-state extra)}))))))) 405 | 406 | (local apps-effect 407 | (app-effect-handler 408 | {:enter-app-effect (fn [state extra] 409 | (when (and state state.context) 410 | (enter-app-effect state.context))) 411 | :leave-app-effect (fn [state extra] 412 | (when (and state state.context state.context.prev-app) 413 | (lifecycle.deactivate-app state.context.prev-app)) 414 | nil) 415 | :launch-app-effect (fn [state extra] 416 | (when (and state state.context) 417 | (launch-app-effect state.context))) 418 | :close-app-effect (fn [state extra] 419 | (when (and state state.context state.context.prev-app) 420 | (lifecycle.close-app state.context.prev-app)) 421 | nil)})) 422 | 423 | 424 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 425 | ;; Initialization 426 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 427 | 428 | (fn init 429 | [config] 430 | " 431 | Initialize apps finite-state-machine and create hs.application.watcher 432 | instance to listen for app specific events. 433 | Takes the current config.fnl table 434 | Returns a function to cleanup the hs.application.watcher. 435 | " 436 | ;; Build app lookup cache for O(1) access 437 | (set app-cache (build-app-cache config.apps)) 438 | 439 | (let [active-app (active-app-name) 440 | initial-context {:apps config.apps 441 | :app nil} 442 | template {:state {:current-state :general-app 443 | :context initial-context} 444 | :states states 445 | :log "apps"} 446 | app-watcher (hs.application.watcher.new watch-apps)] 447 | (set fsm (statemachine.new template)) 448 | (fsm.subscribe apps-effect) 449 | (start-logger fsm) 450 | (fsm.subscribe watch-actions) 451 | (enter active-app) 452 | (: app-watcher :start) 453 | (fn cleanup [] 454 | (: app-watcher :stop)))) 455 | 456 | 457 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 458 | ;; Exports 459 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 460 | 461 | 462 | {: init 463 | : get-app 464 | : subscribe} 465 | -------------------------------------------------------------------------------- /windows.fnl: -------------------------------------------------------------------------------- 1 | (local {: filter 2 | : get-in 3 | : count 4 | : concat 5 | : map 6 | : for-each 7 | : split} (require :lib.functional)) 8 | (local {:global-filter global-filter} (require :lib.utils)) 9 | (local {:atom atom 10 | :deref deref 11 | :swap! swap! 12 | :reset! reset!} (require :lib.atom)) 13 | (require-macros :lib.advice.macros) 14 | 15 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16 | ;; History 17 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 18 | 19 | (global history {}) 20 | 21 | (fn history.push 22 | [self] 23 | " 24 | Append current window frame geometry to history. 25 | self refers to history table instance 26 | " 27 | (let [win (hs.window.focusedWindow) 28 | id (when win (win:id)) 29 | tbl (. self id)] 30 | (when win 31 | (if (= (type tbl) :nil) 32 | (tset self id [(win:frame)]) 33 | (let [last-el (. tbl (length tbl))] 34 | (when (~= last-el (win:frame)) 35 | (table.insert tbl (win:frame)))))))) 36 | 37 | (fn history.pop 38 | [self] 39 | " 40 | Go back to previous window frame geometry in history. 41 | self refers to history table instance 42 | " 43 | (let [win (hs.window.focusedWindow) 44 | id (when win (win:id)) 45 | tbl (. self id)] 46 | (when (and win tbl) 47 | (let [el (table.remove tbl) 48 | num-of-undos (length tbl)] 49 | (if el 50 | (do 51 | (win:setFrame el) 52 | (when (< 0 num-of-undos) 53 | (alert (.. num-of-undos " undo steps available")))) 54 | (alert "nothing to undo")))))) 55 | 56 | (fn undo 57 | [] 58 | (: history :pop)) 59 | 60 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 61 | ;; Shared Functions 62 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 63 | 64 | (defn highlight-active-window 65 | [] 66 | " 67 | Draw a border around the active window for a short period to highlight 68 | " 69 | (let [rect (hs.drawing.rectangle (: (hs.window.focusedWindow) :frame))] 70 | (: rect :setStrokeColor {:red 1 :blue 0 :green 1 :alpha 1}) 71 | (: rect :setStrokeWidth 5) 72 | (: rect :setFill false) 73 | (: rect :show) 74 | (hs.timer.doAfter .3 (fn [] (: rect :delete))))) 75 | 76 | (fn maximize-window-frame 77 | [] 78 | (: history :push) 79 | (: (hs.window.focusedWindow) :maximize 0) 80 | (highlight-active-window)) 81 | 82 | (defn position-window-center 83 | [ratio-str window screen] 84 | " 85 | Takes the center-ratio key from config, or default value if not 86 | provided, and the window center-window-frame was called with, 87 | and the current screen. 88 | Should calculate the centered dimensions of the target window 89 | using the ratio values 90 | This function is advisable. 91 | " 92 | (let [frame (: screen :fullFrame) 93 | [w-percent h-percent] (split ":" ratio-str) 94 | w-percent (/ (tonumber w-percent) 100) 95 | h-percent (/ (tonumber h-percent) 100) 96 | update {:w (* w-percent frame.w) 97 | :h (* h-percent frame.h) 98 | :x 0 99 | :y 0}] 100 | (doto window 101 | (: :setFrameInScreenBounds update) 102 | (: :centerOnScreen)) 103 | (highlight-active-window))) 104 | 105 | (fn center-window-frame 106 | [] 107 | (: history :push) 108 | (let [win (hs.window.focusedWindow) 109 | prev-duration hs.window.animationDuration 110 | config (get-config) 111 | ratio (or (?. config :modules :windows :center-ratio) "80:50") 112 | screen (hs.screen.primaryScreen)] 113 | (tset hs.window :animationDuration 0) 114 | (position-window-center ratio win screen) 115 | (tset hs.window :animationDuration prev-duration))) 116 | 117 | (fn activate-app 118 | [app-name] 119 | (hs.application.launchOrFocus app-name) 120 | (let [app (hs.application.find app-name)] 121 | (when app 122 | (: app :activate) 123 | (hs.timer.doAfter .05 highlight-active-window) 124 | (: app :unhide)))) 125 | 126 | (fn set-mouse-cursor-at 127 | [app-title] 128 | (let [sf (: (: (hs.application.find app-title) :focusedWindow) :frame) 129 | desired-point (hs.geometry.point (- (+ sf._x sf._w) 130 | (/ sf._w 2)) 131 | (- (+ sf._y sf._h) 132 | (/ sf._h 2)))] 133 | (hs.mouse.setAbsolutePosition desired-point))) 134 | 135 | (fn show-grid 136 | [] 137 | (: history :push) 138 | (hs.grid.show)) 139 | 140 | (fn jump-to-last-window 141 | [] 142 | (-> (global-filter) 143 | (: :getWindows hs.window.filter.sortByFocusedLast) 144 | (. 2) 145 | (: :focus))) 146 | 147 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 148 | ;; Jumping Windows 149 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 150 | 151 | (fn jump-window 152 | [arrow] 153 | " 154 | Navigate to the window nearest the current active window 155 | For instance if you open up emacs to the left of a web browser, activate 156 | emacs, then run (jump-window :l) hammerspoon will move active focus 157 | to the browser. 158 | Takes an arrow like :h :j :k :l to support vim key bindings. 159 | Performs side effects 160 | Returns nil 161 | " 162 | (let [dir {:h "West" :j "South" :k "North" :l "East"} 163 | frontmost-win (hs.window.frontmostWindow) 164 | focus-dir (.. :focusWindow (. dir arrow))] 165 | (: hs.window.filter.defaultCurrentSpace focus-dir frontmost-win true true) 166 | (highlight-active-window))) 167 | 168 | (fn jump-window-left 169 | [] 170 | (jump-window :h)) 171 | 172 | (fn jump-window-above 173 | [] 174 | (jump-window :j)) 175 | 176 | (fn jump-window-below 177 | [] 178 | (jump-window :k)) 179 | 180 | (fn jump-window-right 181 | [] 182 | (jump-window :l)) 183 | 184 | (fn allowed-app? 185 | [window] 186 | (if (: window :isStandard) 187 | true 188 | false)) 189 | 190 | (fn jump [] 191 | " 192 | Displays hammerspoon's window jump UI 193 | " 194 | (let [wns (->> (hs.window.allWindows) 195 | (filter allowed-app?))] 196 | (hs.hints.windowHints wns nil true))) 197 | 198 | 199 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 200 | ;; Movement\Resizing Constants 201 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 202 | 203 | (local 204 | arrow-map 205 | {:k {:half [0 0 1 .5] :movement [ 0 -20] :resize "Shorter"} 206 | :j {:half [0 .5 1 .5] :movement [ 0 20] :resize "Taller"} 207 | :h {:half [0 0 .5 1] :movement [-20 0] :resize "Thinner"} 208 | :l {:half [.5 0 .5 1] :movement [ 20 0] :resize "Wider"}}) 209 | 210 | (fn grid 211 | [method direction] 212 | " 213 | Moves, expands, or shrinks the active window by the next grid dimension. Grid 214 | settings are specified in config.fnl. 215 | " 216 | (let [fn-name (.. method direction) 217 | f (. hs.grid fn-name)] 218 | (f (hs.window.focusedWindow)))) 219 | 220 | 221 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 222 | ;; Resize window by half 223 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 224 | 225 | (fn rect 226 | [rct] 227 | " 228 | Change a window's rect geometry which includes x, y, width, and height 229 | Takes a rectangle table 230 | Performs side-effects to move or resize the active window and update history. 231 | Returns nil 232 | " 233 | (: history :push) 234 | (let [win (hs.window.focusedWindow)] 235 | (when win (: win :move rct)))) 236 | 237 | (fn resize-window-halve 238 | [arrow] 239 | " 240 | Resize a window by half the grid dimensions specified in config.fnl. 241 | Takes an :h :j :k or :l arrow 242 | Performs a side effect to resize the active window's frame rect 243 | Returns nil 244 | " 245 | (: history :push) 246 | (rect (. arrow-map arrow :half))) 247 | 248 | (fn resize-half-left 249 | [] 250 | (resize-window-halve :h)) 251 | 252 | (fn resize-half-right 253 | [] 254 | (resize-window-halve :l)) 255 | 256 | (fn resize-half-top 257 | [] 258 | (resize-window-halve :k)) 259 | 260 | (fn resize-half-bottom 261 | [] 262 | (resize-window-halve :j)) 263 | 264 | 265 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 266 | ;; Resize window by increments 267 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 268 | 269 | (fn resize-by-increment 270 | [arrow] 271 | " 272 | Resize the active window by the next window increment 273 | Let's say we make the grid dimensions 4x4 and we place a window in the 1x1 274 | meaning first column in the first row. 275 | We then resize an increment right. The dimensions would now be 2x1 276 | 277 | Takes an arrow like :h :j :k :l 278 | Performs a side-effect to resize the current window to the next grid increment 279 | Returns nil 280 | " 281 | (let [directions {:h "Left" 282 | :j "Down" 283 | :k "Up" 284 | :l "Right"}] 285 | (: history :push) 286 | (when (or (= arrow :h) (= arrow :l)) 287 | (hs.grid.resizeWindowThinner (hs.window.focusedWindow))) 288 | (when (or (= arrow :j) (= arrow :k)) 289 | (hs.grid.resizeWindowShorter (hs.window.focusedWindow))) 290 | (grid :pushWindow (. directions arrow)))) 291 | 292 | (fn resize-inc-left 293 | [] 294 | (resize-by-increment :h)) 295 | 296 | (fn resize-inc-bottom 297 | [] 298 | (resize-by-increment :j)) 299 | 300 | (fn resize-inc-top 301 | [] 302 | (resize-by-increment :k)) 303 | 304 | (fn resize-inc-right 305 | [] 306 | (resize-by-increment :l)) 307 | 308 | 309 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 310 | ;; Resize windows 311 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 312 | 313 | (fn resize-window 314 | [arrow] 315 | " 316 | Resizes a window against the grid specifed in config.fnl 317 | Takes an arrow string like :h :k :j :l 318 | Performs a side effect to resize the current window. 319 | Returns nil 320 | " 321 | (: history :push) 322 | ;; hs.grid.resizeWindowShorter/Taller/Thinner/Wider 323 | (grid :resizeWindow (. arrow-map arrow :resize))) 324 | 325 | (fn resize-left 326 | [] 327 | (resize-window :h)) 328 | 329 | (fn resize-up 330 | [] 331 | (resize-window :k)) 332 | 333 | (fn resize-down 334 | [] 335 | (resize-window :j)) 336 | 337 | (fn resize-right 338 | [] 339 | (resize-window :l)) 340 | 341 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 342 | ;; Resize to grid preset 343 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 344 | 345 | (fn resize-to-grid 346 | [grid] 347 | (: history :push) 348 | (hs.grid.set (hs.window.focusedWindow) grid)) 349 | 350 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 351 | ;; Move to screen directions 352 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 353 | 354 | (fn move-to-screen 355 | [screen] 356 | "Moves current window onto given hs.screen instance" 357 | (let [w (hs.window.focusedWindow) 358 | no-resize true] 359 | (: w :moveToScreen screen no-resize))) 360 | 361 | (fn move-screen 362 | [method] 363 | " 364 | Moves a window to the display in the specified direction 365 | :north ^ :south v :east -> :west <- 366 | Takes a method name of the hammer spoon window instance. 367 | You probably will not be using this function directly. 368 | Performs a side effect that will move a window the next screen in specified 369 | direction. 370 | Returns nil 371 | " 372 | (let [window (hs.window.focusedWindow)] 373 | (: window method nil true))) 374 | 375 | (fn move-north 376 | [] 377 | (move-screen :moveOneScreenNorth)) 378 | 379 | (fn move-south 380 | [] 381 | (move-screen :moveOneScreenSouth)) 382 | 383 | (fn move-east 384 | [] 385 | (move-screen :moveOneScreenEast)) 386 | 387 | (fn move-west 388 | [] 389 | (move-screen :moveOneScreenWest)) 390 | 391 | (local canvas (require :hs.canvas)) 392 | (local screen-number-canvases (atom [])) 393 | 394 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 395 | ;; Move to screen by number 396 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 397 | 398 | (fn show-display-number 399 | [idx screen] 400 | "Shows a big number at the corner of hs.screen. 401 | To be used as for multi-monitor setups, to easily identify index of each 402 | screen." 403 | (let [cs (canvas.new {}) 404 | font-size (/ (. (: screen :frame) :w) 10)] 405 | (swap! screen-number-canvases (fn [t] (concat t [cs]))) 406 | (doto cs 407 | (: :frame (: screen :frame)) 408 | (: :appendElements 409 | [{:action :fill 410 | :type :text 411 | :frame {:x "0.93" :y 0 :h "1" :w "1"} 412 | :text (hs.styledtext.new 413 | idx 414 | {:font {:size font-size} 415 | :color {:red 1 :green 0.5 :blue 0 :alpha 1}}) 416 | :withShadow true}]) 417 | (: :show)))) 418 | 419 | (fn show-display-numbers 420 | [screens] 421 | "Shows big number at the corner of each screen. 422 | To be used as for multi-monitor setups, to easily identify index of each screen." 423 | (let [ss (hs.screen.allScreens)] 424 | (when (< 1 (count ss)) 425 | (each [idx display (ipairs (hs.screen.allScreens))] 426 | (show-display-number idx display))))) 427 | 428 | (fn hide-display-numbers 429 | [] 430 | "Hides big numbers at the corner of each screen that are used for guidance in 431 | multi-monitor setups." 432 | (for-each 433 | (fn [c] (: c :delete .4)) 434 | (deref screen-number-canvases)) 435 | (reset! screen-number-canvases [])) 436 | 437 | (fn monitor-item 438 | [screen i] 439 | " 440 | Creates a menu item to move the frontMost window to the specified screen index 441 | Takes a hs.screen instance and an index integer 442 | Returns a table-map to add to a config.fnl modal menu 443 | " 444 | {:title (.. "Monitor " i) 445 | :key (tostring i) 446 | :group :monitor 447 | :action (fn [] 448 | (when screen 449 | (move-to-screen screen)))}) 450 | 451 | (fn set-monitor-items 452 | [menu screens] 453 | " 454 | Update a menu by adding an item for each connected monitor 455 | Takes a menu table-map and a table-list of hs.screens 456 | Mutates the menu.items by adding items for each monitor 457 | If any menu items were added previously for each monitor, 458 | they are cleaned up. 459 | Returns mutated modal menu table-map 460 | " 461 | (->> screens 462 | (map monitor-item) 463 | (concat (filter #(not (= (. $ :group) :monitor)) menu.items)) 464 | (tset menu :items)) 465 | menu) 466 | 467 | (fn enter-window-menu 468 | [menu] 469 | " 470 | Handler that can be used when entering the windows menu 471 | Takes modal menu table-map 472 | - Hides any previous display numbers 473 | - Shows display numbers at top right of each screen 474 | - Sets monitor items based on currently connected monitors 475 | Returns mutated modal menu table-map for threading or chaining 476 | " 477 | (let [screens (hs.screen.allScreens)] 478 | (hide-display-numbers) 479 | (show-display-numbers screens) 480 | (set-monitor-items menu screens)) 481 | menu) 482 | 483 | (fn exit-window-menu 484 | [menu] 485 | " 486 | Handler that can be used when exiting the windows menu 487 | - Removes previous monitor items if any were added 488 | Returns mutated modal menu table-map for threading or chaining 489 | " 490 | (hide-display-numbers) 491 | menu) 492 | 493 | 494 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 495 | ;; Initialization 496 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 497 | 498 | (fn init 499 | [config] 500 | " 501 | Initializes the windows module 502 | Performs side effects: 503 | - Set grid margins from config.fnl like {:grid {:margins [10 10]}} 504 | - Set the grid dimensions from config.fnl like {:grid {:size \"3x2\"}} 505 | " 506 | (hs.grid.setMargins (or (get-in [:grid :margins] config) [0 0])) 507 | (hs.grid.setGrid (or (get-in [:grid :size] config) "3x2")) 508 | (let [grid-ui (get-in [:grid :ui] config)] 509 | (when grid-ui 510 | (each [key value (pairs grid-ui)] 511 | (tset hs.grid.ui key value))))) 512 | 513 | 514 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 515 | ;; Exports 516 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 517 | 518 | {: activate-app 519 | : center-window-frame 520 | : enter-window-menu 521 | : exit-window-menu 522 | : hide-display-numbers 523 | : highlight-active-window 524 | : init 525 | : jump 526 | : jump-to-last-window 527 | : jump-window-above 528 | : jump-window-below 529 | : jump-window-left 530 | : jump-window-right 531 | : maximize-window-frame 532 | : move-east 533 | : move-north 534 | : move-south 535 | : move-to-screen 536 | : move-west 537 | : position-window-center 538 | : rect 539 | : resize-down 540 | : resize-half-bottom 541 | : resize-half-left 542 | : resize-half-right 543 | : resize-half-top 544 | : resize-inc-bottom 545 | : resize-inc-left 546 | : resize-inc-right 547 | : resize-inc-top 548 | : resize-left 549 | : resize-right 550 | : resize-up 551 | : resize-to-grid 552 | : set-mouse-cursor-at 553 | : show-display-numbers 554 | : show-grid 555 | : undo} 556 | -------------------------------------------------------------------------------- /lib/modal.fnl: -------------------------------------------------------------------------------- 1 | " 2 | Displays the menu modals, sub-menus, and application-specific modals if set 3 | in config.fnl. 4 | 5 | We define a state machine, which uses our local states to determine states, and 6 | transitions. Then we can send actions that may transition between specific 7 | states defined in the table. 8 | 9 | Allows us to create the machinery for displaying, entering, exiting, and 10 | switching menus in one place which is then powered by config.fnl. 11 | " 12 | (local atom (require :lib.atom)) 13 | (local statemachine (require :lib.statemachine)) 14 | (local apps (require :lib.apps)) 15 | (local {: butlast 16 | : call-when 17 | : concat 18 | : conj 19 | : find 20 | : filter 21 | : has-some? 22 | : identity 23 | : join 24 | : map 25 | : merge} 26 | (require :lib.functional)) 27 | (local {: logger} (require :lib.utils)) 28 | (local {:align-columns align-columns} 29 | (require :lib.text)) 30 | (local {:action->fn action->fn 31 | :bind-keys bind-keys} 32 | (require :lib.bind)) 33 | (local lifecycle (require :lib.lifecycle)) 34 | 35 | (local log (logger "modal.fnl" "warning")) 36 | (var fsm nil) 37 | (local default-style {:textFont "Menlo" 38 | :textSize 16 39 | :radius 0 40 | :strokeWidth 0 41 | :fadeInDuration 0 42 | :fadeOutDuration 0}) 43 | (var style {}) 44 | 45 | ;; Store current alert UUID for fast closeSpecific instead of closeAll 46 | (var current-alert-uuid nil) 47 | 48 | 49 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 50 | ;; General Utils 51 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 52 | 53 | (fn timeout 54 | [f] 55 | " 56 | Create a pre-set timeout task that takes a function to run later. 57 | Takes a function to call after 2 seconds. 58 | Returns a function to destroy the timeout task. 59 | " 60 | (let [task (hs.timer.doAfter 2 f)] 61 | (fn destroy-task 62 | [] 63 | (when task 64 | (task:stop) 65 | nil)))) 66 | 67 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 68 | ;; Action dispatch functions 69 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 70 | 71 | (fn activate-modal 72 | [menu-key] 73 | " 74 | API to enter the main menu. Only effective when in the idle state (with no 75 | modal on screen) 76 | Side effectful 77 | " 78 | (fsm.send :activate menu-key)) 79 | 80 | (fn enter-modal 81 | [menu-key] 82 | " 83 | API to transition to the active state of our modal finite state machine 84 | It is called by a trigger set on the outside world and provided relevant 85 | context to determine which menu modal to activate. 86 | Takes the name of a menu to activate or nil if it's the root menu. 87 | menu-key refers to either a submenu key in config.fnl or an application 88 | specific menu key. 89 | Side effectful 90 | " 91 | (fsm.send :enter menu-key)) 92 | 93 | 94 | (fn deactivate-modal 95 | [] 96 | " 97 | API to transition to the idle state of our modal finite state machine. 98 | Takes no arguments. 99 | Side effectful 100 | " 101 | (fsm.send :deactivate)) 102 | 103 | 104 | (fn previous-modal 105 | [] 106 | " 107 | API to transition to the previous modal in our history. Useful for returning 108 | to the main menu when in the window modal for instance. 109 | " 110 | (fsm.send :previous)) 111 | 112 | 113 | (fn start-modal-timeout 114 | [] 115 | " 116 | API for starting a menu timeout. Some menu actions like the window navigation 117 | actions can be repeated without having to re-enter into the Menu 118 | Modal > Window but we don't want to be listening for key events indefinitely. 119 | This begins a timeout that will close the modal and remove the key bindings 120 | after a time delay specified in the timout function. 121 | Takes no arguments. 122 | Side effectful 123 | " 124 | (fsm.send :start-timeout)) 125 | 126 | 127 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 128 | ;; Set Key Bindings 129 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 130 | 131 | (fn create-action-trigger 132 | [{:action action :repeatable repeatable :timeout timeout}] 133 | " 134 | Creates a function to dispatch an action associated with a menu item defined 135 | by config.fnl. 136 | Takes a table defining the following: 137 | 138 | action :: function | string - Either a string like \"module:function-name\" 139 | or a fennel function to call. 140 | repeatable :: bool | nil - If this action is repeatable like jumping between 141 | windows where we might wish to jump 2 windows 142 | left and it wouldn't want to re-enter the jump menu 143 | timeout :: bool | nil - If a timeout should be started. Defaults to true when 144 | repeatable is true. 145 | 146 | Returns a function to execute the action-fn async. 147 | " 148 | (let [action-fn (action->fn action)] 149 | (fn [] 150 | (if (and repeatable (~= timeout false)) 151 | (start-modal-timeout) 152 | (not repeatable) 153 | (deactivate-modal)) 154 | ;; Delay the action-fn ever so slightly 155 | ;; to speed up the closing of the menu 156 | ;; This makes the UI feel slightly snappier 157 | (hs.timer.doAfter 0.01 action-fn)))) 158 | 159 | 160 | (fn create-menu-trigger 161 | [{:key key}] 162 | " 163 | Takes a config menu option and returns a function to enter that submenu when 164 | action is activated. 165 | Returns a function to activate submenu. 166 | " 167 | (fn [] 168 | (enter-modal key))) 169 | 170 | 171 | (fn select-trigger 172 | [item] 173 | " 174 | Transform a menu item into an action to either call a function or enter a 175 | submenu. 176 | Takes a menu item from config.fnl 177 | Returns a function to perform the action associated with menu item. 178 | " 179 | (if (and item.action (= item.action :previous)) 180 | previous-modal 181 | item.action 182 | (create-action-trigger item) 183 | item.items 184 | (create-menu-trigger item) 185 | (fn [] 186 | (log.w "No trigger could be found for item: " 187 | (hs.inspect item))))) 188 | 189 | 190 | (fn bind-item 191 | [item] 192 | " 193 | Create a bindspec to map modal menu items to actions and submenus. 194 | Takes a menu item 195 | Returns a table to create a hs key binding. 196 | " 197 | {:mods (or item.mods []) 198 | :key item.key 199 | :action (select-trigger item)}) 200 | 201 | 202 | (fn bind-menu-keys 203 | [items] 204 | " 205 | Binds all actions and submenu items within a menu to VenueBook. 206 | Takes a list of modal menu items. 207 | Returns a function to remove menu key bindings for easy cleanup. 208 | " 209 | (-> items 210 | (->> (filter (fn [item] 211 | (or item.action 212 | item.items))) 213 | (map bind-item)) 214 | (concat [{:key :ESCAPE 215 | :action deactivate-modal} 216 | {:mods [:ctrl] 217 | :key "[" 218 | :action deactivate-modal}]) 219 | (bind-keys))) 220 | 221 | 222 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 223 | ;; Display Modals 224 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 225 | 226 | (local mod-chars {:cmd "CMD" 227 | :alt "OPT" 228 | :shift "SHFT" 229 | :tab "TAB"}) 230 | 231 | (fn format-key 232 | [item] 233 | " 234 | Format the key binding of a menu item to display in a modal menu to user 235 | Takes a modal menu item 236 | Returns a string describing the key 237 | " 238 | (let [mods (-?>> item.mods 239 | (map (fn [m] (or (. mod-chars m) m))) 240 | (join " ") 241 | (identity))] 242 | (.. (or mods "") 243 | (if mods " + " "") 244 | item.key))) 245 | 246 | 247 | (fn modal-alert 248 | [menu] 249 | " 250 | Display a menu modal in an hs.alert. 251 | Uses closeSpecific instead of closeAll for much faster rendering. 252 | Takes a menu table specified in config.fnl 253 | Opens an alert modal as a side effect 254 | Returns nil 255 | " 256 | ;; Close previous alert specifically (much faster than closeAll) 257 | (when current-alert-uuid 258 | (hs.alert.closeSpecific current-alert-uuid 0)) 259 | 260 | ;; Build and show new alert, store UUID 261 | (let [items (->> menu.items 262 | (filter (fn [item] item.title)) 263 | (map (fn [item] 264 | [(format-key item) (. item :title)])) 265 | (align-columns)) 266 | text (join "\n" items)] 267 | (set current-alert-uuid (hs.alert.show text style 99999)))) 268 | 269 | (fn show-modal-menu 270 | [state] 271 | " 272 | Main API to display a modal and run side-effects 273 | - Display the modal alert 274 | Takes current modal state from our modal statemachine 275 | Returns the function to cleanup everything it sets up 276 | " 277 | (lifecycle.enter-menu state.context.menu) 278 | (modal-alert state.context.menu) 279 | (let [unbind-keys (bind-menu-keys state.context.menu.items) 280 | stop-timeout state.context.stop-timeout] 281 | (fn [] 282 | ;; Use closeSpecific for faster cleanup 283 | (when current-alert-uuid 284 | (hs.alert.closeSpecific current-alert-uuid 0) 285 | (set current-alert-uuid nil)) 286 | (unbind-keys) 287 | (call-when stop-timeout) 288 | (lifecycle.exit-menu state.context.menu)))) 289 | 290 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 291 | ;; Menus, & Config Navigation 292 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 293 | 294 | (fn by-key 295 | [target] 296 | " 297 | Checker function to filter menu items where key matches target 298 | Takes a target string to look for like \"window\" 299 | Returns true or false 300 | " 301 | (fn [item] 302 | (and (= (. item :key) target) 303 | (has-some? item.items)))) 304 | 305 | 306 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 307 | ;; State Transition Functions 308 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 309 | 310 | 311 | (fn ->menu 312 | [state action menu-key] 313 | " 314 | Enter a menu like entering into the Window menu from the default main menu. 315 | Enters the main menu when called from the idle state. 316 | Takes the current menu state table and the submenu key as 'extra'. 317 | Returns updated menu state 318 | " 319 | (let [{:config config 320 | :menu prev-menu} state.context 321 | app-menu (apps.get-app) 322 | menu (if menu-key 323 | (find (by-key menu-key) prev-menu.items) 324 | (if (and app-menu (has-some? app-menu.items)) 325 | app-menu 326 | config))] 327 | {:state {:current-state :active 328 | :context (merge state.context {:menu menu})} 329 | :effect :open-menu})) 330 | 331 | 332 | (fn active->idle 333 | [state action extra] 334 | " 335 | Transition our modal state machine from the active, open state to idle. 336 | Takes the current modal state table. 337 | Kicks off an effect to close the modal, stop the timeout, and unbind keys 338 | Returns updated modal state machine state table. 339 | " 340 | {:state {:current-state :idle 341 | :context (merge state.context {:menu :nil 342 | :history []})} 343 | :effect :close-modal-menu}) 344 | 345 | 346 | (fn ->enter-app 347 | [state _action _extra] 348 | " 349 | Transition our modal state machine the main menu to an app menu 350 | Takes the current modal state table and the app menu table. 351 | Displays updated modal menu if the current menu is different than the previous 352 | menu otherwise results in no operation 353 | Returns new modal state 354 | " 355 | (let [{:config config 356 | :menu prev-menu} state.context 357 | app-menu (apps.get-app) 358 | menu (if (and app-menu (has-some? app-menu.items)) 359 | app-menu 360 | config)] 361 | (if (= menu.key prev-menu.key) 362 | ; nil transition object means keep all state 363 | nil 364 | {:state {:current-state :active 365 | :context (merge state.context {:menu menu})} 366 | :effect :open-menu}))) 367 | 368 | 369 | (fn active->leave-app 370 | [state action extra] 371 | " 372 | Transition to the regular menu when user removes focus (blurs) another app. 373 | If the leave event was fired for the app we are already in, do nothing. 374 | Takes the current modal state table. 375 | Returns new updated modal state if we are leaving the current app. 376 | " 377 | (let [{:config config 378 | :menu prev-menu} state.context] 379 | (if (= prev-menu.key config.key) 380 | nil 381 | (->menu state)))) 382 | 383 | 384 | (fn add-timeout-transition 385 | [state action extra] 386 | " 387 | Transition from active to idle, but this transition only fires when the 388 | timeout occurs. The timeout is only started after firing a repeatable action. 389 | For instance if you enter window > jump east you may want to jump again 390 | without having to bring up the modal and enter the window submenu. We wait for 391 | more modal keypresses until the timeout triggers which will deactivate the 392 | modal. 393 | Takes the current modal state table. 394 | Returns a the old state with a :stop-timeout added 395 | " 396 | {:state {:current-state state.current-state 397 | :context 398 | (merge state.context {:stop-timeout (timeout deactivate-modal)})} 399 | :effect :open-menu}) 400 | 401 | (fn ->previous 402 | [state _action _extra] 403 | " 404 | Transition to the previous submenu. Like if you went into the window menu 405 | and wanted to go back to the main menu. 406 | Takes the modal state table. 407 | Returns a partial modal state table update. 408 | Dynamically calls another transition depending on history. 409 | " 410 | (let [{:config config 411 | :history hist 412 | :menu menu} state.context 413 | prev-menu (. hist (- (length hist) 1))] 414 | (if prev-menu 415 | {:state {:current-state :active 416 | :context (merge state.context {:menu prev-menu 417 | :history (butlast hist)})} 418 | :effect :open-menu} 419 | (->menu state)))) 420 | 421 | 422 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 423 | ;; Finite State Machine States 424 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 425 | 426 | 427 | ;; State machine states table. Maps states to actions to transition functions. 428 | ;; These transition functions return transition objects that contain the new 429 | ;; state key and context. 430 | (local states 431 | {:idle {:activate ->menu} 432 | :active {:deactivate active->idle 433 | :enter ->menu 434 | :start-timeout add-timeout-transition 435 | :previous ->previous 436 | :enter-app ->enter-app}}) 437 | 438 | 439 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 440 | ;; Watchers, Dispatchers, & Logging 441 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 442 | 443 | 444 | (fn start-logger 445 | [fsm] 446 | " 447 | Start logging the status of the modal state machine. 448 | Takes our finite state machine. 449 | Returns nil 450 | Creates a watcher of our state atom to log state changes reactively. 451 | " 452 | (atom.add-watch 453 | fsm.state :log-state 454 | (fn log-state 455 | [state] 456 | (when state.context.history 457 | (log.df (hs.inspect (map #(. $1 :title) state.context.history))))))) 458 | 459 | (local modal-effect 460 | (statemachine.effect-handler 461 | {:open-menu show-modal-menu})) 462 | 463 | (fn proxy-app-action 464 | [[action data]] 465 | " 466 | Provide a semi-public API function for other state machines to dispatch 467 | changes to the modal menu state. Currently used by the app state machine to 468 | tell the modal menu state machine when an app is launched, activated, 469 | deactivated, or exited. 470 | Executes a side-effect 471 | Returns nil 472 | " 473 | (fsm.send action data)) 474 | 475 | 476 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 477 | ;; Initialization 478 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 479 | 480 | (fn init 481 | [config] 482 | " 483 | Initialize the modal state machine responsible for displaying modal alerts 484 | to the user to trigger actions defined by their config.fnl. 485 | Takes the config.fnl table. 486 | Causes side effects to start the state machine, show the modal, and logging. 487 | Returns a function to unsubscribe from the app state machine. 488 | " 489 | (let [initial-context {:config config 490 | :history [] 491 | :menu :nil} 492 | template {:state {:current-state :idle 493 | :context initial-context} 494 | :states states 495 | :log "modal"} 496 | unsubscribe (apps.subscribe proxy-app-action)] 497 | (set style (merge default-style (?. config :modal-style))) 498 | (set fsm (statemachine.new template)) 499 | (fsm.subscribe modal-effect) 500 | (start-logger fsm) 501 | (fn cleanup [] 502 | (unsubscribe)))) 503 | 504 | 505 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 506 | ;; Exports 507 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 508 | 509 | 510 | {: init 511 | : activate-modal} 512 | -------------------------------------------------------------------------------- /test/advice-test.fnl: -------------------------------------------------------------------------------- 1 | (import-macros {: defn 2 | : afn 3 | : defadvice} :lib.advice.macros) 4 | (local {: reset 5 | : make-advisable 6 | : add-advice 7 | : remove-advice 8 | : get-advice 9 | : print-advisable-keys} (require :lib.advice)) 10 | 11 | (local fennel (require :fennel)) 12 | (local is (require :lib.testing.assert)) 13 | (local {: join 14 | : map} (require :lib.functional)) 15 | 16 | (describe 17 | "Advice" 18 | (fn [] 19 | (before reset) 20 | 21 | 22 | (it "Should call unadvised functions as-is" 23 | (fn [] 24 | (let [test-func (make-advisable 25 | :test-func-1 26 | (fn test-func-1 [arg] 27 | "Advisable test function" 28 | (.. "Hello " arg)))] 29 | 30 | (is.eq? (test-func "cat") "Hello cat" "Unadvised test-func did not return \"Hello cat\"")))) 31 | 32 | (it "Should call override functions instead" 33 | (fn [] 34 | (let [test-func (make-advisable 35 | :test-func-2 36 | (fn [x y z] 37 | "Advisable test function" 38 | (+ x y z)))] 39 | 40 | (is.eq? (test-func 1 2 3) 6 "Original function did not return 6") 41 | (add-advice test-func :override (fn [x y z] (+ x y z 1))) 42 | (is.eq? (test-func 1 2 3) 7 "Override advice did not return 7")))) 43 | 44 | (it "Should support advice added by string name" 45 | (fn [] 46 | (let [test-func (make-advisable 47 | :test-func-2b 48 | (fn [...] 49 | "Advisable test function" 50 | "Plain pizza"))] 51 | 52 | (add-advice :test/advice-test/test-func-2b :override 53 | (fn [...] 54 | (is.eq? (length [...]) 2 "Override advice received more than 2 args") 55 | (.. "Overrided " (join " " [...])))) 56 | (is.eq? (test-func "anchovie" "pizza") "Overrided anchovie pizza" "Override test-func did not return \"Overrided anchovie pizza\"")))) 57 | 58 | (it "Should call original when remove-advice is called" 59 | (fn [] 60 | (let [test-func (make-advisable 61 | :test-func-2c 62 | (fn [x y z] 63 | "Advisable test function" 64 | "default")) 65 | advice-fn (fn [x y z] 66 | "over-it")] 67 | 68 | (add-advice test-func :override advice-fn) 69 | (remove-advice test-func :override advice-fn) 70 | 71 | (is.eq? (test-func) "default" "Original function was not called")))) 72 | 73 | (it "Should support advice added before advisable function is created" 74 | (fn [] 75 | (add-advice :test/advice-test/test-func-2d :override 76 | (fn [x y z] 77 | "over-it")) 78 | (let [test-func (make-advisable 79 | :test-func-2d 80 | (fn [...] 81 | "Advisable test function" 82 | "default"))] 83 | 84 | (is.eq? (test-func) "over-it" "test-func was not advised")))) 85 | 86 | 87 | (it "Should call around functions with orig" 88 | (fn [] 89 | (let [test-func (make-advisable 90 | :test-func-3 91 | (fn [...] 92 | "Advisable test function" 93 | ["old" (table.unpack [...])]))] 94 | 95 | (add-advice test-func :around (fn [orig ...] (join " " ["around" (table.unpack (orig (table.unpack [...])))]))) 96 | (is.eq? (test-func "one" "two") "around old one two" "Around test-func did not return \"around one two old\"")))) 97 | 98 | (it "Should call before functions" 99 | (fn [] 100 | (let [state {:calls 0 101 | :args ""} 102 | test-func (make-advisable 103 | :test-func-4 104 | (fn [...] 105 | "Advisable test function" 106 | (let [args [...]] 107 | (tset state :args (.. state.args " " (join " " (map #(+ $1 2) [...]))))) 108 | (tset state :calls (+ state.calls 1)) 109 | "original"))] 110 | 111 | (add-advice test-func :before (fn [...] 112 | (let [args [...]] 113 | (tset state :args (join " " [...]))) 114 | (tset state :calls (+ state.calls 1)))) 115 | (is.eq? (test-func 1 2) "original" "Before test-func did not return original return value") 116 | (is.eq? state.calls 2 "Before test-func did not call both the original and before fn") 117 | (is.eq? state.args "1 2 3 4" "Before test-func did not call both the original and before with the same args")))) 118 | 119 | (it "Should call orig if before-while returns truthy" 120 | (fn [] 121 | (let [state {:called false} 122 | test-func (make-advisable 123 | :test-func-5 124 | (fn [...] 125 | "Advisable test function" 126 | (.. "original " (join " " [...]))))] 127 | 128 | (add-advice test-func 129 | :before-while 130 | (fn [...] 131 | (tset state :called true) 132 | true)) 133 | (is.eq? (test-func 1 2) "original 1 2" "Before-while test-func did not call original function") 134 | (is.eq? state.called true "Before-while test-func advice function was not called")))) 135 | 136 | (it "Should not call orig if before-while returns false" 137 | (fn [] 138 | (let [state {:called false} 139 | test-func (make-advisable 140 | :test-func-5b 141 | (fn [...] 142 | "Advisable test function" 143 | (.. "original " (join " " [...]))))] 144 | 145 | (add-advice test-func 146 | :before-while 147 | (fn [...] 148 | (tset state :called true) 149 | false)) 150 | (is.eq? (test-func 1 2) false "Before-while test-func did call original function") 151 | (is.eq? state.called true "Before-while test-func advice function was not called")))) 152 | 153 | 154 | (it "Should call orig if before-until returns falsey value" 155 | (fn [] 156 | (let [state {:called false} 157 | test-func (make-advisable 158 | :test-func-6 159 | (fn [...] 160 | "Advisable test function" 161 | (.. "original " (join " " [...]))))] 162 | 163 | (add-advice test-func 164 | :before-until 165 | (fn [...] 166 | (tset state :called true) 167 | false)) 168 | (is.eq? (test-func 1 2) "original 1 2" "Before-until test-func did not call original function") 169 | (is.eq? state.called true "Before-until test-func advice function was not called")))) 170 | 171 | 172 | (it "Should not call orig if before-until returns truthy value" 173 | (fn [] 174 | (let [state {:called false} 175 | test-func (make-advisable 176 | :test-func-6b 177 | (fn [...] 178 | "Advisable test function" 179 | (.. "original " (join " " [...]))))] 180 | 181 | (add-advice test-func 182 | :before-until 183 | (fn [...] 184 | (tset state :called true) 185 | true)) 186 | (is.eq? (test-func 1 2) true "Before-until test-func did call original function") 187 | (is.eq? state.called true "Before-until test-func advice function was not called")))) 188 | 189 | 190 | (it "Should call after functions" 191 | (fn [] 192 | (let [state {:calls 0 193 | :args ""} 194 | test-func (make-advisable 195 | :test-func-7 196 | (fn [...] 197 | "Advisable test function" 198 | (let [args [...]] 199 | (tset state :args (join " " [...]))) 200 | (tset state :calls (+ state.calls 1)) 201 | true))] 202 | 203 | (add-advice test-func :after (fn [...] 204 | (let [args [...]] 205 | (tset state :args (.. state.args " " (join " " (map #(+ $1 2) [...]))))) 206 | (tset state :calls (+ state.calls 1)))) 207 | (is.eq? (test-func 1 2) true "After did not return the original return value") 208 | (is.eq? state.calls 2 "After test-func did not call both the original and after fn") 209 | (is.eq? state.args "1 2 3 4" "After test-func did not call both the original and after with the same args")))) 210 | 211 | 212 | (it "Should call after-while if orig returns truthy" 213 | (fn [] 214 | (let [state {:called false} 215 | test-func (make-advisable 216 | :test-func-8 217 | (fn [...] 218 | "Advisable test function" 219 | (.. "original " (join " " [...]))))] 220 | 221 | (add-advice test-func 222 | :after-while 223 | (fn [...] 224 | (tset state :called true) 225 | true)) 226 | (is.eq? (test-func 1 2) true "After-while test-func did not call original function") 227 | (is.eq? state.called true "After-while test-func advice function was not called")))) 228 | 229 | (it "Should not call after-while if orig returns falsey" 230 | (fn [] 231 | (let [state {:called false} 232 | test-func (make-advisable 233 | :test-func-8b 234 | (fn [...] 235 | "Advisable test function" 236 | false))] 237 | 238 | (add-advice test-func 239 | :after-while 240 | (fn [...] 241 | (tset state :called true) 242 | true)) 243 | (is.eq? (test-func 1 2) false "After-while test-func did not call original function") 244 | (is.eq? state.called false "After-while test-func advice function was called")))) 245 | 246 | 247 | 248 | (it "Should call after-until if orig returns falsey value" 249 | (fn [] 250 | (let [state {:called false} 251 | test-func (make-advisable 252 | :test-func-9 253 | (fn [...] 254 | "Advisable test function" 255 | false))] 256 | 257 | (add-advice test-func 258 | :after-until 259 | (fn [...] 260 | (tset state :called true) 261 | false)) 262 | (is.eq? (test-func 1 2) false "After-until test-func did not call original function") 263 | (is.eq? state.called true "After-until test-func advice function was not called")))) 264 | 265 | (it "Should not call after-until if orig returns truthy value" 266 | (fn [] 267 | (let [state {:called false} 268 | test-func (make-advisable 269 | :test-func-9b 270 | (fn [...] 271 | "Advisable test function" 272 | (.. "original " (join " " [...]))))] 273 | 274 | (add-advice test-func 275 | :after-until 276 | (fn [...] 277 | (tset state :called true) 278 | false)) 279 | (is.eq? (test-func 1 2) "original 1 2" "After-until test-func did call advise function") 280 | (is.eq? state.called false "After-until test-func advice function was called")))) 281 | 282 | (it "Should filter args sent to orig function" 283 | (fn [] 284 | (let [state {:called false} 285 | test-func (make-advisable 286 | :test-func-10 287 | (fn [...] 288 | "Advisable test function" 289 | (.. "original " (join " " [...]))))] 290 | 291 | (add-advice test-func 292 | :filter-args 293 | (fn [arg-1 arg-2] 294 | (tset state :called true) 295 | [ arg-2 ])) 296 | (is.eq? (test-func 1 2) "original 2" "Filter-args test-func did call orig function with filtered-args") 297 | (is.eq? state.called true "Filter-args test-func advice function was not called")))) 298 | 299 | (it "Should filter the return value from orig function" 300 | (fn [] 301 | (let [state {:called false} 302 | test-func (make-advisable 303 | :test-func-11 304 | (fn [...] 305 | "Advisable test function" 306 | [ "original" (table.unpack [...])]))] 307 | 308 | (add-advice test-func 309 | :filter-return 310 | (fn [[arg-1 arg-2 arg-3]] 311 | (tset state :called true) 312 | (.. "filtered " arg-2 " " arg-3))) 313 | (is.eq? (test-func 1 2) "filtered 1 2" "Filter-return test-func did call advise with orig return") 314 | (is.eq? state.called true "Filter-return test-func advice function was not called")))) 315 | 316 | 317 | (it "Should support the defn macro for defining a function within a scope" 318 | (fn [] 319 | (defn defn-func-1 320 | [x y z] 321 | "docstr" 322 | (print "Hi")) 323 | 324 | (add-advice defn-func-1 :override (fn [x y z] "over-it")) 325 | 326 | (is.eq? (type defn-func-1) "table" "defn call did not result in a callable table") 327 | (is.eq? (defn-func-1) "over-it" "defn function was not advised with override"))) 328 | 329 | (it "Should support the afn macro for defining inline functions" 330 | (fn [] 331 | (let [priv-func (afn priv-func [x y z] "default")] 332 | (add-advice priv-func :override (fn [x y z] "over-it")) 333 | 334 | (is.eq? (type priv-func) "table" "afn did not result in a callable table") 335 | (is.eq? (priv-func) "over-it" "afn function was not advised with override")))) 336 | 337 | (it "Should support advice added with defadvice" 338 | (fn [] 339 | (defn defn-func-2 340 | [x y z] 341 | "docstr" 342 | (print "hi")) 343 | 344 | (defadvice defn-func-2-advice [x y z] 345 | :override defn-func-2 346 | "Override defn-func-2 with this sweet, sweet syntax sugar" 347 | "This feature is done!") 348 | 349 | (is.eq? (defn-func-2) "This feature is done!" "defadvice did not advise defn-func-2"))) 350 | 351 | (it "Should support afn advice added with defadvice" 352 | (fn [] 353 | (let [afn-func-2 (afn afn-func-2 354 | [x y z] 355 | "docstr" 356 | (+ x y z))] 357 | (defadvice afn-func-2-advice [x y z] 358 | :override afn-func-2 359 | "Override afn-func-2 with this sweet, sweet syntax sugar" 360 | (+ x y z 1)) 361 | 362 | (is.eq? (afn-func-2 1 2 3) 7 "defadvice did not advise afn-func-2")))) 363 | 364 | (it "Should support advice added with defadvice" 365 | (fn [] 366 | (defn defn-func-3 367 | [x y z] 368 | "docstr" 369 | "default") 370 | 371 | (is.eq? (defn-func-3) "default" "original-fn did not return default") 372 | 373 | (defadvice defn-func-3-advice [x y z] 374 | :override defn-func-3 375 | "Override defn-func-3 with this sweet, sweet syntax sugar" 376 | "over-it") 377 | 378 | (is.eq? (defn-func-3) "over-it" "defadvice did not advise defn-func-3") 379 | 380 | (remove-advice defn-func-3 :override defn-func-3-advice) 381 | 382 | (is.eq? (defn-func-3) "default" "advice was not removed from original-fn"))) 383 | 384 | (it "Should support get-advice returning the advice list for an advised func" 385 | (fn [] 386 | (defn defn-func-4 387 | [x y z] 388 | "docstr" 389 | "default") 390 | 391 | (defadvice defn-func-4-advice [x y z] 392 | :override defn-func-4 393 | "Override defn-func-4" 394 | "over-it") 395 | 396 | (is.eq? (defn-func-4) "over-it" "defn-func-4 was not advised") 397 | (is.eq? (length (get-advice defn-func-4)) 1 "advice list should be 1"))) 398 | 399 | (it "Should support get-advice on afn advisable functions" 400 | (fn [] 401 | (let [afn-func-3 (afn afn-func-3 402 | [x yz] 403 | "docstr" 404 | "default")] 405 | 406 | (defadvice afn-func-3-advice [x y z] 407 | :override afn-func-3 408 | "Override afn-func-3" 409 | "over-it") 410 | 411 | (is.eq? (afn-func-3) "over-it" "afn-func-3 was not advised") 412 | (is.eq? (length (get-advice afn-func-3)) 1 "advice list should be 1")))) 413 | 414 | 415 | )) 416 | --------------------------------------------------------------------------------