├── .github └── CODEOWNERS ├── .gitignore ├── CHANGELOG.ORG ├── LICENSE ├── README.ORG ├── apps.fnl ├── chrome.fnl ├── config.example.fnl ├── core.fnl ├── docs ├── advice.org ├── edit-with-emacs-demo.gif ├── emacs.org ├── spacehammer-fsm-0.1.png ├── spacehammer-fsm.graffle └── testing.org ├── emacs.fnl ├── grammarly.fnl ├── init.lua ├── lib ├── advice │ ├── init.fnl │ └── macros.fnl ├── apps.fnl ├── atom.fnl ├── bind.fnl ├── functional.fnl ├── globals.fnl ├── hyper.fnl ├── lifecycle.fnl ├── macros.fnl ├── modal.fnl ├── statemachine.fnl ├── testing │ ├── assert.fnl │ ├── init.fnl │ ├── test-runner.fnl │ └── test.lua ├── text.fnl └── utils.fnl ├── multimedia.fnl ├── repl.fnl ├── run-test ├── secrets.fnl ├── slack.fnl ├── spacehammer.el ├── test ├── advice-test.fnl ├── functional-test.fnl └── statemachine-test.fnl ├── vim.fnl └── windows.fnl /.github/CODEOWNERS: -------------------------------------------------------------------------------- 1 | # Global codeowners 2 | * @agzam @jaidetree @Grazfather 3 | *.el @agzam 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | private 2 | Spoons 3 | -------------------------------------------------------------------------------- /CHANGELOG.ORG: -------------------------------------------------------------------------------- 1 | * [2023-04-13 Thu] 2 | ** Improved 3 | - Edit-with-Emacs. Simplified and fixed various bugs. Now works with multiple apps. 4 | * [2021-09-16 Thu] 5 | ** Added 6 | - [[docs/advice.org][Advising system]] 7 | - [[repl.fnl][REPL support]] 8 | - [[./docs/testing.org][Basic unit testing]] 9 | * [2020-09-20 Sun] 10 | ** Fixed 11 | - support for Hammerspoon 0.9.79 which uses Lua 5.4 see https://github.com/agzam/spacehammer/pull/70 for instructions 12 | * [2020-05-14 Thu] 13 | ** Changed 14 | - Edit-with-emacs feature now detects if there's a pre-selected text already and edits only that chunk 15 | * [2020-05-13 Wed] 16 | ** Fixed 17 | - Addressed workaround for regression in fennel 0.4.0 https://github.com/bakpakin/Fennel/issues/276 18 | * [2020-02-23 Sun] 19 | ** Added 20 | - 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. 21 | 22 | Note: if ~/.spacehammer/config.fnl is used, it 23 | needs to be updated in order for this feature to work. 24 | * [2020-02-04 Tue] 25 | ** Added 26 | - New, completely revamped modal engine - [[https://github.com/eccentric-j][@eccentric-j]] 27 | - Improved state-machine implementation - [[https://github.com/eccentric-j][@eccentric-j]] 28 | - ~/.spacehammer.d/config for localized customization - [[https://github.com/eccentric-j][@eccentric-j]] 29 | - Nicer HUD - [[https://github.com/eccentric-j][@eccentric-j]] 30 | - Lots of docstrings - [[https://github.com/eccentric-j][@eccentric-j]] 31 | ** Changed 32 | - Fixed compatibility issues. Currently supported Fennel version 0.3.2 - [[https://github.com/eccentric-j][@eccentric-j]] 33 | - =LEAD= keybinding is now by default set to =Option+SPC= (used to be =Cmd+SPC=) 34 | - App switcher keybinding is now by default set to =Option+n/p= (used to be =Cmde+n/p=) 35 | - Tab switcher keybinding is now by default set to =Option+j/k= (used to be =Cmd+j/k=) 36 | - Pressing =SPC= in a submodal, brings you to the previous level modal (used to open ~Alfred~) 37 | pressing =SPC= at the top level modal still takes you to ~Alfred~ 38 | * [2019-07-19 Fri] 39 | ** Changed 40 | + Modals 41 | + Configuration 42 | + Keybindingsn 43 | + App specific keybindings 44 | + App specific modals 45 | + Vim mode 46 | * [2019-06-25 Tue] 47 | ** Changed 48 | *** Emacs improvements 49 | + run-emacs-fn 50 | + full-screen 51 | + vertical-split-with-emacs 52 | * [2019-06-23 Sun] 53 | ** Added 54 | - Auxiliary Emacs package, spacehammer.el 55 | ** Changed 56 | - Fixes Local app-keys are leaking #15 57 | * [2019-05-07 Tue] 58 | ** Added 59 | - Added local modals 60 | - Grammarly + Emacs interaction 61 | * [2019-05-06 Mon] 62 | ** Changed 63 | - Rewrote everything in Fennel 64 | * [2017-10-14 Sat] 65 | ** Added 66 | - Improved modal system - simplifies adding and extending modals 67 | - 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]] 68 | * [2017-06-25 Sun] 69 | ** Added 70 | - Sierra compatibility 71 | /*Since Karabiner is not compatible anymore (starting with Sierra), had to find a way to get similar features*/ 72 | - ~keybdings~ module 73 | - App switcher - =Cmd+j/k= 74 | - Simple tab switcher for Chrome and iTerm2 - =Cmd+h/l= 75 | - Simple =Vi-mode= - =Alt+j/k/l/m= 76 | - App specific keybindings 77 | ** Changed 78 | - Changed Slack reaction key to =C-r=, so =Cmd+i= can be used to switch between current application windows 79 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /README.ORG: -------------------------------------------------------------------------------- 1 | [[http://www.hammerspoon.org/][Hammerspoon]] config inspired by [[http://spacemacs.org/][Spacemacs]] 2 | 3 | ** Rationale 4 | Keyboard-oriented workflows are often far more efficient and less frustrating than similar mouse-driven techniques. However, the most popular strategy in that space is to use a multitude of keyboard shortcuts. And obviously, that approach is not very scalable. You start adding keyboard shortcuts for various actions, and soon you will be blocked by conflicting shortcuts. 5 | 6 | Command composability (first explored in ~Vi~ and later expanded in its successor ~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 ~h/j/k/l~ keys alone. 7 | 8 | However, the "one-dimensional" approach utilized in vanilla Vim, where a single modal (to switch from Normal to Edit to Select mode) is used, also 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 there is a single primary "modifier" key ~SPACE~. To trigger an action, user is required to press a mnemonically recognizable combination of keys (that usually starts with ~SPACE~ key), e.g., ~SPC w m~ is used to maximize the current window/buffer. 9 | 10 | The Spacehammer project explores these ideas to allow you to take your keyboard-driven workflow to the next level. Jumping between applications, controlling the size and 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 - which inevitably slows you down. 11 | 12 | *** Fennel 13 | Spacehammer initially was written in Lua (as the majority of Hammerspoon 14 | configs), but later was completely re-written in 15 | [[https://fennel-lang.org/][Fennel]] - a tiny Lisp that compiles to Lua. 16 | There is nothing wrong with Lua, but Lisp has many benefits (sadly often 17 | overlooked and ignored by majority of programmers today). Switching to 18 | Fennel allowed us to keep the code more structured and concise. 19 | 20 | ** Installation 21 | *** Install Hammerspoon 22 | You can use [[https://brew.sh/][brew]]: 23 | #+begin_src bash 24 | brew install hammerspoon 25 | #+end_src 26 | *** Install Fennel >= v1.0.0 27 | #+begin_src bash 28 | brew install luarocks 29 | 30 | luarocks install fennel 31 | #+end_src 32 | 33 | Older versions of Fennel are incompatible with Spacehammer. 34 | *** Clone Spacehammer 35 | #+begin_src bash 36 | git clone https://github.com/agzam/spacehammer ~/.hammerspoon 37 | #+end_src 38 | ** LEAD keybinding 39 | =LEAD= is the main and major keybinding that invokes the main Spacehammer modal. By default it is set to =Option+SPC=, but it can be re-configured 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=. 40 | 41 | 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. 42 | 43 | ***** Unbinding =Cmd+SPC= in system preferences. 44 | Go to your Preferences/Keyboard, find =Cmd+SPC= keybinding and change it to something else. Unfortunately, simply disabling it sometimes is not enough. You'd have to set it to be something else e.g. =Ctrl+Cmd+Shift+\= or anything else , it doesn't really matter, since you can then un-check the checkbox and disable it. 45 | 46 | ** Features 47 | **** =LEAD w= - Window management 48 | - =hjkl= - moving windows around halves of the screen 49 | - =Ctrl + hjkl= - for jumping between application windows (handy for side by side windows) 50 | - =w= - jump to previous window 51 | - =n/p= - moving current window to prev/next monitor 52 | - =Option + hjkl= - moving in increments (works across monitors) 53 | - =Shift + hjkl= - re-sizing active window 54 | - =g= - re-sizing with [[http://www.hammerspoon.org/docs/hs.grid.html][hs.grid]] 55 | - =m= - maximize active window 56 | - =c= - center active window 57 | - =u= - undo last window operation (similar to Spacemacs's =SPC w u=) 58 | 59 | **** =LEAD a= - Apps (quick jump) 60 | - =e= - Emacs 61 | - =g= - Chrome 62 | - =i= - iTerm 63 | - =s= - Slack 64 | 65 | you can add more, also try =LEAD j j= 66 | 67 | **** =LEAD SPC= - open Alfred search bar 68 | pressing =SPC= in the main modal takes you to Alfred search popup, pressing =SPC= in other modals returns to previous modal. 69 | 70 | **** =LEAD m= - multimedia controls 71 | Why not use media-keys? 72 | 73 | a) because different external keyboards impose their own ways to control media. 74 | 75 | b) because Spacehammer allows you to keep fingers on the home row. 76 | 77 | By default =LEAD m a= - =jump to music app= is configured to work with Spotify, but you can change that in =~/.spacehammer/config.fnl= 78 | 79 | *** Edit anything [with Emacs] 80 | You can edit any text in any app =Cmd+Ctrl+O=. Currently, it supports only Emacs. Read more [[docs/emacs.org][here]]. 81 | 82 | ** Other features 83 | **** Alternative App Switcher =Option n/p= 84 | **** Simple tab switcher for Chrome and iTerm =Option j/k= 85 | **** Slack Desktop App enhancements 86 | - Scroll through current Slack thread =Ctrl-j/Ctrl-k= (slow) or =Ctrl-e/Ctrl-y= (fast) 87 | - Jump to the end of the thread with =Cmd-g= 88 | - Add emoji to the last message - =Cmd-r= (Slack's default =Cmd-Shift+\= is quite inconvenient) 89 | - Jump back and forth through history - =Ctrl-o/Ctrl-i= 90 | 91 | ** Customizing 92 | *** Update menus, menu items, bindings, and app-specific features 93 | All menu, app, and key bindings are defined in =~/.spacehammer/config.fnl=. 94 | That is your custom config and will be safe from any upstream changes to the default config.fnl. 95 | /The reason to keep it in its own directory is so that it can be maintained in version-control in your own repo/. 96 | **** Modal Menu Items 97 | Menu items are listed when you press =LEAD= and they can be nested. 98 | 99 | Items map a key binding to an action, either a function or ="module:function-name"= string. 100 | 101 | Menu items may either define an action or a table list of items. 102 | 103 | For menu items that should be repeated, add =repeatable: true= to the item table. 104 | The repeatable flag keeps the menu option after the action has been triggered. 105 | 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. 106 | 107 | #+BEGIN_SRC fennel 108 | (local launch-alfred {:title "Alfred" 109 | :key :SPACE 110 | :action (fn [] (hs.appplication.launchOrFocus "Alfred"))}) 111 | (local slack-jump {:title "Slack" 112 | :key :s 113 | :action "slack:quick-switcher"}) 114 | (local window-inc {:title "Window Halves" 115 | :mods [:cmd] 116 | :key :l 117 | :action "windows:resize-inc-right"}) 118 | (local submenu {:title "Submenu" 119 | :key :t 120 | :items [{:key :m 121 | :title "Show a message" 122 | :action (fn [] (alert "I'm a submenu action"))}]}) 123 | (local config {:items [launch-alfred 124 | slack-jump 125 | window-inc 126 | submenu]}) 127 | #+END_SRC 128 | 129 | ***** Lifecycle methods 130 | 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. 131 | **** Global keys 132 | Global keys are used to set up universal hot-keys for the actions you specify. 133 | Unlike menu items they do not require a title attribute. 134 | Additionally you may specify =:repeat true= to repeat the action while the key is held down. 135 | 136 | If you place =:hyper= as a mod, it will use a hyper mode that can be configured by the =hyper= config attribute. 137 | This can be used to help create bindings that won't interfere with other apps. 138 | 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=. 139 | 140 | #+BEGIN_SRC fennel 141 | (local config {:hyper {:key :F18} 142 | :keys [{:mods [:cmd] 143 | :key :space 144 | :action "lib.modal:activate-modal"} 145 | {:mods [:cmd] 146 | :key :h 147 | :action "chrome:prev-tab" 148 | :repeat true} 149 | {:mods [:hyper] 150 | :key :f 151 | :action (fn [] (alert "Haha you pressed f!"))}]}) 152 | #+END_SRC 153 | **** App specific customizations 154 | Configure separate menu options and key bindings while specified apps are active. 155 | Additionally, several lifecycle functions or action strings may be provided for each app. 156 | 157 | - ~:activate~ When an application receives keyboard focus 158 | - ~:deactivate~ When an application loses keyboard focus 159 | - ~:launch~ When an application is launched 160 | - ~:close~ When an application is terminated 161 | 162 | #+BEGIN_SRC fennel 163 | (local emacs-config 164 | {:key "Emacs" 165 | :activate "vim:disable" 166 | :deactivate "vim:enable" 167 | :launch "emacs:maximize" 168 | :items [] 169 | :keys []}) 170 | 171 | (local config {:apps [emacs-config]}) 172 | #+END_SRC 173 | *** Replacing spacehammer behavior 174 | The =~/.spacehammer= directory is added to the module search paths. 175 | 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. 176 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /core.fnl: -------------------------------------------------------------------------------- 1 | (hs.ipc.cliInstall) ; ensure CLI installed 2 | 3 | (local fennel (require :fennel)) 4 | (require :lib.globals) 5 | (local {:contains? contains? 6 | :for-each for-each 7 | :map map 8 | :merge merge 9 | :reduce reduce 10 | :split split 11 | :some some} (require :lib.functional)) 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 | (tset fennel :path (.. customdir "/?.fnl;" fennel.path)) 26 | 27 | (local log (hs.logger.new "\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 | -------------------------------------------------------------------------------- /docs/edit-with-emacs-demo.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/agzam/spacehammer/ecd66b062865374c396454e942dc35caa40a62b2/docs/edit-with-emacs-demo.gif -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /docs/spacehammer-fsm-0.1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/agzam/spacehammer/ecd66b062865374c396454e942dc35caa40a62b2/docs/spacehammer-fsm-0.1.png -------------------------------------------------------------------------------- /docs/spacehammer-fsm.graffle: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/agzam/spacehammer/ecd66b062865374c396454e942dc35caa40a62b2/docs/spacehammer-fsm.graffle -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | modal (require :lib.modal)] 113 | (when app 114 | (: app :activate) 115 | (windows.maximize-window-frame)))))) 116 | 117 | {:capture capture 118 | :edit-with-emacs edit-with-emacs 119 | :full-screen full-screen 120 | :maximize maximize 121 | :note (fn [] (capture true)) 122 | :switchToApp switch-to-app 123 | :switchToAppAndPasteFromClipboard switch-to-app-and-paste-from-clipboard 124 | :vertical-split-with-emacs vertical-split-with-emacs 125 | :run-emacs-fn run-emacs-fn} 126 | -------------------------------------------------------------------------------- /grammarly.fnl: -------------------------------------------------------------------------------- 1 | 2 | ;; somehow Grammarly doesn't let you easily copy or cut the text out of its 3 | ;; window. so I need to emulate a click event first. 4 | (fn click-in-window [] 5 | (let [app (-> (hs.window.focusedWindow) (: :application)) 6 | win (: app :mainWindow) 7 | frame (: win :frame) 8 | {:_x x :_y y} frame 9 | coords {:x (+ x 100) :y (+ y 100)}] 10 | (: (hs.eventtap.event.newMouseEvent 11 | hs.eventtap.event.types.leftMouseDown 12 | coords) :post) 13 | (: (hs.eventtap.event.newMouseEvent 14 | hs.eventtap.event.types.leftMouseUp 15 | coords) :post))) 16 | 17 | (fn back-to-emacs 18 | [] 19 | (let [windows (require :windows) 20 | run-str (.. "/usr/local/bin/emacsclient" 21 | " -e " 22 | "'(with-current-buffer (window-buffer (selected-window)) " 23 | " (if (region-active-p)" 24 | " (delete-region (region-beginning) (region-end))" 25 | " (erase-buffer))" 26 | " (clipboard-yank))" "'") 27 | app (-> (hs.window.focusedWindow) (: :application))] 28 | (click-in-window) 29 | (: app :selectMenuItem [:Edit "Select All"]) 30 | (: app :selectMenuItem [:Edit :Cut]) 31 | (hs.timer.usleep 200000) 32 | (io.popen run-str) 33 | (hs.application.launchOrFocus :Emacs))) 34 | 35 | {:back-to-emacs back-to-emacs} 36 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 {: contains? 8 | : compose 9 | : filter 10 | : first 11 | : join 12 | : last 13 | : map 14 | : reduce 15 | : seq 16 | : slice 17 | : split} (require :lib.functional)) 18 | 19 | (var advice {}) 20 | (var advisable []) 21 | 22 | (fn register-advisable 23 | [key f] 24 | (let [advice-entry (. advice key)] 25 | (when (and advice-entry 26 | advice-entry.original 27 | (not (= advice-entry.original f))) 28 | (error (.. "Advisable function " key " already exists"))) 29 | (if advice-entry 30 | (tset advice-entry 31 | :original f) 32 | (tset advice key 33 | {:original f 34 | :advice []})) 35 | (. advice key))) 36 | 37 | (fn get-or-create-advice-entry 38 | [key] 39 | " 40 | Gets or create an advice-entry without an original. This allows 41 | advice to be added before the advisable function is defined 42 | " 43 | (let [advice-entry (. advice key)] 44 | (if advice-entry 45 | advice-entry 46 | (do 47 | ;; Don't set original as that is used to determine when an 48 | ;; advisable function by that key was already defined 49 | (tset advice key {:advice []}) 50 | (. advice key))))) 51 | 52 | (fn advisable-keys 53 | [] 54 | (slice 0 advisable)) 55 | 56 | (fn get-module-name 57 | [] 58 | (->> (. (debug.getinfo 3 "S") :short_src) 59 | (split "/") 60 | (slice -1) 61 | (join "/") 62 | (split "%.") 63 | (first))) 64 | 65 | (fn advisor 66 | [type f orig-f] 67 | (if 68 | (= type :override) 69 | (fn [args] 70 | (f (table.unpack args))) 71 | 72 | (= type :around) 73 | (fn [args] 74 | (f orig-f (table.unpack args))) 75 | 76 | (= type :before) 77 | (fn [args] 78 | (f (table.unpack args)) 79 | (orig-f (table.unpack args))) 80 | 81 | (= type :before-while) 82 | (fn [args] 83 | (and (f (table.unpack args)) 84 | (orig-f (table.unpack args)))) 85 | 86 | (= type :before-until) 87 | (fn [args] 88 | (or (f (table.unpack args)) 89 | (orig-f (table.unpack args)))) 90 | 91 | (= type :after) 92 | (fn [args] 93 | (let [ret (orig-f (table.unpack args))] 94 | (f (table.unpack args)) 95 | ret)) 96 | 97 | (= type :after-while) 98 | (fn [args] 99 | (and (orig-f (table.unpack args)) 100 | (f (table.unpack args)))) 101 | 102 | (= type :after-until) 103 | (fn [args] 104 | (or (orig-f (table.unpack args)) 105 | (f (table.unpack args)))) 106 | 107 | (= type :filter-args) 108 | (fn [args] 109 | (orig-f (table.unpack (f (table.unpack args))))) 110 | 111 | (= type :filter-return) 112 | (fn [args] 113 | (f (orig-f (table.unpack args)))))) 114 | 115 | (fn apply-advice 116 | [entry args] 117 | (((compose 118 | (table.unpack (->> entry.advice 119 | (map (fn [{: f 120 | : type}] 121 | (fn [next-f] 122 | (advisor type f next-f))))))) 123 | (fn [...] (entry.original (table.unpack [...])))) 124 | args)) 125 | 126 | (fn count 127 | [tbl] 128 | (->> tbl 129 | (reduce (fn [acc _x _key] 130 | (+ acc 1)) 131 | 0))) 132 | 133 | (fn dispatch-advice 134 | [entry args] 135 | (if (> (count entry.advice) 0) 136 | (apply-advice entry args) 137 | (entry.original (table.unpack args)))) 138 | 139 | 140 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 141 | ;; Public API 142 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 143 | 144 | (fn make-advisable 145 | [fn-name f] 146 | " 147 | Registers a function name against the global advisable table that 148 | contains advice registered for a function. Advice can be defined 149 | before a function is defined making it a really safe way to extend 150 | behavior without exploding config options. 151 | 152 | It is recommended to use the `defn` or `afn` macros instead. 153 | 154 | Usage: 155 | (make-advisable :some-func (fn some-func [] \"Some return string\")) 156 | 157 | - Supports passing some-func directly into add-advice 158 | - Supports passing in some-func.key directly into add-advice 159 | - Supports passing in a string like :path/to/module/some-func to 160 | add-advice 161 | " 162 | (let [module (get-module-name) 163 | key (.. module "/" fn-name) 164 | advice-entry (register-advisable key f) 165 | ret {:key key 166 | :advice advice-entry}] 167 | (setmetatable ret 168 | {:__name fn-name 169 | :__call (fn [_tbl ...] 170 | (dispatch-advice advice-entry [...])) 171 | :__index (fn [tbl key] 172 | (. tbl key))}) 173 | (each [k v (pairs (or (. fennel.metadata f) []))] 174 | (: fennel.metadata :set ret k v)) 175 | ret)) 176 | 177 | (fn add-advice 178 | [f advice-type advice-fn] 179 | " 180 | Register advice for an advisable function. It is recommended to use 181 | the `defadvice` macro instead. 182 | 183 | Takes a key string or a callable table with a key property, an 184 | advising type key string, and an advising function 185 | 186 | Returns nil, as it performs a side-effect 187 | " 188 | (let [key (or f.key f) 189 | advice-entry (get-or-create-advice-entry key)] 190 | (when advice-entry 191 | (table.insert advice-entry.advice {:type advice-type :f advice-fn})))) 192 | 193 | (fn remove-advice 194 | [f advice-type advice-fn] 195 | " 196 | Remove advice from a function 197 | " 198 | (let [key (or f.key f) 199 | advice-entry (. advice key)] 200 | (tset advice-entry :advice 201 | (->> advice-entry.advice 202 | (filter #(not (and (= $1.type advice-type) 203 | (= $1.f advice-fn)))))) 204 | nil)) 205 | 206 | (fn reset 207 | [] 208 | " 209 | Anticipated for internal, testing, and debugging 210 | Use with Caution 211 | " 212 | (set advice {}) 213 | (set advisable [])) 214 | 215 | (fn print-advisable-keys 216 | [] 217 | " 218 | Prints a list of advisable function keys 219 | " 220 | (print "\nAdvisable functions:\n") 221 | (each [i key (ipairs (advisable-keys))] 222 | (print (.. " :" key)))) 223 | 224 | (fn get-advice 225 | [f-or-key] 226 | " 227 | Returns the advice list for a given function or advice entry key 228 | " 229 | (let [advice-entry (. advice (or f-or-key.key f-or-key))] 230 | (if advice-entry 231 | (map 232 | (fn [adv] 233 | {:f (tostring adv.f) :type adv.type}) 234 | (slice 0 advice-entry.advice)) 235 | []))) 236 | 237 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 238 | ;; Exports 239 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 240 | 241 | {: reset 242 | : make-advisable 243 | : add-advice 244 | : remove-advice 245 | : get-advice 246 | : print-advisable-keys} 247 | -------------------------------------------------------------------------------- /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/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 os (require :os)) 13 | (local {: call-when 14 | : find 15 | : merge 16 | : noop 17 | : tap} 18 | (require :lib.functional)) 19 | (local {:action->fn action->fn 20 | :bind-keys bind-keys} 21 | (require :lib.bind)) 22 | (local lifecycle (require :lib.lifecycle)) 23 | 24 | 25 | (local log (hs.logger.new "apps.fnl" "debug")) 26 | 27 | (local actions (atom.new nil)) 28 | ;; Create a dynamic var to hold an accessible instance of our finite state 29 | ;; machine for apps. 30 | (var fsm nil) 31 | 32 | 33 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 34 | ;; Utils 35 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 36 | 37 | (fn gen-key 38 | [] 39 | " 40 | Generates a unique, random, base64 encoded string 7 chars long. 41 | Takes no arguments. 42 | Side effectful. 43 | Returns unique 7 char, randomized string. 44 | " 45 | (var nums "") 46 | (for [i 1 7] 47 | (set nums (.. nums (math.random 0 9)))) 48 | (string.sub (hs.base64.encode nums) 1 7)) 49 | 50 | (fn emit 51 | [action data] 52 | " 53 | Broadcasts an action from our state machine so modals can transition. 54 | Takes action name and data to transition another finite state machine. 55 | Side-effect: Updates the actions atom. 56 | Returns nil. 57 | " 58 | (atom.swap! actions (fn [] [action data]))) 59 | 60 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 61 | ;; Action dispatch functions 62 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 63 | 64 | (fn enter 65 | [app-name] 66 | " 67 | Action to focus or activate an app. App must have either menu options 68 | or key bindings defined in config.fnl. 69 | 70 | Takes the name of the app we entered. 71 | Transitions to the entered finite-state-machine state. 72 | Returns nil. 73 | " 74 | (fsm.send :enter-app app-name)) 75 | 76 | (fn leave 77 | [app-name] 78 | " 79 | The user has deactivated/blurred an app we have config defined. 80 | Takes the name of the app the user deactivated. 81 | Transition the state machine to idle from active app state. 82 | Returns nil. 83 | " 84 | (fsm.send :leave-app app-name)) 85 | 86 | (fn launch 87 | [app-name] 88 | " 89 | The user launched an app we have config defined for. 90 | Takes name of the app launched. 91 | Calls the launch lifecycle method defined for an app in config.fnl 92 | Returns nil. 93 | " 94 | (fsm.send :launch-app app-name)) 95 | 96 | (fn close 97 | [app-name] 98 | " 99 | The user closed an app we have config defined for. 100 | Takes name of the app closed. 101 | Calls the exit lifecycle method defined for an app in config.fnl 102 | Returns nil. 103 | " 104 | (fsm.send :close-app app-name)) 105 | 106 | 107 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 108 | ;; Set Key Bindings 109 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 110 | 111 | (fn bind-app-keys 112 | [items] 113 | " 114 | Binds config.fnl app keys to actions 115 | Takes a list of local app bindings 116 | Returns a function to call without arguments to remove bindings. 117 | " 118 | (bind-keys items)) 119 | 120 | 121 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 122 | ;; Apps Navigation 123 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 124 | 125 | (fn by-key 126 | [target] 127 | " 128 | Checker to search for app definitions to find the app with a key property 129 | that matches the target. 130 | Takes a target key string 131 | Returns a predicate that takes an app menu table and returns true if 132 | app.key == target 133 | " 134 | (fn [app] 135 | (= app.key target))) 136 | 137 | 138 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 139 | ;; State Transitions 140 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 141 | 142 | (fn ->enter 143 | [state action app-name] 144 | " 145 | Transitions the app state machine from the general, shared key bindings to an 146 | app we have local keybindings for. 147 | Kicks off an effect to bind app-specific keys. 148 | Takes the current app state machine state table 149 | Returns update modal state machine state table. 150 | " 151 | (let [{: apps 152 | : app} state.context 153 | next-app (find (by-key app-name) apps)] 154 | {:state {:current-state :in-app 155 | :context {:apps apps 156 | :app next-app 157 | :prev-app app}} 158 | :effect :enter-app-effect})) 159 | 160 | 161 | (fn in-app->leave 162 | [state action app-name] 163 | " 164 | Transitions the app state machine from an app the user was using with local 165 | keybindings to another app that may or may not have local keybindings. 166 | Because a 'enter (new) app' action is fired before a 'leave (old) app', we 167 | know that this will be called AFTER the enter transition has updated the 168 | state, so we should not update the state. 169 | Takes the current app state machine state table, 170 | Kicks off an effect to run leave-app effects and unbind the old app's keys 171 | Returns the old state. 172 | " 173 | {:state state 174 | :effect :leave-app-effect}) 175 | 176 | (fn launch-app 177 | [state action app-name] 178 | " 179 | Using the state machine we also react to launching apps by calling the :launch 180 | lifecycle method on apps defined in a user's config.fnl. This way they can run 181 | hammerspoon functions when an app is opened like say resizing emacs on launch. 182 | Takes the current app state machine state table. 183 | Kicks off an effect to bind app-specific keys & fire launch app lifecycle 184 | Returns a new state. 185 | " 186 | (let [{: apps 187 | : app} state.context 188 | next-app (find (by-key app-name) apps)] 189 | {:state {:current-state :in-app 190 | :context {:apps apps 191 | :app next-app 192 | :prev-app app}} 193 | :effect :launch-app-effect})) 194 | 195 | (fn ->close 196 | [state action app-name] 197 | " 198 | Using the state machine we also react to launching apps by calling the :close 199 | lifecycle method on apps defined in a user's config.fnl. This way they can run 200 | hammerspoon functions when an app is closed. For instance re-enabling vim mode 201 | when an app is closed that was incompatible 202 | Takes the current app state machine state table 203 | Kicks off an effect to bind app-specific keys 204 | Returns the old state 205 | " 206 | {:state state 207 | :effect :close-app-effect}) 208 | 209 | 210 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 211 | ;; Finite State Machine States 212 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 213 | 214 | " 215 | State machine transition definitions 216 | Defines the two states our app state machine can be in: 217 | 1. General, non-specific app where no table defined in config.fnl exists 218 | 2. In a specific app where a table is defined to customize local keys, 219 | modal menu items, or lifecycle methods to trigger other hammerspoon functions 220 | Maps each state to a table of actions mapped to handlers responsible for 221 | returning the next state the statemachine is in. 222 | " 223 | 224 | (local states 225 | {:general-app {:enter-app ->enter 226 | :leave-app noop 227 | :launch-app launch-app 228 | :close-app ->close} 229 | :in-app {:enter-app ->enter 230 | :leave-app in-app->leave 231 | :launch-app launch-app 232 | :close-app ->close}}) 233 | 234 | 235 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 236 | ;; Watchers, Dispatchers, & Logging 237 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 238 | 239 | " 240 | Assign some simple keywords for each hs.application.watcher event type. 241 | " 242 | (local app-events 243 | {hs.application.watcher.activated :activated 244 | hs.application.watcher.deactivated :deactivated 245 | hs.application.watcher.hidden :hidden 246 | hs.application.watcher.launched :launched 247 | hs.application.watcher.launching :launching 248 | hs.application.watcher.terminated :terminated 249 | hs.application.watcher.unhidden :unhidden}) 250 | 251 | 252 | (fn watch-apps 253 | [app-name event app] 254 | " 255 | Hammerspoon application watcher callback 256 | Looks up the event type based on our keyword mappings and dispatches the 257 | corresponding action against the state machine to manage side-effects and 258 | update their state. 259 | 260 | Takes the name of the app, the hs.application.watcher event-type, an the 261 | hs.application.instance that triggered the event. 262 | Returns nil. Relies on side-effects. 263 | " 264 | (let [event-type (. app-events event)] 265 | (if (= event-type :activated) 266 | (enter app-name) 267 | (= event-type :deactivated) 268 | (leave app-name) 269 | (= event-type :launched) 270 | (launch app-name) 271 | (= event-type :terminated) 272 | (close app-name)))) 273 | 274 | (fn active-app-name 275 | [] 276 | " 277 | Internal API function to return the name of the frontmost app 278 | Returns the name of the app if there is a frontmost app or nil. 279 | " 280 | (let [app (hs.application.frontmostApplication)] 281 | (if app 282 | (: app :name) 283 | nil))) 284 | 285 | (fn start-logger 286 | [fsm] 287 | " 288 | Debugging handler to add a watcher to the apps finite-state-machine 289 | state atom to log changes over time. 290 | " 291 | (atom.add-watch 292 | fsm.state :log-state 293 | (fn log-state 294 | [state] 295 | (log.df "app is now: %s" (and state.context.app state.context.app.key))))) 296 | 297 | (fn watch-actions 298 | [{: prev-state : next-state : action : effect : extra}] 299 | " 300 | Internal API function to emit app-specific state machine events and transitions to 301 | other state machines. Like telling our modal state machine the user has 302 | entered into emacs so display the emacs-specific menu modal. 303 | Subscribes to the apps state machine. 304 | Takes a transition record from the FSM. 305 | Returns nil. 306 | " 307 | (emit action next-state.context.app)) 308 | 309 | 310 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 311 | ;; API Methods 312 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 313 | 314 | (fn get-app 315 | [] 316 | " 317 | Public API method to get the user's config table for the current app defined 318 | in their config.fnl. 319 | Takes no arguments. 320 | Returns the current app config table or nil if no config was defined for the 321 | current app. 322 | " 323 | (when fsm 324 | (let [state (atom.deref fsm.state)] 325 | state.context.app))) 326 | 327 | (fn subscribe 328 | [f] 329 | " 330 | Public API to subscribe to the stream atom of app specific actions. 331 | Allows the menu modal FSM to subscribe to app actions to know when to switch 332 | to an app specific menu or revert back to default main menu. 333 | Takes a function to call on each action update. 334 | Returns a function to remove the subscription to actions stream. 335 | " 336 | (let [key (gen-key)] 337 | (atom.add-watch actions key f) 338 | (fn unsubscribe 339 | [] 340 | (atom.remove-watch actions key)))) 341 | 342 | (fn enter-app-effect 343 | [context] 344 | " 345 | Binds keys and lifecycle for the new current app. 346 | Returns a cleanup function to cleanup these bindings. 347 | " 348 | (when context.app 349 | (lifecycle.activate-app context.app) 350 | (let [unbind-keys (bind-app-keys context.app.keys)] 351 | (fn [] 352 | (unbind-keys))))) 353 | 354 | (fn launch-app-effect 355 | [context] 356 | " 357 | Binds keys and lifecycle for the next current app. 358 | Returns a cleanup function to cleanup these bindings. 359 | " 360 | (when context.app 361 | (lifecycle.launch-app context.app) 362 | (let [unbind-keys (bind-app-keys context.app.keys)] 363 | (fn [] 364 | (unbind-keys))))) 365 | 366 | (fn app-effect-handler 367 | [effect-map] 368 | " 369 | Takes a map of effect->function and returns a function that handles these 370 | effects by calling the mapped-to function, and then calls that function's 371 | return value (a cleanup function) and calls it on the next transition. 372 | 373 | Unlike the fsm's effect-handler, these are app-aware and only call the cleanup 374 | function for that particular app. 375 | 376 | These functions must return their own cleanup function or nil. 377 | " 378 | ;; Create a one-time atom used to store the cleanup function map 379 | (let [cleanup-ref (atom.new {})] 380 | ;; Return a subscriber function 381 | (fn [{: prev-state : next-state : action : effect : extra}] 382 | ;; Call the cleanup function for this app if it's set 383 | (call-when (. (atom.deref cleanup-ref) extra)) 384 | (let [cleanup-map (atom.deref cleanup-ref) 385 | effect-func (. effect-map effect)] 386 | ;; Update the cleanup entry for this app with a new func or nil 387 | (atom.reset! cleanup-ref 388 | (merge cleanup-map 389 | {extra (call-when effect-func next-state extra)})))))) 390 | 391 | (local apps-effect 392 | (app-effect-handler 393 | {:enter-app-effect (fn [state extra] 394 | (enter-app-effect state.context)) 395 | :leave-app-effect (fn [state extra] 396 | (when state.context.prev-app 397 | (lifecycle.deactivate-app state.context.prev-app)) 398 | nil) 399 | :launch-app-effect (fn [state extra] 400 | (launch-app-effect state.context)) 401 | :close-app-effect (fn [state extra] 402 | (when state.context.prev-app 403 | (lifecycle.close-app state.context.prev-app)) 404 | nil)})) 405 | 406 | 407 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 408 | ;; Initialization 409 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 410 | 411 | (fn init 412 | [config] 413 | " 414 | Initialize apps finite-state-machine and create hs.application.watcher 415 | instance to listen for app specific events. 416 | Takes the current config.fnl table 417 | Returns a function to cleanup the hs.application.watcher. 418 | " 419 | (let [active-app (active-app-name) 420 | initial-context {:apps config.apps 421 | :app nil} 422 | template {:state {:current-state :general-app 423 | :context initial-context} 424 | :states states 425 | :log "apps"} 426 | app-watcher (hs.application.watcher.new watch-apps)] 427 | (set fsm (statemachine.new template)) 428 | (fsm.subscribe apps-effect) 429 | (start-logger fsm) 430 | (fsm.subscribe watch-actions) 431 | (enter active-app) 432 | (: app-watcher :start) 433 | (fn cleanup [] 434 | (: app-watcher :stop)))) 435 | 436 | 437 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 438 | ;; Exports 439 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 440 | 441 | 442 | {: init 443 | : get-app 444 | : subscribe} 445 | -------------------------------------------------------------------------------- /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 | next-value (f (copy prev-value) (table.unpack [...]))] 151 | (set atom.state next-value) 152 | (notify-watchers atom next-value prev-value) 153 | atom)) 154 | 155 | (fn reset! 156 | [atom v] 157 | " 158 | API to replace an atom's state value with a new value. 159 | Takes an atom instance and the new value 160 | Returns the updated atom instance 161 | 162 | Example: 163 | (local x (atom 1)) 164 | (reset! x 3) 165 | ;; => x 166 | (deref x) 167 | ;; => 3 168 | " 169 | (swap! atom (fn [] v))) 170 | 171 | {:atom atom 172 | :new atom 173 | :deref deref 174 | :notify-watchers notify-watchers 175 | :add-watch add-watch 176 | :remove-watch remove-watch 177 | :reset! reset! 178 | :swap! swap!} 179 | -------------------------------------------------------------------------------- /lib/bind.fnl: -------------------------------------------------------------------------------- 1 | (local hyper (require :lib.hyper)) 2 | (local {: contains? 3 | : map 4 | : split} 5 | (require :lib.functional)) 6 | 7 | (local log (hs.logger.new "bind.fnl" "debug")) 8 | 9 | (fn do-action 10 | [action args] 11 | " 12 | Resolves an action string to a function in a module then runs that function. 13 | Takes an action string like \"lib.bind:do-action\" 14 | Performs side-effects. 15 | Returns the return value of the target function or nil if function could 16 | not be resolved. 17 | " 18 | (let [[file fn-name] (split ":" action) 19 | module (require file) 20 | f (. module fn-name)] 21 | (if f 22 | (f (table.unpack (or args []))) 23 | (do 24 | (log.wf "Could not dispatch action %s: Function \"%s\" was not found in module \"%s\".\nEnsure the correct action is referenced in config.fnl." 25 | action 26 | fn-name 27 | file))))) 28 | 29 | 30 | (fn create-action-fn 31 | [action] 32 | " 33 | Takes an action string 34 | Returns function to resolve and execute action. 35 | 36 | Example: 37 | (hs.timer.doAfter 1 (create-action-fn \"messages:greeting\")) 38 | ; Waits 1 second 39 | ; Looks for a function called greeting in messages.fnl 40 | " 41 | (fn [...] 42 | (do-action action [...]))) 43 | 44 | 45 | (fn action->fn 46 | [action] 47 | " 48 | Normalize an action like say from config.fnl into a function 49 | Takes an action either a string like \"lib.bind:action->fn\" or an actual 50 | function instance. 51 | Returns a function to perform that action or logs an error and returns 52 | an always true function if a function could not be found. 53 | " 54 | (match (type action) 55 | :function action 56 | :string (create-action-fn action) 57 | _ (do 58 | (log.wf "Could not create action handler for %s" 59 | (hs.inspect action)) 60 | (fn [] true)))) 61 | 62 | 63 | (fn bind-keys 64 | [items] 65 | " 66 | Binds keys defined in config.fnl to action functions. 67 | Takes a list of bindings from a config.fnl menu 68 | Performs side-effect of binding hotkeys to action functions. 69 | Returns a function to remove bindings. 70 | " 71 | (let [modal (hs.hotkey.modal.new [] nil)] 72 | (each [_ item (ipairs items)] 73 | (let [{:key key 74 | :mods mods 75 | :action action 76 | :repeat repeat} item 77 | mods (or mods []) 78 | action-fn (action->fn action)] 79 | (if repeat 80 | (: modal :bind mods key action-fn nil action-fn) 81 | (: modal :bind mods key nil action-fn)))) 82 | (: modal :enter) 83 | (fn destroy-bindings 84 | [] 85 | (when modal 86 | (: modal :exit) 87 | (: modal :delete))))) 88 | 89 | (fn bind-global-keys 90 | [items] 91 | " 92 | Binds keys to actions globally like pressing cmd + space to open modal menu 93 | Takes a list of bindings from config.fnl 94 | Performs side-effect of creating the key binding to a function. 95 | Returns a function to unbind keys. 96 | " 97 | (map 98 | (fn [item] 99 | (let [{:key key} item 100 | mods (or item.mods []) 101 | action-fn (action->fn item.action)] 102 | (if (contains? :hyper mods) 103 | (hyper.bind key action-fn) 104 | (let [binding (hs.hotkey.bind mods key action-fn)] 105 | (fn unbind 106 | [] 107 | (: binding :delete)))))) 108 | items)) 109 | 110 | (fn unbind-global-keys 111 | [bindings] 112 | " 113 | Takes a list of functions to remove a binding created by bind-global-keys 114 | Performs a side effect to remove binding. 115 | Returns nil 116 | " 117 | (each [_ unbind (ipairs bindings)] 118 | (unbind))) 119 | 120 | (fn init 121 | [config] 122 | " 123 | Initializes our key bindings by binding the global keys 124 | Creates a list of unbind functions for global keys 125 | Returns a cleanup function to unbind all global key bindings 126 | " 127 | (let [keys (or config.keys []) 128 | bindings (bind-global-keys keys)] 129 | (fn cleanup 130 | [] 131 | (unbind-global-keys bindings)))) 132 | 133 | {:init init 134 | :action->fn action->fn 135 | :bind-keys bind-keys 136 | :do-action do-action} 137 | -------------------------------------------------------------------------------- /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/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/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 | -------------------------------------------------------------------------------- /lib/lifecycle.fnl: -------------------------------------------------------------------------------- 1 | (local {: do-action} (require :lib.bind)) 2 | (local log (hs.logger.new "lifecycle.fnl" "debug")) 3 | 4 | 5 | " 6 | Functions for calling lifecycle methods of config.fnl local app configuration or 7 | lifecycle methods assigned to a specific modal menu in config.fnl. 8 | {:key \"emacs\" 9 | :launch (fn [] (hs.alert \"Launched emacs\")) 10 | :activate (fn [] (hs.alert \"Entered emacs\")) 11 | :deactivate (fn [] (hs.alert \"Leave emacs\")) 12 | :exit (fn [] (hs.alert \"Closed emacs\"))} 13 | Meant for internal use only. 14 | " 15 | 16 | (fn do-method 17 | [obj method-name] 18 | " 19 | Takes a app menu table from config.fnl 20 | Calls the lifecycle function if a function instance or resolves it to an 21 | action if an action string was provided like \"lib.lifecycle:do-method\" 22 | Takes a config.fnl app table and a method name string to try and call. 23 | Returns the return value of calling the provided lifecycle function. 24 | " 25 | (let [method (. obj method-name)] 26 | (match (type method) 27 | :function (method obj) 28 | :string (do-action method [obj]) 29 | _ (do 30 | (log.wf "Could not call lifecycle method %s on %s" 31 | method-name 32 | obj))))) 33 | 34 | (fn activate-app 35 | [menu] 36 | "Calls :activate method on an app in config.fnl when focused on by user" 37 | (when (and menu menu.activate) 38 | (do-method menu :activate))) 39 | 40 | (fn close-app 41 | [menu] 42 | "Calls the :close method on an app in config.fnl when closed by the user" 43 | (when (and menu menu.close) 44 | (do-method menu :close))) 45 | 46 | (fn deactivate-app 47 | [menu] 48 | "Calls the :deactivate method on a config.fnl app when user blurs the app" 49 | (when (and menu menu.deactivate) 50 | (do-method menu :deactivate))) 51 | 52 | (fn enter-menu 53 | [menu] 54 | "Calls the :enter lifecycle method on a modal menu table in config.fnl" 55 | (when (and menu menu.enter) 56 | (do-method menu :enter))) 57 | 58 | (fn exit-menu 59 | [menu] 60 | "Calls the :exit lifecycle method on a modal menu table defined in config.fnl" 61 | (when (and menu menu.exit) 62 | (do-method menu :exit))) 63 | 64 | (fn launch-app 65 | [menu] 66 | "Calls the :launch app table in config.fnl when user opens the app." 67 | (when (and menu menu.launch) 68 | (do-method menu :launch))) 69 | 70 | {:activate-app activate-app 71 | :close-app close-app 72 | :deactivate-app deactivate-app 73 | :enter-menu enter-menu 74 | :exit-menu exit-menu 75 | :launch-app launch-app} 76 | -------------------------------------------------------------------------------- /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/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 {:align-columns align-columns} 28 | (require :lib.text)) 29 | (local {:action->fn action->fn 30 | :bind-keys bind-keys} 31 | (require :lib.bind)) 32 | (local lifecycle (require :lib.lifecycle)) 33 | 34 | (local log (hs.logger.new "modal.fnl" "debug")) 35 | (var fsm nil) 36 | (local default-style {:textFont "Menlo" 37 | :textSize 16 38 | :radius 0 39 | :strokeWidth 0}) 40 | (var style {}) 41 | 42 | 43 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 44 | ;; General Utils 45 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 46 | 47 | (fn timeout 48 | [f] 49 | " 50 | Create a pre-set timeout task that takes a function to run later. 51 | Takes a function to call after 2 seconds. 52 | Returns a function to destroy the timeout task. 53 | " 54 | (let [task (hs.timer.doAfter 2 f)] 55 | (fn destroy-task 56 | [] 57 | (when task 58 | (: task :stop) 59 | nil)))) 60 | 61 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 62 | ;; Action dispatch functions 63 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 64 | 65 | (fn activate-modal 66 | [menu-key] 67 | " 68 | API to enter the main menu. Only effective when in the idle state (with no 69 | modal on screen) 70 | Side effectful 71 | " 72 | (fsm.send :activate menu-key)) 73 | 74 | (fn enter-modal 75 | [menu-key] 76 | " 77 | API to transition to the active state of our modal finite state machine 78 | It is called by a trigger set on the outside world and provided relevant 79 | context to determine which menu modal to activate. 80 | Takes the name of a menu to activate or nil if it's the root menu. 81 | menu-key refers to either a submenu key in config.fnl or an application 82 | specific menu key. 83 | Side effectful 84 | " 85 | (fsm.send :enter menu-key)) 86 | 87 | 88 | (fn deactivate-modal 89 | [] 90 | " 91 | API to transition to the idle state of our modal finite state machine. 92 | Takes no arguments. 93 | Side effectful 94 | " 95 | (fsm.send :deactivate)) 96 | 97 | 98 | (fn previous-modal 99 | [] 100 | " 101 | API to transition to the previous modal in our history. Useful for returning 102 | to the main menu when in the window modal for instance. 103 | " 104 | (fsm.send :previous)) 105 | 106 | 107 | (fn start-modal-timeout 108 | [] 109 | " 110 | API for starting a menu timeout. Some menu actions like the window navigation 111 | actions can be repeated without having to re-enter into the Menu 112 | Modal > Window but we don't want to be listening for key events indefinitely. 113 | This begins a timeout that will close the modal and remove the key bindings 114 | after a time delay specified in the timout function. 115 | Takes no arguments. 116 | Side effectful 117 | " 118 | (fsm.send :start-timeout)) 119 | 120 | 121 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 122 | ;; Set Key Bindings 123 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 124 | 125 | (fn create-action-trigger 126 | [{:action action :repeatable repeatable :timeout timeout}] 127 | " 128 | Creates a function to dispatch an action associated with a menu item defined 129 | by config.fnl. 130 | Takes a table defining the following: 131 | 132 | action :: function | string - Either a string like \"module:function-name\" 133 | or a fennel function to call. 134 | repeatable :: bool | nil - If this action is repeatable like jumping between 135 | windows where we might wish to jump 2 windows 136 | left and it wouldn't want to re-enter the jump menu 137 | timeout :: bool | nil - If a timeout should be started. Defaults to true when 138 | repeatable is true. 139 | 140 | Returns a function to execute the action-fn async. 141 | " 142 | (let [action-fn (action->fn action)] 143 | (fn [] 144 | (if (and repeatable (~= timeout false)) 145 | (start-modal-timeout) 146 | (not repeatable) 147 | (deactivate-modal)) 148 | ;; Delay the action-fn ever so slightly 149 | ;; to speed up the closing of the menu 150 | ;; This makes the UI feel slightly snappier 151 | (hs.timer.doAfter 0.01 action-fn)))) 152 | 153 | 154 | (fn create-menu-trigger 155 | [{:key key}] 156 | " 157 | Takes a config menu option and returns a function to enter that submenu when 158 | action is activated. 159 | Returns a function to activate submenu. 160 | " 161 | (fn [] 162 | (enter-modal key))) 163 | 164 | 165 | (fn select-trigger 166 | [item] 167 | " 168 | Transform a menu item into an action to either call a function or enter a 169 | submenu. 170 | Takes a menu item from config.fnl 171 | Returns a function to perform the action associated with menu item. 172 | " 173 | (if (and item.action (= item.action :previous)) 174 | previous-modal 175 | item.action 176 | (create-action-trigger item) 177 | item.items 178 | (create-menu-trigger item) 179 | (fn [] 180 | (log.w "No trigger could be found for item: " 181 | (hs.inspect item))))) 182 | 183 | 184 | (fn bind-item 185 | [item] 186 | " 187 | Create a bindspec to map modal menu items to actions and submenus. 188 | Takes a menu item 189 | Returns a table to create a hs key binding. 190 | " 191 | {:mods (or item.mods []) 192 | :key item.key 193 | :action (select-trigger item)}) 194 | 195 | 196 | (fn bind-menu-keys 197 | [items] 198 | " 199 | Binds all actions and submenu items within a menu to VenueBook. 200 | Takes a list of modal menu items. 201 | Returns a function to remove menu key bindings for easy cleanup. 202 | " 203 | (-> items 204 | (->> (filter (fn [item] 205 | (or item.action 206 | item.items))) 207 | (map bind-item)) 208 | (concat [{:key :ESCAPE 209 | :action deactivate-modal} 210 | {:mods [:ctrl] 211 | :key "[" 212 | :action deactivate-modal}]) 213 | (bind-keys))) 214 | 215 | 216 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 217 | ;; Display Modals 218 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 219 | 220 | (local mod-chars {:cmd "CMD" 221 | :alt "OPT" 222 | :shift "SHFT" 223 | :tab "TAB"}) 224 | 225 | (fn format-key 226 | [item] 227 | " 228 | Format the key binding of a menu item to display in a modal menu to user 229 | Takes a modal menu item 230 | Returns a string describing the key 231 | " 232 | (let [mods (-?>> item.mods 233 | (map (fn [m] (or (. mod-chars m) m))) 234 | (join " ") 235 | (identity))] 236 | (.. (or mods "") 237 | (if mods " + " "") 238 | item.key))) 239 | 240 | 241 | (fn modal-alert 242 | [menu] 243 | " 244 | Display a menu modal in an hs.alert. 245 | Takes a menu table specified in config.fnl 246 | Opens an alert modal as a side effect 247 | Returns nil 248 | " 249 | (let [items (->> menu.items 250 | (filter (fn [item] item.title)) 251 | (map (fn [item] 252 | [(format-key item) (. item :title)])) 253 | (align-columns)) 254 | text (join "\n" items)] 255 | (hs.alert.closeAll) 256 | (alert text 257 | style 258 | 99999))) 259 | 260 | (fn show-modal-menu 261 | [state] 262 | " 263 | Main API to display a modal and run side-effects 264 | - Display the modal alert 265 | Takes current modal state from our modal statemachine 266 | Returns the function to cleanup everything it sets up 267 | " 268 | (lifecycle.enter-menu state.context.menu) 269 | (modal-alert state.context.menu) 270 | (let [unbind-keys (bind-menu-keys state.context.menu.items) 271 | stop-timeout state.context.stop-timeout] 272 | (fn [] 273 | (hs.alert.closeAll 0) 274 | (unbind-keys) 275 | (call-when stop-timeout) 276 | (lifecycle.exit-menu state.context.menu) 277 | ))) 278 | 279 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 280 | ;; Menus, & Config Navigation 281 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 282 | 283 | (fn by-key 284 | [target] 285 | " 286 | Checker function to filter menu items where key matches target 287 | Takes a target string to look for like \"window\" 288 | Returns true or false 289 | " 290 | (fn [item] 291 | (and (= (. item :key) target) 292 | (has-some? item.items)))) 293 | 294 | 295 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 296 | ;; State Transition Functions 297 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 298 | 299 | 300 | (fn ->menu 301 | [state action menu-key] 302 | " 303 | Enter a menu like entering into the Window menu from the default main menu. 304 | Enters the main menu when called from the idle state. 305 | Takes the current menu state table and the submenu key as 'extra'. 306 | Returns updated menu state 307 | " 308 | (let [{:config config 309 | :menu prev-menu} state.context 310 | app-menu (apps.get-app) 311 | menu (if menu-key 312 | (find (by-key menu-key) prev-menu.items) 313 | (if (and app-menu (has-some? app-menu.items)) 314 | app-menu 315 | config))] 316 | {:state {:current-state :active 317 | :context (merge state.context {:menu menu})} 318 | :effect :open-menu})) 319 | 320 | 321 | (fn active->idle 322 | [state action extra] 323 | " 324 | Transition our modal state machine from the active, open state to idle. 325 | Takes the current modal state table. 326 | Kicks off an effect to close the modal, stop the timeout, and unbind keys 327 | Returns updated modal state machine state table. 328 | " 329 | {:state {:current-state :idle 330 | :context (merge state.context {:menu :nil 331 | :history []})} 332 | :effect :close-modal-menu}) 333 | 334 | 335 | (fn ->enter-app 336 | [state action extra] 337 | " 338 | Transition our modal state machine the main menu to an app menu 339 | Takes the current modal state table and the app menu table. 340 | Displays updated modal menu if the current menu is different than the previous 341 | menu otherwise results in no operation 342 | Returns new modal state 343 | " 344 | (let [{:config config 345 | :menu prev-menu} state.context 346 | app-menu (apps.get-app) 347 | menu (if (and app-menu (has-some? app-menu.items)) 348 | app-menu 349 | config)] 350 | (if (= menu.key prev-menu.key) 351 | ; nil transition object means keep all state 352 | nil 353 | {:state {:current-state :active 354 | :context (merge state.context {:menu menu})} 355 | :effect :open-menu}))) 356 | 357 | 358 | (fn active->leave-app 359 | [state action extra] 360 | " 361 | Transition to the regular menu when user removes focus (blurs) another app. 362 | If the leave event was fired for the app we are already in, do nothing. 363 | Takes the current modal state table. 364 | Returns new updated modal state if we are leaving the current app. 365 | " 366 | (let [{:config config 367 | :menu prev-menu} state.context] 368 | (if (= prev-menu.key config.key) 369 | nil 370 | (->menu state)))) 371 | 372 | 373 | (fn add-timeout-transition 374 | [state action extra] 375 | " 376 | Transition from active to idle, but this transition only fires when the 377 | timeout occurs. The timeout is only started after firing a repeatable action. 378 | For instance if you enter window > jump east you may want to jump again 379 | without having to bring up the modal and enter the window submenu. We wait for 380 | more modal keypresses until the timeout triggers which will deactivate the 381 | modal. 382 | Takes the current modal state table. 383 | Returns a the old state with a :stop-timeout added 384 | " 385 | {:state {:current-state state.current-state 386 | :context 387 | (merge state.context {:stop-timeout (timeout deactivate-modal)})} 388 | :effect :open-menu}) 389 | 390 | (fn ->previous 391 | [state action extra] 392 | " 393 | Transition to the previous submenu. Like if you went into the window menu 394 | and wanted to go back to the main menu. 395 | Takes the modal state table. 396 | Returns a partial modal state table update. 397 | Dynamically calls another transition depending on history. 398 | " 399 | (let [{:config config 400 | :history hist 401 | :menu menu} state.context 402 | prev-menu (. hist (- (length hist) 1))] 403 | (if prev-menu 404 | {:state {:current-state :active 405 | :context (merge state.context {:menu prev-menu 406 | :history (butlast hist)})} 407 | :effect :open-menu} 408 | (->menu state)))) 409 | 410 | 411 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 412 | ;; Finite State Machine States 413 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 414 | 415 | 416 | ;; State machine states table. Maps states to actions to transition functions. 417 | ;; These transition functions return transition objects that contain the new 418 | ;; state key and context. 419 | (local states 420 | {:idle {:activate ->menu} 421 | :active {:deactivate active->idle 422 | :enter ->menu 423 | :start-timeout add-timeout-transition 424 | :previous ->previous 425 | :enter-app ->enter-app}}) 426 | 427 | 428 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 429 | ;; Watchers, Dispatchers, & Logging 430 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 431 | 432 | 433 | (fn start-logger 434 | [fsm] 435 | " 436 | Start logging the status of the modal state machine. 437 | Takes our finite state machine. 438 | Returns nil 439 | Creates a watcher of our state atom to log state changes reactively. 440 | " 441 | (atom.add-watch 442 | fsm.state :log-state 443 | (fn log-state 444 | [state] 445 | (when state.context.history 446 | (log.df (hs.inspect (map #(. $1 :title) state.context.history))))))) 447 | 448 | (local modal-effect 449 | (statemachine.effect-handler 450 | {:open-menu show-modal-menu})) 451 | 452 | (fn proxy-app-action 453 | [[action data]] 454 | " 455 | Provide a semi-public API function for other state machines to dispatch 456 | changes to the modal menu state. Currently used by the app state machine to 457 | tell the modal menu state machine when an app is launched, activated, 458 | deactivated, or exited. 459 | Executes a side-effect 460 | Returns nil 461 | " 462 | (fsm.send action data)) 463 | 464 | 465 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 466 | ;; Initialization 467 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 468 | 469 | (fn init 470 | [config] 471 | " 472 | Initialize the modal state machine responsible for displaying modal alerts 473 | to the user to trigger actions defined by their config.fnl. 474 | Takes the config.fnl table. 475 | Causes side effects to start the state machine, show the modal, and logging. 476 | Returns a function to unsubscribe from the app state machine. 477 | " 478 | (let [initial-context {:config config 479 | :history [] 480 | :menu :nil} 481 | template {:state {:current-state :idle 482 | :context initial-context} 483 | :states states 484 | :log "modal"} 485 | unsubscribe (apps.subscribe proxy-app-action)] 486 | (set style (merge default-style (?. config :modal-style))) 487 | (set fsm (statemachine.new template)) 488 | (fsm.subscribe modal-effect) 489 | (start-logger fsm) 490 | (fn cleanup [] 491 | (unsubscribe)))) 492 | 493 | 494 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 495 | ;; Exports 496 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 497 | 498 | 499 | {: init 500 | : activate-modal} 501 | -------------------------------------------------------------------------------- /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 {: butlast 44 | : call-when 45 | : concat 46 | : conj 47 | : last 48 | : merge 49 | : slice} (require :lib.functional)) 50 | 51 | 52 | (fn update-state 53 | [fsm state] 54 | (atom.swap! fsm.state (fn [_ state] state) state)) 55 | 56 | (fn get-transition-function 57 | [fsm current-state action] 58 | (. fsm.states current-state action)) 59 | 60 | (fn get-state 61 | [fsm] 62 | (atom.deref fsm.state)) 63 | 64 | (fn send 65 | [fsm action extra] 66 | " 67 | Based on the action and the fsm's current-state, set the new state and call 68 | all subscribers with the previous state, new state, action, and extra. 69 | " 70 | (let [state (get-state fsm) 71 | {: current-state : context} state] 72 | (if-let [tx-fn (get-transition-function fsm current-state action)] 73 | (let [ 74 | transition (tx-fn state action extra) 75 | new-state (if transition transition.state state) 76 | effect (if transition transition.effect nil)] 77 | 78 | (update-state fsm new-state) 79 | ; Call all subscribers 80 | (each [_ sub (pairs (atom.deref fsm.subscribers))] 81 | (sub {:prev-state state :next-state new-state : action : effect : extra})) 82 | true) 83 | (do 84 | (if fsm.log 85 | (fsm.log.df "Action :%s does not have a transition function in state :%s" 86 | action current-state)) 87 | false)))) 88 | 89 | (fn subscribe 90 | [fsm sub] 91 | " 92 | Adds a subscriber to the provided fsm. Returns a function to unsubscribe 93 | Naive: Because each entry is keyed by the function address it doesn't allow 94 | the same function to subscribe more than once. 95 | " 96 | (let [sub-key (tostring sub)] 97 | (atom.swap! fsm.subscribers (fn [subs sub] 98 | (merge {sub-key sub} subs)) sub) 99 | ; Return the unsub func 100 | (fn [] 101 | (atom.swap! fsm.subscribers (fn [subs key] (tset subs key nil) subs) sub-key)))) 102 | 103 | (fn effect-handler 104 | [effect-map] 105 | " 106 | Takes a map of effect->function and returns a function that handles these 107 | effects by calling the mapped-to function, and then calls that function's 108 | return value (a cleanup function) and calls it on the next transition. 109 | 110 | These functions must return their own cleanup function or nil. 111 | " 112 | ;; Create a one-time atom used to store the cleanup function 113 | (let [cleanup-ref (atom.new nil)] 114 | ;; Return a subscriber function 115 | (fn [{: prev-state : next-state : action : effect : extra}] 116 | ;; Whenever a transition occurs, call the cleanup function, if set 117 | (call-when (atom.deref cleanup-ref)) 118 | ;; Get a new cleanup function or nil and update cleanup-ref atom 119 | (atom.reset! 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 :context template.state.context}) 125 | :states template.states 126 | :subscribers (atom.new {}) 127 | :log (if template.log (hs.logger.new template.log "info"))}] 128 | ; Add methods 129 | (tset fsm :get-state (partial get-state fsm)) 130 | (tset fsm :send (partial send fsm)) 131 | (tset fsm :subscribe (partial subscribe fsm)) 132 | fsm)) 133 | 134 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 135 | ;; Exports 136 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 137 | 138 | {: effect-handler 139 | : send 140 | : subscribe 141 | :new create-machine} 142 | -------------------------------------------------------------------------------- /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 them so all can use them in `each` 33 | (assert (and 34 | ; Ensure all keys in actual are in expected 35 | (every? (fn [k v] (= v (. expected k))) #(pairs actual)) 36 | ; Ensure all keys in expected are in actual, to ensure expected isn't just a superset 37 | (every? (fn [k v] (= v (. actual k))) #(pairs expected))) 38 | (.. message " expected " (hs.inspect expected) " instead got " (hs.inspect actual))) 39 | (assert false (.. message " expected two tables but got " 40 | (type actual) " and " (type expected))))) 41 | 42 | (fn exports.ok? 43 | [actual message] 44 | (assert (= (not (not actual)) true) (.. message " instead got " (hs.inspect actual)))) 45 | 46 | exports 47 | -------------------------------------------------------------------------------- /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 | (do 67 | (tset state :failed (+ state.failed 1)) 68 | (print (.. " " (red "[ FAIL ]") "\n")) 69 | (print (debug.traceback err) "\n"))))] 70 | (if ok 71 | (do 72 | (print (.. " " (green "[ OK ]") "\n")) 73 | (tset state :passed (+ state.passed 1))) 74 | ))) 75 | 76 | (fn init 77 | [] 78 | (set suites []) 79 | (set state {:suite nil 80 | :before [] 81 | :after [] 82 | :ran 0 83 | :failed 0 84 | :passed 0})) 85 | 86 | (fn run-all-tests 87 | [] 88 | (print "") 89 | (let [start (os.clock)] 90 | (each [i before-f (ipairs state.before)] 91 | (before-f)) 92 | (each [i suite-map (ipairs suites)] 93 | (print suite-map.name "\n") 94 | (each [i before-f (ipairs suite-map.before)] 95 | (before-f)) 96 | (each [_ test-map (ipairs suite-map.tests)] 97 | (print (.. " " test-map.desc " ... \t")) 98 | (try-test test-map.test) 99 | (tset state :ran (+ state.ran 1))) 100 | (each [i after-f (ipairs suite-map.after)] 101 | (after-f))) 102 | (each [i after-f (ipairs state.after)] 103 | (after-f)) 104 | (let [end (os.clock) 105 | elapsed (- end start)] 106 | (print (.. "\n Ran " state.ran " tests " (green state.passed) " passed " (red state.failed) " failed in " elapsed " seconds")) 107 | (when (> state.failed 0) 108 | (error "Tests failed"))))) 109 | 110 | {: init 111 | : suites 112 | : after 113 | : before 114 | : it 115 | : describe 116 | : collect-tests 117 | : run-all-tests} 118 | -------------------------------------------------------------------------------- /lib/testing/test-runner.fnl: -------------------------------------------------------------------------------- 1 | (local fennel (require :fennel)) 2 | (require :lib.globals) 3 | (local {: map 4 | : slice 5 | : pprint} (require :lib.functional)) 6 | 7 | (local homedir (os.getenv "HOME")) 8 | (local customdir (.. homedir "/.spacehammer")) 9 | (tset fennel :path (.. customdir "/?.fnl;" fennel.path)) 10 | (tset fennel :path (.. customdir "/?/init.fnl;" fennel.path)) 11 | 12 | ;; Setup some globals for test files and debugging 13 | 14 | 15 | (global {: after 16 | : before 17 | : describe 18 | : it} (require :lib.testing)) 19 | 20 | ;; Pull in some locals from the testing library as well 21 | 22 | (local {: init 23 | : collect-tests 24 | : run-all-tests} (require :lib.testing)) 25 | 26 | (fn load-tests 27 | [args] 28 | 29 | " 30 | Takes a list of args starting with a directory 31 | Runs each test file using fennel.dofile 32 | " 33 | (init) 34 | (let [[dir & test-files] (slice 2 args)] 35 | (each [i test-file (ipairs test-files)] 36 | (let [test-file-path (hs.fs.pathToAbsolute (.. dir "/" test-file))] 37 | (print "Running tests for" test-file-path) 38 | (fennel.dofile test-file-path)) 39 | )) 40 | 41 | 42 | (collect-tests) 43 | (run-all-tests)) 44 | 45 | 46 | {: load-tests} 47 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 :Emacs {:allowRoles [:AXUnknown :AXStandardWindow :AXDialog :AXSystemDialog]}))) 8 | 9 | {:global-filter global-filter} 10 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /repl.fnl: -------------------------------------------------------------------------------- 1 | (local coroutine (require :coroutine)) 2 | (local fennel (require :fennel)) 3 | (local jeejah (require :jeejah)) 4 | (local {:merge merge} (require :lib.functional)) 5 | 6 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 | ;; nREPL support 8 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 9 | 10 | ;; This module adds support to start an nREPL server. This allows a client to 11 | ;; connect to the running server and interact with it while it is running, which 12 | ;; can help avoid repeatedly reloading the config. 13 | ;; 14 | ;; Example usage: 15 | ;; 16 | ;; - To your ~/.spacehammer/config.fnl add: 17 | ;; (local repl (require :repl)) 18 | ;; (repl.run (repl.start)) 19 | ;; 20 | ;; repl.start takes an optional 'opts' table with the following fields: 21 | ;; - host: Define the host to listen on (default "localhost") 22 | ;; - port: Define the port to listen on (default 7888) 23 | ;; - fennel: Expect fennel code (as opposed to lua) (default true) 24 | ;; - serialize: Provide a function that converts objects to strings 25 | ;; (default hs.inspect) 26 | 27 | (fn fennel-middleware 28 | [f msg] 29 | (match msg.op 30 | "load-file" (let [f (assert (io.open msg.filename "rb"))] 31 | (tset msg 32 | :op "eval" 33 | :code (-> f 34 | (: :read "*all") 35 | (: :gsub "^#![^\n]*\n" ""))) 36 | (: f :close)) 37 | _ (f msg))) 38 | 39 | (local default-opts 40 | {:port nil 41 | :fennel true 42 | :middleware fennel-middleware 43 | :serialize hs.inspect}) 44 | 45 | (local repl-coro-freq 0.05) 46 | 47 | (fn run 48 | [server] 49 | (let [repl-coro server 50 | repl-spin (fn [] (coroutine.resume repl-coro)) 51 | repl-chk (fn [] (not= (coroutine.status repl-coro) "dead"))] 52 | (hs.timer.doWhile repl-chk repl-spin repl-coro-freq))) 53 | 54 | (fn start 55 | [custom-opts] 56 | (let [opts (merge {} default-opts custom-opts) 57 | server (jeejah.start opts.port opts)] 58 | server)) 59 | 60 | (fn stop 61 | [server] 62 | (jeejah.stop server)) 63 | 64 | {: run 65 | : start 66 | : stop} 67 | -------------------------------------------------------------------------------- /run-test: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | exec hs ./lib/testing/test.lua "$(pwd)" "$@" 4 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /vim.fnl: -------------------------------------------------------------------------------- 1 | (local atom (require :lib.atom)) 2 | (local {: call-when 3 | : contains? 4 | : eq? 5 | : filter 6 | : find 7 | : get-in 8 | : has-some? 9 | : map 10 | : noop 11 | : some} (require :lib.functional)) 12 | (local statemachine (require :lib.statemachine)) 13 | (local {:bind-keys bind-keys} (require :lib.bind)) 14 | (local log (hs.logger.new "vim.fnl" "debug")) 15 | 16 | " 17 | Create a vim mode for any text editor! 18 | - Modal editing like NORMAL, VISUAL, and INSERT mode. 19 | - vim key navigation like hjkl 20 | - Displays a box to display which mode you are in 21 | - Largely experimental 22 | 23 | TODO: Create another state machine system to support key chords for bindings 24 | like gg -> scroll to top of document. 25 | - Should work a lot like the menu modal state machine where you can 26 | endlessly enter recursive submenus 27 | " 28 | 29 | (var fsm nil) 30 | 31 | ;; Box shapes for displaying current mode 32 | (local shape {:x 900 33 | :y 900 34 | :h 40 35 | :w 180}) 36 | (local text (hs.drawing.text shape "")) 37 | (local box (hs.drawing.rectangle shape)) 38 | 39 | (: text :setBehaviorByLabels [:canJoinAllSpaces 40 | :transient]) 41 | 42 | (: box :setBehaviorByLabels [:canJoinAllSpaces 43 | :transient]) 44 | 45 | (: text :setLevel :overlay) 46 | (: box :setLevel :overlay) 47 | 48 | 49 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 50 | ;; Action dispatch functions 51 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 52 | 53 | (fn disable 54 | [] 55 | (when fsm 56 | (fsm.send :disable))) 57 | 58 | (fn enable 59 | [] 60 | (when fsm 61 | (fsm.send :enable))) 62 | 63 | (fn normal 64 | [] 65 | (when fsm 66 | (fsm.send :normal))) 67 | 68 | (fn visual 69 | [] 70 | (when fsm 71 | (fsm.send :visual))) 72 | 73 | (fn insert 74 | [] 75 | (when fsm 76 | (fsm.send :insert))) 77 | 78 | 79 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 80 | ;; Helpers, Utils & Config 81 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 82 | 83 | (var ignore-fx false) 84 | 85 | (fn keystroke 86 | [target-mods target-key] 87 | (set ignore-fx true) 88 | (hs.eventtap.keyStroke (or target-mods []) target-key 10000) 89 | (hs.timer.doAfter 0.1 (fn [] (set ignore-fx false)))) 90 | 91 | (fn key-fn 92 | [target-mods target-key] 93 | (fn [] (keystroke target-mods target-key))) 94 | 95 | (local bindings 96 | {:normal [{:key :h 97 | :action (key-fn [] :left) 98 | :repeat true} 99 | {:key :j 100 | :action (key-fn [] :down) 101 | :repeat :true} 102 | {:key :k 103 | :action (key-fn [] :up) 104 | :repeat true} 105 | {:key :l 106 | :action (key-fn [] :right) 107 | :repeat true} 108 | {:mods [:shift] 109 | :key :i 110 | :action (fn [] 111 | (insert) 112 | (keystroke [:ctrl] :a))} 113 | {:key :i 114 | :action insert} 115 | {:key :a 116 | :action (fn [] 117 | (insert) 118 | (keystroke nil :right))} 119 | {:mods [:shift] 120 | :key :a 121 | :action (fn [] 122 | (insert) 123 | (keystroke [:ctrl] :e))} 124 | {:key :v 125 | :action visual} 126 | {:mods [:shift] 127 | :key :v 128 | :action (fn [] 129 | (keystroke [:cmd] :left) 130 | (keystroke [:shift :cmd] :right) 131 | (visual))} 132 | {:key :/ 133 | :action (key-fn [:cmd] :f)} 134 | {:key :x 135 | :action (key-fn nil :forwarddelete)} 136 | {:key :o 137 | :action (fn [] 138 | (keystroke [:cmd] :right) 139 | (keystroke [:alt] :return) 140 | (insert))} 141 | {:mods [:shift] 142 | :key :o 143 | :action (fn [] 144 | (keystroke [:cmd] :left) 145 | (keystroke [:alt] :return) 146 | (keystroke nil :left) 147 | (insert))} 148 | {:key :p 149 | :action (key-fn [:cmd] :v)} 150 | {:key :0 151 | :action (key-fn [:cmd] :left)} 152 | {:mods [:shift] 153 | :key :4 154 | :action (key-fn [:cmd] :right)} 155 | {:mods [:ctrl] 156 | :key :u 157 | :action (key-fn nil :pageup)} 158 | {:mods [:ctrl] 159 | :key :d 160 | :action (key-fn nil :pagedown)} 161 | {:mods [:shift] 162 | :key :g 163 | :action (key-fn [:cmd] :down)} 164 | {:key :b 165 | :action (key-fn [:alt] :left)} 166 | {:key :w 167 | :action (fn [] 168 | (keystroke [:alt] :right) 169 | (keystroke nil :right))} 170 | {:key :u 171 | :action (key-fn [:cmd] :z)} 172 | {:mods [:ctrl] 173 | :key :r 174 | :action (key-fn [:cmd :shift] :z)} 175 | {:key :c 176 | :action (fn [] 177 | (keystroke [] :forwarddelete) 178 | (insert))} 179 | {:mods [:shift] 180 | :key :d 181 | :action (fn [] 182 | (keystroke [:cmd] :left) 183 | (keystroke [:shift :cmd] :right) 184 | (keystroke nil :delete) 185 | (keystroke nil :delete))} 186 | {:mods [:shift] 187 | :key :c 188 | :action (fn [] 189 | (keystroke [:cmd] :left) 190 | (keystroke [:shift :cmd] :right) 191 | (keystroke nil :delete) 192 | (insert))} 193 | {:key :s 194 | :action (fn [] 195 | (keystroke nil :forwarddelete) 196 | (insert))} 197 | {:mods [:ctrl] 198 | :key :h 199 | :action "windows:jump-window-left"} 200 | {:mods [:ctrl] 201 | :key :j 202 | :action "windows:jump-window-below"} 203 | {:mods [:ctrl] 204 | :key :k 205 | :action "windows:jump-window-above"} 206 | {:mods [:ctrl] 207 | :key :l 208 | :action "windows:jump-window-right"}] 209 | :insert [{:key :ESCAPE 210 | :action normal}] 211 | :visual [{:key :ESCAPE 212 | :action (fn [] 213 | (keystroke nil :left) 214 | (normal))} 215 | {:key :h 216 | :action (key-fn [:shift] :left)} 217 | {:key :j 218 | :action (key-fn [:shift] :down)} 219 | {:key :k 220 | :action (key-fn [:shift] :up)} 221 | {:key :l 222 | :action (key-fn [:shift] :right)} 223 | {:key :y 224 | :action (key-fn [:cmd] :c)} 225 | {:key :x 226 | :action (key-fn nil :delete)} 227 | {:key :c 228 | :action (fn [] 229 | (keystroke [] :delete) 230 | (insert))} 231 | {:key :b 232 | :action (key-fn [:shift :alt] :left)} 233 | {:key :w 234 | :action (fn [] 235 | (keystroke [:shift :alt] :right) 236 | (keystroke [:shift] :right))} 237 | {:key :0 238 | :action (key-fn [:shift :cmd] :left)} 239 | {:mods [:shift] 240 | :key :4 241 | :action (key-fn [:shift :cmd] :right)}]}) 242 | 243 | (fn create-screen-watcher 244 | [f] 245 | (let [watcher (hs.screen.watcher.newWithActiveScreen f)] 246 | (: watcher :start) 247 | (fn destroy [] 248 | (: watcher :stop)))) 249 | 250 | (fn state-box 251 | [label] 252 | (let [frame (: (hs.screen.mainScreen) :fullFrame) 253 | x frame.x 254 | y frame.y 255 | width frame.w 256 | height frame.h 257 | coords {:x (+ x (- width shape.w)) 258 | :y (+ y (- height shape.h)) 259 | :h shape.h 260 | :w shape.w}] 261 | (: box :setFillColor {:hex "#000" 262 | :alpha 0.8}) 263 | (: box :setFill true) 264 | (: text :setTextColor {:hex "#FFF" 265 | :alpha 1.0}) 266 | (: text :setFrame coords) 267 | (: box :setFrame coords) 268 | (: text :setText label) 269 | (if (= label :Normal) 270 | (: text :setTextColor {:hex "#999" 271 | :alpha 0.8}) 272 | (= label :Insert) 273 | (: text :setTextColor {:hex "#0F0" 274 | :alpha 0.8}) 275 | (= label :Visual) 276 | (: text :setTextColor {:hex "#F0F" 277 | :alpha 0.8})) 278 | (: text :setTextStyle {:alignment :center}) 279 | (: box :show) 280 | (: text :show)) 281 | box) 282 | 283 | 284 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 285 | ;; Side Effects 286 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 287 | 288 | (fn enter-normal-mode 289 | [state extra] 290 | (state-box "Normal") 291 | (bind-keys bindings.normal)) 292 | 293 | (fn enter-insert-mode 294 | [state extra] 295 | (state-box "Insert") 296 | (bind-keys bindings.insert)) 297 | 298 | (fn enter-visual-mode 299 | [state extra] 300 | (state-box "Visual") 301 | (bind-keys bindings.visual)) 302 | 303 | (fn disable-vim-mode 304 | [state extra] 305 | (: box :hide) 306 | (: text :hide)) 307 | 308 | (local vim-effect 309 | (statemachine.effect-handler 310 | {:enter-normal-mode enter-normal-mode 311 | :enter-insert-mode enter-insert-mode 312 | :enter-visual-mode enter-visual-mode 313 | :disable-vim-mode disable-vim-mode})) 314 | 315 | 316 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 317 | ;; Transitions 318 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 319 | 320 | (fn disabled->normal 321 | [state data] 322 | (when (get-in [:context :config :vim :enabled] state) 323 | {:state {:current-state :normal 324 | :context state.context} 325 | :effect :enter-normal-mode})) 326 | 327 | (fn normal->insert 328 | [state data] 329 | {:state {:current-state :insert 330 | :context state.context} 331 | :effect :enter-insert-mode}) 332 | 333 | (fn normal->visual 334 | [state data] 335 | {:state {:current-state :visual 336 | :context state.context} 337 | :effect :enter-visual-mode}) 338 | 339 | (fn ->disabled 340 | [state data] 341 | {:state {:current-state :disabled 342 | :context state.context} 343 | :effect :disable-vim-mode}) 344 | 345 | (fn insert->normal 346 | [state data] 347 | {:state {:current-state :normal 348 | :context state.context} 349 | :effect :enter-normal-mode}) 350 | 351 | (fn visual->normal 352 | [state data] 353 | {:state {:current-state :normal 354 | :context state.context} 355 | :effect :enter-normal-mode}) 356 | 357 | 358 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 359 | ;; States 360 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 361 | 362 | (local states 363 | {:disabled {:enable disabled->normal} 364 | :normal {:insert normal->insert 365 | :visual normal->visual 366 | :disable ->disabled} 367 | :insert {:normal insert->normal 368 | :disable ->disabled} 369 | :visual {:normal visual->normal 370 | :disable ->disabled}}) 371 | 372 | 373 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 374 | ;; Watchers & Logging 375 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 376 | 377 | (fn log-updates 378 | [fsm] 379 | (atom.add-watch fsm.state :logger 380 | (fn [state] 381 | (log.f "Vim mode: %s" state.current-state)))) 382 | 383 | (fn watch-screen 384 | [fsm active-screen-changed] 385 | (let [state (atom.deref fsm.state)] 386 | (when (~= state.current-state :disabled) 387 | (state-box state.current-state)))) 388 | 389 | ;; (fn log-key 390 | ;; [event] 391 | ;; (let [key-code (: event :getKeyCode) 392 | ;; flags (: event :getFlags) 393 | ;; key-char (. hs.keycodes.map key-code)] 394 | ;; (values false {}))) 395 | 396 | ;; (let [types hs.eventtap.event.types 397 | ;; tap (hs.eventtap.new [types.keyDown] 398 | ;; log-key)] 399 | ;; (: tap :start)) 400 | 401 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 402 | ;; Initialize 403 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 404 | 405 | (fn init 406 | [config] 407 | " 408 | Initialize vim mode only enables it if {:vim {:enabled true}} is in config.fnl 409 | Takes config.fnl table 410 | Performs side-effects: 411 | - Creates a state machine to track which mode we are in and switch bindings 412 | accordingly 413 | - Creates a screen watcher so it can move the mode UI to the currently active 414 | screen. 415 | Returns function to cleanup watcher resources 416 | " 417 | (let [template {:state {:current-state :disabled 418 | :context {:config config}} 419 | :states states} 420 | _fsm (statemachine.new template) 421 | stop-screen-watcher (create-screen-watcher 422 | (partial watch-screen _fsm))] 423 | (set fsm _fsm) 424 | (fsm.subscribe vim-effect) 425 | (log-updates fsm) 426 | (when (get-in [:vim :enabled] config) 427 | (enable)) 428 | (fn [] 429 | (stop-screen-watcher)))) 430 | 431 | 432 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 433 | ;; Exports 434 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 435 | 436 | {: init 437 | : disable 438 | : enable} 439 | -------------------------------------------------------------------------------- /windows.fnl: -------------------------------------------------------------------------------- 1 | (local {: filter 2 | : get-in 3 | : count 4 | : concat 5 | : contains? 6 | : map 7 | : for-each 8 | : split} (require :lib.functional)) 9 | (local {:global-filter global-filter} (require :lib.utils)) 10 | (local {:atom atom 11 | :deref deref 12 | :swap! swap! 13 | :reset! reset!} (require :lib.atom)) 14 | (require-macros :lib.advice.macros) 15 | 16 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 17 | ;; History 18 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 19 | 20 | (global history {}) 21 | 22 | (fn history.push 23 | [self] 24 | " 25 | Append current window frame geometry to history. 26 | self refers to history table instance 27 | " 28 | (let [win (hs.window.focusedWindow) 29 | id (when win (win:id)) 30 | tbl (. self id)] 31 | (when win 32 | (if (= (type tbl) :nil) 33 | (tset self id [(win:frame)]) 34 | (let [last-el (. tbl (length tbl))] 35 | (when (~= last-el (win:frame)) 36 | (table.insert tbl (win:frame)))))))) 37 | 38 | (fn history.pop 39 | [self] 40 | " 41 | Go back to previous window frame geometry in history. 42 | self refers to history table instance 43 | " 44 | (let [win (hs.window.focusedWindow) 45 | id (when win (win:id)) 46 | tbl (. self id)] 47 | (when (and win tbl) 48 | (let [el (table.remove tbl) 49 | num-of-undos (length tbl)] 50 | (if el 51 | (do 52 | (win:setFrame el) 53 | (when (< 0 num-of-undos) 54 | (alert (.. num-of-undos " undo steps available")))) 55 | (alert "nothing to undo")))))) 56 | 57 | (fn undo 58 | [] 59 | (: history :pop)) 60 | 61 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 62 | ;; Shared Functions 63 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 64 | 65 | (defn highlight-active-window 66 | [] 67 | " 68 | Draw a border around the active window for a short period to highlight 69 | " 70 | (let [rect (hs.drawing.rectangle (: (hs.window.focusedWindow) :frame))] 71 | (: rect :setStrokeColor {:red 1 :blue 0 :green 1 :alpha 1}) 72 | (: rect :setStrokeWidth 5) 73 | (: rect :setFill false) 74 | (: rect :show) 75 | (hs.timer.doAfter .3 (fn [] (: rect :delete))))) 76 | 77 | (fn maximize-window-frame 78 | [] 79 | (: history :push) 80 | (: (hs.window.focusedWindow) :maximize 0) 81 | (highlight-active-window)) 82 | 83 | (defn position-window-center 84 | [ratio-str window screen] 85 | " 86 | Takes the center-ratio key from config, or default value if not 87 | provided, and the window center-window-frame was called with, 88 | and the current screen. 89 | Should calculate the centered dimensions of the target window 90 | using the ratio values 91 | This function is advisable. 92 | " 93 | (let [frame (: screen :fullFrame) 94 | [w-percent h-percent] (split ":" ratio-str) 95 | w-percent (/ (tonumber w-percent) 100) 96 | h-percent (/ (tonumber h-percent) 100) 97 | update {:w (* w-percent frame.w) 98 | :h (* h-percent frame.h) 99 | :x 0 100 | :y 0}] 101 | (doto window 102 | (: :setFrameInScreenBounds update) 103 | (: :centerOnScreen)) 104 | (highlight-active-window))) 105 | 106 | (fn center-window-frame 107 | [] 108 | (: history :push) 109 | (let [win (hs.window.focusedWindow) 110 | prev-duration hs.window.animationDuration 111 | config (get-config) 112 | ratio (or (?. config :modules :windows :center-ratio) "80:50") 113 | screen (hs.screen.primaryScreen)] 114 | (tset hs.window :animationDuration 0) 115 | (position-window-center ratio win screen) 116 | (tset hs.window :animationDuration prev-duration))) 117 | 118 | (fn activate-app 119 | [app-name] 120 | (hs.application.launchOrFocus app-name) 121 | (let [app (hs.application.find app-name)] 122 | (when app 123 | (: app :activate) 124 | (hs.timer.doAfter .05 highlight-active-window) 125 | (: app :unhide)))) 126 | 127 | (fn set-mouse-cursor-at 128 | [app-title] 129 | (let [sf (: (: (hs.application.find app-title) :focusedWindow) :frame) 130 | desired-point (hs.geometry.point (- (+ sf._x sf._w) 131 | (/ sf._w 2)) 132 | (- (+ sf._y sf._h) 133 | (/ sf._h 2)))] 134 | (hs.mouse.setAbsolutePosition desired-point))) 135 | 136 | (fn show-grid 137 | [] 138 | (: history :push) 139 | (hs.grid.show)) 140 | 141 | (fn jump-to-last-window 142 | [] 143 | (-> (global-filter) 144 | (: :getWindows hs.window.filter.sortByFocusedLast) 145 | (. 2) 146 | (: :focus))) 147 | 148 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 149 | ;; Jumping Windows 150 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 151 | 152 | (fn jump-window 153 | [arrow] 154 | " 155 | Navigate to the window nearest the current active window 156 | For instance if you open up emacs to the left of a web browser, activate 157 | emacs, then run (jump-window :l) hammerspoon will move active focus 158 | to the browser. 159 | Takes an arrow like :h :j :k :l to support vim key bindings. 160 | Performs side effects 161 | Returns nil 162 | " 163 | (let [dir {:h "West" :j "South" :k "North" :l "East"} 164 | frontmost-win (hs.window.frontmostWindow) 165 | focus-dir (.. :focusWindow (. dir arrow))] 166 | (: hs.window.filter.defaultCurrentSpace focus-dir frontmost-win true true) 167 | (highlight-active-window))) 168 | 169 | (fn jump-window-left 170 | [] 171 | (jump-window :h)) 172 | 173 | (fn jump-window-above 174 | [] 175 | (jump-window :j)) 176 | 177 | (fn jump-window-below 178 | [] 179 | (jump-window :k)) 180 | 181 | (fn jump-window-right 182 | [] 183 | (jump-window :l)) 184 | 185 | (fn allowed-app? 186 | [window] 187 | (if (: window :isStandard) 188 | true 189 | false)) 190 | 191 | (fn jump [] 192 | " 193 | Displays hammerspoon's window jump UI 194 | " 195 | (let [wns (->> (hs.window.allWindows) 196 | (filter allowed-app?))] 197 | (hs.hints.windowHints wns nil true))) 198 | 199 | 200 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 201 | ;; Movement\Resizing Constants 202 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 203 | 204 | (local 205 | arrow-map 206 | {:k {:half [0 0 1 .5] :movement [ 0 -20] :resize "Shorter"} 207 | :j {:half [0 .5 1 .5] :movement [ 0 20] :resize "Taller"} 208 | :h {:half [0 0 .5 1] :movement [-20 0] :resize "Thinner"} 209 | :l {:half [.5 0 .5 1] :movement [ 20 0] :resize "Wider"}}) 210 | 211 | (fn grid 212 | [method direction] 213 | " 214 | Moves, expands, or shrinks the active window by the next grid dimension. Grid 215 | settings are specified in config.fnl. 216 | " 217 | (let [fn-name (.. method direction) 218 | f (. hs.grid fn-name)] 219 | (f (hs.window.focusedWindow)))) 220 | 221 | 222 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 223 | ;; Resize window by half 224 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 225 | 226 | (fn rect 227 | [rct] 228 | " 229 | Change a window's rect geometry which includes x, y, width, and height 230 | Takes a rectangle table 231 | Performs side-effects to move or resize the active window and update history. 232 | Returns nil 233 | " 234 | (: history :push) 235 | (let [win (hs.window.focusedWindow)] 236 | (when win (: win :move rct)))) 237 | 238 | (fn resize-window-halve 239 | [arrow] 240 | " 241 | Resize a window by half the grid dimensions specified in config.fnl. 242 | Takes an :h :j :k or :l arrow 243 | Performs a side effect to resize the active window's frame rect 244 | Returns nil 245 | " 246 | (: history :push) 247 | (rect (. arrow-map arrow :half))) 248 | 249 | (fn resize-half-left 250 | [] 251 | (resize-window-halve :h)) 252 | 253 | (fn resize-half-right 254 | [] 255 | (resize-window-halve :l)) 256 | 257 | (fn resize-half-top 258 | [] 259 | (resize-window-halve :k)) 260 | 261 | (fn resize-half-bottom 262 | [] 263 | (resize-window-halve :j)) 264 | 265 | 266 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 267 | ;; Resize window by increments 268 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 269 | 270 | (fn resize-by-increment 271 | [arrow] 272 | " 273 | Resize the active window by the next window increment 274 | Let's say we make the grid dimensions 4x4 and we place a window in the 1x1 275 | meaning first column in the first row. 276 | We then resize an increment right. The dimensions would now be 2x1 277 | 278 | Takes an arrow like :h :j :k :l 279 | Performs a side-effect to resize the current window to the next grid increment 280 | Returns nil 281 | " 282 | (let [directions {:h "Left" 283 | :j "Down" 284 | :k "Up" 285 | :l "Right"}] 286 | (: history :push) 287 | (when (or (= arrow :h) (= arrow :l)) 288 | (hs.grid.resizeWindowThinner (hs.window.focusedWindow))) 289 | (when (or (= arrow :j) (= arrow :k)) 290 | (hs.grid.resizeWindowShorter (hs.window.focusedWindow))) 291 | (grid :pushWindow (. directions arrow)))) 292 | 293 | (fn resize-inc-left 294 | [] 295 | (resize-by-increment :h)) 296 | 297 | (fn resize-inc-bottom 298 | [] 299 | (resize-by-increment :j)) 300 | 301 | (fn resize-inc-top 302 | [] 303 | (resize-by-increment :k)) 304 | 305 | (fn resize-inc-right 306 | [] 307 | (resize-by-increment :l)) 308 | 309 | 310 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 311 | ;; Resize windows 312 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 313 | 314 | (fn resize-window 315 | [arrow] 316 | " 317 | Resizes a window against the grid specifed in config.fnl 318 | Takes an arrow string like :h :k :j :l 319 | Performs a side effect to resize the current window. 320 | Returns nil 321 | " 322 | (: history :push) 323 | ;; hs.grid.resizeWindowShorter/Taller/Thinner/Wider 324 | (grid :resizeWindow (. arrow-map arrow :resize))) 325 | 326 | (fn resize-left 327 | [] 328 | (resize-window :h)) 329 | 330 | (fn resize-up 331 | [] 332 | (resize-window :k)) 333 | 334 | (fn resize-down 335 | [] 336 | (resize-window :j)) 337 | 338 | (fn resize-right 339 | [] 340 | (resize-window :l)) 341 | 342 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 343 | ;; Resize to grid preset 344 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 345 | 346 | (fn resize-to-grid 347 | [grid] 348 | (: history :push) 349 | (hs.grid.set (hs.window.focusedWindow) grid)) 350 | 351 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 352 | ;; Move to screen directions 353 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 354 | 355 | (fn move-to-screen 356 | [screen] 357 | "Moves current window onto given hs.screen instance" 358 | (let [w (hs.window.focusedWindow) 359 | no-resize true] 360 | (: w :moveToScreen screen no-resize))) 361 | 362 | (fn move-screen 363 | [method] 364 | " 365 | Moves a window to the display in the specified direction 366 | :north ^ :south v :east -> :west <- 367 | Takes a method name of the hammer spoon window instance. 368 | You probably will not be using this function directly. 369 | Performs a side effect that will move a window the next screen in specified 370 | direction. 371 | Returns nil 372 | " 373 | (let [window (hs.window.focusedWindow)] 374 | (: window method nil true))) 375 | 376 | (fn move-north 377 | [] 378 | (move-screen :moveOneScreenNorth)) 379 | 380 | (fn move-south 381 | [] 382 | (move-screen :moveOneScreenSouth)) 383 | 384 | (fn move-east 385 | [] 386 | (move-screen :moveOneScreenEast)) 387 | 388 | (fn move-west 389 | [] 390 | (move-screen :moveOneScreenWest)) 391 | 392 | (local canvas (require :hs.canvas)) 393 | (local screen-number-canvases (atom [])) 394 | 395 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 396 | ;; Move to screen by number 397 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 398 | 399 | (fn show-display-number 400 | [idx screen] 401 | "Shows a big number at the corner of hs.screen. 402 | To be used as for multi-monitor setups, to easily identify index of each 403 | screen." 404 | (let [cs (canvas.new {}) 405 | font-size (/ (. (: screen :frame) :w) 10)] 406 | (swap! screen-number-canvases (fn [t] (concat t [cs]))) 407 | (doto cs 408 | (: :frame (: screen :frame)) 409 | (: :appendElements 410 | [{:action :fill 411 | :type :text 412 | :frame {:x "0.93" :y 0 :h "1" :w "1"} 413 | :text (hs.styledtext.new 414 | idx 415 | {:font {:size font-size} 416 | :color {:red 1 :green 0.5 :blue 0 :alpha 1}}) 417 | :withShadow true}]) 418 | (: :show)))) 419 | 420 | (fn show-display-numbers 421 | [screens] 422 | "Shows big number at the corner of each screen. 423 | To be used as for multi-monitor setups, to easily identify index of each screen." 424 | (let [ss (hs.screen.allScreens)] 425 | (when (< 1 (count ss)) 426 | (each [idx display (ipairs (hs.screen.allScreens))] 427 | (show-display-number idx display))))) 428 | 429 | (fn hide-display-numbers 430 | [] 431 | "Hides big numbers at the corner of each screen that are used for guidance in 432 | multi-monitor setups." 433 | (for-each 434 | (fn [c] (: c :delete .4)) 435 | (deref screen-number-canvases)) 436 | (reset! screen-number-canvases [])) 437 | 438 | (fn monitor-item 439 | [screen i] 440 | " 441 | Creates a menu item to move the frontMost window to the specified screen index 442 | Takes a hs.screen instance and an index integer 443 | Returns a table-map to add to a config.fnl modal menu 444 | " 445 | {:title (.. "Monitor " i) 446 | :key (tostring i) 447 | :group :monitor 448 | :action (fn [] 449 | (when screen 450 | (move-to-screen screen)))}) 451 | 452 | (fn set-monitor-items 453 | [menu screens] 454 | " 455 | Update a menu by adding an item for each connected monitor 456 | Takes a menu table-map and a table-list of hs.screens 457 | Mutates the menu.items by adding items for each monitor 458 | If any menu items were added previously for each monitor, 459 | they are cleaned up. 460 | Returns mutated modal menu table-map 461 | " 462 | (->> screens 463 | (map monitor-item) 464 | (concat (filter #(not (= (. $ :group) :monitor)) menu.items)) 465 | (tset menu :items)) 466 | menu) 467 | 468 | (fn enter-window-menu 469 | [menu] 470 | " 471 | Handler that can be used when entering the windows menu 472 | Takes modal menu table-map 473 | - Hides any previous display numbers 474 | - Shows display numbers at top right of each screen 475 | - Sets monitor items based on currently connected monitors 476 | Returns mutated modal menu table-map for threading or chaining 477 | " 478 | (let [screens (hs.screen.allScreens)] 479 | (hide-display-numbers) 480 | (show-display-numbers screens) 481 | (set-monitor-items menu screens)) 482 | menu) 483 | 484 | (fn exit-window-menu 485 | [menu] 486 | " 487 | Handler that can be used when exiting the windows menu 488 | - Removes previous monitor items if any were added 489 | Returns mutated modal menu table-map for threading or chaining 490 | " 491 | (hide-display-numbers) 492 | menu) 493 | 494 | 495 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 496 | ;; Initialization 497 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 498 | 499 | (fn init 500 | [config] 501 | " 502 | Initializes the windows module 503 | Performs side effects: 504 | - Set grid margins from config.fnl like {:grid {:margins [10 10]}} 505 | - Set the grid dimensions from config.fnl like {:grid {:size \"3x2\"}} 506 | " 507 | (hs.grid.setMargins (or (get-in [:grid :margins] config) [0 0])) 508 | (hs.grid.setGrid (or (get-in [:grid :size] config) "3x2")) 509 | (let [grid-ui (get-in [:grid :ui] config)] 510 | (when grid-ui 511 | (each [key value (pairs grid-ui)] 512 | (tset hs.grid.ui key value))))) 513 | 514 | 515 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 516 | ;; Exports 517 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 518 | 519 | {: activate-app 520 | : center-window-frame 521 | : enter-window-menu 522 | : exit-window-menu 523 | : hide-display-numbers 524 | : highlight-active-window 525 | : init 526 | : jump 527 | : jump-to-last-window 528 | : jump-window-above 529 | : jump-window-below 530 | : jump-window-left 531 | : jump-window-right 532 | : maximize-window-frame 533 | : move-east 534 | : move-north 535 | : move-south 536 | : move-to-screen 537 | : move-west 538 | : position-window-center 539 | : rect 540 | : resize-down 541 | : resize-half-bottom 542 | : resize-half-left 543 | : resize-half-right 544 | : resize-half-top 545 | : resize-inc-bottom 546 | : resize-inc-left 547 | : resize-inc-right 548 | : resize-inc-top 549 | : resize-left 550 | : resize-right 551 | : resize-up 552 | : resize-to-grid 553 | : set-mouse-cursor-at 554 | : show-display-numbers 555 | : show-grid 556 | : undo} 557 | --------------------------------------------------------------------------------