diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/general-20180628.1112/general.el')
| -rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/general-20180628.1112/general.el | 2469 |
1 files changed, 2469 insertions, 0 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/general-20180628.1112/general.el b/configs/shared/emacs/.emacs.d/elpa/general-20180628.1112/general.el new file mode 100644 index 0000000000..0f6ea39a90 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/general-20180628.1112/general.el @@ -0,0 +1,2469 @@ +;;; general.el --- Convenience wrappers for keybindings. -*- lexical-binding: t -*- + +;; Author: Fox Kiester <noct@openmailbox.org> +;; URL: https://github.com/noctuid/general.el +;; Package-Version: 20180628.1112 +;; Created: February 17, 2016 +;; Keywords: vim, evil, leader, keybindings, keys +;; Package-Requires: ((emacs "24.4") (cl-lib "0.5")) +;; Version: 0.1 + +;; This file is not part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; This package provides convenient wrappers for more succinctly defining +;; keybindings. It allows defining multiple keys at once, specifying an +;; arbitrary number of named prefix keys to be used in key definitions, +;; implicitly wrapping key strings with (kbd ...), and more. It provides a +;; single function for standard emacs key definitions as well as evil key +;; definitions for any evil state and any keymap. It also provides a setup +;; function to generate "nmap", "vmap", etc. keybinding functions for evil. + +;; For more information see the README in the online repository. + +;;; Code: +(require 'cl-lib) + +;; * Settings +(defgroup general nil + "Gives convenient wrappers for key definitions." + :group 'convenience + :prefix 'general-) + +(defcustom general-implicit-kbd t + "Whether to implicitly wrap a (kbd) around `general-define-key' keys. +This applies to the prefix key as well. This option is provided to make it easy + to transition from other key definers to `general-define-key'. It does not + apply to other helpers such as `general-key', `general-key-dispatch', and + `general-translate-key'. These will always use `kbd' on keys that are + strings." + :group 'general + :type 'boolean) + +(defcustom general-default-prefix nil + "The default prefix key sequence to use." + :group 'general + :type 'string) +(make-obsolete-variable 'general-default-prefix + "This functionality will be removed in the future." + "2018-01-21") + +(defcustom general-default-non-normal-prefix nil + "The default prefix key sequence to use for the 'emacs and 'insert states. +Note that this setting is only useful for evil-users and will only have an +effect when binding keys in the 'emacs and/or 'insert states or in the +'evil-insert-state-map and/or 'evil-emacs-state-map keymaps. When this is not +specified, `general-default-prefix' will be the default prefix for any states +and keymaps. If this is specified `general-default-prefix' or the arg to :prefix +will not be used when binding keys in the insert and emacs states." + :group 'general + :type 'string) +(make-obsolete-variable 'general-default-non-normal-prefix + "This functionality will be removed in the future." + "2018-01-21") + +(defcustom general-default-global-prefix nil + "The default prefix key sequence to use for all evil states. +This setting is only useful for evil users. Note that like with +`general-default-non-normal-prefix', if this or :global-prefix is specified, +`general-default-prefix' or the arg to :prefix will not be used for binding +keys in the insert and emacs states. If you don't need a different or extra +prefix for one or both state types (insert and emacs vs. the other states), +just use `general-default-prefix'/:prefix by itself." + :group 'general + :type 'string) +(make-obsolete-variable 'general-default-global-prefix + "This functionality will be removed in the future." + "2018-01-21") + +(define-widget 'general-state 'lazy + "General's evil state type." + :type '(choice + (const :tag "Insert state" insert) + (const :tag "Emacs state" emacs) + (const :tag "Normal state" normal) + (const :tag "Visual state" visual) + (const :tag "Motion state" motion) + (const :tag "Operator state" operator) + (const :tag "Replace state" replace) + (const :tag "Use define-key not evil-define-key" nil) + ;; other packages define states + symbol)) + +(defcustom general-default-states nil + "The default evil state(s) to make mappings in. +Non-evil users should keep this nil." + :group 'general + :type '(choice general-state + (set general-state))) +(make-obsolete-variable 'general-default-states + "This functionality will be removed in the future." + "2018-01-21") + +(defcustom general-non-normal-states '(insert emacs hybrid iedit-insert) + "List of \"non-normal\" evil states (used with :non-normal-prefix). When + :states is not specified (only :keymaps), these will automatically be expanded + to their full global evil keymap equivalents." + :group 'general + :type '(repeat general-state)) + +(define-widget 'general-keymap 'lazy + "General's keymap type." + :type '(choice + (const :tag "Global keymap" global) + (const :tag "Buffer local keymap" local) + symbol)) + +(defcustom general-default-keymaps 'global + "The default keymap(s) to bind keys in." + :group 'general + :type '(choice general-keymap + (repeat general-keymap))) +(make-obsolete-variable 'general-default-keymaps + "This functionality will be removed in the future." + "2018-01-21") + +(defcustom general-vim-definer-default nil + "Whether set the states or keymaps in a `general-create-vim-definer' function. +If nil, use the default from when the function was created. If 'keymaps, set the +default keymaps. If 'states, set the default states." + :group 'general + :type '(choice + (const :tag "Default to setting :keymaps" keymaps) + (const :tag "Default to setting :states" states) + (const :tag "Use the initial default" nil))) +(make-obsolete-variable 'general-vim-definer-default + "This functionality is no longer necessary." + "2018-01-20") + +(defvar general-keybindings nil + "Holds all the keybindings created with `general-define-key' (and wrappers). +This is an alist of a keymap to an alist of a state to keybindings.") + +(defvar general-local-keybindings nil + "Holds all the local keybindings created with `general-define-key'. +This is an alist of a state to keybindings.") +(make-variable-buffer-local 'general-local-keybindings) + +(define-widget 'general-alist 'lazy + "General's alist type." + :type '(alist :key-type (or symbol (repeat symbol)) + :value-type symbol)) + +(defcustom general-keymap-aliases + '((override . general-override-mode-map) + ((i insert) . evil-insert-state-map) + ((e emacs) . evil-emacs-state-map) + ((h hybrid) . evil-hybrid-state-map) + ((n normal) . evil-normal-state-map) + ((v visual) . evil-visual-state-map) + ((m motion) . evil-motion-state-map) + ((o operator) . evil-operator-state-map) + ((r replace) . evil-replace-state-map) + ((in inner) . evil-inner-text-objects-map) + ((out outer) . evil-outer-text-objects-map)) + "An alist for mapping short keymap names to their full names. +Earlier entries have higher precedence." + :group 'general + :type 'general-alist) + +(defcustom general-state-aliases + '((i . insert) + (e . emacs) + (h . hybrid) + (n . normal) + (v . visual) + (m . motion) + (o . operator) + (r . replace)) + "An alist for mapping short state names to their full names. +Earlier entries have higher precedence." + :group 'general + :type 'general-alist) + +;; ** `general-describe-keybindings' Settings +(defcustom general-describe-keybinding-sort-function nil + "Function used to sort keybindings for `general-describe-keybindings'." + :group 'general + :type '(choice function (const nil))) + +(defcustom general-describe-state-sort-function + #'general--sort-evil-state-conses + "Function used to sort the states conses for `general-describe-keybindings'." + :group 'general + :type '(choice function (const nil))) + +(defcustom general-describe-keymap-sort-function nil + "Function used to sort the keymap conses`general-keybindings' for +`general-describe-keybindings'." + :group 'general + :type '(choice function (const nil))) + +(defcustom general-describe-priority-keymaps + '(local + global + evil-insert-state-map + evil-emacs-state-map + evil-hybrid-state-map + evil-normal-state-map + evil-visual-state-map + evil-motion-state-map + evil-operator-state-map + evil-replace-state-map + evil-inner-text-objects-map + evil-outer-text-objects-map + evil-ex-search-keymap + evil-ex-completion-map + evil-command-window-mode-map + evil-window-map) + "Keymaps to print first for `general-describe-keybindings'." + :group 'general + :type '(repeat sybmol)) + +(defcustom general-describe-update-previous-definition 'on-change + "Whether to update the previous definition when a key is bound. +When set to 'on-change, the previous definition will only be updated when the +definition changes (e.g. re-evaluating a file with keybindings will not affect +the stored previous definition). When set to nil, it will only be updated when +the key was previously unbound." + :group 'general + ;; can't think of a use case, but add 'always if requested + ;; t is equivalent of on-change + :type '(choice + (const :tag "When definition has changed" on-change) + (const :tag "When the key was previously unbound" nil))) + +;; * Override Minor Modes +(defcustom general-override-auto-enable t + "Whether to automatically enable `general-override-mode'. +If non-nil, enable `general-override-mode' when binding a key in +`general-override-mode-map'." + :group 'general + :type 'boolean) + +(defvar general-override-mode-map (make-sparse-keymap) + "A keymap that will take priority over other minor mode keymaps. +This is only for non-evil keybindings (it won't override keys bound with +`evil-define-key'.") + +(define-minor-mode general-override-mode + "A global minor mode used for key definitions that should override others." + :lighter "" + :global t + :keymap general-override-mode-map) + +(defvar-local general-override-local-mode-map (make-sparse-keymap) + "A keymap that will take priority over other minor mode keymaps. +This keymap is buffer-local and will take precedence over +`general-override-mode-map'. General uses this keymap when creating non-evil +local keybindings.") + +(define-minor-mode general-override-local-mode + "A local minor mode used for key definitions that should override others." + :lighter "" + :keymap general-override-local-mode-map) + +(defvar-local general-maps-alist + `((general-override-mode . ,general-override-mode-map)) + "Holds the (mode . keymap) pairs for general's override modes.") +;; not affected by changing major modes +(put 'general-maps-alist 'permanent-local t) + +(defvar-local general--maps-alist-updated nil + "Whether `general-maps-alist' has been set correctly for the current buffer.") +(put 'general-maps-alist 'permanent-local t) + +(declare-function evil-make-intercept-map "evil-core") +(defun general-override-make-intercept-maps (_sym states) + "Make intercept keymaps for STATES in `general-override-mode-map'. +This means that keys bound in STATES for `general-override-mode-map' will take +precedence over keys bound in other evil auxiliary maps." + ;; can't use `general-with-eval-after-load' here; not available + (with-eval-after-load 'evil + ;; TODO eventually use new evil-make-intercept-map arg + (dolist (state states) + (evil-make-intercept-map + (evil-get-auxiliary-keymap general-override-mode-map state t t) + state)))) + +(defcustom general-override-states + '(insert + emacs + hybrid + normal + visual + motion + operator + replace) + "States to make intercept maps for in `general-override-mode-map'. +Note that this uses :set, meaning that if you want to change the value, you +should either set it using customize (e.g. `general-setq' or +`customize-set-variable') or set it before loading general if using `setq'." + :group 'general + :type '(repeat general-state) + :set #'general-override-make-intercept-maps) + +(defun general--update-maps-alist () + "Update `general-maps-alist' for override modes. +This is necessary to ensure `general-override-local-mode-map' is the buffer's +local version." + (setq general-maps-alist + `((general-override-local-mode . ,general-override-local-mode-map) + (general-override-mode . ,general-override-mode-map)) + general--maps-alist-updated t)) + +(cl-pushnew 'general-maps-alist emulation-mode-map-alists) + +(defun general-local-map () + "Return `general-override-local-mode-map'. +Also turn on `general-override-local-mode' and update `general-maps-alist'." + (or general-override-local-mode (general-override-local-mode)) + (unless general--maps-alist-updated + (general--update-maps-alist)) + general-override-local-mode-map) + +;; * General Helpers +(defmacro general-with-eval-after-load (file &rest body) + "Like `with-eval-after-load' but don't always add to `after-load-alist'. +When FILE has already been loaded, execute BODY immediately without adding it to +`after-load-alist'." + (declare (indent 1)) + `(if (if (stringp ,file) + (load-history-filename-element + (purecopy (load-history-regexp ,file))) + (featurep ,file)) + (progn ,@body) + (eval-after-load ,file (lambda () ,@body)))) + +(defun general--unalias (symbol &optional statep) + "Return the full keymap or state name associated with SYMBOL. +If STATEP is non-nil, check `general-state-aliases' instead of +`general-keymap-aliases'." + (let ((match + (cdr (cl-assoc symbol + (if statep + general-state-aliases + general-keymap-aliases) + ;; test-fn is new to assoc in 26.1 + :test (lambda (symbol key) + (or (eq symbol key) + (ignore-errors (memq symbol key)))))))) + (or match symbol))) + +;; don't want to reuse `general--unalias' since the user can alter +;; `general-keymap-aliases' +(defun general--evil-keymap-for-state (state) + "Return a symbol corresponding to the global evil keymap for STATE." + (intern (concat "evil-" (symbol-name state) "-state-map"))) + +(defun general--kbd (key) + "Use `kbd' on KEY when it is a string." + (if (stringp key) + (kbd key) + key)) + +;; TODO refactor to be more straightforward +(defun general--concat (nokbd &rest keys) + "Concatenate the strings in KEYS. +If `general-implicit-kbd' is non-nil, interleave the strings in KEYS with +spaces; unless NOKBD is non-nil, apply (kbd ...) to the result. If +`general-implicit-kbd' is nil, just concatenate the keys." + (setq keys (remove nil keys)) + (if general-implicit-kbd + (let ((keys (mapconcat (lambda (x) + (if (vectorp x) + (key-description x) + x)) + keys " "))) + (if nokbd + keys + (kbd keys))) + (apply #'concat keys))) + +(defun general--apply-prefix-and-kbd (prefix maps) + "Prepend the PREFIX sequence to all the keys that are strings in MAPS. +Also apply (kbd ...) to key and definition strings if `general-implicit-kbd' is +non-nil." + (setq prefix (or prefix "")) + (cl-loop for (key def) on maps by 'cddr + collect (general--concat nil prefix key) + and collect def)) + +(defun general--lookup-key (state keymap key &optional minor-mode-p) + "Return the current definition for STATE, KEYMAP, and KEY." + (when key + (let ((keymap (general--get-keymap state keymap minor-mode-p))) + (when keymap + (let ((def (lookup-key keymap key))) + (if (and (numberp def) (= def 1)) + nil + def)))))) + +(defun general--record-keybindings (keymap state maps &optional minor-mode-p) + "For KEYMAP and STATE, add MAPS to `general-keybindings'. +If KEYMAP is \"local\", add MAPS to `general-local-keybindings.' For non-evil +keybindings, STATE will be nil. Duplicate keys will be replaced with the new +ones. MINOR-MODE-P should be non-nil when keymap corresponds to a minor-mode +name (as used with `evil-define-minor-mode-key') as opposed to a keymap name." + (if (and state (not (featurep 'evil))) + (general-with-eval-after-load 'evil + (general--record-keybindings keymap state maps minor-mode-p)) + (let* (keys + (maps (cl-loop + for (key new-def _orig-def) on maps by 'cl-cdddr + collect + (list key + new-def + (let* ((current-def (general--lookup-key + state keymap key minor-mode-p)) + ;; none of these will fail if nil + (keymap-cons (assq keymap general-keybindings)) + (state-cons (assq state (cdr keymap-cons))) + (mapping (cl-find key (cdr state-cons) + :test #'equal :key #'car)) + (previous-def (cl-caddr mapping))) + (if (or + (and current-def (not previous-def)) + (and general-describe-update-previous-definition + (not (equal new-def current-def)))) + current-def + previous-def))) + do (push key keys)))) + (cond ((eq keymap 'local) + (unless (assq state general-local-keybindings) + (add-to-list 'general-local-keybindings (list state))) + (let ((state-cons (assq state general-local-keybindings))) + (setcdr state-cons + ;; remove old duplicate keys + (cl-remove-duplicates (append (cdr state-cons) maps) + :key #'car + :test #'equal)))) + (t + (unless (assq keymap general-keybindings) + (add-to-list 'general-keybindings (list keymap))) + (unless (assq state (assq keymap general-keybindings)) + (setcdr (assq keymap general-keybindings) + (append (cdr (assq keymap general-keybindings)) + (list (list state))))) + (let ((state-cons (assq state (assq keymap general-keybindings)))) + (setcdr state-cons + (cl-remove-duplicates (append (cdr state-cons) maps) + :key #'car + :test #'equal)))))))) + +;; don't force non-evil user to require evil for one function +(defun general--delay (condition form hook &optional append local name) + "Execute FORM when CONDITION becomes true, checking with HOOK. +NAME specifies the name of the entry added to HOOK. If APPEND is +non-nil, the entry is appended to the hook. If LOCAL is non-nil, +the buffer-local value of HOOK is modified. + +This is `evil-delay'." + (declare (indent 2)) + (if (and (not (booleanp condition)) (eval condition)) + (eval form) + (let* ((name (or name (format "general-delay-form-in-%s" hook))) + (fun (make-symbol name)) + (condition (or condition t))) + (fset fun `(lambda (&rest args) + (when ,condition + (remove-hook ',hook #',fun ',local) + ,form))) + (put fun 'permanent-local-hook t) + (add-hook hook fun append local)))) + +(defun general--getf (def fallback-plist keyword) + "From DEF or FALLBACK-PLIST get the corresponding value for KEYWORD. +FALLBACK-PLIST will be checked when KEYWORD does not exist in DEF (not in cases +where it is explicitly specified as nil). If DEF isn't a general extended +definition, only check in FALLBACK-PLIST." + (if (general--extended-def-p def) + (cl-getf def keyword + (cl-getf fallback-plist keyword)) + (cl-getf fallback-plist keyword))) + +(defun general--getf2 (plist keyword1 keyword2) + "Check in PLIST for either KEYWORD1 or KEYWORD2." + (or (cl-getf plist keyword1) + (cl-getf plist keyword2))) + +(declare-function evil-get-minor-mode-keymap "evil-core") +(declare-function evil-state-property "evil-common") +(declare-function evil-get-auxiliary-keymap "evil-core") +(cl-defun general--get-keymap (state &optional keymap + minor-mode + ignore-special) + "Transform STATE and the symbol or keymap KEYMAP into the appropriate keymap. +If MINOR-MODE and STATE are non-nil, use `evil-get-minor-mode-keymap'. If +IGNORE-SPECIAL is non-nil, do not try to resolve the \"special\" keymaps 'global +and 'local. In this case, the only thing this function will do is return the +actually keymap if KEYMAP is a symbol besides 'global or 'local. Otherwise the +keymap returned depends on whether STATE is specified. Note that if STATE is +specified, evil needs to be installed and will be required. + +STATE nil: +'local - Run/return `general-local-map' +'global - Run/return `current-global-map' +else - Return keymap or (symbol-value keymap) + +STATE non-nil: +'local - Return the corresponding evil local map +'global - Return the corresponding evil global map +else - Return the corresponding evil auxiliary or minor mode map" + (when (and (symbolp keymap) + (not (memq keymap '(global local)))) + (setq keymap (symbol-value keymap))) + (when ignore-special + (cl-return-from general--get-keymap keymap)) + (if state + (if (require 'evil nil t) + (cond ((or (null keymap) + (eq keymap 'global)) + (evil-state-property state :keymap t)) + (minor-mode + (evil-get-minor-mode-keymap state keymap)) + ((eq keymap 'local) + (evil-state-property state :local-keymap t)) + (t + (evil-get-auxiliary-keymap keymap state t t))) + (error "Evil is required if state is specified")) + (cl-case keymap + (global (current-global-map)) + (local (general-local-map)) + (t keymap)))) +(define-obsolete-function-alias 'general--parse-keymap 'general--get-keymap + "2018-01-14") + +(defun general--remove-keyword-args (rest) + "Remove all keyword arguments from the list REST. +Return a list of the altered REST list and a list of the removed keyword +arguments. The order of arguments will be preserved. Note that the length of +REST does not need to be even (i.e. there can be an odd number of positional +arguments)." + (let (args + kargs) + (while rest + (cond ((keywordp (car rest)) + (push (pop rest) kargs) + (push (pop rest) kargs)) + (t + (push (pop rest) args)))) + (list (nreverse args) (nreverse kargs)))) + +(defmacro general--ensure-lists (&rest vars) + "Ensure that all variables in VARS are lists if they are not already. +If any variable is a lambda, it will not be considered to be a list. If a var is +nil, it will be set to (list nil)." + `(progn + ,@(mapcar (lambda (var) + `(unless (and ,var + (listp ,var) + ;; lambdas are lists + (not (functionp ,var))) + (setq ,var (list ,var)))) + vars))) + +;; * Extended Key Definition Language +;; ** Variables +(defvar general-extended-def-keywords + '(:which-key :wk :properties :repeat :jump) + "Extra keywords that are valid for extended definitions. + +These can work both locally (in extended definitions) and globally (in which +case they apply to all definitions including normal ones). Note that not all +keywords need to make sense/work globally. If the keyword should be ignored when +used globally, add it to `general-extended-def-global-ignore-keywords' as well. + +For each keyword there should be a corresponding function named +general-extended-def-:<keyword> which will be passed state, keymap (the symbol +not actual keymap), key (the internal representation, i.e. `kbd' already called +if necessary), edef (always a plist; normal definitions will automatically be +converted), and kargs (the original `general-define-key' keyword argument plist; +useful when the keyword can be used globally or has helper keywords that can be +used globally). This function is only called for side effects; if you actually +need to alter the definition, you should add the keyword to +`general-rewrite-def-keywords' or `general-rewrite-def-after-keywords' instead. +The order of those lists matters, but the order of this list does not. + +`general--get-keymap' may be useful for getting the actual keymap from the +keymap symbol. `general--getf' may be useful for keywords (helper or main) that +can be specified globally (in kargs) and overridden locally (in def).") + +(defvar general-rewrite-def-keywords + '(:keymap :prefix-command :prefix-keymap) + "Extended definition keywords that alter the definition. + +Each keyword should have a corresponding function named +general-extended-def-:<keyword> and should return a new extended definition +plist (with an altered :def entry). See `general-extended-def-keywords' for +information on the arguments this function should take. These functions will be +run in the order they appear in this list, and each will be passed the most +recent version of the extended definition plist. + +In contrast to the functions for `general-rewrite-def-after-keywords', these +functions will alter the definition before any `general-extended-def-keyword' +functions run. For example, if your function creates a newly named wrapper +command around the user-specified command, you'd want to add the keyword to this +list, so that `general-extended-def-keywords' functions would have access to new +command name (e.g. for :which-key to work properly). On the other hand, if the +keyword, for example, involves putting the definition in an extended menu item +like with :predicate, you should add to `general-rewrite-def-after-keywords' +instead.") + +(defvar general-rewrite-def-after-keywords + '(:predicate) + "Extended definition keywords that alter the definition. +See `general-rewrite-def-keywords' for more information.") + +(defvar general-extended-def-global-ignore-keywords + '(:keymap :prefix-command :prefix-map) + "Extended definitions that should be ignored when used globally. +For example, :prefix-command and :prefix-map are handled differently when used +globally (they have special interaction with other global keywords). :keymap, on +the other hand, doesn't make sense at all globally.") + +;; ** Normal Extended Definition Functions +(defvar which-key-replacement-alist) +(defun general--add-which-key-replacement (mode replacement) + (let* ((mode-match (assq mode which-key-replacement-alist)) + (mode-alist (cdr mode-match))) + (cond (mode + (push replacement mode-alist) + (if mode-match + (setcdr mode-match mode-alist) + (push (cons mode mode-alist) + which-key-replacement-alist))) + (t + (push replacement which-key-replacement-alist))))) + +(defvar which-key--prefix-title-alist) +(defun general--add-which-key-title-prefix (mode keys title-prefix) + (let* ((mode-match (assq mode which-key--prefix-title-alist)) + (title-mode-alist (cdr mode-match)) + (title-cons (cons keys title-prefix))) + (cond (mode + (push title-cons title-mode-alist) + (if mode-match + (setcdr mode-match + title-mode-alist) + (push (cons mode title-mode-alist) + which-key--prefix-title-alist))) + (t + (push title-cons which-key--prefix-title-alist))))) + +(defun general--remove-map (keymap) + "Remove \"-map\" from the symbol KEYMAP." ; + (intern (replace-regexp-in-string "-map$" "" (symbol-name keymap)))) + +;; TODO better documentation +(defun general-extended-def-:which-key (_state keymap key edef kargs) + "Add a which-key description for KEY. +If :major-modes is specified in EDEF, add the description for the corresponding +major mode. KEY should not be in the kbd format (kbd should have already been +run on it)." + (general-with-eval-after-load 'which-key + (let* ((wk (general--getf2 edef :which-key :wk)) + (major-modes (general--getf edef kargs :major-modes)) + (keymaps (plist-get kargs :keymaps)) + ;; index of keymap in :keymaps + (keymap-index (cl-dotimes (ind (length keymaps)) + (when (eq (nth ind keymaps) keymap) + (cl-return ind)))) + (mode (let ((mode (if (and major-modes (listp major-modes)) + (nth keymap-index major-modes) + major-modes))) + (if (eq mode t) + (general--remove-map keymap) + mode))) + (key (key-description key)) + (key-regexp (concat (when (general--getf edef kargs :wk-full-keys) + "\\`") + (regexp-quote key) + "\\'")) + (prefix (plist-get kargs :prefix)) + (binding (or (when (and (plist-get edef :def) + (not (plist-get edef :keymp))) + (plist-get edef :def)) + (when (and prefix + (string= key prefix)) + (plist-get kargs :prefix-command)))) + (replacement (cond ((stringp wk) + (cons nil wk)) + (t + wk))) + (match/replacement + (cons + (cons (when (general--getf edef kargs :wk-match-keys) + key-regexp) + (when (and (general--getf edef kargs :wk-match-binding) + binding + (symbolp binding)) + (symbol-name binding))) + replacement))) + (general--add-which-key-replacement mode match/replacement) + (when (and (consp replacement) + ;; lambda + (not (functionp replacement))) + (general--add-which-key-title-prefix + mode key (cdr replacement)))))) + +(defalias 'general-extended-def-:wk #'general-extended-def-:which-key) + +(declare-function evil-add-command-properties "evil-common") +(defun general-extended-def-:properties (_state _keymap _key edef kargs) + "Use `evil-add-command-properties' to add properties to a command. +The properties should be specified with :properties in either EDEF or KARGS." + (general-with-eval-after-load 'evil + (let ((properties (general--getf edef kargs :properties)) + (command (cl-getf edef :def))) + (apply #'evil-add-command-properties command properties)))) + +(defun general-extended-def-:repeat (_state _keymap _key edef kargs) + "Use `evil-add-command-properties' to set the :repeat property for a command. +The repeat property should be specified with :repeat in either EDEF or KARGS." + (general-with-eval-after-load 'evil + (let ((repeat-property (general--getf edef kargs :repeat)) + (command (cl-getf edef :def))) + (evil-add-command-properties command :repeat repeat-property)))) + +(defun general-extended-def-:jump (_state _keymap _key edef kargs) + "Use `evil-add-command-properties' to set the :jump property for a command. +The jump property should be specified with :jump in either EDEF or KARGS." + (general-with-eval-after-load 'evil + (let ((jump-property (general--getf edef kargs :jump)) + (command (cl-getf edef :def))) + (evil-add-command-properties command :jump jump-property)))) + +;; ** Extended Defintion Functions That Alter the Definition +(defun general-extended-def-:keymap (state keymap _key edef kargs) + "Return an extended definition for a keymap or a \"autoloaded\" keymap. +If the specified keymap does not exist, create a function that binds the keys it +was invoked with in STATE and KEYMAP to the keymap specified in the extended +definition EDEF and then act as if it was originally bound to that +keymap (subsequent keys will be looked up in the keymap). KARGS or EDEF should +contain the package in which the keymap is created (as specified with :package). +If the keymap already exists, it will simply be returned." + (let ((bind-keymap-sym (plist-get edef :def)) + (package (general--getf edef kargs :package)) + (definer (general--getf edef kargs :definer))) + (if (boundp bind-keymap-sym) + (setf (cl-getf edef :def) (symbol-value bind-keymap-sym)) + (if package + (setf (cl-getf edef :def) + ;; relying on lexical binding here + (lambda () + (interactive) + (unless (or (featurep package) + (require package nil t)) + (error (format "Failed to load package: %s" package))) + (unless (and (boundp bind-keymap-sym) + (keymapp (symbol-value bind-keymap-sym))) + (error (format + "A keymap called %s is not defined in the %s package" + bind-keymap-sym package))) + ;; use `this-command-keys' as `key' may not be the full sequence + (let ((keys (this-command-keys)) + (general-implicit-kbd nil)) + (general-define-key + :states state + :keymaps keymap + :definer definer + keys (symbol-value bind-keymap-sym)) + (setq prefix-arg current-prefix-arg + unread-command-events + (mapcar (lambda (ev) (cons t ev)) + (listify-key-sequence keys)))))) + (error "In order to \"autoload\" a keymap, :package must be specified")))) + edef) + +(defun general--define-prefix (command-name &optional map-name menu-name) + "Define a prefix command and/or keymap. +COMMAND-NAME corresponds to the prefix command name. When COMMAND-NAME is +non-nil, `define-prefix-command' will be used and will be passed MAP-NAME and +MENU-NAME. When COMMAND-NAME is nil and MAP-NAME is non-nil, only a prefix +keymap will be created, and its menu name/prompt will be set to MENU-NAME (if +MENU-NAME is non-nil). Existing prefix keymaps/commands will not be +recreated/rebound." + (if (or (and command-name (fboundp command-name)) + (and map-name (boundp map-name))) + (or command-name (symbol-value map-name)) + (cond (command-name + (define-prefix-command command-name map-name menu-name)) + (map-name + (eval `(defvar ,map-name (make-sparse-keymap ,menu-name))))))) + +(defun general-extended-def-:prefix-command (_state _keymap _key edef _kargs) + "Create and return a prefix command or map for the extended definition EDEF. +The :prefix-command, :prefix-map, and :prefix-name properties from EDEF are +passed to `general--define-prefix'." + ;; NOTE will be called twice if both specified, but doesn't matter because + ;; won't recreate prefix-command + (setf (cl-getf edef :def) + (general--define-prefix (plist-get edef :prefix-command) + (plist-get edef :prefix-map) + (plist-get edef :prefix-name))) + edef) + +(defalias 'general-extended-def-:prefix-map + #'general-extended-def-:prefix-command) + +;; http://endlessparentheses.com/define-context-aware-keys-in-emacs.html +(defun general-extended-def-:predicate (_state _keymap _key edef kargs) + "Return an altered extended definition EDEF with a predicate applied. +The predicate is obtained either from EDEF or KARGS." + (let ((def (cl-getf edef :def)) + (predicate (general--getf edef kargs :predicate))) + (setf (cl-getf edef :def) + `(menu-item + "" nil + :filter (lambda (&optional _) + (when ,predicate + ',def)))) + edef)) + +;; ** Parsing Extended Definitions +(defun general--extended-def-p (def) + "Return whether DEF is an extended definition." + (and (listp def) + (not (keymapp def)) + ;; lambda + (not (functionp def)) + (not (eq (car def) 'menu-item)) + ;; will error on cons + (ignore-errors (cl-some #'keywordp def)))) + +(defun general--normalize-extended-def (edef) + "Rewrite the extended definition EDEF to include a :def property. +If EDEF is not an extended defintion, make it into one. + +This handles the allowed shorthand syntax. For example, these are the same: + + (some-func) + (:def some-func) + +Some extended definition keywords can be used instead of :def (mainly for +backwards compatibility). For example, these are the same: + + (some-keymap :keymap t) + (:keymap some-keymap) + (:def some-keymap :keymap t)" + ;; NOTE: This is absolutely necessary for plist functions to work + (if (general--extended-def-p edef) + (unless (keywordp (car edef)) + (setq edef (cons :def edef))) + (setq edef (list :def edef))) + ;; :keymap checks :def always instead of :keymap, and :which-key also checks + ;; :def always (instead of :prefix-command) + ;; note that :keymap and :prefix-map will later rewrite their :def to the + ;; actual keymap value + (unless (plist-get edef :def) + (setf (cl-getf edef :def) + (cl-getf edef :keymap + (cl-getf edef :prefix-command + (plist-get edef :prefix-map))))) + edef) + +(defun general--extract-def (edef) + "Return the bindable definition from the extended definition EDEF." + (if (plist-get edef :ignore) + ;; just for side effects (e.g. which-key description for prefix) + ;; return something that isn't a valid definition + :ignore + (plist-get edef :def))) + +(defun general--run-extended-def-functions (state keymap key edef kargs) + "Run the extended definition functions for the matched keywords. +Pass each extended definition function STATE, KEYMAP, KEY, EDEF, and KARGS. For +each keyword from `general-extended-def-keywords', +`general-rewrite-def-keywords', and `general-rewrite-def-after-keywords' found +in EDEF or KARGS, call the corresponding function named +general-extended-def-:<keyword>. The functions for +`general-rewrite-def-keywords' will rewrite the extended definition plist before +the functions for `general-extended-def-keywords' are called, and the functions +for `general-rewrite-def-after-keywords' are called after that. Functions +are called in the order they appear in each list. Finally, return the +potentially altered extended definition plist." + (cl-flet ((run-edef-functions + (keywords &optional alter-def) + (dolist (keyword keywords) + (when (or (plist-get edef keyword) + (and (not + (memq + keyword + general-extended-def-global-ignore-keywords)) + (plist-get kargs keyword))) + (let ((ret (funcall + (intern (format "general-extended-def-%s" keyword)) + state keymap key edef kargs))) + (when alter-def + (setq edef ret))))))) + (run-edef-functions general-rewrite-def-keywords t) + (run-edef-functions general-extended-def-keywords) + (run-edef-functions general-rewrite-def-after-keywords t)) + edef) + +(defun general--parse-def (state keymap key def kargs) + "Rewrite DEF into a valid/bindable definition. +This function will execute all extended definitions, potentially rewriting the +original definition (e.g. applying a predicate). Pass STATE, KEYMAP, KEY, DEF, and +KARGS to each matched extended definition function. See +`general--run-extended-def-functions' for more information." + (setq def (general--normalize-extended-def def)) + (general--extract-def + (general--run-extended-def-functions state keymap key def kargs))) + +(defun general--parse-maps (state keymap maps kargs) + "Rewrite MAPS so that the definitions are bindable. +This includes possibly calling `kbd' on keys and parsing extended definitions. +Turn key/binding pairs in MAPS into triples in the form of (key parsed-def +original-def) where parsed-def is the bindable form and original-def is the +original definition as an extended definition plist (turn normal definitions +into extended definition plists and implicitly add \":def\" to the beginning of +extended definitions when necessary)." + (let (bindable-def) + (cl-loop for (key def) on maps by 'cddr + do (setq bindable-def + (general--parse-def state keymap key def kargs)) + unless (eq bindable-def :ignore) + collect key + and collect (if general-implicit-kbd + (general--kbd bindable-def) + bindable-def) + and collect (general--normalize-extended-def def)))) + +;; * Helper Key Definers +(declare-function evil-define-minor-mode-key "evil-core") +(defun general-minor-mode-define-key (state mode key def _orig-def _kargs) + "A wrapper for `evil-define-minor-mode-key'." + (general-with-eval-after-load 'evil + (evil-define-minor-mode-key state mode key def))) + +(declare-function lispy-define-key "lispy") +(defun general-lispy-define-key (_state keymap key def orig-def kargs) + "A wrapper for `lispy-define-key'." + (general-with-eval-after-load 'lispy + (let* ((keymap (general--get-keymap nil keymap)) + (key (key-description key)) + (plist (general--getf orig-def kargs :lispy-plist))) + (apply #'lispy-define-key keymap key def plist)))) + +(declare-function worf-define-key "worf") +(defun general-worf-define-key (_state keymap key def orig-def kargs) + "A wrapper for `worf-define-key'." + (general-with-eval-after-load 'worf + (let* ((keymap (general--get-keymap nil keymap)) + (key (key-description key)) + (plist (general--getf orig-def kargs :worf-plist))) + (apply #'worf-define-key keymap key def plist)))) + +(declare-function lpy-define-key "lpy") +(defun general-lpy-define-key (_state keymap key def _orig-def _kargs) + "A wrapper for `lpy-define-key'." + (general-with-eval-after-load 'lpy + (let* ((keymap (general--get-keymap nil keymap)) + (key (key-description key))) + (lpy-define-key keymap key def)))) + +(declare-function evil-define-key* "evil-core") +(defun general--define-key-dispatch (state keymap maps kargs) + "In STATE (if non-nil) and KEYMAP, bind MAPS. +MAPS is composed of triplets of (key parsed-def original-def). This function +determines the appropriate base definer function to use based depending on +whether :definer is present in original-def or KARGS or whether STATE is +non-nil if no custom definer is specified." + (when (and general-override-auto-enable + (eq keymap 'general-override-mode-map) + (not general-override-mode)) + (general-override-mode)) + (while maps + (let* ((key (pop maps)) + (def (pop maps)) + (orig-def (pop maps)) + (definer (general--getf orig-def kargs :definer))) + (if definer + (funcall (intern (format "general-%s-define-key" + (symbol-name definer))) + state keymap key def orig-def kargs) + (cond (state + ;; just to get the symbol-value of the keymap when it is not + ;; global/local + (setq keymap (general--get-keymap nil keymap nil t)) + (general-with-eval-after-load 'evil + (evil-define-key* state keymap key def))) + (t + (setq keymap (general--get-keymap nil keymap)) + (define-key keymap key def))))))) + +(defvar general--definer-p nil + "Whether the current keybinding is being created with `general-define-key'.") + +(defun general--define-key + (states keymap maps non-normal-maps global-maps kargs) + "A helper function for `general-define-key'. +Choose based on STATES and KEYMAP which of MAPS, NON-NORMAL-MAPS, and +GLOBAL-MAPS to use for the keybindings. This function will rewrite extended +definitions, add predicates when applicable, and then choose the base function +to bind the keys with by calling `general--define-key-dispatch'." + (let ((general--definer-p t)) + (dolist (state states) + (let* ((non-normal-p (if state + (memq state general-non-normal-states) + (memq keymap + (mapcar #'general--evil-keymap-for-state + general-non-normal-states)))) + (valid-maps (list (cond ((and non-normal-maps non-normal-p) + non-normal-maps) + ((and global-maps non-normal-p) + nil) + (t + maps)) + global-maps))) + (dolist (maps valid-maps) + (when maps + (setq maps (general--parse-maps state keymap maps kargs)) + ;; NOTE: :definer 'minor-mode cannot be specified locally + (general--record-keybindings keymap state maps + (eq (cl-getf kargs :definer) + 'minor-mode)) + (general--define-key-dispatch state keymap maps kargs))))))) + +;; * Functions With Keyword Arguments +;;;###autoload +(cl-defun general-define-key + (&rest maps &key + definer + (states general-default-states) + (keymaps general-default-keymaps keymaps-specified-p) + (prefix general-default-prefix) + (non-normal-prefix general-default-non-normal-prefix) + (global-prefix general-default-global-prefix) + infix + prefix-command + prefix-map + prefix-name + predicate + ;; related to extended definitions + package + properties + repeat + jump + major-modes + (wk-match-keys t) + (wk-match-binding t) + (wk-full-keys t) + ;; for custom key definers + lispy-plist + worf-plist + &allow-other-keys) + "The primary key definition function provided by general.el. + +Define MAPS, optionally using DEFINER, in the keymap(s) corresponding to STATES +and KEYMAPS. + +MAPS consists of paired keys (vectors or strings; also see +`general-implicit-kbd') and definitions (those mentioned in `define-key''s +docstring and general.el's \"extended\" definitions). All pairs (when not +ignored) will be recorded and can be later displayed with +`general-describe-keybindings'. + +If DEFINER is specified, a custom key definer will be used to bind MAPS. See +general.el's documentation/README for more information. + +Unlike with normal key definitions functions, the keymaps in KEYMAPS should be +quoted (this allows using the keymap name for other purposes, e.g. deferring +keybindings if the keymap symbol is not bound, optionally inferring the +corresponding major mode for a symbol by removing \"-map\" for :which-key, +easily storing the keymap name for use with `general-describe-keybindings', +etc.). Note that general.el provides other key definer macros that do not +require quoting keymaps. + +STATES corresponds to the evil state(s) to bind the keys in. Non-evil users +should not set STATES. When STATES is non-nil, `evil-define-key*' will be +used (the evil auxiliary keymaps corresponding STATES and KEYMAPS will be used); +otherwise `define-key' will be used (unless DEFINER is specified). KEYMAPS +defaults to 'global. There is also 'local, which create buffer-local +keybindings for both evil and non-evil keybindings. There are other special, +user-alterable \"shorthand\" symbols for keymaps and states (see +`general-keymap-aliases' and `general-state-aliases'). + +Note that STATES and KEYMAPS can either be lists or single symbols. If any +keymap does not exist, those keybindings will be deferred until the keymap does +exist, so using `eval-after-load' is not necessary with this function. + +PREFIX corresponds to a key to prefix keys in MAPS with and defaults to none. To +bind/unbind a key specified with PREFIX, \"\" can be specified as a key in +MAPS (e.g. ...:prefix \"SPC\" \"\" nil... will unbind space). + +The keywords in this paragraph are only useful for evil users. If +NON-NORMAL-PREFIX is specified, this prefix will be used instead of PREFIX for +states in `general-non-normal-states' (e.g. the emacs and insert states). This +argument will only have an effect if one of these states is in STATES or if +corresponding global keymap (e.g. `evil-insert-state-map') is in KEYMAPS. +Alternatively, GLOBAL-PREFIX can be used with PREFIX and/or NON-NORMAL-PREFIX to +bind keys in all states under the specified prefix. Like with NON-NORMAL-PREFIX, +GLOBAL-PREFIX will prevent PREFIX from applying to `general-non-normal-states'. +INFIX can be used to append a string to all of the specified prefixes. This is +potentially useful when you are using GLOBAL-PREFIX and/or NON-NORMAL-PREFIX so +that you can sandwich keys in between all the prefixes and the specified keys in +MAPS. This may be particularly useful if you are using default prefixes in a +wrapper function/macro so that you can add to them without needing to re-specify +all of them. If none of the other prefix keyword arguments are specified, INFIX +will have no effect. + +If PREFIX-COMMAND or PREFIX-MAP is specified, a prefix command and/or keymap +will be created. PREFIX-NAME can be additionally specified to set the keymap +menu name/prompt. If PREFIX-COMMAND is specified, `define-prefix-command' will +be used. Otherwise, only a prefix keymap will be created. Previously created +prefix commands/keymaps will never be redefined/cleared. All prefixes (including +the INFIX key, if specified) will then be bound to PREFIX-COMMAND or PREFIX-MAP. +If the user did not specify any PREFIX or manually specify any KEYMAPS, general +will bind all MAPS in the prefix keymap corresponding to either PREFIX-MAP or +PREFIX-COMMAND instead of in the default keymap. + +PREDICATE corresponds to a predicate to check to determine whether a definition +should be active (e.g. \":predicate '(eobp)\"). Definitions created with a +predicate will only be active when the predicate is true. When the predicate is +false, key lookup will continue to search for a match in lower-precedence +keymaps. + +In addition to the normal definitions supported by `define-key', general.el also +provides \"extended\" definitions, which are plists containing the normal +definition as well as other keywords. For example, PREDICATE can be specified +globally or locally in an extended definition. New global (~general-define-key~) +and local (extended definition) keywords can be added by the user. See +`general-extended-def-keywords' and general.el's documentation/README for more +information. + +PACKAGE is the global version of the extended definition keyword that specifies +the package a keymap is defined in (used for \"autoloading\" keymaps) + +PROPERTIES, REPEAT, and JUMP are the global versions of the extended definition +keywords used for adding evil command properties to commands. + +MAJOR-MODES, WK-MATCH-KEYS, WK-MATCH-BINDINGS, and WK-FULL-KEYS are the +corresponding global versions of which-key extended definition keywords. They +will only have an effect for extended definitions that specify :which-key or +:wk. See the section on extended definitions in the general.el +documentation/README for more information. + +LISPY-PLIST and WORF-PLIST are the global versions of extended definition +keywords that are used for each corresponding custom DEFINER." + ;; to silence compiler warning; variables that are later extracted from kargs + (ignore definer + predicate + package + properties + repeat + jump + major-modes + lispy-plist + worf-plist) + (let ((prefix-def (or prefix-command + (when prefix-map + (list :keymap prefix-map)))) + non-normal-prefix-maps + global-prefix-maps + kargs) + ;; don't force the user to wrap a single state or keymap in a list + (general--ensure-lists states keymaps) + ;; unalias states and keymaps + (setq states (mapcar (lambda (state) (general--unalias state t)) + states)) + (setq keymaps (mapcar #'general--unalias keymaps)) + ;; remove keyword arguments from rest var + (let ((split-maps (general--remove-keyword-args maps))) + (setq maps (car split-maps) + ;; order will be preserved; matters for duplicates + kargs (append + (list + ;; should be included even if not manually specified + ;; (because have non-nil defaults) + :wk-match-keys wk-match-keys + :wk-match-binding wk-match-binding + :wk-full-keys wk-full-keys + ;; so :keymaps and :states are always lists in kargs + ;; needed for matching against :major-modes + :keymaps keymaps + ;; for consistency; may be useful in future or for user + :states states) + (cadr split-maps)))) + (general--define-prefix prefix-command prefix-map prefix-name) + (when (and (or prefix-map prefix-command) + (not (or prefix keymaps-specified-p))) + (setq keymaps (list (or prefix-map prefix-command)))) + ;; TODO reduce code duplication here + (when non-normal-prefix + (setq non-normal-prefix-maps + (general--apply-prefix-and-kbd + (general--concat t non-normal-prefix infix) + (append (when (and prefix prefix-def) + (list "" prefix-def)) + maps)))) + (when global-prefix + (setq global-prefix-maps + (general--apply-prefix-and-kbd + (general--concat t global-prefix infix) + (append (when (and prefix prefix-def) + (list "" prefix-def)) + maps)))) + ;; last so not applying prefix twice + (setq maps (general--apply-prefix-and-kbd + (general--concat t prefix infix) + (append (when (and prefix prefix-def) + (list "" prefix-def)) + maps))) + (dolist (keymap keymaps) + (general--delay `(or (memq ',keymap '(local global)) + (boundp ',keymap)) + `(general--define-key ',states + ',keymap + ',maps + ',non-normal-prefix-maps + ',global-prefix-maps + ',kargs) + 'after-load-functions t nil + (symbol-name + (cl-gensym (format "general-define-key-in-%s" keymap))))))) + +;;;###autoload +(defmacro general-emacs-define-key (keymaps &rest args) + "A wrapper for `general-define-key' that is similar to `define-key'. +It has a positional argument for KEYMAPS (that will not be overridden by a later +:keymaps argument). Besides this, it acts the same as `general-define-key', and +ARGS can contain keyword arguments in addition to keybindings. This can +basically act as a drop-in replacement for `define-key', and unlike with +`general-define-key', KEYMAPS does not need to be quoted." + (declare (indent 1)) + `(general-define-key + :keymaps ,(if (and (listp keymaps) + (eq (car keymaps) 'quote)) + `,keymaps + `',keymaps) + ,@args)) + +;;;###autoload +(defmacro general-evil-define-key (states keymaps &rest args) + "A wrapper for `general-define-key' that is similar to `evil-define-key'. +It has positional arguments for STATES and KEYMAPS (that will not be overridden +by a later :keymaps or :states argument). Besides this, it acts the same as +`general-define-key', and ARGS can contain keyword arguments in addition to +keybindings. This can basically act as a drop-in replacement for +`evil-define-key', and unlike with `general-define-key', KEYMAPS does not need +to be quoted." + (declare (indent 2)) + `(general-define-key + :states ,(if (and (listp states) + (eq (car states) 'quote)) + `,states + `',states) + :keymaps ,(if (and (listp keymaps) + (eq (car keymaps) 'quote)) + `,keymaps + `',keymaps) + ,@args)) + +(defun general--positional-arg-p (arg) + "Return whether ARG is a positional argument for a key definer. +Keyword arguments and strings/vectors are not considered positional arguments." + (and arg + (or (symbolp arg) (listp arg)) + (not (keywordp arg)))) + +;;;###autoload +(defmacro general-def (&rest args) + "General definer that takes a variable number of positional arguments in ARGS. +This macro will act as `general-define-key', `general-emacs-define-key', or +`general-evil-define-key' based on how many of the initial arguments do not +correspond to keybindings. All quoted and non-quoted lists and symbols before +the first string, vector, or keyword are considered to be positional arguments. +This means that you cannot use a function or variable for a key that starts +immediately after the positional arguments. If you need to do this, you should +use one of the definers that `general-def' dispatches to or explicitly separate +the positional arguments from the maps with a bogus keyword pair like +\":start-maps t\"" + (declare (indent defun)) + (let ((pos-args 0)) + (while (general--positional-arg-p (nth pos-args args)) + (cl-incf pos-args)) + (cl-case pos-args + (0 + `(general-define-key ,@args)) + (1 + `(general-emacs-define-key ,@args)) + (2 + `(general-evil-define-key ,@args))))) + +;;;###autoload +(cl-defmacro general-create-definer (name &rest defaults &key wrapping + &allow-other-keys) + "A helper macro to create wrappers for `general-def'. +This can be used to create key definers that will use a certain keymap, evil +state, prefix key, etc. by default. NAME is the wrapper name and DEFAULTS are +the default arguments. WRAPPING can also be optionally specified to use a +different definer than `general-def'. It should not be quoted." + (declare (indent defun)) + (let ((defaults (cl-loop for (key val) on defaults by 'cddr + unless (eq key :wrapping) + collect key + and collect val)) + (definer (or wrapping 'general-def))) + `(defmacro ,name (&rest args) + (declare (indent defun)) + ,(let ((print-quoted t)) + (format + "A wrapper for `%s'. + +It has the following defaults: +%s" + definer defaults)) + ;; can still override keywords afterwards (first keyword takes precedence) + `(,',definer + ,@args ,@',defaults)))) + +(defun general--starter-arg-p (arg) + "Return whether ARG is a keyword or positional argument for a key definer." + (or (keywordp arg) + (general--positional-arg-p arg))) + +;;;###autoload +(defmacro general-defs (&rest args) + "A wrapper that splits into multiple `general-def's. +Each consecutive grouping of positional argument followed by keyword/argument +pairs (having only one or the other is fine) marks the start of a new section. +Each section corresponds to one use of `general-def'. This means that settings +only apply to the keybindings that directly follow." + (declare (indent defun) + (debug [&rest sexp])) + (let (arglists + arglist) + (while args + (while (and args (general--starter-arg-p (car args))) + (when (keywordp (car args)) + (push (pop args) arglist)) + (push (pop args) arglist)) + (while (and args (not (general--starter-arg-p (car args)))) + (push (pop args) arglist) + (push (pop args) arglist)) + (push (nreverse arglist) arglists) + (setq arglist nil)) + `(progn + ,@(mapcar (lambda (arglist) + (cons 'general-def arglist)) + (nreverse arglists))))) + +;;;###autoload +(cl-defmacro general-unbind (&rest args) + "A wrapper for `general-def' to unbind multiple keys simultaneously. +Insert after all keys in ARGS before passing ARGS to `general-def.' \":with + #'func\" can optionally specified to use a custom function instead (e.g. + `ignore')." + (declare (indent defun)) + ;; Note: :with can be at an odd position, so must handle internally and not + ;; with &key + (let* (with + (split-args (general--remove-keyword-args args)) + (kargs (cl-loop for (key val) on (cadr split-args) by 'cddr + if (eq key :with) + do (setq with val) + else + collect key + and collect val)) + (positional-args-and-maps + ;; interleave appropriate definitions into maps + (cl-loop for key in (car split-args) + collect key + and + unless (general--positional-arg-p key) + collect (if (eq with t) + nil + with))) + (args (append positional-args-and-maps kargs))) + `(general-def ,@args))) + +;; * Displaying Keybindings +(defun general--to-string (x) + "Convert key vector or symbol X to a string." + (cond ((vectorp x) + (key-description x)) + ((symbolp x) + (symbol-name x)) + (t + x))) + +;; these sorting functions assume x != y (which will hold true for +;; `general-keybindings') +(defun general--< (x y) + "Return t if X is alphabetically less than Y. +Each should be either a string, symbol, or vector. Nil is a special case and is +considered the \"smallest\"." + (cond ((null x) + t) + ((null y) + nil) + (t + (setq x (general--to-string x) + y (general--to-string y)) + (string< x y)))) + +(defun general-sort-by-car (list) + "Sort LIST by comparing the car of each element with `general--<'." + (cl-sort list #'general--< :key #'car)) + +(defun general-sort-by-cadr (list) + "Sort LIST by comparing the cadr of each element with `general--<'." + (cl-sort list #'general--< :key #'cadr)) + +(defvar general-describe-evil-states + '(nil + insert + emacs + hybrid + normal + visual + motion + operator + replace) + "Ordered list of evil states used for `general--evil-state-<'.") + +(defun general--evil-state-< (x y) + "Return t if evil state X should come before state Y. +If X and Y are conses, the first element will be compared. Ordering is based on +`general-describe-evil-states' or the symbol names for states not in the list." + (let ((xind (cl-position x general-describe-evil-states)) + (yind (cl-position y general-describe-evil-states))) + (cond ((and (null xind) + (null yind)) + (general--< x y)) + ((null xind) + nil) + ((null yind) + t) + (t + (< xind yind))))) + +(defun general--sort-evil-state-conses (state-conses) + "Sort STATE-CONSES using `general--evil-state-<'." + (cl-sort state-conses #'general--evil-state-< :key #'car)) + +(defun general--print-map (map) + "Print the keybinding MAP." + (cl-destructuring-bind (key command previous) map + (princ (format "|=%.50s=|~%.50s~|~%.50s~|\n" + (replace-regexp-in-string "|" "ยฆ" (key-description key)) + command + previous)))) + +(defun general--print-maps-table (maps) + "Print an org table for MAPS." + (when general-describe-keybinding-sort-function + (setq maps (funcall general-describe-keybinding-sort-function maps))) + (princ "|key|command|previous|\n|-+-|\n") + (dolist (map maps) + (general--print-map map)) + (princ "\n")) + +(defun general--print-state-heading (state-cons) + "Print a table and possibly a heading for STATE-CONS." + (let ((state (car state-cons)) + (maps (cdr state-cons))) + (unless (null state) + (princ (capitalize (concat "** " (symbol-name state) " State\n")))) + (general--print-maps-table maps))) + +(defun general--print-keymap-heading (keymap-cons) + "Print headings and tables for KEYMAP-CONS." + (let ((keymap (car keymap-cons)) + (state-conses (cdr keymap-cons))) + (princ (capitalize (concat "* " (symbol-name keymap) " Keybindings\n"))) + (when general-describe-state-sort-function + (setq state-conses (funcall general-describe-state-sort-function + state-conses))) + (dolist (state-cons state-conses) + (general--print-state-heading state-cons)))) + +(declare-function org-at-heading-p "org") +(declare-function org-table-align "org-table") +(declare-function outline-next-heading "outline") +(defvar org-startup-folded) +;;;###autoload +(defun general-describe-keybindings (&optional arg) + "Show all keys that have been bound with general in an org buffer. +Any local keybindings will be shown first followed by global keybindings. +With a non-nil prefix ARG only show bindings in active maps." + (interactive "P") + (with-output-to-temp-buffer "*General Keybindings*" + (let* ((keybindings (append + (copy-alist general-keybindings) + (list (cons 'local general-local-keybindings)))) + (active-maps (current-active-maps))) + ;; print prioritized keymaps first (if any) + (dolist (keymap general-describe-priority-keymaps) + (let ((keymap-cons (assq keymap keybindings))) + (when (and keymap-cons + (or (null arg) + (and (boundp (car keymap-cons)) + (memq (symbol-value (car keymap-cons)) + active-maps)))) + (general--print-keymap-heading keymap-cons) + (setq keybindings (assq-delete-all keymap keybindings))))) + ;; sort the remaining and then print them + (when general-describe-keymap-sort-function + (setq keybindings (funcall general-describe-keymap-sort-function + keybindings))) + (dolist (keymap-cons keybindings) + (when (or (null arg) + (and (boundp (car keymap-cons)) + (memq (symbol-value (car keymap-cons)) active-maps))) + (general--print-keymap-heading keymap-cons))))) + (with-current-buffer "*General Keybindings*" + (let ((org-startup-folded 'showall)) + (org-mode)) + (read-only-mode -1) + (while (progn + (while (progn + (forward-line) + (org-at-heading-p))) + (org-table-align) + (outline-next-heading))) + (goto-char (point-min)) + (read-only-mode))) + +;; * Functions/Macros to Aid Key Definition +;; ** Helpers +(cl-defun general--call-interactively + (function &optional (remap t) record-flag keys) + "Like `call-interactively' but use the remapped FUNCTION if it exists. +If REMAP is specified as nil (it is true by default), this is the same as +`call-interactively'. FUNCTION, RECORD-FLAG, and KEYS are passed to +`call-interactively'." + (when remap + (setq function (or (key-binding (kbd (format "<remap> <%s>" function))) + function))) + (call-interactively function record-flag keys)) + +;; ** Key Simulation +;; https://emacs.stackexchange.com/questions/6037/emacs-bind-key-to-prefix/13432#13432 +;; altered to +;; - allow execution in an arbitrary state and keymap +;; - create a named function with a docstring +;; - optionally dynamically lookup the key(s) up in the correct keymap to try to +;; match a command to execute instead +;; - handle more edge cases like correctly working with macros/repeating + +;; TODO +;; - rename keys arguments to key for consistency with builtin functions + +(declare-function evil-change-state "evil-core") +(defvar evil-no-display) +(defvar evil-state) +(defvar evil-previous-state) +(defvar evil-previous-state-alist) +(defvar evil-next-state) +(defmacro general--save-state (&rest body) + "Save the current state; execute BODY; restore the state. +This is a combination of `evil-without-display' and `evil-save-state'. It is +necessary to define this directly in general so that it is available when +general is compiled (as evil is an optional dependency and may not be installed +when general is compiled)." + (declare (indent defun) + (debug t)) + `(let* ((evil-no-display t) + (evil-state evil-state) + (evil-previous-state evil-previous-state) + (evil-previous-state-alist (copy-tree evil-previous-state-alist)) + (evil-next-state evil-next-state) + (old-state evil-state) + (inhibit-quit t) + (buf (current-buffer))) + (unwind-protect + (progn ,@body) + (when (buffer-live-p buf) + (with-current-buffer buf + (evil-change-state old-state)))))) + +;;;###autoload +(cl-defmacro general-key (key &key + state + docstring + accept-default no-remap position) + "Act as KEY's definition in the current context. +This uses an extended menu item's capability of dynamically computing a +definition. It is recommended over `general-simulate-key' wherever possible. KEY +should be a string given in `kbd' notation and should correspond to a single +definition (as opposed to a sequence of commands). When STATE is specified, look +up KEY with STATE as the current evil state. When specified, DOCSTRING will be +the menu item's name/description. ACCEPT-DEFAULT, NO-REMAP, and POSITION are +passed to `key-binding'." + `'(menu-item + ,(or docstring "") + nil + :filter + (lambda (&optional _) + ,(if state + `(general--save-state + (evil-change-state ,state) + (key-binding (general--kbd ,key) ,accept-default ,no-remap + ,position)) + `(key-binding (general--kbd ,key) ,accept-default ,no-remap + ,position))))) + +(defvar general--last-simulated-command nil + "Holds the last simulated command (or nil for incomplete key sequence).") + +(defvar general--simulate-next-as-is nil + "Whether to fake keys unconditionally in the next `general--simulate-keys'. +This is used for testing (but could potentially be useful for a user). Since +`general--simulate-keys' will normally assume it is being run inside a macro +that was manually recorded, this is needed when executing a keyboard macro that +ends up running `general--simulate-keys' for the first time.") + +(defvar general--simulate-as-is nil + "Whether to fake the keys unconditionally in any `general--simulate-keys'.") + +(defun general--key-binding (keys &optional state keymap) + "Look up KEYS in the keymap corresponding to STATE and/or KEYMAP. +Continually check whether subsequences of KEYS are bound to a command or keymap +starting with the full KEYS and ending when a match is found or no subsequences +remain. Unlike `lookup-key' if KEYS is not matched, fall back to checking with +`key-binding'. If STATE is specified and KEYMAP is not, temporarily switch to +STATE to look up the keys (this means that keybindings inherited from a +different evil state can still be detected). Return a list of the match and the +leftover keys (or nil if the full KEYS was matched)." + (let* ((keymap (when keymap + (general--get-keymap state keymap))) + (len (length keys)) + (ind len) + match) + (while (and (> ind 0) (not match)) + (let* ((key (substring keys 0 ind)) + (result (cond (keymap + (or (lookup-key keymap key) + (key-binding key))) + (state + ;; this also works fine when evil-local-mode is off + (general--save-state + (evil-change-state state) + (key-binding key))) + (t + (key-binding key))))) + (if (or (commandp result) + (keymapp result)) + (setq match result) + (cl-decf ind)))) + (list match + (if (= ind len) + nil + (substring keys ind len))))) + +(cl-defun general--simulate-keys (command keys &optional state keymap + (lookup t) + (remap t)) + "Simulate COMMAND followed by KEYS in STATE and/or KEYMAP. +If COMMAND is nil, just simulate KEYS. If STATE and KEYMAP are nil, simulate the +keys in the current context. When COMMAND is non-nil, STATE and KEYMAP will have +no effect. KEYS should be a string that can be passed to `kbd' or nil. If KEYS +is nil, the COMMAND will just be called interactively. If COMMAND is nil and +LOOKUP is non-nil, KEYS will be looked up in the correct context to determine if +any subsequence corresponds to a command or keymap. If a command is matched, +that command will be called followed by the simulation of any leftover keys. To +simulate the keys as-is without any lookup, LOOKUP can be explicitly specified +as nil. When COMMAND has been remapped (i.e. [remap COMMAND] is currently +bound), the remapped version will be used instead of the original command unless +REMAP is specified as nil (it is true by default)." + (let* ((keys (when keys + (general--kbd keys))) + ;; TODO remove when get rid of `general-simulate-keys' + (state (if (eq state t) + 'emacs + state))) + (unless (or command (not lookup)) + (cl-destructuring-bind (match leftover-keys) + (general--key-binding keys state keymap) + (cond ((commandp match) + (setq command match + keys leftover-keys)) + ;; not documented because no current use case + ;; left in because may be useful later + ((and (eq lookup 'always) (keymapp match)) + (setq keymap match + state nil + ;; should be nil + keys leftover-keys))))) + ;; set context for keys + (when (and keymap (not command)) + ;; TODO is it possible to set transient map and then use e.g. + ;; `evil-execute-in-normal-state' (so that commands bound in the motion + ;; state auxiliary map could also be executed)? + (set-transient-map (general--get-keymap state keymap))) + (when keys + ;; only set prefix-arg when only keys + ;; (otherwise will also affect the next command) + (unless command + (setq prefix-arg current-prefix-arg)) + (when (or general--simulate-as-is + general--simulate-next-as-is + (not executing-kbd-macro)) + (setq general--simulate-next-as-is nil) + ;; keys are incorrectly saved as this-command-keys when recording macros + ;; these keys will be played back, so don't simulate them + (setq unread-command-events + (nconc + ;; force keys to be added to this-command-keys + ;; this happens normally already for macros but it needs to be + ;; forced for evil-repeat though, which will only include the + ;; first key otherwise (ideally no keys would ever be added in + ;; either case) + (mapcar (lambda (ev) (cons t ev)) + (listify-key-sequence keys)) + unread-command-events)))) + (when command + (let ((this-command command)) + (general--call-interactively command remap))) + (setq general--last-simulated-command command))) + +;;;###autoload +(cl-defmacro general-simulate-keys (keys &optional state keymap + (lookup t) + docstring name) + "Deprecated. Please use `general-simulate-key' instead." + (let* ((command (when (listp keys) + (car keys))) + (keys (if (listp keys) + (cadr keys) + keys)) + (state (if (eq state t) + ''emacs + state)) + (name (or name + (intern (concat + (format "general-simulate-%s" + (if command + (eval command) + "")) + (when command + "-") + (replace-regexp-in-string " " "_" keys) + (when state + (concat "-in-" + (symbol-name (eval state)) + "-state")) + (when keymap + (concat "-in-" + (symbol-name keymap)))))))) + `(progn + (eval-after-load 'evil + '(evil-set-command-property #',name :repeat 'general--simulate-repeat)) + (defun ,name + () + ,(or docstring + (concat "Simulate " + (when command + (concat "`" + (symbol-name (eval command)) + "' then ")) + "'" + keys + "' in " + (cond ((and state keymap) + (concat (symbol-name (eval state)) + " state in `" + (symbol-name keymap) + "'.")) + (keymap + (concat (symbol-name keymap) + ".")) + (state + (concat (symbol-name (eval state)) + " state.")) + (t + "the current context.")))) + (interactive) + (general--simulate-keys ,command ,keys ,state ,keymap ,lookup))))) +(make-obsolete 'general-simulate-keys 'general-simulate-key "2018-01-14") + +;;;###autoload +(cl-defmacro general-simulate-key (keys + &key + state keymap + name docstring + (lookup t) + which-key + (remap t)) + "Create and return a command that simulates KEYS in STATE and KEYMAP. +KEYS should be a string given in `kbd' notation. It can also be a list of a +single command followed by a string of the key(s) to simulate after calling that +command. STATE should only be specified by evil users and should be a quoted +evil state. KEYMAP should not be quoted. Both STATE and KEYMAP aliases are +supported (but they have to be set when the macro is expanded). When neither +STATE or KEYMAP are specified, the key(s) will be simulated in the current +context. + +If NAME is specified, it will replace the automatically generated function name. +NAME should not be quoted. If DOCSTRING is specified, it will replace the +automatically generated docstring. + +Normally the generated function will look up KEY in the correct context to try +to match a command. To prevent this lookup, LOOKUP can be specified as nil. +Generally, you will want to keep LOOKUP non-nil because this will allow checking +the evil repeat property of matched commands to determine whether or not they +should be recorded. See the docstring for `general--simulate-keys' for more +information about LOOKUP. + +When a WHICH-KEY description is specified, it will replace the command name in +the which-key popup. + +When a command name is specified and that command has been remapped (i.e. [remap +command] is currently bound), the remapped version will be used instead of the +original command unless REMAP is specified as nil (it is true by default). + +The advantages of this over a keyboard macro are as follows: +- Prefix arguments are supported +- The user can control the context in which the keys are simulated +- The user can simulate both a named command and keys +- The user can simulate an incomplete key sequence (e.g. for a keymap)" + (declare (indent defun)) + (let* ((command (when (listp keys) + (car keys))) + (keys (if (listp keys) + (cadr keys) + keys)) + (state (general--unalias (eval state) t)) + (keymap (general--unalias keymap)) + (name (or name + (intern (concat + (format "general-simulate-%s" + (if command + (eval command) + "")) + (when command + "-") + (replace-regexp-in-string " " "_" keys) + (when state + (concat "-in-" + (symbol-name state) + "-state")) + (when keymap + (concat "-in-" + (symbol-name keymap)))))))) + `(progn + (eval-after-load 'evil + '(evil-set-command-property #',name :repeat 'general--simulate-repeat)) + (when ,which-key + (general-with-eval-after-load 'which-key + (push '((nil . ,(symbol-name name)) + nil . ,which-key) + which-key-replacement-alist))) + (defun ,name + () + ,(or docstring + (concat "Simulate " + (when command + (concat "`" + (symbol-name (eval command)) + "' then ")) + "'" + keys + "' in " + (cond ((and state keymap) + (concat (symbol-name state) + " state in `" + (symbol-name keymap) + "'.")) + (keymap + (concat (symbol-name keymap) + ".")) + (state + (concat (symbol-name state) + " state.")) + (t + "the current context.")))) + (interactive) + (general--simulate-keys ,command ,keys ',state ,keymap ,lookup ,remap)) + #',name))) + +(defun general--repeat-abort-p (repeat-prop) + "Return t if repeat recording should be aborted based on REPEAT-PROP." + (or (memq repeat-prop (list nil 'abort 'ignore)) + (and (eq repeat-prop 'motion) + (not (memq evil-state '(insert replace)))))) + +(declare-function evil-repeat-record "evil-repeat") +(declare-function evil-get-command-property "evil-common") +(declare-function evil-repeat-abort "evil-repeat") +(declare-function evil-this-command-keys "evil-repeat") +(declare-function evil-clear-command-keys "evil-repeat") +(defvar evil-this-register) +(defun general--simulate-repeat (flag) + "Modified version of `evil-repeat-keystrokes'. +It behaves as normal but will check the repeat property of a simulated command +to determine whether to abort recording." + (cond ((eq flag 'pre) + (when evil-this-register + (evil-repeat-record + `(set evil-this-register ,evil-this-register)))) + ((eq flag 'post) + (let* ((command general--last-simulated-command) + (repeat-prop (evil-get-command-property command :repeat t))) + (if (and command (general--repeat-abort-p repeat-prop)) + (evil-repeat-abort) + (evil-repeat-record + (evil-this-command-keys t)) + (evil-clear-command-keys)))))) + +;; ** Key Dispatch +(defvar general--last-dispatch-command nil + "Holds the last command run from a `general-key-dispatch' function.") + +(defun general--extend-key-sequence (keys) + "Read a key and append it to KEYS. +KEYS should be a string given in `kbd' notation." + (let ((key (read-event))) + (concat keys + (when keys + " ") + (key-description (if (characterp key) + (char-to-string key) + (vector key)))))) + +;;;###autoload +(cl-defmacro general-key-dispatch + (fallback-command &rest maps + &key + timeout + inherit-keymap + name docstring + which-key + (remap t) + &allow-other-keys) + "Create and return a command that runs FALLBACK-COMMAND or a command in MAPS. +MAPS consists of <key> <command> pairs. If a key in MAPS is matched, the +corresponding command will be run. Otherwise FALLBACK-COMMAND will be run with +the unmatched keys. So, for example, if \"ab\" was pressed, and \"ab\" is not +one of the key sequences from MAPS, the FALLBACK-COMMAND will be run followed by +the simulated keypresses of \"ab\". Prefix arguments will still work regardless +of which command is run. This is useful for binding under non-prefix keys. For +example, this can be used to redefine a sequence like \"cw\" or \"cow\" in evil +but still have \"c\" work as `evil-change'. If TIMEOUT is specified, +FALLBACK-COMMAND will also be run in the case that the user does not press the +next key within the TIMEOUT (e.g. 0.5). + +NAME and DOCSTRING are optional keyword arguments. They can be used to replace +the automatically generated name and docstring for the created function. By +default, `cl-gensym' is used to prevent name clashes (e.g. allows the user to +create multiple different commands using `self-insert-command' as the +FALLBACK-COMMAND without explicitly specifying NAME to manually prevent +clashes). + +When INHERIT-KEYMAP is specified, all the keybindings from that keymap will be +inherited in MAPS. + +When a WHICH-KEY description is specified, it will replace the command name in +the which-key popup. + +When command to be executed has been remapped (i.e. [remap command] is currently +bound), the remapped version will be used instead of the original command unless +REMAP is specified as nil (it is true by default)." + (declare (indent 1)) + (let ((name (or name (cl-gensym (format "general-dispatch-%s-" + (eval fallback-command))))) + ;; remove keyword arguments from maps + (maps (car (general--remove-keyword-args maps)))) + `(progn + (eval-after-load 'evil + '(evil-set-command-property #',name :repeat 'general--dispatch-repeat)) + (when ,which-key + (general-with-eval-after-load 'which-key + (push '((nil . ,(symbol-name name)) + nil . ,which-key) + which-key-replacement-alist))) + ;; TODO list all of the bound keys in the docstring + (defun ,name () + ,(or docstring (format (concat "Run %s or something else based" + "on the next keypresses.") + (eval fallback-command))) + (interactive) + (let ((map (make-sparse-keymap)) + (maps (list ,@maps)) + (invoked-keys (this-command-keys)) + (timeout ,timeout) + (inherit-keymap ,inherit-keymap) + matched-command + fallback + char + timed-out-p) + (when inherit-keymap + (set-keymap-parent map inherit-keymap)) + (while maps + (define-key map (general--kbd (pop maps)) (pop maps))) + (while (progn + (if timeout + (with-timeout (timeout (setq timed-out-p t)) + ;; TODO rename char + (setq char (general--extend-key-sequence char))) + (setq char (general--extend-key-sequence char))) + (and (not timed-out-p) + (keymapp (lookup-key map (kbd char)))))) + (cond + ((and (not timed-out-p) + (setq matched-command (lookup-key map (kbd char)))) + ;; necessary for evil-this-operator checks because + ;; evil-define-operator sets evil-this-operator to this-command + (let ((this-command matched-command)) + (general--call-interactively matched-command ,remap))) + (t + (setq matched-command ,fallback-command) + (general--simulate-keys ,fallback-command char + nil nil t ,remap))) + (setq general--last-dispatch-command matched-command))) + #',name))) + +(defun general--dispatch-repeat (flag) + "Modified version of `evil-repeat-keystrokes'. +It behaves as normal but will check the repeat property of a simulated command +to determine whether to abort recording." + (cond ((eq flag 'pre) + (when evil-this-register + (evil-repeat-record + `(set evil-this-register ,evil-this-register)))) + ((eq flag 'post) + (let ((repeat-prop (evil-get-command-property + general--last-dispatch-command + :repeat t))) + (if (general--repeat-abort-p repeat-prop) + (evil-repeat-abort) + (evil-repeat-record (evil-this-command-keys t)) + (evil-clear-command-keys)))))) + +;; ** Predicate Dispatch +;;;###autoload +(cl-defmacro general-predicate-dispatch + (fallback-def &rest defs + &key docstring + &allow-other-keys) + (declare (indent 1)) + "Create a menu item that will run FALLBACK-DEF or a definition from DEFS. +DEFS consists of <predicate> <definition> pairs. Binding this menu-item to a key +will cause that key to act as the corresponding definition (a command, keymap, +etc) for the first matched predicate. If no predicate is matched FALLBACK-DEF +will be run. When FALLBACK-DEF is nil and no predicates are matched, the keymap +with the next highest precedence for the pressed key will be checked. DOCSTRING +can be specified as a description for the menu item." + ;; remove keyword arguments from defs and sort defs into pairs + (let ((defs (cl-loop for (key value) on defs by 'cddr + unless (keywordp key) + collect (list key value)))) + `'(menu-item + ,(or docstring "") nil + :filter (lambda (&optional _) + (cond ,@(mapcar (lambda (pred-def) + `(,(car pred-def) ,(cadr pred-def))) + defs) + (t ,fallback-def)))))) + +;; ** Key "Translation" +;;;###autoload +(cl-defun general-translate-key (states keymaps + &rest maps + &key destructive + &allow-other-keys) + "Translate keys in the keymap(s) corresponding to STATES and KEYMAPS. +STATES should be the name of an evil state, a list of states, or nil. KEYMAPS +should be a symbol corresponding to the keymap to make the translations in or a +list of keymap names. Keymap and state aliases are supported (as well as 'local +and 'global for KEYMAPS). MAPS corresponds to a list of translations (key +replacement pairs). For example, specifying \"a\" \"b\" will bind \"a\" to +\"b\"'s definition in the keymap. If DESTRUCTIVE is non-nil, the keymap will be +destructively altered without creating a backup. If DESTRUCTIVE is nil, a backup +of the keymap will be stored on the initial invocation, and future invocations +will always look up keys in the backup keymap. On the other hand, if DESTRUCTIVE +is non-nil, calling this function multiple times with \"a\" \"b\" \"b\" \"a\", +for example, would continue to swap and unswap the definitions of these keys. +This means that when DESTRUCTIVE is non-nil, all related swaps/cycles should be +done in the same invocation." + (declare (indent defun)) + (general--ensure-lists states keymaps) + (dolist (keymap-name keymaps) + (dolist (state states) + (setq keymap-name (general--unalias keymap-name) + state (general--unalias state t)) + (let* ((keymap (general--get-keymap state keymap-name)) + (backup-keymap (intern (format "general-%s%s-backup-map" + keymap-name + (if state + (format "-%s-state" state) + "")))) + (lookup-keymap (if (and (not destructive) + (boundp backup-keymap)) + (symbol-value backup-keymap) + (copy-keymap keymap))) + (maps (cl-loop for (key replacement) on maps by 'cddr + ;; :destructive can be in MAPS + unless (keywordp key) + collect (general--kbd key) + and collect (lookup-key + lookup-keymap + (general--kbd replacement))))) + (unless (or destructive + (boundp backup-keymap)) + (set backup-keymap lookup-keymap)) + (apply #'general-define-key :states state :keymaps keymap-name maps))))) + +;;;###autoload +(defmacro general-swap-key (states keymaps &rest args) + "Wrapper around `general-translate-key' for swapping keys. +STATES, KEYMAPS, and ARGS are passed to `general-translate-key'. ARGS should +consist of key swaps (e.g. \"a\" \"b\" is equivalent to \"a\" \"b\" \"b\" \"a\" +with `general-translate-key') and optionally keyword arguments for +`general-translate-key'." + (declare (indent defun)) + (setq args (cl-loop for (key replacement) on args by 'cddr + collect key and collect replacement + and unless (keywordp key) + collect replacement and collect key)) + `(general-translate-key ,states ,keymaps ,@args)) + +;; ** Automatic Key Unbinding +(defun general-unbind-non-prefix-key (define-key keymap key def) + "Use DEFINE-KEY in KEYMAP to unbind an existing non-prefix subsequence of KEY. +When a general key definer is in use and a subsequnece of KEY is already bound +in KEYMAP, unbind it using DEFINE-KEY. Always bind KEY to DEF using DEFINE-KEY." + (when general--definer-p + (let ((key (if (stringp key) + (string-to-vector key) + key))) + (while (numberp (lookup-key keymap key)) + (setq key (cl-subseq key 0 -1))) + (funcall define-key keymap key nil))) + (funcall define-key keymap key def)) + +;;;###autoload +(defun general-auto-unbind-keys (&optional undo) + "Advise `define-key' to automatically unbind keys when necessary. +This will prevent errors when a sub-sequence of a key is already bound (e.g. the +user attempts to bind \"SPC a\" when \"SPC\" is bound, resulting in a \"Key +sequnce starts with non-prefix key\" error). When UNDO is non-nil, remove +advice." + (if undo + ;; using general versions in case start recording advice for later display + (general-advice-remove 'define-key #'general-unbind-non-prefix-key) + (general-advice-add 'define-key :around #'general-unbind-non-prefix-key))) + +;; ** Interactive Lambdas +(defmacro general-lambda (&rest body) + "Wrap BODY in an interactive lamba" + `(lambda () (interactive) + ,@body)) + +(defalias 'general-l #'general-lambda) + +;; * Functions/Macros to Aid Other Configuration +;; ** Settings +(defmacro general-setq (&rest settings) + "A stripped-down `customize-set-variable' with the syntax of `setq'. +Like `setq', multiple variables can be set at once; SETTINGS should consist of +variable value pairs. Some variables have a custom setter (specified with +`defcustom' and :set) that is used to run code necessary for changes to take +effect (e.g. `auto-revert-interval'). If a package has already been loaded, and +the user uses `setq' to set one of these variables, the :set code will not +run (e.g. in the case of `auto-revert-interval', the timer will not be updated). +Like with `customize-set-variable', `general-setq' will use the custom :set +setter when necessary. If the package defining the variable has not yet been +loaded, the custom setter will not be known, but it will still be run upon +loading the package. Unlike `customize-set-variable', `general-setq' does not +attempt to load any dependencies for the variable and does not support giving +variables comments." + `(progn + ,@(cl-loop for (var val) on settings by 'cddr + collect `(funcall (or (get ',var 'custom-set) #'set-default) + ',var ,val)))) + +;; ** Hooks +;;;###autoload +(defun general-add-hook (hooks functions &optional append local) + "A drop-in replacement for `add-hook'. +Unlike `add-hook', HOOKS and FUNCTIONS can be single items or lists. APPEND and +LOCAL are passed directly to `add-hook'." + (general--ensure-lists hooks functions) + (dolist (hook hooks) + (dolist (func functions) + (add-hook hook func append local)))) + +;;;###autoload +(defun general-remove-hook (hooks functions &optional local) + "A drop-in replacement for `remove-hook'. +Unlike `remove-hook', HOOKS and FUNCTIONS can be single items or lists. LOCAL is +passed directly to `remove-hook'." + (general--ensure-lists hooks functions) + (dolist (hook hooks) + (dolist (func functions) + (remove-hook hook func local)))) + +;; ** Advice +;;;###autoload +(defun general-advice-add (symbols where functions &optional props) + "A drop-in replacement for `advice-add'. +SYMBOLS, WHERE, FUNCTIONS, and PROPS correspond to the arguments for +`advice-add'. Unlike `advice-add', SYMBOLS and FUNCTIONS can be single items or +lists." + (general--ensure-lists symbols functions) + (dolist (symbol symbols) + (dolist (func functions) + (advice-add symbol where func props)))) + +;; specify full autoload to prevent function indirection (autoload generation +;; will put a /flipped/ defalias into the autoloads file causing an infinite +;; loop) +;;;###autoload (autoload 'general-add-advice "general") +(defalias 'general-add-advice #'general-advice-add) + +;;;###autoload +(defun general-advice-remove (symbols functions) + "A drop-in replacement for `advice-remove'. +Unlike `advice-remove', SYMBOLS and FUNCTIONS can be single items or lists." + (general--ensure-lists symbols functions) + (dolist (symbol symbols) + (dolist (func functions) + (advice-remove symbol func)))) + +;;;###autoload (autoload 'general-remove-advice "general") +(defalias 'general-remove-advice #'general-advice-remove) + +;; * Optional Setup +;;;###autoload +(defun general-evil-setup (&optional short-names _) + "Set up some basic equivalents for vim mapping functions. +This creates global key definition functions for the evil states. +Specifying SHORT-NAMES as non-nil will create non-prefixed function +aliases such as `nmap' for `general-nmap'." + (general-create-definer general-imap :states 'insert) + (general-create-definer general-emap :states 'emacs) + (general-create-definer general-nmap :states 'normal) + (general-create-definer general-vmap :states 'visual) + (general-create-definer general-mmap :states 'motion) + (general-create-definer general-omap :states 'operator) + (general-create-definer general-rmap :states 'replace) + (general-create-definer general-iemap :states '(insert emacs)) + (general-create-definer general-nvmap :states '(normal visual)) + ;; these two don't have corresponding states + (general-create-definer general-itomap :keymaps 'evil-inner-text-objects-map) + (general-create-definer general-otomap :keymaps 'evil-outer-text-objects-map) + (general-create-definer general-tomap + :keymaps '(evil-outer-text-objects-map + evil-inner-text-objects-map)) + (when short-names + (defalias 'imap #'general-imap) + (defalias 'emap #'general-emap) + (defalias 'nmap #'general-nmap) + (defalias 'vmap #'general-vmap) + (defalias 'mmap #'general-mmap) + (defalias 'omap #'general-omap) + (defalias 'rmap #'general-rmap) + (defalias 'iemap #'general-iemap) + (defalias 'nvmap #'general-nvmap) + (defalias 'itomap #'general-itomap) + (defalias 'otomap #'general-otomap) + (defalias 'tomap #'general-tomap))) + +;; * Use-package Integration +;; maybe useful for something else in future +(defun general--extract-autoloadable-symbol (def) + "Extract an autoloadable symbol from DEF, a normal or extended definition. +This will also correctly extract the definition from a cons of the form (STRING +. DEFN). If the extracted definition is nil, a string, a lambda, a keymap symbol +from an extended definition, or some other definition that cannot be autoloaded, +return nil." + ;; explicit null checks not required because nil return value means no def + (when (general--extended-def-p def) + ;; extract definition + (let ((first (car def))) + (setq def (if (keywordp first) + (plist-get def :def) + first)))) + (cond ((symbolp def) + def) + ((and (consp def) + (symbolp (cdr def))) + (cdr def)))) + +(general-with-eval-after-load 'use-package-core + (declare-function use-package-concat "use-package") + (declare-function use-package-process-keywords "use-package") + (defvar use-package-keywords) + (defvar use-package-deferring-keywords) + ;; ** :general Keyword + (setq use-package-keywords + ;; should go in the same location as :bind + ;; adding to end may not cause problems, but see issue #22 + (cl-loop for item in use-package-keywords + if (eq item :bind-keymap*) + collect :bind-keymap* and collect :general + else + ;; don't add duplicates + unless (eq item :general) + collect item)) + + ;; altered args will be passed to the autoloads and handler functions + (defun use-package-normalize/:general (_name _keyword general-arglists) + "Return a plist containing the original ARGLISTS and autoloadable symbols." + (let* ((sanitized-arglist + ;; combine arglists into one without function names or + ;; positional arguments + (let (result) + (dolist (arglist general-arglists result) + (while (general--positional-arg-p (car arglist)) + (setq arglist (cdr arglist))) + (setq result (append result arglist))))) + (commands + (cl-loop for (key def) on sanitized-arglist by 'cddr + when (and (not (keywordp key)) + (not (null def)) + (ignore-errors + ;; TODO use cdr instead if possible + (setq def (eval def)) + (setq def (general--extract-autoloadable-symbol + def)))) + collect def))) + (list :arglists general-arglists :commands commands))) + + (defun use-package-autoloads/:general (_name _keyword args) + "Return an alist of commands extracted from ARGS. +Return something like '((some-command-to-autoload . command) ...)." + (mapcar (lambda (command) (cons command 'command)) + (plist-get args :commands))) + + (defun use-package-handler/:general (name _keyword args rest state) + "Use-package handler for :general." + (use-package-concat + (use-package-process-keywords name rest state) + `(,@(mapcar (lambda (arglist) + ;; Note: prefix commands are not valid functions + (if (or (functionp (car arglist)) + (macrop (car arglist))) + `(,@arglist :package ',name) + `(general-def + ,@arglist + :package ',name))) + (plist-get args :arglists))))) + + ;; ** :ghook and :gfhook Keyword + (setq use-package-keywords + ;; should go in the same location as :bind + ;; adding to end may not cause problems, but see issue #22 + (cl-loop for item in use-package-keywords + if (eq item :hook) + collect :hook and collect :ghook and collect :gfhook + else + ;; don't add duplicates + unless (memq item '(:ghook :gfhook)) + collect item)) + + (defun general-normalize-hook-arglist (arglist mode-enable mode-hook + &optional symbol-is-function-p) + "Rewrite a :g(f)hook ARGLIST to a `general-add-hook' arglist. +MODE-ENABLE is the inferred command to enable the package's mode, and MODE-HOOK +is the mode inferred hook to enable the package's mode. When ARGLIST is a symbol +instead of a list, it will be considered to be a hook name unless +SYMBOL-IS-FUNCTION-P is non-nil, in which case it will considered to be a +function." + ;; standalone symbols are quoted automatically; unquote + (when (ignore-errors (memq (car arglist) (list 'quote 'function))) + (setq arglist (cadr arglist))) + (cond ((listp arglist) + ;; necessary to extract commands because they could be stored in a + ;; variable or returned by a macro/function + ;; e.g. (list #'func1 #'func2) needs to be evaluated + (setq arglist (mapcar (lambda (arg) (eval arg)) + arglist)) + (if (= (length arglist) 1) + ;; <user specified hook(s)> #'<package>-mode + (append arglist (list mode-enable)) + (let ((hooks (car arglist)) + (functions (cadr arglist))) + (when (or (null hooks) + (not (or (symbolp hooks) + (listp hooks)))) + (setq hooks mode-hook)) + (when (or (null functions) + (not (or (symbolp functions) + (listp functions)))) + (setq functions mode-enable)) + (cons hooks (cons functions (cddr arglist)))))) + (t + (if symbol-is-function-p + ;; '<package>-mode-hook <user specified function> + (list mode-hook arglist) + ;; <user specified hook> #'<package>-mode + (list arglist mode-enable))))) + + ;; altered args will be passed to the autoloads and handler functions + (defun general-normalize-hook (name _keyword args &optional gfhookp) + "Return a plist containing arglists and autoloadable commands. +Transform ARGS into arglists suitable for `general-add-hook'." + (let* ((mode (if (string-match-p "mode\\'" (symbol-name name)) + name + (intern (format "%s-mode" name)))) + (mode-hook (intern (format "%s-hook" mode)))) + (cl-loop for arg in args + collect (general-normalize-hook-arglist + arg mode mode-hook gfhookp)))) + + (defalias 'use-package-normalize/:ghook #'general-normalize-hook) + + (defun use-package-autoloads/:ghook (_name _keyword arglists) + "Return an alist of commands extracted from ARGLISTS. +Return something like '((some-command-to-autoload . command) ...)." + (let ((commands + (cl-loop for (_ functions) in arglists + if (symbolp functions) + collect functions + else + unless (functionp functions) + append (cl-loop for function in functions + when (symbolp function) + collect function)))) + (mapcar (lambda (command) (cons command 'command)) + commands))) + + (defun use-package-handler/:ghook (name _keyword arglists rest state) + "Use-package handler for :ghook and :gfhook." + (use-package-concat + (use-package-process-keywords name rest state) + `(,@(mapcar (lambda (arglist) + arglist + ;; requote (unfortunately need to evaluate in normalizer) + `(general-add-hook ,@(mapcar (lambda (x) `',x) + arglist))) + arglists)))) + + (defun use-package-normalize/:gfhook (name keyword args) + "Use-package normalizer for :gfhook." + (general-normalize-hook name keyword args t)) + + (defalias 'use-package-handler/:gfhook #'use-package-handler/:ghook)) + +;; * Key-chord "Integration" +(defun general-chord (keys) + "Rewrite the string KEYS into a valid key-chord vector." + ;; taken straight from key-chord.el + (if (/= 2 (length keys)) + (error "Key-chord keys must have two elements")) + ;; Exotic chars in a string are >255 but define-key wants 128..255 for those + (let ((key1 (logand 255 (aref keys 0))) + (key2 (logand 255 (aref keys 1)))) + (vector 'key-chord key1 key2))) + +(provide 'general) +;;; general.el ends here |