├── .github ├── .envrc ├── FUNDING.yml ├── flake.lock ├── flake.nix ├── pull_request_template.md ├── run-shim.el └── workflows │ ├── ci.yml │ └── dco.yml ├── .gitignore ├── NOTES.org ├── README.org ├── lisp ├── user-keys-abstract.el └── user-keys.el └── test ├── user-keys-abstract-test.el └── user-keys-test.el /.github/.envrc: -------------------------------------------------------------------------------- 1 | use flake 2 | -------------------------------------------------------------------------------- /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # This is the bootstrap solution. It will live for approximately a year. 2 | github: positron-solutions 3 | -------------------------------------------------------------------------------- /.github/flake.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "emacs-overlay": { 4 | "inputs": { 5 | "flake-utils": [ 6 | "flake-utils" 7 | ], 8 | "nixpkgs": [ 9 | "nixpkgs" 10 | ] 11 | }, 12 | "locked": { 13 | "lastModified": 1685412232, 14 | "narHash": "sha256-Oifn6uAP+IS0jEGs50tlRBCIwtUVIN4f+8RdlxbvK88=", 15 | "owner": "nix-community", 16 | "repo": "emacs-overlay", 17 | "rev": "04f25058fbe3ae1aadd435aba49b66493e939f83", 18 | "type": "github" 19 | }, 20 | "original": { 21 | "owner": "nix-community", 22 | "repo": "emacs-overlay", 23 | "type": "github" 24 | } 25 | }, 26 | "flake-utils": { 27 | "locked": { 28 | "lastModified": 1653893745, 29 | "narHash": "sha256-0jntwV3Z8//YwuOjzhV2sgJJPt+HY6KhU7VZUL0fKZQ=", 30 | "owner": "numtide", 31 | "repo": "flake-utils", 32 | "rev": "1ed9fb1935d260de5fe1c2f7ee0ebaae17ed2fa1", 33 | "type": "github" 34 | }, 35 | "original": { 36 | "owner": "numtide", 37 | "repo": "flake-utils", 38 | "type": "github" 39 | } 40 | }, 41 | "nixpkgs": { 42 | "locked": { 43 | "lastModified": 1685435132, 44 | "narHash": "sha256-Z3Bym0Ylr1SCj49q0RjS4yB5KNKY/i6Zg9inUbemqLE=", 45 | "owner": "nixos", 46 | "repo": "nixpkgs", 47 | "rev": "bedc973122bbaef6facf431812f2ec805785e53b", 48 | "type": "github" 49 | }, 50 | "original": { 51 | "owner": "nixos", 52 | "ref": "release-22.11", 53 | "repo": "nixpkgs", 54 | "type": "github" 55 | } 56 | }, 57 | "root": { 58 | "inputs": { 59 | "emacs-overlay": "emacs-overlay", 60 | "flake-utils": "flake-utils", 61 | "nixpkgs": "nixpkgs" 62 | } 63 | } 64 | }, 65 | "root": "root", 66 | "version": 7 67 | } 68 | -------------------------------------------------------------------------------- /.github/flake.nix: -------------------------------------------------------------------------------- 1 | # Copyright (C) 2022 Positron Solutions 2 | 3 | # Permission is hereby granted, free of charge, to any person obtaining a copy of 4 | # this software and associated documentation files (the "Software"), to deal in 5 | # the Software without restriction, including without limitation the rights to 6 | # use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 7 | # the Software, and to permit persons to whom the Software is furnished to do so, 8 | # subject to the following conditions: 9 | 10 | # The above copyright notice and this permission notice shall be included in all 11 | # copies or substantial portions of the Software. 12 | 13 | # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 15 | # FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 16 | # COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 17 | # IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 18 | # CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 19 | 20 | { 21 | description = "This flake provides CI & local development dependencies"; 22 | 23 | # inputs are pinned via flake.lock. The normal way to update an individual 24 | # version is: 25 | # nix flake lock --update-input emacs-overlay 26 | # Tracking can be accomplished via CI and machine commits 27 | inputs = { 28 | # stable branches are recommended for CI, regression spotting. Testing with 29 | # multiple versions can be done via input overrides, such as: 30 | # nix build .#ci --override-input nixpkgs github:nixpkgs/nixpkgs/unstable 31 | nixpkgs.url = "github:nixos/nixpkgs?ref=release-22.11"; 32 | flake-utils.url = "github:numtide/flake-utils"; 33 | emacs-overlay.url = "github:nix-community/emacs-overlay"; 34 | # slave Emacs overlay to our nixpkgs. This doesn't do a lot except reduce 35 | # the closure size and allow us to control both nixpkgs versions with one 36 | # declaration. 37 | emacs-overlay.inputs.nixpkgs.follows = "nixpkgs"; 38 | emacs-overlay.inputs.flake-utils.follows = "flake-utils"; 39 | }; 40 | 41 | outputs = inputs: 42 | with inputs; 43 | flake-utils.lib.eachDefaultSystem (system: 44 | let 45 | 46 | # instantaite nixpkgs with the emacs overlay applied. 47 | # to explore available attributes, you can instantiate nixpkgs with the emacs overlay in a nix repl: 48 | # pkgs = import (builtins.getFlake "nixpkgs") { system = builtins.currentSystem; overlays = [ (builtins.getFlake ("emacs-overlay")).overlay ];} 49 | # pkgs.emacs will tab complete 50 | pkgs = import nixpkgs { 51 | inherit system; 52 | overlays = [ emacs-overlay.overlay ]; 53 | }; 54 | 55 | # List of Emacsen to generate development shells for 56 | emacsPackages = [ 57 | "emacsUnstable" 58 | "emacsGit" 59 | "emacs" 60 | ]; 61 | 62 | # let's have a development shell per Emacs! 63 | devShells = pkgs.lib.genAttrs emacsPackages (emacsPkg: 64 | pkgs.mkShell { 65 | packages = [ 66 | # pkgs, contains many dependencies you can provide to your elisp 67 | # programs. Search for packages here: 68 | # https://search.nixos.org/packages 69 | 70 | pkgs.git # for elisp-repo-kit-clone. 71 | 72 | # https://github.com/nix-community/emacs-overlay 73 | # The emacs overlay provides up-to-date snapshots of Melpa packages. 74 | # These will be pure & pinned, so you need to update the flake lock 75 | # or use appropriate options. 76 | # 77 | # This expression builds an Emacs that loads the packages passed 78 | # to emacsWithPackages on startup. 79 | ((pkgs.emacsPackagesFor pkgs.${emacsPkg}).emacsWithPackages 80 | (epkgs: [ 81 | # List your project's dependencies here: 82 | # epkgs.melpaPackages.dash 83 | # epkgs.melpaStablePackages.dash 84 | # epkgs.elpaPackages.dash 85 | # epkgs.dash 86 | 87 | # Development dependencies 88 | epkgs.elpaPackages.relint 89 | epkgs.melpaPackages.elisp-lint 90 | # epkgs.melpaPackages.buttercup # XXX finish after #218 on buttercup 91 | # epkgs.melpaPackages.elsa # XXX did not work out of the box 92 | 93 | # Dependencies of elisp-repo-kit itself. These are no longer 94 | # needed by your repo after cloning. 95 | epkgs.melpaPackages.keymap-utils 96 | ])) 97 | ]; 98 | }); 99 | in { 100 | # The output set, where all useful things go. If your nix flake exposes 101 | # packages, overlays, shells, or nix utils, they can be exposed here for 102 | # downstream consumption. 103 | 104 | # Augment the devShells with a default so that `nix develop` knows what 105 | # to do. Run `nix flake show` to see the results. Per-system, 106 | # per-Emacs, we have a development environment avaialble. 107 | devShells = devShells // { default = devShells.emacsGit; }; 108 | }); 109 | } 110 | -------------------------------------------------------------------------------- /.github/pull_request_template.md: -------------------------------------------------------------------------------- 1 | ## Pull Requests 2 | 3 | Generated changes to the flake.lock should be kept in a separate commit for the 4 | reviewer. Title your commit as "generated". 5 | 6 | Keeping these changes isolated in specific commits makes it much easier to pull 7 | in your changes in parallel with other features. Maintainers may harvest your 8 | changes. We only guarantee to preserve authorship, signature, and sign-off in 9 | the git log. 10 | 11 | ### Creating pull requests 12 | 13 | 1. Fork this repository into the personal GitHub account 14 | 1. Make changes on the personal fork 15 | 1. Remember to sign off and sign all commits in your PR branch (instructions in readme) 16 | 1. Make a Pull Request against this repository 17 | 1. **Allow maintainers to make changes to your pull request** (there's a 18 | checkbox) 19 | 1. Once the pull request has been approved, you will be thanked and observe your 20 | changes applied with authorship, signature, and sign-off in the git log 21 | -------------------------------------------------------------------------------- /.github/run-shim.el: -------------------------------------------------------------------------------- 1 | ;;; run-shim.el --- -*-no-byte-compile: t; lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2022 Positron Solutions 4 | 5 | ;; Author: Psionic K 6 | 7 | ;; Permission is hereby granted, free of charge, to any person obtaining a copy of 8 | ;; this software and associated documentation files (the "Software"), to deal in 9 | ;; the Software without restriction, including without limitation the rights to 10 | ;; use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 11 | ;; the Software, and to permit persons to whom the Software is furnished to do so, 12 | ;; subject to the following conditions: 13 | 14 | ;; The above copyright notice and this permission notice shall be included in all 15 | ;; copies or substantial portions of the Software. 16 | 17 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 18 | ;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 19 | ;; FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 20 | ;; COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 21 | ;; IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 22 | ;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 23 | 24 | ;;; Commentary: 25 | 26 | ;; This package sets up load paths and then loads the test files and runs 27 | ;; commands depending on the command line arguments. 28 | ;; 29 | ;; Usage: 30 | ;; 31 | ;; Always get a fresh Emacs for your test runs. It will reload features and 32 | ;; byte compile where necessary. The Emacs provided by the nix develop shell 33 | ;; contains the dependencies declared in the flake.nix. 34 | ;; 35 | ;; nix develop .github# 36 | ;; "emacs" --quick --script .github/run-shim.el -- test 37 | ;; "emacs" --quick --script .github/run-shim.el -- lint 38 | ;; "emacs" --quick --script .github/run-shim.el -- lint-tests 39 | ;; 40 | ;; Note that this elisp script assumes that some packages are located in 41 | ;; specific locations. 42 | 43 | ;;; Code: 44 | 45 | (defun run-shim () 46 | "Execute a CI process based on CLI arguments." 47 | (run-shim-setup) 48 | 49 | ;; Consume the command argument and run one of the routines Additional 50 | ;; arguments can be read as needed in sub-commands. 51 | 52 | ;; Modify this hunk to change your CI steps. 53 | (pcase (pop argv) 54 | ("test" 55 | (require 'user-keys-test) 56 | (ert-run-tests-batch-and-exit)) 57 | ("lint" 58 | (run-shim-lint-package)) 59 | ("lint-tests" 60 | (run-shim-lint-tests)) 61 | (_ 62 | (message "Command %s not recognized. Use test, lint, lint-tests etc." 63 | run-shim-command)))) 64 | 65 | (defun run-shim-lint-package () 66 | "Lint the files in the package directory." 67 | (require 'elisp-lint) 68 | ;; 100-character column limit for lints. If it's good enough for Linux, it's 69 | ;; good enough for us. https://lkml.org/lkml/2020/5/29/1038 70 | (setq-default fill-column 100) 71 | ;; Spaces 72 | (setq-default indent-tabs-mode nil) 73 | 74 | ;; `command-line-args-left has the same effect as passing command line arguments. 75 | (let ((command-line-args-left 76 | (append 77 | '(;; "--no- 78 | ;; "--no-byte-compile" 79 | ;; "--no-checkdoc" 80 | "--no-package-lint" 81 | "--no-indent" 82 | ;; "--no-indent-character" 83 | ;; "--no-fill-column" 84 | ;; "--no-trailing-whitespace" 85 | ;; "--no-check-declare" 86 | ) 87 | (seq-filter 88 | (lambda (s) (not (or (string-match-p "*-test.el$" s) 89 | (string-match-p ".*autoloads.*.el$" s)))) 90 | (file-expand-wildcards 91 | (if (file-exists-p "lisp/") "lisp/*.el" 92 | "*.el")))))) 93 | 94 | (message "ARGS: %s" command-line-args-left) 95 | 96 | ;; (setq elisp-lint-ignored-validators nil 97 | ;; elisp-lint-file-validators nil 98 | ;; elisp-lint-buffer-validators nil 99 | ;; elisp-lint-batch-files nil) 100 | 101 | (elisp-lint-files-batch))) 102 | 103 | (defun run-shim-lint-tests () 104 | "Lint the files in the test directory." 105 | 106 | (require 'elisp-lint) 107 | 108 | ;; Use this file's directory as default directory so that lisp file locations 109 | ;; are fixed with respect to this file. 110 | 111 | ;; 100-character column limit for lints. If it's good enough for Linux, it's 112 | ;; good enough for us. https://lkml.org/lkml/2020/5/29/1038 113 | (setq-default fill-column 100) 114 | ;; Spaces 115 | (setq-default indent-tabs-mode nil) 116 | 117 | ;; `command-line-args-left has the same effect as passing command line arguments. 118 | (let ((command-line-args-left 119 | (append 120 | '(;; "--no- 121 | ;; "--no-byte-compile" 122 | "--no-checkdoc" 123 | "--no-package-lint" 124 | ;; "--no-indent" 125 | ;; "--no-indent-character" 126 | ;; "--no-fill-column" 127 | ;; "--no-trailing-whitespace" 128 | ;; "--no-check-declare" 129 | ) 130 | (seq-filter 131 | (lambda (s) (string-match-p "*-test.el$" s)) 132 | (file-expand-wildcards 133 | (if (file-exists-p "test/") "test/*.el" 134 | "*-test.el")))))) 135 | 136 | (message "ARGS: %s" command-line-args-left) 137 | 138 | ;; (setq elisp-lint-ignored-validators nil 139 | ;; elisp-lint-file-validators nil 140 | ;; elisp-lint-buffer-validators nil 141 | ;; elisp-lint-batch-files nil) 142 | 143 | (elisp-lint-files-batch))) 144 | 145 | (defun run-shim-compile-dir-recursively (dir) 146 | "Compile .el files in DIR. 147 | This is usually before loading for tests etc. The behavior of 148 | byte compiled and native compiled code is more interesting than 149 | uncompiled elisp because usually installed packages will be 150 | compiled when run by the user." 151 | (mapc (if (native-comp-available-p) #'native-compile 152 | #'byte-compile-file) 153 | (directory-files-recursively dir (rx ".el" eol)))) 154 | 155 | (defun run-shim-setup () 156 | "Normalize load paths, compilation, and behavior of shell arguments. 157 | The `default-directory' will be set to the root of the 158 | repository. Arguments will be stripped of Nix wrapper load 159 | paths. The load path will be configured to included /test, 160 | /load, and the repository root. Elisp files on the load path 161 | will be compiled, natively if available." 162 | 163 | ;; This expression normalizes the behavior of --quick --load and --script 164 | ;; behavior. If you don't do this, --script will see every argument 165 | ;; passed and the arguments from the Nix wrapper to set load paths. You can use 166 | ;; this to pass extra options to your scripts in the github actions. 167 | (when (member (car argv) '("-l" "--")) 168 | (print "Normalizing arguments") 169 | (while (not (member (car argv) '("--" nil))) 170 | (print (format "Normalizing arguments, stripped: %s" (pop argv)))) 171 | (pop argv)) ; pop the sentinel "--" 172 | 173 | (message "original default directory: %s" default-directory) 174 | (let* ((root-directory (if load-file-name 175 | (file-name-directory 176 | (directory-file-name 177 | (file-name-directory load-file-name))) 178 | (file-name-directory 179 | (directory-file-name 180 | default-directory)))) 181 | (test-dir (concat root-directory "test")) 182 | (lisp-dir (concat root-directory "lisp")) 183 | (package-dir (if (file-exists-p lisp-dir) lisp-dir 184 | root-directory))) 185 | (message "load-file-name for run-shim.el: %s" load-file-name) 186 | (message "root load path: %s" root-directory) 187 | (when (file-exists-p test-dir) 188 | (message (format "test load path: %s" test-dir)) 189 | (push test-dir load-path)) 190 | (message (format "package load path: %s" root-directory)) 191 | (push package-dir load-path) 192 | (setq default-directory root-directory)) 193 | 194 | ;; running manually may encounter stale .elc 195 | (setq load-prefer-newer t)) 196 | 197 | ;; Only attempt to run when Emacs is loading with or --batch --no-x-resources, 198 | ;; which is implied by -Q. 199 | (when (or noninteractive inhibit-x-resources) 200 | (run-shim)) 201 | 202 | (provide 'run-shim) 203 | ;;; run-shim.el ends here 204 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | # Copyright (C) 2022 Positron Solutions 2 | 3 | # Permission is hereby granted, free of charge, to any person obtaining a copy of 4 | # this software and associated documentation files (the "Software"), to deal in 5 | # the Software without restriction, including without limitation the rights to 6 | # use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 7 | # the Software, and to permit persons to whom the Software is furnished to do so, 8 | # subject to the following conditions: 9 | 10 | # The above copyright notice and this permission notice shall be included in all 11 | # copies or substantial portions of the Software. 12 | 13 | # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 15 | # FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 16 | # COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 17 | # IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 18 | # CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 19 | 20 | name: CI 21 | 22 | on: # trigger this workflow on 23 | push: 24 | branches: [ $default-branch ] # pushes to the default branch 25 | paths-ignore: 26 | - 'README.org' 27 | - 'CONTRIBUTING.org' 28 | pull_request_target: # or every pull request, from any branch to any branch 29 | paths-ignore: 30 | - 'README.org' 31 | - 'CONTRIBUTING.org' 32 | 33 | workflow_dispatch: 34 | # Allows you to run this workflow manually from the Actions tab 35 | 36 | jobs: 37 | continuous-integration: # just a job name 38 | 39 | # Run on every OS and Emacsen 40 | # Some steps switch logic on os or emacsPkg! 41 | strategy: 42 | matrix: 43 | os: [ubuntu-latest] #, macos-latest 44 | emacsPkg: [ emacs, emacsGit, ] 45 | runs-on: ${{ matrix.os }} 46 | steps: 47 | - uses: actions/checkout@v3.2.0 48 | with: 49 | ref: ${{ github.event.pull_request.head.sha }} 50 | - uses: cachix/install-nix-action@v20 51 | with: 52 | extra_nix_config: | 53 | access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} 54 | - uses: cachix/cachix-action@v12 55 | with: 56 | # This CACHIX_AUTH_TOKEN & CACHIX_CACHE_NAME are secrets you must set 57 | # in your repository settings 58 | name: ${{ secrets.CACHIX_CACHE_NAME }} 59 | authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} 60 | extraPullNames: nix-community # look for pre-built binaries from upstream 61 | # Some paths may confuse cachix. Add them with a pipe to the pushFilter 62 | pushFilter: "(.drv.chroot$)" 63 | 64 | # Loading the development shell with frozen versions is important to 65 | # verify that any flake commands will successfully run straight off of the 66 | # github repository. 67 | - name: load the shell with frozen versions 68 | run: nix develop .github#${{ matrix.emacsPkg }} --ignore-environment --command "emacs" "--version" 69 | 70 | # Linting the package is less useful on multiple version. Modify the 71 | # logic if you wish to expand lint coverage. 72 | - name: lint package 73 | if: matrix.emacsPkg == 'emacs' && matrix.os == 'ubuntu-latest' 74 | run: | 75 | eval "$(nix print-dev-env \ 76 | --override-input nixpkgs github:nixos/nixpkgs/release-22.11 \ 77 | --update-input emacs-overlay \ 78 | .github#${{ matrix.emacsPkg }})" 79 | 80 | # Lint the package 81 | emacs --script .github/run-shim.el -- lint 82 | 83 | # Lint the tests 84 | emacs --script .github/run-shim.el -- lint-tests 85 | 86 | - name: run tests 87 | run: | 88 | # First load the shell. Updating inputs will update the view of ELPA 89 | # Emacs git, and nixpkgs. 90 | 91 | # Possible RUNNER_OS values: Windows Linux MacOS 92 | # https://docs.github.com/en/actions/learn-github-actions/environment-variables#default-environment-variables 93 | 94 | # These eval "$(nix print-dev-env)" calls alter the shell. In a 95 | # non-interactive shell like CI, calling nix develop doesn't have the 96 | # same behavior. 97 | if [[ $RUNNER_OS == Linux ]]; then 98 | eval "$(nix print-dev-env \ 99 | --override-input nixpkgs github:nixos/nixpkgs/release-22.11 \ 100 | --update-input emacs-overlay \ 101 | .github#${{ matrix.emacsPkg }})" 102 | 103 | else 104 | eval "$(nix print-dev-env \ 105 | --override-input nixpkgs github:nixos/nixpkgs/nixpkgs-22.11-darwin \ 106 | --update-input emacs-overlay \ 107 | .github#${{ matrix.emacsPkg }})" 108 | fi 109 | 110 | # Runs the tests in a graphical window (can freeze) 111 | # emacs --quick --load .github/run-shim.el -- test $GITHUB_SHA 112 | 113 | # Run tests with terminal output and no graphical window 114 | emacs --script .github/run-shim.el -- test $GITHUB_SHA 115 | -------------------------------------------------------------------------------- /.github/workflows/dco.yml: -------------------------------------------------------------------------------- 1 | # Copyright (C) 2022 Positron Solutions 2 | 3 | # Permission is hereby granted, free of charge, to any person obtaining a copy of 4 | # this software and associated documentation files (the "Software"), to deal in 5 | # the Software without restriction, including without limitation the rights to 6 | # use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 7 | # the Software, and to permit persons to whom the Software is furnished to do so, 8 | # subject to the following conditions: 9 | 10 | # The above copyright notice and this permission notice shall be included in all 11 | # copies or substantial portions of the Software. 12 | 13 | # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 15 | # FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 16 | # COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 17 | # IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 18 | # CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 19 | 20 | # This Developer Certificate of Origin check verifies that all commits in a PR 21 | # are signed off on by the author. It only needs to run once on each PR 22 | # update. 23 | # 24 | # The check is added as a shield to the project's README.org so that all can see 25 | # the license check for the entire commit history. 26 | 27 | name: DCO Check 28 | 29 | on: 30 | pull_request: 31 | # any pull-request 32 | workflow_dispatch: 33 | # Allows you to run this workflow manually from the Actions tab 34 | push: 35 | branches: 36 | - master 37 | jobs: 38 | check: 39 | runs-on: ubuntu-latest 40 | steps: 41 | - uses: actions/checkout@v3.2.0 42 | - name: Set up Python 3.10 43 | uses: actions/setup-python@v4 44 | with: 45 | python-version: '3.10' 46 | - name: Check DCO 47 | env: 48 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 49 | run: | 50 | pip3 install -U dco-check==0.3.1 51 | dco-check 52 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | **.direnv/ 2 | **.elc 3 | ***autoloads.el 4 | **trash 5 | **~ 6 | **.~undo-tree -------------------------------------------------------------------------------- /NOTES.org: -------------------------------------------------------------------------------- 1 | #+TITLE: Hacking Notes on Layouts and Bindings 2 | #+AUTHOR: Psionik K 3 | 4 | This is an abbreviated re-index of the Elisp manual section on 5 | [[info:elisp#Keymaps][Keymaps]]. 6 | 7 | This guide is not authoritative, and clarifications are appreciated 8 | if you happen to be an expert and find yourself reading this. 9 | 10 | An index of elisp forms is available in [[https://github.com/positron-solutions/posimacs-shortdocs][posimacs shortdocs]] under the 11 | key-bindings group, although the provided shortdocs also now have 12 | some bindings. 13 | 14 | ** Keymap structure 15 | 16 | Summary of [[https://www.gnu.org/software/emacs/manual/html_node/elisp/Keymaps.html][keymap format]] section from the Elisp manual. 17 | 18 | - All keymaps are lists, and the first element is just the symbol, =keymap= 19 | - Some contain a chartable (full versus sparse keymap) 20 | - Elements in the list of [[info:elisp#Format of Keymaps][many types]] 21 | - Elements can be composed keymaps, of form =(keymap ... elements)= 22 | - Parent keymaps start in the middle, after another =keymap= symbol followed by more elements. 23 | - Binding elements can point to keymaps, implementing prefix 24 | commands 25 | 26 | ** Variables 27 | 28 | - =global-map= 29 | - =active-global-map= (usually same) 30 | 31 | - =current-local-map= (buffer local) 32 | - =minor-mode-map-alist= 33 | Conses of enabling variable and the map 34 | - =minor-mode-overriding-map-alist= (buffer local) 35 | Same as minor mode map alist, but used by major modes (and users) to punch 36 | minor modes. 37 | - =emulation-mode-map-alists= Alist of alists. Variable keys determine if 38 | values are enabled. Mostly for implementing modal systems, full rebind 39 | schemes with lots of dynamic state. 40 | - =overriding-local-map= (buffer local) 41 | - =overriding-terminal-local-map= (terminal local) 42 | 43 | ** Keymap behavior 44 | 45 | This [[info:elisp#Searching Keymaps][lookup order]] pseudo-code describes keymap precedence. 46 | 47 | =meta-prefix-char= should be left alone. Messing with it is not a good 48 | solution to any likely problem. 49 | 50 | ** Functions 51 | 52 | - =current-minor-mode-maps= Get the enabled minor modes, respects 53 | =minor-mode-overriding-map-alist= 54 | 55 | *** Converting representations 56 | 57 | - =kbd= will convert strings to representations accweped by 58 | =define-key= 59 | - =vconcat= will convert those representations into a vector, 60 | which is frequently the literal you see when inspecting keymaps 61 | or using the keymap-utils package 62 | - =key-description= will convert vector representations back onto 63 | something that =kbd= can understand, completing the round trip. 64 | 65 | #+begin_src elisp 66 | 67 | (key-description (vconcat (kbd "C-x"))) ; "C-x" 68 | 69 | #+end_src 70 | 71 | *** What maps are active? 72 | 73 | - =accessible-keymaps= can be called a variety of ways to see 74 | which keymaps could still satisfy an incomplete &optional PREFIX 75 | sequence starting in KEYMAP 76 | 77 | *** What does this key do? 78 | 79 | - =key-binding= all maps 80 | - =local-key-binding= local maps 81 | - =minor-mode-key-binding= active minor mode maps 82 | - =lookup-key= For looking at a specific map. Documents now say 83 | to use =keymap-lookup=, which accepts a string instead of vector 84 | (and probably other) type. 85 | 86 | *** What is in this map? 87 | 88 | - =map-keymap= map over all bindings with event type + binding as arguments. 89 | - =keymap-parent= 90 | 91 | - =use-global-map= sets a new global map. 92 | 93 | *warning* Never set =global-map= to anything you didn't prepare well with a 94 | full keymap, which has a charset so that =self-insert-command= and M-x work, 95 | otherwise you will need to restart Emacs and perhaps fix your config with a 96 | =emacs -q= etc. 97 | 98 | ** Commands 99 | 100 | The [[https://github.com/Wilfred/helpful][helpful package]] has some beneficial behaviors for inspecting keymaps in 101 | normal Emacs workflows. 102 | 103 | =helpful-key= 104 | =describe-key= (less nice) 105 | 106 | =describe-bindings= (pretty nice). =helpful-variable= is also pretty good at 107 | presenting the contents of keymaps compared to vanilla =describe-variable=. 108 | 109 | ** Tarsius's Keymap Utilities 110 | 111 | [[https://github.com/tarsius/keymap-utils/blob/master/keymap-utils.el][keymap-utils.el]] is a small package containing many implementations 112 | for working with keymap types. There are probably some 113 | re-implementations as well that behave slightly differently. In 114 | particular, there is =kmu-remove-key= to completely remove keys 115 | from both chartables and keymap lists 116 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | #+TITLE: User-Keys 2 | #+AUTHOR: Psionik K 3 | #+PROPERTY: header-args :results silent 4 | 5 | #+HTML: Sequences consisting of C-c and a letter are the only sequences reserved for users. (An error). 6 | #+HTML:
7 | #+HTML: melpa package melpa stable package 8 | #+HTML: CI workflow status 9 | #+HTML: DCO Check 10 | 11 | - Remove legacy keymap spam 12 | - Move keys that express ideas, such as =C-n=, coherently across multiple modes 13 | - See the current state of your preferred top-level sequences 14 | - Introspect modal key bindings, for both package development & configuration 15 | 16 | * Install User-Keys 17 | 18 | #+begin_src elisp :eval never 19 | 20 | (use-package user-keys) ; vanilla 21 | 22 | ;; using elpaca's with explicit recipe 23 | (use-package user-keys 24 | :elpaca (user-keys :host github :repo "positron-solutions/user-keys")) 25 | 26 | ;; straight with explicit recipe 27 | (use-package user-keys 28 | :straight (user-keys :type git :host github :repo "positron-solutions/user-keys")) 29 | 30 | ;; or use manual load-path & require, you brave yak shaver 31 | 32 | #+end_src 33 | 34 | * Use User-Keys 35 | 36 | #+begin_src elisp :eval never 37 | 38 | ;; Show the state of your preferred sequences in the current major 39 | ;; mode. Use this to find out which sequences you might want to bind 40 | ;; next. 41 | (user-keys-report-preferred) 42 | 43 | ;; See a report of all "stupid" bindings and the maps that bind them. 44 | (user-keys-report-stupid) 45 | 46 | ;; Check for shadows for a common sequence so you can move all of it's bindings 47 | ;; around at once. 48 | (user-keys-report-shadows) 49 | 50 | ;; Open the output buffer and use the transient interface 51 | (user-keys-start) 52 | 53 | #+end_src 54 | 55 | * Contents 56 | :PROPERTIES: 57 | :TOC: :include siblings :ignore this 58 | :END: 59 | :CONTENTS: 60 | - [[#other-packages][Other Packages]] 61 | - [[#motivation][Motivation]] 62 | - [[#long-term-goal][Long-Term Goal]] 63 | - [[#correctly-communicating-about-commands-and-sequences][Correctly Communicating About Commands and Sequences]] 64 | - [[#the-c-c-convention-is-terrible][The C-c Convention is Terrible]] 65 | - [[#please-package-authors][Please, Package Authors]] 66 | - [[#what-we-should-do][What We Should Do]] 67 | - [[#contributing][Contributing]] 68 | - [[#acknowledgments][Acknowledgments]] 69 | :END: 70 | 71 | * Other Packages 72 | 73 | Absolutely check out the newer modal packages such as [[https://github.com/meow-edit/meow][Meow]]. They 74 | don't have a lot of pre-configured bindings, and this opens up room 75 | to do crazy things. 76 | 77 | - Completions frameworks alleviate the need for complex bindings because it's 78 | just faster to complete the command name 79 | - Transient bindings (transient package) are a good way to present 80 | context specific bindings such as for applications like magit 81 | - Helpful presents bindings in a much better format when looking at 82 | keymap variables 83 | - Which-key is definitely more useful after cleaning out some 84 | bindings 85 | - Tree sitter is making more and more editing commands able to use 86 | the structure of text you are working on 87 | - General provides lots of support for defining bindings more 88 | succinctly and differentiating user-defined bindings 89 | 90 | Not all of these packages have a clear best choice, so be sure to 91 | research Emacs awesome and Reddit etc before adopting a 92 | recommendation here. 93 | 94 | * Motivation 95 | 96 | There are too many bindings. Everywhere. It gets in the way of 97 | progress. It gets in the way of use. We need tools to take back 98 | control and move forward. 99 | 100 | - *Empower users to modify & develop new schemes* 101 | 102 | Built-in ways to look at bindings are not appropriate for 103 | designing new bindings schemes or looking at bindings 104 | systematically. There's not a good built-in way to see sets of 105 | bindings across multiple maps or the state of map activation 106 | across different buffers, information that is essential for 107 | designing and developing bindings schemes (such as new modal 108 | schemes). 109 | 110 | - *Give the keyboard back to the user* 111 | 112 | Having so many bindings in the way or being surprised by shadows 113 | from major & minor modes leads to user intimidation and 114 | *calcification of things that were not intended to become 115 | standards.* Whether you start with Evil or defaults, the mass 116 | proliferation of bad bindings gets in the way and adds risk and 117 | complexity to any attempt to go your own way. This package is 118 | developed with the belief that the keyboard belongs to the user, 119 | and that extra effort should be made to get out of the way. 120 | 121 | - *Manage Ad-hoc conventions* 122 | 123 | There is no configuration option for certain conventions, such as 124 | =C-n= usually selecting the next item in a list. Because these 125 | conventions exist but are not first class, changing the binding 126 | for an idea found in multiple keymaps usually requires modifying 127 | each keymap. By viewing all shadows in all maps at once, the user 128 | can modify and maintain their own conventions with more awareness 129 | and ease. 130 | 131 | - *Support Tree Sitter Migration* 132 | 133 | The timing of development was partly motivated by tree-sitter 134 | adoption. Because of tree-sitter, editing commands that are aware 135 | of syntax boundaries will become common. *The old keymaps based 136 | on heuristic editing commands will need to evolve.* We need tools 137 | that make it easy to open up space and move old conventions. 138 | 139 | * Long-Term Goal 140 | 141 | It is possible that this package may become similar to a 142 | no-littering, but for key bindings. Maybe it should be the Magit of 143 | key bindings. Maybe it will become an editing interface for a new 144 | set of modal bindings. A lot depends on user demand. Be sure to 145 | [[https://github.com/sponsors/positron-solutions][support]] the project and help steer the direction. 146 | 147 | * Correctly Communicating About Commands and Sequences 148 | 149 | We need to fix something culturally. Other users might say things such as, 150 | "The C-x C-f command." *This is wrong.* There is no "C-x C-f" command. There 151 | is a "C-x f" *key sequence* that is *bound*, by default, to the *command* 152 | =find-file=. This is a *binding*. 153 | 154 | Why you should always prefer command names when communicating: 155 | 156 | - Command names point to source code and can be used as fuel for 157 | hacking new commands. 158 | - Command names are named using frequent concepts from the [[https://www.gnu.org/software/emacs/manual/html_node/emacs/Glossary.html][glossary]] 159 | - Command names do not change when users rebind keys. You can 160 | communicate about commands no matter what bindings system another 161 | user has. 162 | - Command names tell users more about what package they came from. 163 | 164 | Unfortunately there seems to be no mechanism to find out what a key 165 | /was/ bound to in the default settings. We can all use commands. 166 | We cannot all know what a binding means. 167 | 168 | *Command names make you and other users more successful. 169 | Communicate by saying command names, not key sequences.* 170 | 171 | * The C-c Convention is Terrible 172 | 173 | The [[https://www.gnu.org/software/emacs/manual/html_node/elisp/Key-Binding-Conventions.html][elisp manual]] states that only the ~C-c~ prefix /and only with a 174 | single letter/ should be respected by all major and minor 175 | modes. This means the user is expected to bind all of their 176 | preferred global commands behind just one *prefix* sequence. 177 | 178 | #+begin_quote 179 | 180 | Don’t define C-c letter as a key in Lisp programs. Sequences 181 | consisting of C-c and a letter (either upper or lower case; ASCII or 182 | non-ASCII) are reserved for users; *they are the only sequences 183 | reserved for users*, so do not block them. 184 | 185 | #+end_quote 186 | 187 | Meanwhile countless packages add bindings to high-value short key 188 | sequences just because the package author felt like it or because 189 | they wanted to shadow an ad-hoc convention without knowing if the 190 | user reconfigured it. 191 | 192 | Being forced to sort through massive lists of bindings with many 193 | ad-hoc conventions leads to user intimidation and a calcification of 194 | things that never should have been allowed to become standards. 195 | 196 | =C-c= was never a good idea. It is the kind of choice that occurred 197 | after far too much spam was protected by being legacy, a legacy that 198 | emerged from mixed contributions and exhausting bike shed mailing 199 | list threads that reach conclusions like a [[https://en.wikipedia.org/wiki/Ouija][ouija]] board. 200 | 201 | ** Please, Package Authors 202 | 203 | Commands do not deserve bindings. They are not entitled to them. 204 | At the very most, a package author should provide a keymap and then 205 | tell the user how to bind that to a prefix. We have absolutely 206 | amazing command discovery these days. The user doesn't need your 207 | bindings. Publish a list of commands in your package usage 208 | documentation. Put them into a context-specific application 209 | interface like transient. Avoid bad key sequences and ad-hoc 210 | conventions unless it's the purpose of your package to shadow the 211 | defaults. 212 | 213 | * What We Should Do 214 | 215 | In addition to innovation in modal bindings that seek to sidestep 216 | the entire problem altogether... 217 | 218 | - *Reserve short sequences for the user* 219 | 220 | Meta and control keys, especially on the home row, should be 221 | considered sacred real-estate only available to the user. Opening 222 | up space will lower the friction for change, speeding up evolution, 223 | eventually leading us to discover new things we actually want to 224 | bind. 225 | 226 | - *Lean on M-x* 227 | 228 | In the modern era of awesome M-x completions, there's almost no use 229 | to bind functions beyond a certain level of rarity. It only makes 230 | sense to have short sequences bound when no M-x sequences are 231 | actually very long. 232 | 233 | - *RISC, stateful commands with composition* 234 | 235 | In the global bindings, we should try to do more with a smaller set 236 | of commands, similar to a RISC style of compressing the possible 237 | input values but increasing the meaning of strings of values, which 238 | can be composed more easily than long sequences. 239 | 240 | - *Use modal interfaces for context-specific commands* 241 | 242 | For bindings that are very context-specific, they should be moved 243 | into more transient-like interfaces. If you won't use a command 244 | often, it doesn't make sense to try to use it from memory or to use 245 | it non-modally. 246 | 247 | - *Remove crufty applications from Emacs* 248 | 249 | Many bindings and the applications that they are tied to should just 250 | be removed from Emacs altogether and treated as independent packages 251 | on the GNU ELPA. This will lower the weight of the manual and other 252 | deep integrations, making more room to grow. 253 | 254 | - *Put legacy choices into a package* 255 | 256 | It needs to be easier to remove default bindings without disrupting legacy 257 | users, and that means using a compat package like every other platform out 258 | there. Users who want modern Emacs don't need to care. Users who rely on the 259 | old ways should be served by a compat package, not by carrying forward the 260 | same old legacy defaults forever. 261 | 262 | * Contributing 263 | 264 | [[./CONTRIBUTING.org][CONTRIBUTING]] contains instructions on using this repository's 265 | functionality. A DCO and GPL3 license are included with this 266 | project. 267 | 268 | Check the hacking [[./NOTES.org][NOTES]] document for some help getting started 269 | hacking on keymaps and bindings. The keymap data structures 270 | themselves are a little bit unwieldy. 271 | 272 | *Github Sponsors is configured.* If you want features & support, 273 | organize an international coalition of backers and each donate a 274 | comfortable amount, while delegating the authority to pick 275 | priorities to those who either demonstrate competence or are willing 276 | to pay for what they want. 277 | 278 | * Acknowledgments 279 | 280 | Thanks to [[https://github.com/tarsius][Tarsius]] for publishing the keymap-utils package to MELPA. 281 | Some of the built-in functions for exploring keymaps in Emacs were 282 | not immediately appropriate for implementing all of the ideas in 283 | user-keys. =keymap-map-keys= seemed to provide a buffet of data 284 | types and structures. =kmu-map-keymap= was very helpful. 285 | 286 | # Local Variables: 287 | # before-save-hook: (lambda () (when (require 'org-make-toc nil t) (org-make-toc))) 288 | # org-make-toc-link-type-fn: org-make-toc--link-entry-github 289 | # End: 290 | -------------------------------------------------------------------------------- /lisp/user-keys-abstract.el: -------------------------------------------------------------------------------- 1 | ;;; user-keys-abstract.el --- Make binding conventions configurable -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2022 Positron Solutions 4 | 5 | ;; Author: Psionik K <73710933+psionic-k@users.noreply.github.com> 6 | ;; Keywords: convenience 7 | ;; Version: 0.1.0 8 | ;; Package-Requires: ((emacs "28.1")) 9 | ;; Homepage: http://github.com/positron-solutions/user-keys-abstract 10 | 11 | ;;; License notice: 12 | 13 | ;; SPDX-License-Identifier: GPL-3.0-or-later 14 | 15 | ;; This program is free software: you can redistribute it and/or modify 16 | ;; it under the terms of the GNU General Public License as published by 17 | ;; the Free Software Foundation, either version 3 of the License, or 18 | ;; (at your option) any later version. 19 | 20 | ;; This program is distributed in the hope that it will be useful, 21 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 22 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 23 | ;; GNU General Public License for more details. 24 | 25 | ;; You should have received a copy of the GNU General Public License 26 | ;; along with this program. If not, see . 27 | 28 | ;;; Commentary: 29 | 30 | ;; This module is a proof of concept for properly implementing conventions such 31 | ;; as C-n and C-p for list and line navigation. Because lists are the most 32 | ;; prevalent concept in Lisp, and Emacs Lisp, the keys for navigating lists are 33 | ;; among the first that the user should have a choice in rebinding. 34 | 35 | ;;; Code: 36 | 37 | (require 'dash) 38 | 39 | (defun user-keys-abstract--strip-kwargs (form) 40 | "Return the stripped FORM and keyword-args as a plist. 41 | FORM must be a list. Keyword args can be out of order but each 42 | value is assumed to follow the keyword." 43 | (let* ((kwargs) 44 | (key) 45 | (stripped)) 46 | (--each form 47 | (if key (progn 48 | (push it kwargs) 49 | (push key kwargs) 50 | (setq key nil)) 51 | (if (and (symbolp it) 52 | ;; look for colon at beginning of symbol name 53 | (equal ?\: (aref (symbol-name it) 0))) 54 | (setq key it) 55 | (push it stripped)))) 56 | (list (reverse stripped) kwargs))) 57 | 58 | (defun user-keys-abstract--expand-shadow-remaps (form) 59 | "Expand the shadow-remaps contained in FORM and flatten. 60 | FORM is a `(remap-definition shadow-remap ... shadow-remap)' 61 | declaration accepted by `user-keys-abstract-define-remap'." 62 | 63 | (pcase-let* ((`(,remap-def _) 64 | (user-keys-abstract--strip-kwargs (car form))) 65 | (`(,abstract-command-name ,orig-sequence _) 66 | remap-def)) 67 | (let* ((shadow-remaps (cdr form)) 68 | ;; push feature to each shadow-remap and normalize each output to 69 | ;; `((feature shadow-remap) (feature shadow-remap))' 70 | (shadow-remaps 71 | (-reduce #'append 72 | (--map (let ((feature (car it)) 73 | (remaps (cdr it))) 74 | (--map (cons feature it) 75 | (if (listp (car remaps)) 76 | remaps 77 | (list remaps)))) 78 | shadow-remaps)))) 79 | (->> shadow-remaps 80 | (-map 81 | (lambda (shadow-remap) 82 | (pcase-let ((`(,feature ,map ,shadow-command) shadow-remap)) 83 | (list 84 | ;; unbind the existing sequence 85 | (if (version< "29" emacs-version) 86 | `(,feature (define-key ,map (kbd ,orig-sequence) nil t)) 87 | ;; emacs 28 cannot remove bindings entirely 88 | `(,feature (define-key ,map (kbd ,orig-sequence) nil))) 89 | ;; remap-bind to the abstract command 90 | `(,feature (define-key 91 | ,map 92 | (vector 'remap #',abstract-command-name) 93 | #',shadow-command)))))) 94 | ;; flatten each pair of `define-key' expressions 95 | (-reduce #'append))))) 96 | 97 | (defmacro user-keys-abstract-define-remap (&rest forms) 98 | "Re-map multiple bindings onto new abstract commands. 99 | An abstract command is one that is usually bound to a sequence. 100 | Real commands that would normally shadow the sequence directly 101 | are instead bound via command remapping. Thus, if the abstract 102 | command is rebound to another sequence, all of the shadows move 103 | with it. This converts ad-hoc sequence conventions like `C-n' 104 | into first-class conventions that the user can manage more 105 | effectively. 106 | 107 | To illustrate, after abstracting all of the `C-n' commands to an 108 | abstract command such as `user-keys-abstract-next', you can 109 | rebind `user-keys-abstract-next' to `C-j' and all of the remapped 110 | commands will move with it, meaning commands like `next-line' 111 | move to `C-j' as well. You can even remove these keys by 112 | providing no binding to the abstract command. 113 | 114 | Regarding the implementation and usage, at a high level, this 115 | macro returns expressions that define abstract commands, binds 116 | them to a sequence, and then uses command remapping to re-direct 117 | the abstract command to a concrete command in a number of 118 | keymaps. Because these are lazily loaded, `eval-after-load' is 119 | used and we need to know the feature name or elisp file. When 120 | making sequences abstract, the sequence binding in each map is 121 | removed so that the map only contains the command remap. This 122 | enables rebinding of the abstract command's sequence to affect 123 | all abstracted sequences. 124 | 125 | Each form in FORMS has the following structure: 126 | 127 | `(remap-definition shadow-remap ... shadow-remap)' 128 | 129 | Each REMAP-DEFINITION form is the following: 130 | 131 | `(abstract-command-name sequence-string original-command &rest args)' 132 | 133 | ARGS should be plist style pairs of :keyword value, with the following support: 134 | 135 | - :map for any map other than the `global-map'. 136 | - :target-sequence if you want to bind commands to a new sequence other than 137 | SEQUENCE-STRING. This is used to both define the abstract command and place 138 | it on a different binding. 139 | - :no-bind if you want to define the abstract command but not the key sequence. 140 | Without a key sequence, any REMAP-DEFINITION forms using the abstract command 141 | will not have an active binding, just a remap to a command that is not itself 142 | bound. 143 | 144 | Each SHADOW-REMAP form is one of the following: 145 | 146 | `(feature1 map shadow-command)' 147 | `(feature2 (map1 shadow-command) 148 | (map2 shadow-command))' 149 | 150 | FEATURE can be any expression suitable for `eval-after-load' and 151 | usually you will use a feature symbol, unquoted, or a string that 152 | points to a file. In the case of subr.el, where many of the most 153 | fundamental maps are defined, there is no corresponding feature, 154 | so just use the elisp file name. 155 | 156 | SHADOW-COMMAND is the command that shadows the SEQUENCE-STRING in 157 | the REMAP-DEFINITION. Two expressions will be generated. One to 158 | unbind SHADOW-COMMAND from SEQUENCE-STRING and another to remap 159 | ABSTRACT-COMMAND-NAME to SHADOW-COMMAND so that SHADOW-COMMAND is 160 | active whenever that map has precedence. 161 | 162 | TODO shadow-remap forms need plist support. If the command is 163 | being moved from a sequence other than SEQUENCE-STRING, this 164 | needs to be expressed per shadow-command. 165 | 166 | TODO When a :target-sequence is expressed, it may need unbinding 167 | in many, many maps so that the abstract command is not shadowed 168 | after being moved. At a minimum, unbind in maps with remaps. 169 | 170 | TODO Moving sequences needs to be coordinated over all forms so 171 | that unbinding and rebinding don't clobber each other in the 172 | global map." 173 | 174 | (let* ((remap-defs (-map #'car forms)) 175 | ;; define abstract commands for each remap-def 176 | (ac-def-forms 177 | (->> remap-defs 178 | (-map #'car) 179 | (-map (lambda (abstract-command-name) 180 | `(defun ,abstract-command-name '() 181 | ,(concat "Abstract command target.\n" 182 | "This is a global map abstract command.") 183 | (interactive) 184 | (undefined)))))) 185 | ;; define global map binding & remap for each remap-def 186 | (global-remap-forms 187 | (->> remap-defs 188 | (-map 189 | (lambda (remap-def) 190 | (pcase-let* ((`(,remap-def ,remap-kwargs) 191 | (user-keys-abstract--strip-kwargs remap-def)) 192 | (`(,abstract-command-name 193 | ,sequence-string 194 | ,original-command) 195 | remap-def)) 196 | (let ((no-bind (plist-get remap-kwargs :no-bind)) 197 | (target-sequence 198 | (plist-get remap-kwargs :target-sequence))) 199 | (list 200 | ;; unbind the original command from the original sequence 201 | (when target-sequence 202 | (if (version< "29" emacs-version) 203 | `(define-key global-map (kbd ,sequence-string) nil t) 204 | ;; emacs 28 cannot remove bindings entirely 205 | `(define-key global-map (kbd ,sequence-string) nil))) 206 | 207 | ;; bind the abstract command to the target sequence 208 | (unless no-bind 209 | `(define-key 210 | global-map 211 | (kbd ,(or target-sequence sequence-string)) 212 | #',abstract-command-name)) 213 | 214 | ;; remap the original command to the abstract command 215 | `(define-key 216 | global-map 217 | (vector 'remap #',abstract-command-name) 218 | #',original-command)))))) 219 | 220 | (-reduce #'append) 221 | (-non-nil))) 222 | 223 | ;; for each remap-def, expand its shadow-remap forms over their feature, 224 | ;; then gather all shadow-remaps over features and generate 225 | ;; `eval-after-load' expressions. 226 | (eval-after-load-forms 227 | (->> 228 | forms 229 | ;; expand shadow-remap forms over the remap-definition 230 | (-map #'user-keys-abstract--expand-shadow-remaps) 231 | (-reduce #'append) ; flatten over each remap-def 232 | (-group-by #'car) ; group shadow-remaps by feature 233 | (-map 234 | (lambda (feature-group) 235 | ;; feature-group is (feature ((feature rebind) (feature rebind))) 236 | ;; with all same feature 237 | (let ((feature (car feature-group)) 238 | (shadow-remaps (-map #'cadr (cdr feature-group)))) 239 | `(eval-after-load ',feature (progn ,@shadow-remaps)))))))) 240 | ;; splice 241 | `(progn ,@ac-def-forms 242 | ,@global-remap-forms 243 | ,@eval-after-load-forms))) 244 | 245 | (defun user-keys-abstract-list-navigation () 246 | "WARNING! YOU BETTER KNOW WHAT YOU ARE DOING! 247 | Okay, so you found this pre-alpha backage and it says it can make 248 | your bindings abstract, allowing you to move around `C-n' and 249 | `C-p' etc. This function will do it, but it's basically a demo 250 | and not intended to be run in your daily driving. This is why I 251 | did not bind it in a command." 252 | (user-keys-abstract-define-remap 253 | ((abstract-next "C-n" next-line) 254 | ("subr.el" esc-map backward-list) 255 | (calendar-mode calendar-mode-map calendar-backward-week) 256 | (comint-mode comint-repeat-map comint-previous-prompt) 257 | (company-mode (company-active-map company-select-previous-or-abort) 258 | (company-search-map company-select-previous-or-abort)) 259 | ;; (doc-view doc-view-mode-map doc-view-previous-line-or-previous-page) 260 | (gnus gnus-summary-goto-map gnus-summary-prev-same-subject) 261 | (kmacro kmacro-keymap kmacro-cycle-ring-previous) 262 | (org (org-agenda-keymap org-agenda-previous-line) 263 | (org-agenda-mode-map org-agenda-previous-line) 264 | (org-babel-map org-babel-previous-src-block)) 265 | (outline (outline-mode-prefix-map outline-previous-visible-heading) 266 | (outline-navigation-repeat-map outline-previous-visible-heading)) 267 | (popup popup-menu-keymap popup-previous) 268 | (quail quail-simple-translation-keymap quail-other-command) 269 | (quail quail-translation-keymap quail-prev-translation-block)) 270 | ;; (menu-bar tty-menu-navigation-map tty-menu-prev-item) 271 | ;; (widget widget-global-map previous-line)) 272 | 273 | ((abstract-previous "C-p" previous-line) 274 | 275 | ("subr.el" esc-map forward-list) 276 | (calendar-mode calendar-mode-map calendar-forward-week) 277 | (comint-mode comint-repeat-map comint-next-prompt) 278 | (company-mode (company-active-map company-select-next-or-abort) 279 | (company-search-map company-select-next-or-abort)) 280 | ;; (doc-view doc-view-mode-map doc-view-next-line-or-next-page) 281 | (gnus gnus-summary-goto-map gnus-summary-prev-same-subject) 282 | (kmacro kmacro-keymap kmacro-cycle-ring-next) 283 | (org (org-agenda-keymap org-agenda-next-line) 284 | (org-agenda-mode-map org-agenda-next-line) 285 | (org-babel-map org-babel-next-src-block)) 286 | (outline (outline-mode-prefix-map outline-next-visible-heading) 287 | (outline-navigation-repeat-map outline-next-visible-heading)) 288 | (popup popup-menu-keymap popup-next) 289 | (quail quail-simple-translation-keymap quail-other-command) 290 | (quail quail-translation-keymap quail-prev-translation-block)))) 291 | ;; (menu-bar tty-menu-navigation-map tty-menu-prev-item) 292 | ;; (widget widget-global-map next-line)))) 293 | 294 | 295 | (provide 'user-keys-abstract) 296 | ;;; user-keys-abstract.el ends here 297 | -------------------------------------------------------------------------------- /lisp/user-keys.el: -------------------------------------------------------------------------------- 1 | ;;; user-keys.el --- Clean, manage, and inspect your keymaps -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2022 Positron Solutions 4 | 5 | ;; Author: Psionik K <73710933+psionic-k@users.noreply.github.com> 6 | ;; Keywords: convenience 7 | ;; Version: 0.1.0 8 | ;; Package-Requires: ((emacs "28.1") (keymap-utils "4.0.0")) 9 | ;; Homepage: http://github.com/positron-solutions/user-keys 10 | 11 | ;;; License notice: 12 | 13 | ;; SPDX-License-Identifier: GPL-3.0-or-later 14 | 15 | ;; This program is free software: you can redistribute it and/or modify 16 | ;; it under the terms of the GNU General Public License as published by 17 | ;; the Free Software Foundation, either version 3 of the License, or 18 | ;; (at your option) any later version. 19 | 20 | ;; This program is distributed in the hope that it will be useful, 21 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 22 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 23 | ;; GNU General Public License for more details. 24 | 25 | ;; You should have received a copy of the GNU General Public License 26 | ;; along with this program. If not, see . 27 | 28 | ;;; Commentary: 29 | 30 | ;; User-keys contains tools to diagnose and remove poor key bindings 31 | ;; and to free up key sequences that users actually want. 32 | 33 | ;;; Code: 34 | 35 | (require 'derived) 36 | (require 'dash) 37 | (require 'keymap-utils) 38 | (require 'transient) 39 | (require 'loadhist) 40 | 41 | (eval-when-compile (require 'subr-x)) 42 | 43 | ;; implementation state and constants 44 | 45 | (defvar user-keys-sequence nil "Current sequence being analyzed.") 46 | 47 | (defvar user-keys-operation nil "Current analysis operation.") 48 | 49 | (defvar user-keys-target-buffer nil "Current buffer for inspecting bindings.") 50 | 51 | ;; TODO f-keys are not currently part of a predicate 52 | (defconst user-keys--fkey-events 53 | (mapcar 54 | (lambda (c) (make-symbol (concat "f" (int-to-string c)))) 55 | (number-sequence 1 20)) 56 | "List of function key events, through F20.") 57 | 58 | ;; TODO stupid events not currently used to create a predicate 59 | (defvar user-keys--stupid-events 60 | '('insert 61 | 'pause 62 | 'print 63 | 'again 64 | 'begin 65 | 'insertchar 66 | 'insertline 67 | 'prior) 68 | "Set this to events you can't input on your keyboard.") 69 | 70 | ;; TODO exception sequences not implemented in stupid keys report 71 | (defvar user-keys--exception-sequences 72 | '([f1] [f11]) 73 | "Sequences to except from usual unbinding. 74 | Some key sequences are from desktop environment idioms rather 75 | than traditional Emacs design errors. While these desktop 76 | environments are also mostly wrong, the cost to benefit is in favor 77 | of keeping them bound.") 78 | 79 | (defvar user-keys--available-string (propertize "available" 'face 'success) 80 | "Nobody has spammed their keymap ads on this key sequence.") 81 | 82 | ;; helper functions for custom 83 | 84 | (defun user-keys-meta-ize (key-letters) 85 | "Return key-sequence encoded forms for meta modified KEY-LETTERS. 86 | KEY-LETERS should be a list of chars or integers." 87 | (--map (vconcat (kbd (format "M-%c" it))) key-letters)) 88 | 89 | (defun user-keys-ctl-fy (key-letters) 90 | "Return key-sequence encoded forms for ctl modified KEY-LETTERS. 91 | KEY-LETERS should be a list of chars or integers." 92 | (--map (vconcat (kbd (format "C-%c" it))) key-letters)) 93 | 94 | ;; customize 95 | 96 | (defgroup user-keys nil "Clean up, inspect, manage keymaps." 97 | :group 'convenience) 98 | 99 | (defcustom user-keys-buffer-name "*user-keys*" 100 | "Where should we display interactive output?" 101 | :type 'string 102 | :group 'user-keys) 103 | 104 | (defcustom user-keys-stupid-modifiers 105 | '(hyper super) 106 | "Sequences should almost never require these modifiers. 107 | Valid modifiers are in A-C-H-M-S-s order. Use `kbd', `vconcat' or 108 | `string-to-vector' and `event-modifiers' to translate Emacs notation to actual 109 | events and modifiers." 110 | :type '(repeat (repeat symbol)) 111 | :group 'user-keys) 112 | 113 | (defcustom user-keys-shifted-keys 114 | (string-to-list "~!@#$%^&*()_+{}|:\"<>?") 115 | "Keys that have an implied shift modifier." 116 | :type '(repeat 'character) 117 | :group 'user-keys) 118 | 119 | (defcustom user-keys-preferred-sequences 120 | (let ((home-row (string-to-list "asdfjkl;")) 121 | (other-meta (string-to-list "qwertyuiop[]\\gh'zxcvbnm,./")) 122 | ;; C-m is RET, C-i is TAB... 123 | ;; Control is just a good preferred modifier... 124 | (other-ctl (string-to-list "qwertyuop\\gh'zxcvbn,./"))) 125 | `((,(propertize "home meta keys\n" 'face 'success) 126 | ,(user-keys-meta-ize home-row)) 127 | (,(propertize "home ctl keys\n" 'face 'font-lock-builtin-face) 128 | ,(user-keys-ctl-fy home-row)) 129 | (,(propertize "meta keys\n" 'face 'font-lock-keyword-face) 130 | ,(user-keys-meta-ize other-meta)) 131 | (,(propertize "ctl keys\n" 'face 'font-lock-string-face) 132 | ,(user-keys-ctl-fy other-ctl)))) 133 | "Sequences to look report in `user-keys-report-preferred'. 134 | Set to an expression or function that returns a list of elements. 135 | Each element is a string and a list of key sequence vectors or a 136 | function that will return such a list. 137 | 138 | The string will be used to generate the match reasons, which are 139 | shown beside each match. There can be overlap in the sequences, 140 | in which case all match reasons will be shown. Sequences are 141 | sorted before display. 142 | 143 | By default, some top-level single-modifier keys on an English US 144 | keyboard are considered preferred sequences. Home row and non-home 145 | row are divided into two groups. 146 | 147 | You are welcome to contribute a function that will respect the 148 | user's keyboard layout and language settings. 149 | 150 | Here's an example expression that just has two sections, 151 | 152 | '((\"control keys\" 153 | ,(--map (vector it (number-sequence ?\C-a ?\C-z)))) 154 | (\"home left meta keys\" 155 | '([134217825] [134217843] [134217828] [134217830]))) 156 | 157 | Key sequences have a lot of variety. Too much. Use `kbd' and 158 | `vconcat' in ielm to output sequences and `key-description' to see 159 | what the outputs mean in Emacs style key sequence notation." 160 | 161 | :type '(repeat (list string (choice function (list key-sequence)))) 162 | :group 'user-keys) 163 | 164 | (defcustom user-keys-ignore-maps '(yank-menu 165 | xterm-function-map 166 | key-translation-map 167 | function-key-map) 168 | "Some maps are simultaneously very weird and not very useful. 169 | In particular, maps that cause errors because of, for example, 170 | failing the `keymapp' test after autoloaded but not before, 171 | should just be ignored." 172 | :type '(repeat symbol) 173 | :group 'user-keys) 174 | 175 | ;; implementation functions 176 | 177 | (defun user-keys--get-buffer () 178 | "Obtain the report buffer." 179 | (let ((buffer (get-buffer user-keys-buffer-name))) 180 | (or buffer 181 | (let ((buffer (get-buffer-create user-keys-buffer-name))) 182 | (set-buffer buffer) 183 | (user-keys-mode) 184 | buffer)))) 185 | 186 | ;; TODO tests for this macro 187 | (defmacro user-keys--with-buffer (&rest body) 188 | "Wrap the evaluation of BODY forms with buffer handling. 189 | We don't want to get read-only at the wrong time or execute in the 190 | wrong buffer's context." 191 | `(progn 192 | (set-buffer (user-keys--get-buffer)) 193 | (setq buffer-read-only nil) 194 | (condition-case form-value 195 | (progn ,@body) 196 | ((debug error) 197 | (setq buffer-read-only t) 198 | ;; propagate errors from BODY 199 | (signal (car form-value) (cadr form-value))) 200 | (:success 201 | (setq buffer-read-only t) 202 | form-value)))) 203 | 204 | (defun user-keys--pop-to-buffer () 205 | "Pop to the reporting buffer." 206 | (pop-to-buffer (user-keys--get-buffer))) 207 | 208 | (defsubst user-keys--maybe-button (text-or-symbol) 209 | "Format TEXT-OR-SYMBOL as a button that displays its documentation." 210 | (if (symbolp text-or-symbol) 211 | (propertize (symbol-name text-or-symbol) 212 | 'face 'button 213 | 'button '(t) 214 | 'category 'default-button) 215 | text-or-symbol)) 216 | 217 | ;; TODO make click actions appropriate for types. Keys should show shadows. 218 | ;; Maps should show preferred and stupid. Modes should show active maps etc. 219 | (defsubst user-keys--section-header (text-or-symbol indentation) 220 | "Make a dividing section header for TEXT-OR-SYMBOL. 221 | Indent by INDENTATION. If not indented, add an underline since 222 | this is a proper section. Make the symbol a button if it 223 | probably should be clickable." 224 | (let ((header-text (user-keys--maybe-button text-or-symbol))) 225 | (if (> indentation 0) 226 | (format "\n%s%s\n" (make-string indentation ?\s) header-text) 227 | (format "\n%s\n%s\n\n" header-text 228 | (make-string (length header-text) ?\-))))) 229 | 230 | (defun user-keys--describe-binding (binding) 231 | "Return a formatted representation of what the BINDING for a key is. 232 | This function handles the numerous possible types of values 233 | that can be returned from `key-binding' and during 234 | `kmu-map-keymap'." 235 | (cond 236 | ((eq nil binding) 237 | nil) 238 | ((or (symbolp binding) 239 | (stringp binding)) 240 | (user-keys--maybe-button binding)) 241 | ((keymapp binding) 242 | "") 243 | ((vectorp binding) ; maps to another sequence 244 | (key-description binding)) 245 | ((numberp binding) ; sequence too long 246 | (format "sequence %s keys too long for prefix" binding)) 247 | ((kmu-menu-binding-p binding) 248 | (format "menu-item - %s" 249 | ;; Some menus are... weird. Because. 250 | (if (proper-list-p binding) 251 | (nth 2 binding) 252 | (if (consp binding) 253 | (car binding) 254 | "")))) 255 | ;; TODO we can sometimes get the name out. 256 | ;; This was originally intended to fix up a weird menu item. 257 | ((functionp binding) 258 | "") 259 | (t 260 | (let* ((str-binding (format "%S" binding))) 261 | (if (> (length str-binding) 20) 262 | (format "Bound to: %.20s..." str-binding) 263 | (format "Bound to: %s" str-binding)))))) 264 | 265 | (defun user-keys--major-mode-keymaps () 266 | "Return a list of major modes map symbols." 267 | (let* ((major-mode-keymaps '()) 268 | (_ (mapatoms 269 | (lambda (a) (when (get a 'derived-mode-parent) 270 | (let ((mode-map-name (derived-mode-map-name a))) 271 | (with-demoted-errors "user-keys major mode lookup: %S" 272 | (when (keymapp 273 | (user-keys--symbol-to-map mode-map-name)) 274 | (push mode-map-name major-mode-keymaps))))))))) 275 | major-mode-keymaps)) 276 | 277 | (defun user-keys--minor-mode-keymaps (&optional active-only) 278 | "Return a list of all minor mode keymaps. 279 | Optional ACTIVE-ONLY argument will control if only active maps 280 | are returned." 281 | (-non-nil 282 | (--map (let* ((mode-name (car it)) 283 | (mode-map-name (derived-mode-map-name mode-name))) 284 | (if (and (or (not active-only) (symbol-value mode-name)) 285 | (keymapp (user-keys--symbol-to-map mode-map-name))) 286 | mode-map-name 287 | nil)) 288 | minor-mode-map-alist))) 289 | 290 | (defun user-keys--emulation-keymaps (&optional active-only) 291 | "Return a list of all minor mode keymaps. 292 | Optional ACTIVE-ONLY argument will control if only active maps 293 | are returned." 294 | ;; TODO go find how to scan these in Ikaruga 295 | (-map emulation-mode-map-alists)) 296 | 297 | (defun user-keys--other-maps(keymaps) 298 | "Return a list of all keymaps not in KEYMAPS. 299 | KEYMAP-LISTS is a list of lists of map symbols." 300 | (let ((other-keymaps (make-hash-table :test 'eq)) 301 | (known-keymaps (make-hash-table :test 'eq))) 302 | (mapc 303 | (lambda (map) 304 | (puthash map map known-keymaps)) 305 | keymaps) 306 | 307 | ;; TODO keymapp on symbols that have symbol-function is annoying 308 | ;; See `user-keys-symbol-to-map' for the reverse operation. 309 | (mapatoms (lambda (a) (when (or (keymapp a) 310 | (and (boundp a) (keymapp (symbol-value a))) 311 | (and (fboundp a) (keymapp (symbol-function a)))) 312 | (unless (or (indirect-function a) ; obsolete symbol 313 | (gethash a known-keymaps)) 314 | (puthash a a other-keymaps))))) 315 | (--remove (member it user-keys-ignore-maps) (hash-table-keys other-keymaps)))) 316 | 317 | (defun user-keys--maps-to-symbols (maps symbols) 318 | "Find which SYMBOLS refer to keymaps in MAPS. 319 | Also return any maps that didn't match. 320 | 321 | This is useful when trying to reconstruct outputs of 322 | `current-active-maps'. 323 | 324 | It would be nice to get a list of these objects as symbols in 325 | order for inferencing keymaps. This is the hard way." 326 | (let ((found) 327 | ;; warns on mapcar, just some dash noise 328 | (maps (--remove (equal it '(keymap)) maps))) 329 | (--map 330 | (let ((m (if (boundp it) 331 | (symbol-value it) 332 | (symbol-function it)))) 333 | (when (seq-contains-p maps m #'eq) ; only match objects 334 | (setq maps (delete m maps)) 335 | (push it found))) 336 | symbols) 337 | `(,found ,maps))) 338 | 339 | (defun user-keys--symbol-to-map (symbol) 340 | "Get an actual keymap for SYMBOL. 341 | `keymapp' will return t for all kinds of values. Keymaps, 342 | autoloads, symbols whose function definitions are keymaps. This 343 | function encapsulates these little quirks." 344 | (condition-case 345 | keymap-error 346 | (progn 347 | (let ((value (or (and (boundp symbol) (symbol-value symbol)) 348 | (and (fboundp symbol) (symbol-function symbol))))) 349 | ;; Go ahead and eagerly load all keymaps so that we can inspect them. 350 | ;; Sorry, user memory. 351 | (when (autoloadp value) 352 | (autoload-do-load value) 353 | (setq value (or (and (boundp symbol) (symbol-value symbol)) 354 | (and (fboundp symbol)(symbol-function symbol))))) 355 | (unless (keymapp value) 356 | (error "Values was not a keymap: %s" symbol)) 357 | value)) 358 | (error (message "No keymap could be obtained from symbol: %s" symbol)))) 359 | 360 | (defun user-keys--symbol-to-feature (symbol &optional ask prompt) 361 | "Return the feature that will define SYMBOL. 362 | If ASK is non-nil, ask the user, with optional PROMPT. This 363 | function attempts definitive answers first before using a 364 | heuristic approach and then finally asks the user to handle 365 | degenerate cases." 366 | (or (when (featurep symbol) symbol) 367 | (alist-get 'provide (assoc-string (symbol-file symbol) load-history)) 368 | (let ((found) ; attempt to find longest matching feature name. 369 | (words (string-split (symbol-name symbol) "-"))) 370 | (while (and words (not found)) 371 | (setq words (-butlast words)) 372 | (setq found (locate-library (string-join words "-")))) 373 | (when words (intern (string-join words "-")))) ; could create new symbols 374 | (when ask 375 | (read-feature 376 | (or prompt 377 | "Feature loading inference failed. Please select correct feature:"))))) 378 | 379 | (defsubst user-keys--normalize-sequence (sequence) 380 | "Round trip the SEQUENCE to eliminate common prefix effect. 381 | Within a keymap, having a common prefix seems to result in sequences 382 | with multiple keys even though the simple `kbd' result is just one key." 383 | (let ((reconverted (kbd (key-description sequence)))) 384 | (if (stringp reconverted) (vconcat reconverted) 385 | reconverted))) 386 | 387 | (defsubst user-keys--maybe-unroll (sequence) 388 | "Unrolls SEQUENCE if it is a range, returning first sequence." 389 | (vconcat (--map 390 | (if (and (consp it) (atom (cdr it))) 391 | (car it) 392 | it) 393 | sequence))) 394 | 395 | (defun user-keys--remove-mouse-mods (modifiers) 396 | "Remove mouse modifiers from MODIFIERS." 397 | (--remove (member it '(click drag down)) modifiers)) 398 | 399 | (defun user-keys--find (keymap seq-predicates &optional exclude-predicates) 400 | "Find all sequences in KEYMAP matched by SEQ-PREDICATES. 401 | 402 | Do not attempt to match sequences that are excluded by 403 | EXCLUDE-PREDICATES. 404 | 405 | Each predicate is called with SEQUENCE and DEFINITION. 406 | 407 | The only potential modification to SEQUENCE before evaluating 408 | predicates is that some sequences representing ranges will be 409 | unrolled into just the first sequence in the range. This means 410 | sequences like `C-0..C-9' will instead be called with just `C-0' and 411 | the result will apply to every key in the range. You can exclude 412 | ranges in EXCLUDE-PREDICATES when this creates a problem. 413 | 414 | Within each predicate, you may need to map over the individual keys in 415 | the sequence. If you need modifiers for a key, call 416 | `event-modifiers'. For the basic key or event, call 417 | `event-basic-type'. These functions return a list of modifiers and a 418 | list of basic events respectively. 419 | 420 | Each predicate can return a reason, and multiple reasons will be 421 | output into the buffer during analysis of bad keys. This is for 422 | easier design and debugging of rules." 423 | (let (matches match-excludes) 424 | (kmu-map-keymap 425 | (lambda (sequence definition) 426 | (let ((orig-sequence sequence) 427 | (sequence 428 | (condition-case error 429 | (user-keys--normalize-sequence 430 | (user-keys--maybe-unroll sequence)) 431 | (error 432 | (message "user-keys: sequence processed raw: %s" sequence) 433 | sequence))) 434 | (exclusions (-non-nil (--map 435 | (funcall it sequence definition) 436 | exclude-predicates)))) 437 | (if exclusions 438 | (push (list orig-sequence definition exclusions) match-excludes) 439 | (when-let ((reasons (-non-nil (--map (funcall it sequence definition) 440 | seq-predicates)))) 441 | (push (list orig-sequence definition reasons) matches))))) 442 | keymap) 443 | (list matches match-excludes))) 444 | 445 | (defun user-keys--render-report (report) 446 | "Generic output function for similar-ishly structured reports. 447 | REPORT is a plist. 448 | :title - This header is rendered first. Any string supported. 449 | :data - A list of elements. Each element is a plist with :header 450 | :col-labels and :rows. 451 | 452 | Each :data element will be rendered as a section and formatted so 453 | that :col-labels, if present, will be printed and aligned above 454 | data in :rows." 455 | (user-keys--with-buffer 456 | (erase-buffer) 457 | ;; TODO title is less prominent than section headers 458 | (insert (plist-get report :title) "\n") 459 | (user-keys--insert-rows (plist-get report :data) 0) 460 | (goto-char 0))) 461 | 462 | (defun user-keys--insert-rows (rows indentation) 463 | "Recursively insert ROWS into the buffer. 464 | Begin each row with INDENTATION spaces. Descend if ROWS is a 465 | plist containing :header, then print :rows. This can handle 466 | recursive plists." 467 | (when rows ; TODO filter empty sections during generation 468 | (let ((header (plist-get rows :header))) 469 | (when header 470 | (insert (user-keys--section-header header indentation)))) 471 | 472 | (let* ((rows (or (plist-get rows :rows) rows)) 473 | (recursive (plist-get (car rows) :rows))) 474 | (if recursive 475 | ;; if each row contains embedded rows, recurse into each 476 | ;; iteration. If not, just render each row. 477 | (--each rows (user-keys--insert-rows it (+ 2 indentation))) 478 | 479 | ;; TODO add col-labels to the header row after the widths 480 | ;; are known, just before inserting rows. Probably 481 | ;; requires backup up in the buffer and popping a mark. 482 | 483 | ;; column information needs to be extracted prior to 484 | ;; rendering any rows. 485 | (let* ((ncols (-max (-map #'length rows))) 486 | (widths (-map 487 | (lambda (n) 488 | (1+ (-max (--map 489 | ;; TODO munge this beforehand so we don't 490 | ;; ever need to convert 491 | (let ((item (nth n it))) 492 | (if (stringp item) 493 | (length item) 494 | (length (format "%s" item)))) 495 | rows)))) 496 | (number-sequence 0 (1- ncols))))) 497 | (--each rows 498 | (apply #'insert 499 | `(,(make-string indentation ?\s) 500 | ,@(-interpose 501 | " " 502 | (--map-indexed 503 | (let* ((width (nth it-index widths)) 504 | (str (if (stringp it) it (format "%s" it))) 505 | (short (- width (length str)))) 506 | (concat str (make-string short ?\s))) 507 | it)) 508 | "\n")))))))) 509 | 510 | (defun user-keys-report-preferred () 511 | "Show each of the user's preferred sequences in the current buffer." 512 | (interactive) 513 | 514 | ;; expand the preferred sequences if they contained functions 515 | ;; TODO test with functions 516 | (let* ((preferred (--map 517 | (let ((seqs (cadr it))) 518 | `(,(car it) ,(if (functionp seqs) 519 | (funcall seqs) 520 | seqs))) 521 | user-keys-preferred-sequences)) 522 | 523 | ;; First we want to see what bindings will be calculated. 524 | ;; This lookup doesn't tell us which map or why, but it does 525 | ;; tell us what the result will be. 526 | (target-buffer (or user-keys-target-buffer 527 | (current-buffer))) 528 | 529 | (local-lookups 530 | (with-current-buffer target-buffer 531 | (--map 532 | (let* ((sequences (cadr it)) 533 | (lookups 534 | (--map 535 | (list 536 | (key-description it) 537 | (or (when-let ((description (key-binding it t))) 538 | (user-keys--describe-binding description)) 539 | user-keys--available-string)) 540 | sequences))) 541 | (list :header (car it) 542 | :rows lookups)) 543 | preferred))) 544 | 545 | ;; TODO this section was being written to work on active 546 | ;; scan active maps with predicates, combining results with 547 | ;; map data to augment the key-binding pairs earlier 548 | ;; maps. It's not clear what the use case is or how it 549 | ;; should fit with other use cases. I left this section 550 | ;; commented in case someone wants to play around. 551 | ;; (predicates (--map (user-keys-sequences-predicate 552 | ;; (cadr it) (car it)) 553 | ;; preferred)) 554 | 555 | ;; (active-map-symbols 556 | ;; (let ((results (user-keys--maps-to-symbols 557 | ;; (current-active-maps) (user-keys--other-maps '())))) 558 | ;; (when (cadr results) 559 | ;; ;; this shouldn't ruin anyone's day, but it is weird. 560 | ;; (message "user-keys: Some maps could not be resolved to symbols.")) 561 | ;; (car results))) 562 | 563 | ;; ;; then report on active maps (which may save time by revealing shadows) 564 | ;; (scanned-lookups (--map 565 | ;; (list :header it 566 | ;; :rows (user-keys--find it predicates)) 567 | ;; active-map-symbols)) 568 | 569 | (report `(:title ,(format "Preferred Sequences in: %s" target-buffer) 570 | :data ,local-lookups))) 571 | (user-keys--render-report report))) 572 | 573 | (defun user-keys-report-shadows (sequence) 574 | "Show all keymaps that potentially could shadow SEQUENCE." 575 | (interactive (list (or user-keys-sequence 576 | (call-interactively 577 | #'user-keys-set-sequence-key)))) 578 | (let* ((basic-mode-maps '(special-mode-map 579 | text-mode-map 580 | prog-mode-map)) 581 | ;; `override-global-map' appears as an emulation map. 582 | (major-mode-maps (user-keys--major-mode-keymaps)) 583 | (minor-mode-maps (user-keys--minor-mode-keymaps)) 584 | (most-maps (append '(global-map) 585 | basic-mode-maps 586 | major-mode-maps 587 | minor-mode-maps)) 588 | (other-maps (user-keys--other-maps most-maps)) 589 | 590 | ;; `keymap-lookup' uses string input. `lookup-key' doc string 591 | ;; says to prefer `keymap-lookup'. 592 | (key-str (key-description sequence)) 593 | 594 | (lookups (->> 595 | `(,'(global-map) 596 | ,basic-mode-maps 597 | ,major-mode-maps 598 | ,minor-mode-maps 599 | ,other-maps) 600 | (--map (-sort #'string< it)) 601 | (--map ; it is a list of maps 602 | (-non-nil 603 | (--map ; it is a single map symbol 604 | (let ((binding (with-demoted-errors 605 | "couldn't get keymap for symbol %s" 606 | (keymap-lookup 607 | (user-keys--symbol-to-map it) 608 | key-str)))) 609 | (when binding 610 | (list it (user-keys--describe-binding binding)))) 611 | it))))) 612 | 613 | (sections '("Global Map" 614 | "Basic Mode Maps" 615 | "Major Mode Maps" 616 | "Minor Mode Maps" 617 | ;; TODO support overriding maps, 618 | ;; support showing maps in lookup order. 619 | "Other Maps")) 620 | (data (->> 621 | (-zip sections lookups) 622 | (--map (when (cdr it) (list 623 | :header (car it) 624 | :rows (cdr it)))) 625 | (-non-nil))) 626 | (report `(:title 627 | ,(format 628 | "Shadows for %s" 629 | (propertize key-str 'face 'success)) 630 | :data ,data))) 631 | (user-keys--render-report report))) 632 | 633 | (defun user-keys-report-stupid () 634 | "Show all of the stupid key sequences that are currently bound." 635 | (interactive) 636 | ;; scan all keymaps and present each one as a section. 637 | ;; TODO it may be more user friendly to look at a single keymap or 638 | ;; buffer to see the preferred and stupid bindings. 639 | (let* ((basic-mode-maps '(special-mode-map 640 | text-mode-map 641 | prog-mode-map)) 642 | ;; `override-global-map' appears as an emulation map. 643 | (major-mode-maps (user-keys--major-mode-keymaps)) 644 | (minor-mode-maps (user-keys--minor-mode-keymaps)) 645 | (most-maps (append '(global-map) 646 | basic-mode-maps 647 | major-mode-maps 648 | minor-mode-maps)) 649 | (other-maps (user-keys--other-maps most-maps)) 650 | (predicates user-keys-stupid-predicates) 651 | 652 | ;; Scan each map with predicates and amend results by 653 | ;; appending the map name to each value. 654 | (lookups (->> 655 | `((global-map) 656 | ,basic-mode-maps 657 | ,major-mode-maps 658 | ,minor-mode-maps 659 | ,other-maps) 660 | (--map (-sort #'string< it)) 661 | (--map ; it is a list of map symbols 662 | (-non-nil 663 | (--map ; it is a single map symbol 664 | (if-let ((map (user-keys--symbol-to-map it))) 665 | (condition-case error 666 | (when-let ((scanned (car (user-keys--find map predicates))) 667 | (display 668 | (--map 669 | (list 670 | (key-description (nth 0 it)) 671 | (user-keys--describe-binding (nth 1 it)) 672 | (mapconcat #'identity (nth 2 it) ", ")) 673 | scanned))) 674 | (when display (list :header it 675 | :rows display))) 676 | (error (warn "Keymap scan failed: %s" it))) 677 | (warn "Keymap could not be scanned: %s" it)) 678 | it))))) 679 | 680 | (sections '("Global Map" 681 | "Basic Mode Maps" 682 | "Major Mode Maps" 683 | "Minor Mode Maps" 684 | "Other Maps")) 685 | (data (->> 686 | (-zip sections lookups) 687 | (--map (when (cdr it) (list 688 | :header (car it) 689 | :rows (cdr it)))) 690 | (-non-nil))) 691 | (report `(:title "Stupid Keys - bindings that should just not" 692 | :data ,data))) 693 | (user-keys--render-report report))) 694 | 695 | (defun user-keys-generate-unbinds (output-type) 696 | "Generate an unbinding expression for OUTPUT-TYPE." 697 | (interactive) 698 | 699 | (undefined)) 700 | 701 | ;; functions useful for those extending user-keys, part of external API 702 | 703 | (defun user-keys-key-predicate (key reason) 704 | "Return a predicate that will match KEY. 705 | The REASON will be returned for reporters." 706 | (lambda (sequence _) 707 | (when (seq-contains-p sequence key) 708 | reason))) 709 | 710 | (defun user-keys-basic-events-predicate (basic-events reason) 711 | "Return predicate matching sequences containing any of BASIC-EVENTS. 712 | The REASON will be returned for reporters. 713 | 714 | Basic events are a list, and for mouse events for example, can contain 715 | multiple elements." 716 | (lambda (sequence _) 717 | (when (-non-nil 718 | (--map (seq-contains-p basic-events (event-basic-type it)) 719 | sequence)) 720 | reason))) 721 | 722 | (defun user-keys-sequences-predicate (sequences reason) 723 | "Return a predicate that matches any sequence from SEQUENCES. 724 | The REASON will be returned for reporters." 725 | (lambda (sequence _) 726 | (message "sequence: %s" sequence) 727 | (when (member sequence sequences) reason))) 728 | 729 | (defun user-keys-multiple-modifiers-predicate (reason) 730 | "Return predicate matching keys with multiple modifiers. 731 | The REASON will be returned for reporters." 732 | (lambda (sequence _) 733 | (when (-non-nil 734 | (--map 735 | (> (length (user-keys--remove-mouse-mods 736 | (event-modifiers it))) 737 | 1) 738 | sequence)) 739 | reason))) 740 | 741 | (defun user-keys-modifiers-predicate (modifiers reason) 742 | "Return predicate matching keys with one of MODIFIERS. 743 | The REASON will be returned for reporters." 744 | (lambda (sequence _) 745 | (when (-non-nil 746 | (--map 747 | (when-let ((event-mods (user-keys--remove-mouse-mods 748 | (event-modifiers it)))) 749 | (-non-nil (--map (member it modifiers) event-mods))) 750 | sequence)) 751 | reason))) 752 | 753 | (defun user-keys-modified-basic-events-predicate (basic-events reason) 754 | "Return a predicate matching any modified use of BASIC-EVENTS. 755 | The REASON will be returned for reporters." 756 | (lambda (sequence _) 757 | (when (-non-nil 758 | (--map (and (event-modifiers it) 759 | (seq-contains-p basic-events (event-basic-type it))) 760 | sequence)) 761 | reason))) 762 | 763 | (defun user-keys-one-mod-events-predicate (modifiers 764 | basic-events reason) 765 | "Return a predicate matching single MODIFIERS and BASIC-EVENTS. 766 | This is useful for looking at top-level, simply modified sequences. 767 | The REASON will be returned for reporters." 768 | (lambda (sequence _) 769 | (when (-non-nil 770 | (--map 771 | (let ((sequence-mods (event-modifiers it))) 772 | (and (= (length sequence-mods) 1) 773 | (seq-contains-p modifiers 774 | (car sequence-mods)) 775 | (seq-contains-p basic-events 776 | (event-basic-type it)))) 777 | sequence)) 778 | reason))) 779 | 780 | (defun user-keys-commands-predicate (commands reason) 781 | "Return a predicate matching COMMANDS. 782 | The REASON will be returned for reporters." 783 | (lambda (_ description) 784 | (message "description %s" description) 785 | (when (member description commands) 786 | reason))) 787 | 788 | ;; TODO add exceptions 789 | ;; Had to move this after predicates for loading order 790 | (defcustom user-keys-stupid-predicates 791 | (list (user-keys-multiple-modifiers-predicate 792 | "multiple modifiers") 793 | (user-keys-modified-basic-events-predicate 794 | user-keys--fkey-events "modified function keys") 795 | (user-keys-modifiers-predicate user-keys-stupid-modifiers 796 | "difficult modifiers") 797 | (user-keys-modified-basic-events-predicate 798 | user-keys-shifted-keys "modified shift keys")) 799 | "Predicates used to report stupid bindings." 800 | :type '(repeat function) 801 | :group 'user-keys) 802 | 803 | ;; user commands and modes 804 | 805 | (defun user-keys--describe-current-sequence () 806 | "Format's the current sequence for display as a group description." 807 | (format "Current key: %s" (if user-keys-sequence 808 | (propertize (key-description 809 | user-keys-sequence) 810 | 'face 'success) 811 | (propertize "none" 'face 'shadow)))) 812 | 813 | (defun user-keys--describe-target-buffer () 814 | "Format's the current buffer for display as a group description." 815 | (format "Target buffer: %s" (if user-keys-target-buffer 816 | (propertize 817 | (buffer-name (get-buffer 818 | user-keys-target-buffer)) 819 | 'face 'success) 820 | (propertize "none" 'face 'shadow)))) 821 | 822 | (defun user-keys-set-target-buffer (buffer) 823 | "Set the BUFFER used for inspecting bindings. 824 | See `user-keys-target-buffer'." 825 | (interactive "bTarget buffer for binding inspection: ") 826 | (setq user-keys-target-buffer buffer)) 827 | 828 | (defun user-keys-set-sequence-key (key) 829 | "Set `user-keys-sequence' by inputting just one KEY. 830 | The key does not need to be bound in any active maps." 831 | (interactive (list (read-key "Enter a key: "))) 832 | (setq user-keys-sequence (vector key))) 833 | 834 | (defun user-keys-set-sequence (sequence) 835 | "Set the SEQUENCE to analyze for buffer or mode maps. 836 | The sequence needs to be bound. Incomplete sequences will 837 | continue reading. TODO This seems to behave differently when 838 | called within transient versus directly. The transient menu has 839 | different maps active." 840 | (interactive (list (read-key-sequence-vector "Bound key sequence: "))) 841 | (setq user-keys-sequence sequence) 842 | ;; there's no feedback when a sequence terminates 843 | (message "Sequence set!")) 844 | 845 | (defun user-keys-set-sequence-string (sequence) 846 | "Set the SEQUENCE, but use a string input. 847 | This can be useful when `read-key-sequence' will not terminate input 848 | because the input in the active maps is still a prefix." 849 | (interactive 850 | (list (let (sequence) 851 | (while (not sequence) 852 | (let ((input (read-string "Key description (for `kbd'): "))) 853 | (if (with-demoted-errors 854 | "`kbd' failed for input: %s" 855 | (kbd input)) 856 | (setq sequence (kbd input)) 857 | (message "Input must be valid argument to call `kbd' function.") 858 | (sit-for 3)))) 859 | sequence))) 860 | (setq user-keys-sequence sequence)) 861 | 862 | (defun user-keys-refresh () 863 | "Refresh the results buffer." 864 | (interactive) 865 | (undefined)) 866 | 867 | ;;;###autoload 868 | (transient-define-prefix user-keys-dispatch () 869 | "Controls for user-keys package." 870 | [["Generate Report" 871 | ("s" "sequence shadows report" user-keys-report-shadows) 872 | ("p" "preferred sequences report" user-keys-report-preferred) 873 | ("t" "stupid sequences report" user-keys-report-stupid) 874 | ("T" "unbinds" user-keys-generate-unbinds)] 875 | ["Controls" 876 | ("h" "toggle menu" transient-quit-one) 877 | ("g" "refresh" user-keys-refresh)]] 878 | ["Options" 879 | [:description 880 | user-keys--describe-current-sequence 881 | "" 882 | ("k" "set sequence (key)" user-keys-set-sequence-key :transient t) 883 | ;; setting the sequence with `kbd' doesn't depend on active maps. 884 | ("S" "set sequence (string)" user-keys-set-sequence-string 885 | :transient t) 886 | ("K" "set sequence" user-keys-set-sequence :transient t)] 887 | [:description 888 | user-keys--describe-target-buffer 889 | "" 890 | ("b" "active buffer" user-keys-set-target-buffer :transient t)]]) 891 | 892 | (declare-function helpful-at-point "helpful" ()) 893 | (defun user-keys--push-button () 894 | "Open help for symbol at point. 895 | Use `helpful' package if loaded." 896 | (interactive) 897 | (if (featurep 'helpful) 898 | (helpful-at-point) 899 | (describe-symbol (symbol-at-point)))) 900 | 901 | (defvar user-keys-mode-map 902 | (let ((map (make-sparse-keymap))) 903 | (set-keymap-parent 904 | map 905 | (make-composed-keymap '(button-buffer-map special-mode-map))) 906 | (define-key map "g" 'user-keys-refresh) 907 | (define-key map "h" 'user-keys-dispatch) 908 | (define-key map "?" 'user-keys-dispatch) 909 | 910 | (define-key map "k" 'user-keys-set-sequence-key) 911 | (define-key map "S" 'user-keys-set-sequence-string) 912 | (define-key map "K" 'user-keys-set-sequence) 913 | (define-key map "b" 'user-keys-set-target-buffer) 914 | 915 | (define-key map "s" 'user-keys-report-shadows) 916 | (define-key map "p" 'user-keys-report-preferred) 917 | (define-key map "t" 'user-keys-report-stupid) 918 | (define-key map "T" 'user-keys-report-unbinds) 919 | 920 | ;; TODO different kinds of values could exist. Function 921 | ;; keymaps are an example. 922 | (define-key map [remap push-button] #'user-keys--push-button) 923 | map)) 924 | 925 | (define-derived-mode user-keys-mode special-mode 926 | "user-keys-mode" 927 | :interactive nil 928 | :group 'user-keys 929 | (use-local-map user-keys-mode-map)) 930 | 931 | ;;;###autoload 932 | (defun user-keys-start () 933 | "An application to inspect bindings and generate re-bindings." 934 | (interactive) 935 | (pop-to-buffer (user-keys--get-buffer)) 936 | (call-interactively #'user-keys-dispatch)) 937 | 938 | (provide 'user-keys) 939 | ;;; user-keys.el ends here 940 | -------------------------------------------------------------------------------- /test/user-keys-abstract-test.el: -------------------------------------------------------------------------------- 1 | ;;; user-keys-abstract-test.el --- test your freaking package! -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2022 Positron Solutions 4 | 5 | ;; Author: 6 | 7 | ;; Permission is hereby granted, free of charge, to any person obtaining a copy of 8 | ;; this software and associated documentation files (the "Software"), to deal in 9 | ;; the Software without restriction, including without limitation the rights to 10 | ;; use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 11 | ;; the Software, and to permit persons to whom the Software is furnished to do so, 12 | ;; subject to the following conditions: 13 | 14 | ;; The above copyright notice and this permission notice shall be included in all 15 | ;; copies or substantial portions of the Software. 16 | 17 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 18 | ;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 19 | ;; FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 20 | ;; COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 21 | ;; IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 22 | ;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 23 | 24 | ;;; Commentary: 25 | 26 | ;; Run the batch tests from root directory: 27 | ;; nix shell .github#emacsGit --quick --script .github/run-shim.el -- test 28 | ;; Test dependencies can be provided to the Emacsen declared inside the root 29 | ;; flake.nix. 30 | 31 | ;; For local development, dependencies should be installed by the user. Tests 32 | ;; can be run from one of the project files using the `erk-ert-project' 33 | ;; command. 34 | 35 | ;;; Code: 36 | 37 | (require 'ert) 38 | (require 'user-keys-abstract) 39 | 40 | (ert-deftest user-keys-abstract--expand-shadow-remaps-test () 41 | (should 42 | (equal 43 | ;; test with a single inline shadow-remap 44 | (user-keys-abstract--expand-shadow-remaps 45 | '((abstract-forward "C-n" forward-word) 46 | (org org-mode-map org-forward-word))) 47 | 48 | '((org 49 | (define-key org-mode-map 50 | (kbd "C-n") 51 | nil t)) 52 | (org 53 | (define-key org-mode-map 54 | (vector 'remap #'abstract-forward) 55 | #'org-forward-word))))) 56 | 57 | (should 58 | (equal 59 | ;; test expansion of multiple shadow maps and inline. 60 | ;; result should be flat (feature define-key) forms 61 | (user-keys-abstract--expand-shadow-remaps 62 | '((abstract-forward "C-n" forward-word) 63 | (foo foo-mode-map foo-forward-word) 64 | (bar (bar-one-mode-map bar-reverse) 65 | (bar-two-mode-map bar-double)))) 66 | '((foo 67 | (define-key foo-mode-map 68 | (kbd "C-n") 69 | nil t)) 70 | (foo 71 | (define-key foo-mode-map 72 | (vector 'remap #'abstract-forward) 73 | #'foo-forward-word)) 74 | (bar 75 | (define-key bar-one-mode-map 76 | (kbd "C-n") 77 | nil t)) 78 | (bar 79 | (define-key bar-one-mode-map 80 | (vector 'remap #'abstract-forward) 81 | #'bar-reverse)) 82 | (bar 83 | (define-key bar-two-mode-map 84 | (kbd "C-n") 85 | nil t)) 86 | (bar 87 | (define-key bar-two-mode-map 88 | (vector 'remap #'abstract-forward) 89 | #'bar-double)))))) 90 | 91 | (ert-deftest user-keys-abstract-define-remap-test () 92 | (should 93 | (equal 94 | (macroexpand 95 | '(user-keys-abstract-define-remap 96 | ((abstract-forward "C-q" forward-word) 97 | (org org-mode-map org-forward-word)))) 98 | '(progn 99 | (defun abstract-forward 'nil "Abstract command target.\nThis is a global map abstract command." 100 | (interactive) 101 | (undefined)) 102 | (define-key global-map 103 | (kbd "C-q") 104 | #'abstract-forward) 105 | (define-key global-map 106 | (vector 'remap #'abstract-forward) 107 | #'forward-word) 108 | (eval-after-load 'org 109 | (progn 110 | (define-key org-mode-map 111 | (kbd "C-q") 112 | nil t) 113 | (define-key org-mode-map 114 | (vector 'remap #'abstract-forward) 115 | #'org-forward-word)))))) 116 | 117 | (should 118 | (equal 119 | (macroexpand 120 | '(user-keys-abstract-define-remap 121 | ((abstract-forward "C-n" forward-word) 122 | (bar (bar-one-mode-map bar-reverse) 123 | (bar-two-mode-map bar-double))))) 124 | '(progn 125 | (defun abstract-forward 'nil "Abstract command target.\nThis is a global map abstract command." 126 | (interactive) 127 | (undefined)) 128 | (define-key global-map 129 | (kbd "C-n") 130 | #'abstract-forward) 131 | (define-key global-map 132 | (vector 'remap #'abstract-forward) 133 | #'forward-word) 134 | (eval-after-load 'bar 135 | (progn 136 | (define-key bar-one-mode-map 137 | (kbd "C-n") 138 | nil t) 139 | (define-key bar-one-mode-map 140 | (vector 'remap #'abstract-forward) 141 | #'bar-reverse) 142 | (define-key bar-two-mode-map 143 | (kbd "C-n") 144 | nil t) 145 | (define-key bar-two-mode-map 146 | (vector 'remap #'abstract-forward) 147 | #'bar-double)))))) 148 | 149 | (should 150 | (equal 151 | (macroexpand 152 | '(user-keys-abstract-define-remap 153 | ((abstract-quit "C-g" keyboard-quit) 154 | (foo foo-mode-map foo-quit)) 155 | ((abstract-forward "C-n" forward-word) 156 | (bar (bar-one-mode-map bar-reverse) 157 | (bar-two-mode-map bar-double))))) 158 | '(progn 159 | (defun abstract-quit 'nil "Abstract command target.\nThis is a global map abstract command." 160 | (interactive) 161 | (undefined)) 162 | (defun abstract-forward 'nil "Abstract command target.\nThis is a global map abstract command." 163 | (interactive) 164 | (undefined)) 165 | (define-key global-map 166 | (kbd "C-g") 167 | #'abstract-quit) 168 | (define-key global-map 169 | (vector 'remap #'abstract-quit) 170 | #'keyboard-quit) 171 | (define-key global-map 172 | (kbd "C-n") 173 | #'abstract-forward) 174 | (define-key global-map 175 | (vector 'remap #'abstract-forward) 176 | #'forward-word) 177 | (eval-after-load 'foo 178 | (progn 179 | (define-key foo-mode-map 180 | (kbd "C-g") 181 | nil t) 182 | (define-key foo-mode-map 183 | (vector 'remap #'abstract-quit) 184 | #'foo-quit))) 185 | (eval-after-load 'bar 186 | (progn 187 | (define-key bar-one-mode-map 188 | (kbd "C-n") 189 | nil t) 190 | (define-key bar-one-mode-map 191 | (vector 'remap #'abstract-forward) 192 | #'bar-reverse) 193 | (define-key bar-two-mode-map 194 | (kbd "C-n") 195 | nil t) 196 | (define-key bar-two-mode-map 197 | (vector 'remap #'abstract-forward) 198 | #'bar-double))))))) 199 | 200 | (provide 'user-keys-abstract-test) 201 | ;;; user-keys-abstract-test.el ends here. 202 | -------------------------------------------------------------------------------- /test/user-keys-test.el: -------------------------------------------------------------------------------- 1 | ;;; user-keys-test.el --- test your freaking package! -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2022 Positron Solutions 4 | 5 | ;; Author: 6 | 7 | ;; Permission is hereby granted, free of charge, to any person obtaining a copy of 8 | ;; this software and associated documentation files (the "Software"), to deal in 9 | ;; the Software without restriction, including without limitation the rights to 10 | ;; use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 11 | ;; the Software, and to permit persons to whom the Software is furnished to do so, 12 | ;; subject to the following conditions: 13 | 14 | ;; The above copyright notice and this permission notice shall be included in all 15 | ;; copies or substantial portions of the Software. 16 | 17 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 18 | ;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 19 | ;; FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 20 | ;; COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 21 | ;; IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 22 | ;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 23 | 24 | ;;; Commentary: 25 | 26 | ;; Run the batch tests from root directory: 27 | ;; nix shell .github#emacsGit --quick --script .github/run-shim.el -- test 28 | ;; Test dependencies can be provided to the Emacsen declared inside the root 29 | ;; flake.nix. 30 | 31 | ;; For local development, dependencies should be installed by the user. Tests 32 | ;; can be run from one of the project files using the `erk-ert-project' 33 | ;; command. 34 | 35 | ;;; Code: 36 | 37 | (require 'ert) 38 | (require 'user-keys) 39 | 40 | (ert-deftest user-keys--maybe-button-test () 41 | (user-keys--maybe-button 'switch-frame)) 42 | 43 | (ert-deftest user-keys--keymaps-test () 44 | (should (equal (user-keys--maybe-unroll [1 2 3]) [1 2 3])) 45 | (should (equal (user-keys--maybe-unroll [1 2 (4 . 3)]) [1 2 4]))) 46 | 47 | (ert-deftest user-keys--major-mode-maps-test () 48 | (should (member 'emacs-lisp-mode-map (user-keys--major-mode-keymaps))) 49 | (should (not (member 'prog-mode-map (user-keys--major-mode-keymaps)))) 50 | (should (not (member 'global-map (user-keys--major-mode-keymaps))))) 51 | 52 | (ert-deftest user-keys--minor-mode-maps-test () 53 | (should (member 'context-menu-mode-map (user-keys--minor-mode-keymaps))) 54 | (should (not (member 'context-menu-mode-map (user-keys--minor-mode-keymaps t)))) 55 | (should (not (member 'prog-mode-map (user-keys--minor-mode-keymaps))))) 56 | 57 | (ert-deftest user-keys--other-mode-maps-test () 58 | (should (not (member 'emacs-lisp-mode-map 59 | (user-keys--other-maps 60 | (user-keys--major-mode-keymaps))))) 61 | (should (member 'global-map (user-keys--other-maps 62 | (user-keys--major-mode-keymaps))))) 63 | 64 | (ert-deftest user-keys--maps-to-symbols-test () 65 | (should (equal '((global-map) nil) 66 | (user-keys--maps-to-symbols 67 | (list (current-global-map)) '(global-map)))) 68 | (should (equal `(nil (,global-map)) 69 | (user-keys--maps-to-symbols 70 | (list (current-global-map)) '())))) 71 | 72 | (ert-deftest user-keys--symbol-to-map-test () 73 | ;; sanity check on the number of maps in the test, about 600 with packages 74 | ;; installed 75 | (should (> (length (user-keys--other-maps '())) 50)) 76 | (should (let ((bad-maps '())) 77 | (mapc (lambda (km) 78 | (unless (keymapp (user-keys--symbol-to-map km)) 79 | (push km bad-maps))) 80 | (user-keys--other-maps '())) 81 | (not bad-maps)))) 82 | 83 | (ert-deftest user-keys--find-test () 84 | ;; no predicates, empty list 85 | (should (equal (user-keys--find global-map nil) '(nil nil))) 86 | 87 | ;; predicate matching all sequences results in nil matches and full excludes 88 | (pcase-let ((`(,matches ,excludes) (user-keys--find global-map 89 | (list (lambda (_s _d) "because"))))) 90 | (should (> (length matches) 10)) 91 | (should (not excludes))) 92 | 93 | ;; predicate matching all sequences but also all excludes results in 94 | ;; empty matches and full excludes 95 | (pcase-let ((`(,matches ,excludes) (user-keys--find global-map 96 | (list (lambda (_s _d) "because")) 97 | (list (lambda (_s _d) "oh-no"))))) 98 | (should (not matches)) 99 | (should (> (length excludes) 10)))) 100 | 101 | (ert-deftest user-keys-key-predicate-test () 102 | (let ((predicate (user-keys-key-predicate ?\C-x "reason")) 103 | (map (make-sparse-keymap))) 104 | 105 | ;; target key not bound, don't match 106 | (define-key map (kbd "C-a") #'forward-char) 107 | (should (equal (user-keys--find map (list predicate)) '(nil nil))) 108 | 109 | ;; match after key is bound 110 | (define-key map (kbd "C-x") #'forward-word) 111 | (should (equal (user-keys--find map (list predicate)) 112 | '((([24] forward-word ("reason"))) nil))))) 113 | 114 | (ert-deftest user-keys-sequences-predicate-test () 115 | (let ((predicate (user-keys-sequences-predicate '([134217825]) "i like these")) 116 | (map (make-sparse-keymap))) 117 | 118 | ;; target key not bound, don't match 119 | (define-key map (kbd "C-a") #'forward-char) 120 | (should (equal (user-keys--find map (list predicate)) '(nil nil))) 121 | 122 | ;; match after a correct sequence is bound 123 | (define-key map (kbd "M-a") #'forward-word) 124 | (should (equal (user-keys--find map (list predicate)) 125 | '((([27 97] forward-word ("i like these"))) nil))))) 126 | 127 | (ert-deftest user-keys-basic-events-predicate-test () 128 | (let ((predicate (user-keys-basic-events-predicate (string-to-list "a") "a reason")) 129 | (map (make-sparse-keymap))) 130 | 131 | ;; bind another basic event, match nothing 132 | (define-key map (kbd "C-e") #'forward-char) 133 | (should (equal (user-keys--find map (list predicate)) '(nil nil))) 134 | 135 | ;; match after matching event is bound 136 | (define-key map (kbd "C-a") #'forward-char) 137 | (should (equal (user-keys--find map (list predicate)) 138 | '((([1] forward-char ("a reason"))) nil))))) 139 | 140 | (ert-deftest user-keys-multiple-modifiers-predicate-test () 141 | (let ((predicate (user-keys-multiple-modifiers-predicate "broken fingers")) 142 | (map (make-sparse-keymap))) 143 | 144 | ;; bind a single modified key and no matches result 145 | (define-key map (kbd "C-e") #'forward-char) 146 | (should (equal (user-keys--find map (list predicate)) '(nil nil))) 147 | 148 | ;; bind a key with multiple modifiers and get a match 149 | 150 | ;; note: view [27 1] with `key-description' as it is not normalized 151 | ;; and depends on the local state of map. 152 | (define-key map (kbd "C-M-a") #'forward-char) 153 | (should (equal (user-keys--find map (list predicate)) 154 | '((([27 1] forward-char ("broken fingers"))) nil))))) 155 | 156 | (ert-deftest user-keys-modifiers-predicate-test () 157 | (let ((predicate (user-keys-modifiers-predicate '(hyper) "broken fingers")) 158 | (map (make-sparse-keymap))) 159 | 160 | ;; bind a modified event not in the list and no matches result 161 | (define-key map (kbd "s-a") #'forward-char) 162 | (should (equal (user-keys--find map (list predicate)) '(nil nil))) 163 | 164 | ;; bind a key with a matching modifier and get a result 165 | 166 | ;; note: view [27 1] with `key-description' as it is not normalized 167 | ;; and depends on the local state of map. 168 | (define-key map (kbd "H-a") #'forward-char) 169 | (should (equal (user-keys--find map (list predicate)) 170 | '((([16777313] forward-char ("broken fingers"))) nil))))) 171 | 172 | (ert-deftest user-keys-modified-basic-events-predicate-test () 173 | (let ((predicate (user-keys-modified-basic-events-predicate 174 | '(f1) 175 | "broken fingers")) 176 | (map (make-sparse-keymap))) 177 | 178 | ;; bind a single modified key and no matches result 179 | (define-key map (kbd "") #'forward-char) 180 | (should (equal (user-keys--find map (list predicate)) '(nil nil))) 181 | 182 | ;; bind a key with multiple modifiers and get a match 183 | (define-key map (kbd "C-") #'forward-char) 184 | (should (equal (user-keys--find map (list predicate)) 185 | '((([C-f1] forward-char ("broken fingers"))) nil))))) 186 | 187 | (ert-deftest user-keys-one-mod-events-predicate-test () 188 | (let ((predicate (user-keys-one-mod-events-predicate 189 | '(meta) 190 | '(97 98 99) ; a b c 191 | "my favorites")) 192 | (map (make-sparse-keymap))) 193 | 194 | ;; bind an unmodified key and see no matches 195 | (define-key map (kbd "a") #'forward-char) 196 | (should (equal (user-keys--find map (list predicate)) '(nil nil))) 197 | 198 | ;; bind an a key with wrong modifier, get no matches 199 | (define-key map (kbd "C-a") #'forward-char) 200 | (should (equal (user-keys--find map (list predicate)) '(nil nil))) 201 | 202 | ;; write modifier, wrong key 203 | (define-key map (kbd "M-d") #'forward-char) 204 | (should (equal (user-keys--find map (list predicate)) '(nil nil))) 205 | 206 | ;; bind a key with correct modifier and correct events, get a match 207 | 208 | ;; note: view [27 97] with `key-description' as it is not normalized 209 | ;; and depends on the local state of map. 210 | (define-key map (kbd "M-a") #'forward-char) 211 | (should (equal (user-keys--find map (list predicate)) 212 | '((([27 97] forward-char ("my favorites"))) nil))))) 213 | 214 | (ert-deftest user-keys-commands-predicate-test () 215 | (let ((predicate (user-keys-commands-predicate 216 | '(forward-char) 217 | "too forward thinking")) 218 | (map (make-sparse-keymap))) 219 | 220 | ;; bind wrong command, get no results 221 | (define-key map (kbd "a") #'backward-char) 222 | (should (equal (user-keys--find map (list predicate)) '(nil nil))) 223 | 224 | ;; bind correct command, get results 225 | (define-key map (kbd "a") #'forward-char) 226 | (should (equal (user-keys--find map (list predicate)) 227 | '((([97] forward-char ("too forward thinking"))) nil))))) 228 | 229 | (ert-deftest user-keys-report-shadows-test () 230 | (user-keys-report-shadows [24])) 231 | 232 | (ert-deftest user-keys--symbol-to-feature-test () 233 | (should 234 | (eq (user-keys--symbol-to-feature 'org-really-long-fake-symbol) 'org)) 235 | (should 236 | (eq (user-keys--symbol-to-feature 'backquote) 'backquote)) 237 | (should 238 | (eq (user-keys--symbol-to-feature 'backquote-fake-symbol) 'backquote)) 239 | (should 240 | (eq (user-keys--symbol-to-feature 'this-symbol-does-not-exist) nil))) 241 | 242 | (provide 'user-keys-test) 243 | ;;; user-keys-test.el ends here. 244 | 245 | ;; Local Variables: 246 | ;; jinx-local-words: #("Pcase" 0 5 (jinx--group "Accept and save word" jinx--suffix #(" [File]" 0 7 (face jinx-annotation)))) 247 | ;; End: 248 | --------------------------------------------------------------------------------