diff options
Diffstat (limited to 'lisp/use-package')
| -rw-r--r-- | lisp/use-package/bind-chord.el | 113 | ||||
| -rw-r--r-- | lisp/use-package/bind-key.el | 544 | ||||
| -rw-r--r-- | lisp/use-package/use-package-bind-key.el | 171 | ||||
| -rw-r--r-- | lisp/use-package/use-package-chords.el | 54 | ||||
| -rw-r--r-- | lisp/use-package/use-package-core.el | 1690 | ||||
| -rw-r--r-- | lisp/use-package/use-package-delight.el | 83 | ||||
| -rw-r--r-- | lisp/use-package/use-package-diminish.el | 72 | ||||
| -rw-r--r-- | lisp/use-package/use-package-ensure-system-package.el | 99 | ||||
| -rw-r--r-- | lisp/use-package/use-package-ensure.el | 206 | ||||
| -rw-r--r-- | lisp/use-package/use-package-jump.el | 70 | ||||
| -rw-r--r-- | lisp/use-package/use-package-lint.el | 76 | ||||
| -rw-r--r-- | lisp/use-package/use-package.el | 51 |
12 files changed, 3229 insertions, 0 deletions
diff --git a/lisp/use-package/bind-chord.el b/lisp/use-package/bind-chord.el new file mode 100644 index 00000000000..ed736a4b966 --- /dev/null +++ b/lisp/use-package/bind-chord.el | |||
| @@ -0,0 +1,113 @@ | |||
| 1 | ;;; bind-chord.el --- key-chord binding helper for use-package-chords -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2015-2022 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Justin Talbott <justin@waymondo.com> | ||
| 6 | ;; Keywords: convenience, tools, extensions | ||
| 7 | ;; URL: https://github.com/jwiegley/use-package | ||
| 8 | ;; Version: 0.2.1 | ||
| 9 | ;; Package-Requires: ((emacs "24.3") (bind-key "1.0") (key-chord "0.6")) | ||
| 10 | ;; Filename: bind-chord.el | ||
| 11 | |||
| 12 | ;; This program is free software; you can redistribute it and/or modify | ||
| 13 | ;; it under the terms of the GNU General Public License as published by | ||
| 14 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 15 | ;; (at your option) any later version. | ||
| 16 | |||
| 17 | ;; This program is distributed in the hope that it will be useful, | ||
| 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 20 | ;; GNU General Public License for more details. | ||
| 21 | |||
| 22 | ;; You should have received a copy of the GNU General Public License | ||
| 23 | ;; along with this program. If not, see <https://www.gnu.org/licenses/>. | ||
| 24 | |||
| 25 | ;;; Commentary: | ||
| 26 | |||
| 27 | ;;; Code: | ||
| 28 | |||
| 29 | (require 'bind-key) | ||
| 30 | (require 'key-chord nil t) | ||
| 31 | |||
| 32 | ;;;###autoload | ||
| 33 | (defmacro bind-chord (chord command &optional keymap) | ||
| 34 | "Bind CHORD to COMMAND in KEYMAP (`global-map' if not passed)." | ||
| 35 | (let ((key1 (logand 255 (aref chord 0))) | ||
| 36 | (key2 (logand 255 (aref chord 1)))) | ||
| 37 | (if (eq key1 key2) | ||
| 38 | `(bind-key (vector 'key-chord ,key1 ,key2) ,command ,keymap) | ||
| 39 | `(progn | ||
| 40 | (bind-key (vector 'key-chord ,key1 ,key2) ,command ,keymap) | ||
| 41 | (bind-key (vector 'key-chord ,key2 ,key1) ,command ,keymap))))) | ||
| 42 | |||
| 43 | (defun bind-chords-form (args keymap) | ||
| 44 | "Bind multiple chords at once. | ||
| 45 | |||
| 46 | Accepts keyword arguments: | ||
| 47 | :map MAP - a keymap into which the keybindings should be | ||
| 48 | added | ||
| 49 | |||
| 50 | The rest of the arguments are conses of keybinding string and a | ||
| 51 | function symbol (unquoted)." | ||
| 52 | (let (map pkg) | ||
| 53 | (let ((cont t)) | ||
| 54 | (while (and cont args) | ||
| 55 | (if (cond ((eq :map (car args)) | ||
| 56 | (setq map (cadr args))) | ||
| 57 | ((eq :package (car args)) | ||
| 58 | (setq pkg (cadr args)))) | ||
| 59 | (setq args (cddr args)) | ||
| 60 | (setq cont nil)))) | ||
| 61 | |||
| 62 | (unless map (setq map keymap)) | ||
| 63 | |||
| 64 | (let (first next) | ||
| 65 | (while args | ||
| 66 | (if (keywordp (car args)) | ||
| 67 | (progn | ||
| 68 | (setq next args) | ||
| 69 | (setq args nil)) | ||
| 70 | (if first | ||
| 71 | (nconc first (list (car args))) | ||
| 72 | (setq first (list (car args)))) | ||
| 73 | (setq args (cdr args)))) | ||
| 74 | |||
| 75 | (cl-flet | ||
| 76 | ((wrap (map bindings) | ||
| 77 | (if (and map pkg (not (memq map '(global-map | ||
| 78 | override-global-map)))) | ||
| 79 | `((if (boundp ',map) | ||
| 80 | ,(macroexp-progn bindings) | ||
| 81 | (eval-after-load | ||
| 82 | ,(if (symbolp pkg) `',pkg pkg) | ||
| 83 | ',(macroexp-progn bindings)))) | ||
| 84 | bindings))) | ||
| 85 | |||
| 86 | (append | ||
| 87 | (wrap map | ||
| 88 | (cl-mapcan | ||
| 89 | (lambda (form) | ||
| 90 | (let ((fun (and (cdr form) (list 'function (cdr form))))) | ||
| 91 | (if (and map (not (eq map 'global-map))) | ||
| 92 | `((bind-chord ,(car form) ,fun ,map)) | ||
| 93 | `((bind-chord ,(car form) ,fun nil))))) | ||
| 94 | first)) | ||
| 95 | (when next | ||
| 96 | (bind-chords-form (if pkg | ||
| 97 | (cons :package (cons pkg next)) | ||
| 98 | next) map))))))) | ||
| 99 | |||
| 100 | ;;;###autoload | ||
| 101 | (defmacro bind-chords (&rest args) | ||
| 102 | "Bind multiple chords at once. | ||
| 103 | |||
| 104 | Accepts keyword argument: | ||
| 105 | :map - a keymap into which the keybindings should be added | ||
| 106 | |||
| 107 | The rest of the arguments are conses of keybinding string and a | ||
| 108 | function symbol (unquoted)." | ||
| 109 | (macroexp-progn (bind-chords-form args nil))) | ||
| 110 | |||
| 111 | (provide 'bind-chord) | ||
| 112 | |||
| 113 | ;;; bind-chord.el ends here | ||
diff --git a/lisp/use-package/bind-key.el b/lisp/use-package/bind-key.el new file mode 100644 index 00000000000..3168f686a09 --- /dev/null +++ b/lisp/use-package/bind-key.el | |||
| @@ -0,0 +1,544 @@ | |||
| 1 | ;;; bind-key.el --- A simple way to manage personal keybindings -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (c) 2012-2022 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: John Wiegley <johnw@newartisans.com> | ||
| 6 | ;; Maintainer: John Wiegley <johnw@newartisans.com> | ||
| 7 | ;; Created: 16 Jun 2012 | ||
| 8 | ;; Version: 2.4.1 | ||
| 9 | ;; Package-Requires: ((emacs "24.3")) | ||
| 10 | ;; Keywords: keys keybinding config dotemacs extensions | ||
| 11 | ;; URL: https://github.com/jwiegley/use-package | ||
| 12 | |||
| 13 | ;; This program is free software; you can redistribute it and/or modify | ||
| 14 | ;; it under the terms of the GNU General Public License as published by | ||
| 15 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 16 | ;; (at your option) any later version. | ||
| 17 | |||
| 18 | ;; This program is distributed in the hope that it will be useful, | ||
| 19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 21 | ;; GNU General Public License for more details. | ||
| 22 | |||
| 23 | ;; You should have received a copy of the GNU General Public License | ||
| 24 | ;; along with this program. If not, see <https://www.gnu.org/licenses/>. | ||
| 25 | |||
| 26 | ;;; Commentary: | ||
| 27 | |||
| 28 | ;; If you have lots of keybindings set in your .emacs file, it can be hard to | ||
| 29 | ;; know which ones you haven't set yet, and which may now be overriding some | ||
| 30 | ;; new default in a new Emacs version. This module aims to solve that | ||
| 31 | ;; problem. | ||
| 32 | ;; | ||
| 33 | ;; Bind keys as follows in your .emacs: | ||
| 34 | ;; | ||
| 35 | ;; (require 'bind-key) | ||
| 36 | ;; | ||
| 37 | ;; (bind-key "C-c x" 'my-ctrl-c-x-command) | ||
| 38 | ;; | ||
| 39 | ;; If the keybinding argument is a vector, it is passed straight to | ||
| 40 | ;; `define-key', so remapping a key with `[remap COMMAND]' works as | ||
| 41 | ;; expected: | ||
| 42 | ;; | ||
| 43 | ;; (bind-key [remap original-ctrl-c-x-command] 'my-ctrl-c-x-command) | ||
| 44 | ;; | ||
| 45 | ;; If you want the keybinding to override all minor modes that may also bind | ||
| 46 | ;; the same key, use the `bind-key*' form: | ||
| 47 | ;; | ||
| 48 | ;; (bind-key* "<C-return>" 'other-window) | ||
| 49 | ;; | ||
| 50 | ;; If you want to rebind a key only in a particular keymap, use: | ||
| 51 | ;; | ||
| 52 | ;; (bind-key "C-c x" 'my-ctrl-c-x-command some-other-mode-map) | ||
| 53 | ;; | ||
| 54 | ;; To unbind a key within a keymap (for example, to stop your favorite major | ||
| 55 | ;; mode from changing a binding that you don't want to override everywhere), | ||
| 56 | ;; use `unbind-key': | ||
| 57 | ;; | ||
| 58 | ;; (unbind-key "C-c x" some-other-mode-map) | ||
| 59 | ;; | ||
| 60 | ;; To bind multiple keys at once, or set up a prefix map, a `bind-keys' macro | ||
| 61 | ;; is provided. It accepts keyword arguments, please see its documentation | ||
| 62 | ;; for a detailed description. | ||
| 63 | ;; | ||
| 64 | ;; To add keys into a specific map, use :map argument | ||
| 65 | ;; | ||
| 66 | ;; (bind-keys :map dired-mode-map | ||
| 67 | ;; ("o" . dired-omit-mode) | ||
| 68 | ;; ("a" . some-custom-dired-function)) | ||
| 69 | ;; | ||
| 70 | ;; To set up a prefix map, use `:prefix-map' and `:prefix' arguments (both are | ||
| 71 | ;; required) | ||
| 72 | ;; | ||
| 73 | ;; (bind-keys :prefix-map my-customize-prefix-map | ||
| 74 | ;; :prefix "C-c c" | ||
| 75 | ;; ("f" . customize-face) | ||
| 76 | ;; ("v" . customize-variable)) | ||
| 77 | ;; | ||
| 78 | ;; You can combine all the keywords together. Additionally, | ||
| 79 | ;; `:prefix-docstring' can be specified to set documentation of created | ||
| 80 | ;; `:prefix-map' variable. | ||
| 81 | ;; | ||
| 82 | ;; To bind multiple keys in a `bind-key*' way (to be sure that your bindings | ||
| 83 | ;; will not be overridden by other modes), you may use `bind-keys*' macro: | ||
| 84 | ;; | ||
| 85 | ;; (bind-keys* | ||
| 86 | ;; ("C-o" . other-window) | ||
| 87 | ;; ("C-M-n" . forward-page) | ||
| 88 | ;; ("C-M-p" . backward-page)) | ||
| 89 | ;; | ||
| 90 | ;; After Emacs loads, you can see a summary of all your personal keybindings | ||
| 91 | ;; currently in effect with this command: | ||
| 92 | ;; | ||
| 93 | ;; M-x describe-personal-keybindings | ||
| 94 | ;; | ||
| 95 | ;; This display will tell you if you've overridden a default keybinding, and | ||
| 96 | ;; what the default was. Also, it will tell you if the key was rebound after | ||
| 97 | ;; your binding it with `bind-key', and what it was rebound it to. | ||
| 98 | |||
| 99 | ;;; Code: | ||
| 100 | |||
| 101 | (require 'cl-lib) | ||
| 102 | (require 'easy-mmode) | ||
| 103 | |||
| 104 | (defgroup bind-key nil | ||
| 105 | "A simple way to manage personal keybindings." | ||
| 106 | :group 'emacs) | ||
| 107 | |||
| 108 | (defcustom bind-key-column-widths '(18 . 40) | ||
| 109 | "Width of columns in `describe-personal-keybindings'." | ||
| 110 | :type '(cons integer integer) | ||
| 111 | :group 'bind-key) | ||
| 112 | |||
| 113 | (defcustom bind-key-segregation-regexp | ||
| 114 | "\\`\\(\\(C-[chx] \\|M-[gso] \\)\\([CM]-\\)?\\|.+-\\)" | ||
| 115 | "Regular expression used to divide key sets in the output from | ||
| 116 | \\[describe-personal-keybindings]." | ||
| 117 | :type 'regexp | ||
| 118 | :group 'bind-key) | ||
| 119 | |||
| 120 | (defcustom bind-key-describe-special-forms nil | ||
| 121 | "If non-nil, extract docstrings from lambdas, closures and keymaps if possible." | ||
| 122 | :type 'boolean | ||
| 123 | :group 'bind-key) | ||
| 124 | |||
| 125 | ;; Create override-global-mode to force key remappings | ||
| 126 | |||
| 127 | (defvar override-global-map (make-keymap) | ||
| 128 | "Keymap for `override-global-mode'.") | ||
| 129 | |||
| 130 | (define-minor-mode override-global-mode | ||
| 131 | "A minor mode so that keymap settings override other modes." | ||
| 132 | :init-value t | ||
| 133 | :lighter "") | ||
| 134 | |||
| 135 | ;; the keymaps in `emulation-mode-map-alists' take precedence over | ||
| 136 | ;; `minor-mode-map-alist' | ||
| 137 | (add-to-list 'emulation-mode-map-alists | ||
| 138 | `((override-global-mode . ,override-global-map))) | ||
| 139 | |||
| 140 | (defvar personal-keybindings nil | ||
| 141 | "List of bindings performed by `bind-key'. | ||
| 142 | |||
| 143 | Elements have the form ((KEY . [MAP]) CMD ORIGINAL-CMD)") | ||
| 144 | |||
| 145 | ;;;###autoload | ||
| 146 | (defmacro bind-key (key-name command &optional keymap predicate) | ||
| 147 | "Bind KEY-NAME to COMMAND in KEYMAP (`global-map' if not passed). | ||
| 148 | |||
| 149 | KEY-NAME may be a vector, in which case it is passed straight to | ||
| 150 | `define-key'. Or it may be a string to be interpreted as | ||
| 151 | spelled-out keystrokes, e.g., `C-c C-z'. See documentation of | ||
| 152 | `edmacro-mode' for details. | ||
| 153 | |||
| 154 | COMMAND must be an interactive function or lambda form. | ||
| 155 | |||
| 156 | KEYMAP, if present, should be a keymap variable or symbol. | ||
| 157 | For example: | ||
| 158 | |||
| 159 | (bind-key \"M-h\" #\\='some-interactive-function my-mode-map) | ||
| 160 | |||
| 161 | (bind-key \"M-h\" #\\='some-interactive-function \\='my-mode-map) | ||
| 162 | |||
| 163 | If PREDICATE is non-nil, it is a form evaluated to determine when | ||
| 164 | a key should be bound. It must return non-nil in such cases. | ||
| 165 | Emacs can evaluate this form at any time that it does redisplay | ||
| 166 | or operates on menu data structures, so you should write it so it | ||
| 167 | can safely be called at any time." | ||
| 168 | (let ((namevar (make-symbol "name")) | ||
| 169 | (keyvar (make-symbol "key")) | ||
| 170 | (kmapvar (make-symbol "kmap")) | ||
| 171 | (kdescvar (make-symbol "kdesc")) | ||
| 172 | (bindingvar (make-symbol "binding"))) | ||
| 173 | `(let* ((,namevar ,key-name) | ||
| 174 | (,keyvar ,(if (stringp key-name) (read-kbd-macro key-name) | ||
| 175 | `(if (vectorp ,namevar) ,namevar | ||
| 176 | (read-kbd-macro ,namevar)))) | ||
| 177 | (,kmapvar (or (if (and ,keymap (symbolp ,keymap)) | ||
| 178 | (symbol-value ,keymap) ,keymap) | ||
| 179 | global-map)) | ||
| 180 | (,kdescvar (cons (if (stringp ,namevar) ,namevar | ||
| 181 | (key-description ,namevar)) | ||
| 182 | (if (symbolp ,keymap) ,keymap (quote ,keymap)))) | ||
| 183 | (,bindingvar (lookup-key ,kmapvar ,keyvar))) | ||
| 184 | (let ((entry (assoc ,kdescvar personal-keybindings)) | ||
| 185 | (details (list ,command | ||
| 186 | (unless (numberp ,bindingvar) | ||
| 187 | ,bindingvar)))) | ||
| 188 | (if entry | ||
| 189 | (setcdr entry details) | ||
| 190 | (add-to-list 'personal-keybindings (cons ,kdescvar details)))) | ||
| 191 | ,(if predicate | ||
| 192 | `(define-key ,kmapvar ,keyvar | ||
| 193 | '(menu-item "" nil :filter (lambda (&optional _) | ||
| 194 | (when ,predicate | ||
| 195 | ,command)))) | ||
| 196 | `(define-key ,kmapvar ,keyvar ,command))))) | ||
| 197 | |||
| 198 | ;;;###autoload | ||
| 199 | (defmacro unbind-key (key-name &optional keymap) | ||
| 200 | "Unbind the given KEY-NAME, within the KEYMAP (if specified). | ||
| 201 | See `bind-key' for more details." | ||
| 202 | (let ((namevar (make-symbol "name")) | ||
| 203 | (kdescvar (make-symbol "kdesc"))) | ||
| 204 | `(let* ((,namevar ,key-name) | ||
| 205 | (,kdescvar (cons (if (stringp ,namevar) ,namevar | ||
| 206 | (key-description ,namevar)) | ||
| 207 | (if (symbolp ,keymap) ,keymap (quote ,keymap))))) | ||
| 208 | (bind-key--remove (if (vectorp ,namevar) ,namevar | ||
| 209 | (read-kbd-macro ,namevar)) | ||
| 210 | (or (if (and ,keymap (symbolp ,keymap)) | ||
| 211 | (symbol-value ,keymap) ,keymap) | ||
| 212 | global-map)) | ||
| 213 | (setq personal-keybindings | ||
| 214 | (cl-delete-if (lambda (k) (equal (car k) ,kdescvar)) | ||
| 215 | personal-keybindings)) | ||
| 216 | nil))) | ||
| 217 | |||
| 218 | (defun bind-key--remove (key keymap) | ||
| 219 | "Remove KEY from KEYMAP. | ||
| 220 | |||
| 221 | In contrast to `define-key', this function removes the binding from the keymap." | ||
| 222 | (define-key keymap key nil) | ||
| 223 | ;; Split M-key in ESC key | ||
| 224 | (setq key (cl-mapcan (lambda (k) | ||
| 225 | (if (and (integerp k) (/= (logand k ?\M-\0) 0)) | ||
| 226 | (list ?\e (logxor k ?\M-\0)) | ||
| 227 | (list k))) | ||
| 228 | key)) | ||
| 229 | ;; Delete single keys directly | ||
| 230 | (if (= (length key) 1) | ||
| 231 | (delete key keymap) | ||
| 232 | ;; Lookup submap and delete key from there | ||
| 233 | (let* ((prefix (vconcat (butlast key))) | ||
| 234 | (submap (lookup-key keymap prefix))) | ||
| 235 | (unless (keymapp submap) | ||
| 236 | (error "Not a keymap for %s" key)) | ||
| 237 | (when (symbolp submap) | ||
| 238 | (setq submap (symbol-function submap))) | ||
| 239 | (delete (last key) submap) | ||
| 240 | ;; Delete submap if it is empty | ||
| 241 | (when (= 1 (length submap)) | ||
| 242 | (bind-key--remove prefix keymap))))) | ||
| 243 | |||
| 244 | ;;;###autoload | ||
| 245 | (defmacro bind-key* (key-name command &optional predicate) | ||
| 246 | "Similar to `bind-key', but overrides any mode-specific bindings." | ||
| 247 | `(bind-key ,key-name ,command override-global-map ,predicate)) | ||
| 248 | |||
| 249 | (defun bind-keys-form (args keymap) | ||
| 250 | "Bind multiple keys at once. | ||
| 251 | |||
| 252 | Accepts keyword arguments: | ||
| 253 | :map MAP - a keymap into which the keybindings should be | ||
| 254 | added | ||
| 255 | :prefix KEY - prefix key for these bindings | ||
| 256 | :prefix-map MAP - name of the prefix map that should be created | ||
| 257 | for these bindings | ||
| 258 | :prefix-docstring STR - docstring for the prefix-map variable | ||
| 259 | :menu-name NAME - optional menu string for prefix map | ||
| 260 | :repeat-docstring STR - docstring for the repeat-map variable | ||
| 261 | :repeat-map MAP - name of the repeat map that should be created | ||
| 262 | for these bindings. If specified, the | ||
| 263 | `repeat-map' property of each command bound | ||
| 264 | (within the scope of the `:repeat-map' keyword) | ||
| 265 | is set to this map. | ||
| 266 | :exit BINDINGS - Within the scope of `:repeat-map' will bind the | ||
| 267 | key in the repeat map, but will not set the | ||
| 268 | `repeat-map' property of the bound command. | ||
| 269 | :continue BINDINGS - Within the scope of `:repeat-map' forces the | ||
| 270 | same behaviour as if no special keyword had | ||
| 271 | been used (that is, the command is bound, and | ||
| 272 | it's `repeat-map' property set) | ||
| 273 | :filter FORM - optional form to determine when bindings apply | ||
| 274 | |||
| 275 | The rest of the arguments are conses of keybinding string and a | ||
| 276 | function symbol (unquoted)." | ||
| 277 | (let (map | ||
| 278 | prefix-doc | ||
| 279 | prefix-map | ||
| 280 | prefix | ||
| 281 | repeat-map | ||
| 282 | repeat-doc | ||
| 283 | repeat-type ;; Only used internally | ||
| 284 | filter | ||
| 285 | menu-name | ||
| 286 | pkg) | ||
| 287 | |||
| 288 | ;; Process any initial keyword arguments | ||
| 289 | (let ((cont t) | ||
| 290 | (arg-change-func 'cddr)) | ||
| 291 | (while (and cont args) | ||
| 292 | (if (cond ((and (eq :map (car args)) | ||
| 293 | (not prefix-map)) | ||
| 294 | (setq map (cadr args))) | ||
| 295 | ((eq :prefix-docstring (car args)) | ||
| 296 | (setq prefix-doc (cadr args))) | ||
| 297 | ((and (eq :prefix-map (car args)) | ||
| 298 | (not (memq map '(global-map | ||
| 299 | override-global-map)))) | ||
| 300 | (setq prefix-map (cadr args))) | ||
| 301 | ((eq :repeat-docstring (car args)) | ||
| 302 | (setq repeat-doc (cadr args))) | ||
| 303 | ((and (eq :repeat-map (car args)) | ||
| 304 | (not (memq map '(global-map | ||
| 305 | override-global-map)))) | ||
| 306 | (setq repeat-map (cadr args)) | ||
| 307 | (setq map repeat-map)) | ||
| 308 | ((eq :continue (car args)) | ||
| 309 | (setq repeat-type :continue | ||
| 310 | arg-change-func 'cdr)) | ||
| 311 | ((eq :exit (car args)) | ||
| 312 | (setq repeat-type :exit | ||
| 313 | arg-change-func 'cdr)) | ||
| 314 | ((eq :prefix (car args)) | ||
| 315 | (setq prefix (cadr args))) | ||
| 316 | ((eq :filter (car args)) | ||
| 317 | (setq filter (cadr args)) t) | ||
| 318 | ((eq :menu-name (car args)) | ||
| 319 | (setq menu-name (cadr args))) | ||
| 320 | ((eq :package (car args)) | ||
| 321 | (setq pkg (cadr args)))) | ||
| 322 | (setq args (funcall arg-change-func args)) | ||
| 323 | (setq cont nil)))) | ||
| 324 | |||
| 325 | (when (or (and prefix-map (not prefix)) | ||
| 326 | (and prefix (not prefix-map))) | ||
| 327 | (error "Both :prefix-map and :prefix must be supplied")) | ||
| 328 | |||
| 329 | (when repeat-type | ||
| 330 | (unless repeat-map | ||
| 331 | (error ":continue and :exit require specifying :repeat-map"))) | ||
| 332 | |||
| 333 | (when (and menu-name (not prefix)) | ||
| 334 | (error "If :menu-name is supplied, :prefix must be too")) | ||
| 335 | |||
| 336 | (unless map (setq map keymap)) | ||
| 337 | |||
| 338 | ;; Process key binding arguments | ||
| 339 | (let (first next) | ||
| 340 | (while args | ||
| 341 | (if (keywordp (car args)) | ||
| 342 | (progn | ||
| 343 | (setq next args) | ||
| 344 | (setq args nil)) | ||
| 345 | (if first | ||
| 346 | (nconc first (list (car args))) | ||
| 347 | (setq first (list (car args)))) | ||
| 348 | (setq args (cdr args)))) | ||
| 349 | |||
| 350 | (cl-flet | ||
| 351 | ((wrap (map bindings) | ||
| 352 | (if (and map pkg (not (memq map '(global-map | ||
| 353 | override-global-map)))) | ||
| 354 | `((if (boundp ',map) | ||
| 355 | ,(macroexp-progn bindings) | ||
| 356 | (eval-after-load | ||
| 357 | ,(if (symbolp pkg) `',pkg pkg) | ||
| 358 | ',(macroexp-progn bindings)))) | ||
| 359 | bindings))) | ||
| 360 | |||
| 361 | (append | ||
| 362 | (when prefix-map | ||
| 363 | `((defvar ,prefix-map) | ||
| 364 | ,@(when prefix-doc `((put ',prefix-map 'variable-documentation ,prefix-doc))) | ||
| 365 | ,@(if menu-name | ||
| 366 | `((define-prefix-command ',prefix-map nil ,menu-name)) | ||
| 367 | `((define-prefix-command ',prefix-map))) | ||
| 368 | ,@(if (and map (not (eq map 'global-map))) | ||
| 369 | (wrap map `((bind-key ,prefix ',prefix-map ,map ,filter))) | ||
| 370 | `((bind-key ,prefix ',prefix-map nil ,filter))))) | ||
| 371 | (when repeat-map | ||
| 372 | `((defvar ,repeat-map (make-sparse-keymap) | ||
| 373 | ,@(when repeat-doc `(,repeat-doc))))) | ||
| 374 | (wrap map | ||
| 375 | (cl-mapcan | ||
| 376 | (lambda (form) | ||
| 377 | (let ((fun (and (cdr form) (list 'function (cdr form))))) | ||
| 378 | (if prefix-map | ||
| 379 | `((bind-key ,(car form) ,fun ,prefix-map ,filter)) | ||
| 380 | (if (and map (not (eq map 'global-map))) | ||
| 381 | ;; Only needed in this branch, since when | ||
| 382 | ;; repeat-map is non-nil, map is always | ||
| 383 | ;; non-nil | ||
| 384 | `(,@(when (and repeat-map (not (eq repeat-type :exit))) | ||
| 385 | `((put ,fun 'repeat-map ',repeat-map))) | ||
| 386 | (bind-key ,(car form) ,fun ,map ,filter)) | ||
| 387 | `((bind-key ,(car form) ,fun nil ,filter)))))) | ||
| 388 | first)) | ||
| 389 | (when next | ||
| 390 | (bind-keys-form `(,@(when repeat-map `(:repeat-map ,repeat-map)) | ||
| 391 | ,@(if pkg | ||
| 392 | (cons :package (cons pkg next)) | ||
| 393 | next)) map))))))) | ||
| 394 | |||
| 395 | ;;;###autoload | ||
| 396 | (defmacro bind-keys (&rest args) | ||
| 397 | "Bind multiple keys at once. | ||
| 398 | |||
| 399 | Accepts keyword arguments: | ||
| 400 | :map MAP - a keymap into which the keybindings should be | ||
| 401 | added | ||
| 402 | :prefix KEY - prefix key for these bindings | ||
| 403 | :prefix-map MAP - name of the prefix map that should be created | ||
| 404 | for these bindings | ||
| 405 | :prefix-docstring STR - docstring for the prefix-map variable | ||
| 406 | :menu-name NAME - optional menu string for prefix map | ||
| 407 | :repeat-docstring STR - docstring for the repeat-map variable | ||
| 408 | :repeat-map MAP - name of the repeat map that should be created | ||
| 409 | for these bindings. If specified, the | ||
| 410 | `repeat-map' property of each command bound | ||
| 411 | (within the scope of the `:repeat-map' keyword) | ||
| 412 | is set to this map. | ||
| 413 | :exit BINDINGS - Within the scope of `:repeat-map' will bind the | ||
| 414 | key in the repeat map, but will not set the | ||
| 415 | `repeat-map' property of the bound command. | ||
| 416 | :continue BINDINGS - Within the scope of `:repeat-map' forces the | ||
| 417 | same behaviour as if no special keyword had | ||
| 418 | been used (that is, the command is bound, and | ||
| 419 | it's `repeat-map' property set) | ||
| 420 | :filter FORM - optional form to determine when bindings apply | ||
| 421 | |||
| 422 | The rest of the arguments are conses of keybinding string and a | ||
| 423 | function symbol (unquoted)." | ||
| 424 | (macroexp-progn (bind-keys-form args nil))) | ||
| 425 | |||
| 426 | ;;;###autoload | ||
| 427 | (defmacro bind-keys* (&rest args) | ||
| 428 | (macroexp-progn (bind-keys-form args 'override-global-map))) | ||
| 429 | |||
| 430 | (defun get-binding-description (elem) | ||
| 431 | (cond | ||
| 432 | ((listp elem) | ||
| 433 | (cond | ||
| 434 | ((memq (car elem) '(lambda function)) | ||
| 435 | (if (and bind-key-describe-special-forms | ||
| 436 | (stringp (nth 2 elem))) | ||
| 437 | (nth 2 elem) | ||
| 438 | "#<lambda>")) | ||
| 439 | ((eq 'closure (car elem)) | ||
| 440 | (if (and bind-key-describe-special-forms | ||
| 441 | (stringp (nth 3 elem))) | ||
| 442 | (nth 3 elem) | ||
| 443 | "#<closure>")) | ||
| 444 | ((eq 'keymap (car elem)) | ||
| 445 | "#<keymap>") | ||
| 446 | (t | ||
| 447 | elem))) | ||
| 448 | ;; must be a symbol, non-symbol keymap case covered above | ||
| 449 | ((and bind-key-describe-special-forms (keymapp elem)) | ||
| 450 | (let ((doc (get elem 'variable-documentation))) | ||
| 451 | (if (stringp doc) doc elem))) | ||
| 452 | ((symbolp elem) | ||
| 453 | elem) | ||
| 454 | (t | ||
| 455 | "#<byte-compiled lambda>"))) | ||
| 456 | |||
| 457 | (defun compare-keybindings (l r) | ||
| 458 | (let* ((regex bind-key-segregation-regexp) | ||
| 459 | (lgroup (and (string-match regex (caar l)) | ||
| 460 | (match-string 0 (caar l)))) | ||
| 461 | (rgroup (and (string-match regex (caar r)) | ||
| 462 | (match-string 0 (caar r)))) | ||
| 463 | (lkeymap (cdar l)) | ||
| 464 | (rkeymap (cdar r))) | ||
| 465 | (cond | ||
| 466 | ((and (null lkeymap) rkeymap) | ||
| 467 | (cons t t)) | ||
| 468 | ((and lkeymap (null rkeymap)) | ||
| 469 | (cons nil t)) | ||
| 470 | ((and lkeymap rkeymap | ||
| 471 | (not (string= (symbol-name lkeymap) (symbol-name rkeymap)))) | ||
| 472 | (cons (string< (symbol-name lkeymap) (symbol-name rkeymap)) t)) | ||
| 473 | ((and (null lgroup) rgroup) | ||
| 474 | (cons t t)) | ||
| 475 | ((and lgroup (null rgroup)) | ||
| 476 | (cons nil t)) | ||
| 477 | ((and lgroup rgroup) | ||
| 478 | (if (string= lgroup rgroup) | ||
| 479 | (cons (string< (caar l) (caar r)) nil) | ||
| 480 | (cons (string< lgroup rgroup) t))) | ||
| 481 | (t | ||
| 482 | (cons (string< (caar l) (caar r)) nil))))) | ||
| 483 | |||
| 484 | ;;;###autoload | ||
| 485 | (defun describe-personal-keybindings () | ||
| 486 | "Display all the personal keybindings defined by `bind-key'." | ||
| 487 | (interactive) | ||
| 488 | (with-output-to-temp-buffer "*Personal Keybindings*" | ||
| 489 | (princ (format (concat "Key name%s Command%s Comments\n%s %s " | ||
| 490 | "---------------------\n") | ||
| 491 | (make-string (- (car bind-key-column-widths) 9) ? ) | ||
| 492 | (make-string (- (cdr bind-key-column-widths) 8) ? ) | ||
| 493 | (make-string (1- (car bind-key-column-widths)) ?-) | ||
| 494 | (make-string (1- (cdr bind-key-column-widths)) ?-))) | ||
| 495 | (let (last-binding) | ||
| 496 | (dolist (binding | ||
| 497 | (setq personal-keybindings | ||
| 498 | (sort personal-keybindings | ||
| 499 | (lambda (l r) | ||
| 500 | (car (compare-keybindings l r)))))) | ||
| 501 | |||
| 502 | (if (not (eq (cdar last-binding) (cdar binding))) | ||
| 503 | (princ (format "\n\n%s: %s\n%s\n\n" | ||
| 504 | (cdar binding) (caar binding) | ||
| 505 | (make-string (+ 21 (car bind-key-column-widths) | ||
| 506 | (cdr bind-key-column-widths)) ?-))) | ||
| 507 | (if (and last-binding | ||
| 508 | (cdr (compare-keybindings last-binding binding))) | ||
| 509 | (princ "\n"))) | ||
| 510 | |||
| 511 | (let* ((key-name (caar binding)) | ||
| 512 | (at-present (lookup-key (or (symbol-value (cdar binding)) | ||
| 513 | (current-global-map)) | ||
| 514 | (read-kbd-macro key-name))) | ||
| 515 | (command (nth 1 binding)) | ||
| 516 | (was-command (nth 2 binding)) | ||
| 517 | (command-desc (get-binding-description command)) | ||
| 518 | (was-command-desc (and was-command | ||
| 519 | (get-binding-description was-command))) | ||
| 520 | (at-present-desc (get-binding-description at-present))) | ||
| 521 | (let ((line | ||
| 522 | (format | ||
| 523 | (format "%%-%ds%%-%ds%%s\n" (car bind-key-column-widths) | ||
| 524 | (cdr bind-key-column-widths)) | ||
| 525 | key-name (format "`%s\'" command-desc) | ||
| 526 | (if (string= command-desc at-present-desc) | ||
| 527 | (if (or (null was-command) | ||
| 528 | (string= command-desc was-command-desc)) | ||
| 529 | "" | ||
| 530 | (format "was `%s\'" was-command-desc)) | ||
| 531 | (format "[now: `%s\']" at-present))))) | ||
| 532 | (princ (if (string-match "[ \t]+\n" line) | ||
| 533 | (replace-match "\n" t t line) | ||
| 534 | line)))) | ||
| 535 | |||
| 536 | (setq last-binding binding))))) | ||
| 537 | |||
| 538 | (provide 'bind-key) | ||
| 539 | |||
| 540 | ;; Local Variables: | ||
| 541 | ;; outline-regexp: ";;;\\(;* [^\s\t\n]\\|###autoload\\)\\|(" | ||
| 542 | ;; End: | ||
| 543 | |||
| 544 | ;;; bind-key.el ends here | ||
diff --git a/lisp/use-package/use-package-bind-key.el b/lisp/use-package/use-package-bind-key.el new file mode 100644 index 00000000000..75def7febdf --- /dev/null +++ b/lisp/use-package/use-package-bind-key.el | |||
| @@ -0,0 +1,171 @@ | |||
| 1 | ;;; use-package-bind-key.el --- Support for the :bind/:bind-keymap keywords -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2012-2022 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: John Wiegley <johnw@newartisans.com> | ||
| 6 | ;; Maintainer: John Wiegley <johnw@newartisans.com> | ||
| 7 | |||
| 8 | ;; This program is free software; you can redistribute it and/or modify | ||
| 9 | ;; it under the terms of the GNU General Public License as published by | ||
| 10 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 11 | ;; (at your option) any later version. | ||
| 12 | |||
| 13 | ;; This program is distributed in the hope that it will be useful, | ||
| 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 16 | ;; GNU General Public License for more details. | ||
| 17 | |||
| 18 | ;; You should have received a copy of the GNU General Public License | ||
| 19 | ;; along with this program. If not, see <https://www.gnu.org/licenses/>. | ||
| 20 | |||
| 21 | ;;; Commentary: | ||
| 22 | |||
| 23 | ;; Provides support for the :bind, :bind*, :bind-keymap and :bind-keymap* | ||
| 24 | ;; keywords. Note that these are currently still baked into | ||
| 25 | ;; `use-package-keywords' and `use-package-deferring-keywords', although this | ||
| 26 | ;; is harmless if they are never used. | ||
| 27 | |||
| 28 | ;;; Code: | ||
| 29 | |||
| 30 | (require 'use-package-core) | ||
| 31 | (require 'bind-key) | ||
| 32 | |||
| 33 | ;;;###autoload | ||
| 34 | (defun use-package-autoload-keymap (keymap-symbol package override) | ||
| 35 | "Loads PACKAGE and then binds the key sequence used to invoke | ||
| 36 | this function to KEYMAP-SYMBOL. It then simulates pressing the | ||
| 37 | same key sequence a again, so that the next key pressed is routed | ||
| 38 | to the newly loaded keymap. | ||
| 39 | |||
| 40 | This function supports use-package's :bind-keymap keyword. It | ||
| 41 | works by binding the given key sequence to an invocation of this | ||
| 42 | function for a particular keymap. The keymap is expected to be | ||
| 43 | defined by the package. In this way, loading the package is | ||
| 44 | deferred until the prefix key sequence is pressed." | ||
| 45 | (if (not (require package nil t)) | ||
| 46 | (use-package-error (format "Cannot load package.el: %s" package)) | ||
| 47 | (if (and (boundp keymap-symbol) | ||
| 48 | (keymapp (symbol-value keymap-symbol))) | ||
| 49 | (let* ((kv (this-command-keys-vector)) | ||
| 50 | (key (key-description kv)) | ||
| 51 | (keymap (symbol-value keymap-symbol))) | ||
| 52 | (if override | ||
| 53 | (bind-key* key keymap) | ||
| 54 | (bind-key key keymap)) | ||
| 55 | (setq unread-command-events | ||
| 56 | (mapcar (lambda (ev) (cons t ev)) | ||
| 57 | (listify-key-sequence kv)))) | ||
| 58 | (use-package-error | ||
| 59 | (format "package.el %s failed to define keymap %s" | ||
| 60 | package keymap-symbol))))) | ||
| 61 | |||
| 62 | ;;;###autoload | ||
| 63 | (defun use-package-normalize-binder (name keyword args) | ||
| 64 | (let ((arg args) | ||
| 65 | args*) | ||
| 66 | (while arg | ||
| 67 | (let ((x (car arg))) | ||
| 68 | (cond | ||
| 69 | ;; (KEY . COMMAND) | ||
| 70 | ((and (consp x) | ||
| 71 | (or (stringp (car x)) | ||
| 72 | (vectorp (car x))) | ||
| 73 | (or (use-package-recognize-function (cdr x) t #'stringp))) | ||
| 74 | (setq args* (nconc args* (list x))) | ||
| 75 | (setq arg (cdr arg))) | ||
| 76 | ;; KEYWORD | ||
| 77 | ;; :map KEYMAP | ||
| 78 | ;; :prefix-docstring STRING | ||
| 79 | ;; :prefix-map SYMBOL | ||
| 80 | ;; :prefix STRING | ||
| 81 | ;; :repeat-docstring STRING | ||
| 82 | ;; :repeat-map SYMBOL | ||
| 83 | ;; :filter SEXP | ||
| 84 | ;; :menu-name STRING | ||
| 85 | ;; :package SYMBOL | ||
| 86 | ;; :continue and :exit are used within :repeat-map | ||
| 87 | ((or (and (eq x :map) (symbolp (cadr arg))) | ||
| 88 | (and (eq x :prefix) (stringp (cadr arg))) | ||
| 89 | (and (eq x :prefix-map) (symbolp (cadr arg))) | ||
| 90 | (and (eq x :prefix-docstring) (stringp (cadr arg))) | ||
| 91 | (and (eq x :repeat-map) (symbolp (cadr arg))) | ||
| 92 | (eq x :continue) | ||
| 93 | (eq x :exit) | ||
| 94 | (and (eq x :repeat-docstring) (stringp (cadr arg))) | ||
| 95 | (eq x :filter) | ||
| 96 | (and (eq x :menu-name) (stringp (cadr arg))) | ||
| 97 | (and (eq x :package) (symbolp (cadr arg)))) | ||
| 98 | (setq args* (nconc args* (list x (cadr arg)))) | ||
| 99 | (setq arg (cddr arg))) | ||
| 100 | ((listp x) | ||
| 101 | (setq args* | ||
| 102 | (nconc args* (use-package-normalize-binder name keyword x))) | ||
| 103 | (setq arg (cdr arg))) | ||
| 104 | (t | ||
| 105 | ;; Error! | ||
| 106 | (use-package-error | ||
| 107 | (concat (symbol-name name) | ||
| 108 | " wants arguments acceptable to the `bind-keys' macro," | ||
| 109 | " or a list of such values")))))) | ||
| 110 | args*)) | ||
| 111 | |||
| 112 | ;;;; :bind, :bind* | ||
| 113 | |||
| 114 | ;;;###autoload | ||
| 115 | (defalias 'use-package-normalize/:bind 'use-package-normalize-binder) | ||
| 116 | ;;;###autoload | ||
| 117 | (defalias 'use-package-normalize/:bind* 'use-package-normalize-binder) | ||
| 118 | |||
| 119 | ;; jww (2017-12-07): This is too simplistic. It will fail to determine | ||
| 120 | ;; autoloads in this situation: | ||
| 121 | ;; (use-package foo | ||
| 122 | ;; :bind (:map foo-map (("C-a" . func)))) | ||
| 123 | ;;;###autoload | ||
| 124 | (defalias 'use-package-autoloads/:bind 'use-package-autoloads-mode) | ||
| 125 | ;;;###autoload | ||
| 126 | (defalias 'use-package-autoloads/:bind* 'use-package-autoloads-mode) | ||
| 127 | |||
| 128 | ;;;###autoload | ||
| 129 | (defun use-package-handler/:bind | ||
| 130 | (name _keyword args rest state &optional bind-macro) | ||
| 131 | (use-package-concat | ||
| 132 | (use-package-process-keywords name rest state) | ||
| 133 | `(,@(mapcar | ||
| 134 | #'(lambda (xs) | ||
| 135 | `(,(if bind-macro bind-macro 'bind-keys) | ||
| 136 | :package ,name ,@(use-package-normalize-commands xs))) | ||
| 137 | (use-package-split-list-at-keys :break args))))) | ||
| 138 | |||
| 139 | (defun use-package-handler/:bind* (name keyword arg rest state) | ||
| 140 | (use-package-handler/:bind name keyword arg rest state 'bind-keys*)) | ||
| 141 | |||
| 142 | ;;;; :bind-keymap, :bind-keymap* | ||
| 143 | |||
| 144 | ;;;###autoload | ||
| 145 | (defalias 'use-package-normalize/:bind-keymap 'use-package-normalize-binder) | ||
| 146 | ;;;###autoload | ||
| 147 | (defalias 'use-package-normalize/:bind-keymap* 'use-package-normalize-binder) | ||
| 148 | |||
| 149 | ;;;###autoload | ||
| 150 | (defun use-package-handler/:bind-keymap | ||
| 151 | (name _keyword args rest state &optional override) | ||
| 152 | (use-package-concat | ||
| 153 | (use-package-process-keywords name rest state) | ||
| 154 | (mapcar | ||
| 155 | #'(lambda (binding) | ||
| 156 | `(,(if override 'bind-key* 'bind-key) | ||
| 157 | ,(car binding) | ||
| 158 | #'(lambda () | ||
| 159 | (interactive) | ||
| 160 | (use-package-autoload-keymap | ||
| 161 | ',(cdr binding) ',(use-package-as-symbol name) | ||
| 162 | ,override)))) | ||
| 163 | args))) | ||
| 164 | |||
| 165 | ;;;###autoload | ||
| 166 | (defun use-package-handler/:bind-keymap* (name keyword arg rest state) | ||
| 167 | (use-package-handler/:bind-keymap name keyword arg rest state t)) | ||
| 168 | |||
| 169 | (provide 'use-package-bind-key) | ||
| 170 | |||
| 171 | ;;; use-package-bind-key.el ends here | ||
diff --git a/lisp/use-package/use-package-chords.el b/lisp/use-package/use-package-chords.el new file mode 100644 index 00000000000..479083b9296 --- /dev/null +++ b/lisp/use-package/use-package-chords.el | |||
| @@ -0,0 +1,54 @@ | |||
| 1 | ;;; use-package-chords.el --- key-chord keyword for use-package -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2015-2022 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Justin Talbott <justin@waymondo.com> | ||
| 6 | ;; Keywords: convenience, tools, extensions | ||
| 7 | ;; URL: https://github.com/jwiegley/use-package | ||
| 8 | ;; Version: 0.2.1 | ||
| 9 | ;; Package-Requires: ((use-package "2.1") (bind-key "1.0") (bind-chord "0.2") (key-chord "0.6")) | ||
| 10 | ;; Filename: use-package-chords.el | ||
| 11 | |||
| 12 | ;; This program is free software; you can redistribute it and/or modify | ||
| 13 | ;; it under the terms of the GNU General Public License as published by | ||
| 14 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 15 | ;; (at your option) any later version. | ||
| 16 | |||
| 17 | ;; This program is distributed in the hope that it will be useful, | ||
| 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 20 | ;; GNU General Public License for more details. | ||
| 21 | |||
| 22 | ;; You should have received a copy of the GNU General Public License | ||
| 23 | ;; along with this program. If not, see <https://www.gnu.org/licenses/>. | ||
| 24 | |||
| 25 | ;;; Commentary: | ||
| 26 | |||
| 27 | ;; The `:chords' keyword allows you to define `key-chord' bindings for | ||
| 28 | ;; `use-package' declarations in the same manner as the `:bind' | ||
| 29 | ;; keyword. | ||
| 30 | |||
| 31 | ;;; Code: | ||
| 32 | |||
| 33 | (require 'use-package) | ||
| 34 | (require 'bind-chord) | ||
| 35 | |||
| 36 | ;;;###autoload | ||
| 37 | (defalias 'use-package-autoloads/:chords 'use-package-autoloads-mode) | ||
| 38 | |||
| 39 | ;;;###autoload | ||
| 40 | (defalias 'use-package-normalize/:chords 'use-package-normalize-binder) | ||
| 41 | |||
| 42 | ;;;###autoload | ||
| 43 | (defun use-package-handler/:chords (name _keyword arg rest state) | ||
| 44 | "Handler for `:chords' keyword in `use-package'." | ||
| 45 | (use-package-concat | ||
| 46 | (use-package-process-keywords name rest state) | ||
| 47 | `(,(macroexpand | ||
| 48 | `(bind-chords :package ,name ,@arg))))) | ||
| 49 | |||
| 50 | (add-to-list 'use-package-keywords :chords) | ||
| 51 | |||
| 52 | (provide 'use-package-chords) | ||
| 53 | |||
| 54 | ;;; use-package-chords.el ends here | ||
diff --git a/lisp/use-package/use-package-core.el b/lisp/use-package/use-package-core.el new file mode 100644 index 00000000000..6606681f2ea --- /dev/null +++ b/lisp/use-package/use-package-core.el | |||
| @@ -0,0 +1,1690 @@ | |||
| 1 | ;;; use-package-core.el --- A configuration macro for simplifying your .emacs -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2012-2022 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: John Wiegley <johnw@newartisans.com> | ||
| 6 | ;; Maintainer: John Wiegley <johnw@newartisans.com> | ||
| 7 | |||
| 8 | ;; This program is free software; you can redistribute it and/or modify | ||
| 9 | ;; it under the terms of the GNU General Public License as published by | ||
| 10 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 11 | ;; (at your option) any later version. | ||
| 12 | |||
| 13 | ;; This program is distributed in the hope that it will be useful, | ||
| 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 16 | ;; GNU General Public License for more details. | ||
| 17 | |||
| 18 | ;; You should have received a copy of the GNU General Public License | ||
| 19 | ;; along with this program. If not, see <https://www.gnu.org/licenses/>. | ||
| 20 | |||
| 21 | ;;; Commentary: | ||
| 22 | |||
| 23 | ;; The `use-package' declaration macro allows you to isolate package | ||
| 24 | ;; configuration in your ".emacs" in a way that is performance-oriented and, | ||
| 25 | ;; well, just tidy. I created it because I have over 80 packages that I use | ||
| 26 | ;; in Emacs, and things were getting difficult to manage. Yet with this | ||
| 27 | ;; utility my total load time is just under 1 second, with no loss of | ||
| 28 | ;; functionality! | ||
| 29 | ;; | ||
| 30 | ;; Please see README.md from the same repository for documentation. | ||
| 31 | |||
| 32 | ;;; Code: | ||
| 33 | |||
| 34 | (require 'bytecomp) | ||
| 35 | (require 'cl-lib) | ||
| 36 | (require 'tabulated-list) | ||
| 37 | |||
| 38 | (eval-and-compile | ||
| 39 | ;; Declare a synthetic theme for :custom variables. | ||
| 40 | ;; Necessary in order to avoid having those variables saved by custom.el. | ||
| 41 | (deftheme use-package)) | ||
| 42 | |||
| 43 | (enable-theme 'use-package) | ||
| 44 | ;; Remove the synthetic use-package theme from the enabled themes, so | ||
| 45 | ;; iterating over them to "disable all themes" won't disable it. | ||
| 46 | (setq custom-enabled-themes (remq 'use-package custom-enabled-themes)) | ||
| 47 | |||
| 48 | (eval-when-compile | ||
| 49 | (if (and (eq emacs-major-version 24) (eq emacs-minor-version 3)) | ||
| 50 | (progn | ||
| 51 | (defsubst hash-table-keys (hash-table) | ||
| 52 | "Return a list of keys in HASH-TABLE." | ||
| 53 | (cl-loop for k being the hash-keys of hash-table collect k)) | ||
| 54 | (defsubst string-suffix-p (suffix string &optional ignore-case) | ||
| 55 | (let ((start-pos (- (length string) (length suffix)))) | ||
| 56 | (and (>= start-pos 0) | ||
| 57 | (eq t (compare-strings suffix nil nil | ||
| 58 | string start-pos nil ignore-case)))))) | ||
| 59 | (require 'subr-x))) | ||
| 60 | |||
| 61 | (eval-when-compile | ||
| 62 | (require 'regexp-opt)) | ||
| 63 | |||
| 64 | (defgroup use-package nil | ||
| 65 | "A `use-package' declaration for simplifying your `.emacs'." | ||
| 66 | :group 'startup) | ||
| 67 | |||
| 68 | (defconst use-package-version "2.4.4" | ||
| 69 | "This version of `use-package'.") | ||
| 70 | |||
| 71 | (defcustom use-package-keywords | ||
| 72 | '(:disabled | ||
| 73 | :load-path | ||
| 74 | :requires | ||
| 75 | :defines | ||
| 76 | :functions | ||
| 77 | :preface | ||
| 78 | :if :when :unless | ||
| 79 | :no-require | ||
| 80 | :catch | ||
| 81 | :after | ||
| 82 | :custom | ||
| 83 | :custom-face | ||
| 84 | :bind | ||
| 85 | :bind* | ||
| 86 | :bind-keymap | ||
| 87 | :bind-keymap* | ||
| 88 | :interpreter | ||
| 89 | :mode | ||
| 90 | :magic | ||
| 91 | :magic-fallback | ||
| 92 | :hook | ||
| 93 | ;; Any other keyword that also declares commands to be autoloaded (such as | ||
| 94 | ;; :bind) must appear before this keyword. | ||
| 95 | :commands | ||
| 96 | :autoload | ||
| 97 | :init | ||
| 98 | :defer | ||
| 99 | :demand | ||
| 100 | :load | ||
| 101 | ;; This must occur almost last; the only forms which should appear after | ||
| 102 | ;; are those that must happen directly after the config forms. | ||
| 103 | :config) | ||
| 104 | "The set of valid keywords, in the order they are processed in. | ||
| 105 | The order of this list is *very important*, so it is only | ||
| 106 | advisable to insert new keywords, never to delete or reorder | ||
| 107 | them. Further, attention should be paid to the NEWS.md if the | ||
| 108 | default order ever changes, as they may have subtle effects on | ||
| 109 | the semantics of `use-package' declarations and may necessitate | ||
| 110 | changing where you had inserted a new keyword earlier. | ||
| 111 | |||
| 112 | Note that `:disabled' is special in this list, as it causes | ||
| 113 | nothing at all to happen, even if the rest of the `use-package' | ||
| 114 | declaration is incorrect." | ||
| 115 | :type '(repeat symbol) | ||
| 116 | :group 'use-package) | ||
| 117 | |||
| 118 | (defcustom use-package-deferring-keywords | ||
| 119 | '(:bind-keymap | ||
| 120 | :bind-keymap* | ||
| 121 | :commands | ||
| 122 | :autoload) | ||
| 123 | "Unless `:demand' is used, keywords in this list imply deferred loading. | ||
| 124 | The reason keywords like `:hook' are not in this list is that | ||
| 125 | they only imply deferred loading if they reference actual | ||
| 126 | function symbols that can be autoloaded from the module; whereas | ||
| 127 | the default keywords provided here always defer loading unless | ||
| 128 | otherwise requested." | ||
| 129 | :type '(repeat symbol) | ||
| 130 | :group 'use-package) | ||
| 131 | |||
| 132 | (defcustom use-package-ignore-unknown-keywords nil | ||
| 133 | "If non-nil, warn instead of signaling error for unknown keywords. | ||
| 134 | The unknown keyword and its associated arguments will be ignored | ||
| 135 | in the `use-package' expansion." | ||
| 136 | :type 'boolean | ||
| 137 | :group 'use-package) | ||
| 138 | |||
| 139 | (defcustom use-package-use-theme t | ||
| 140 | "If non-nil, use a custom theme to avoid saving :custom | ||
| 141 | variables twice (once in the Custom file, once in the use-package | ||
| 142 | call)." | ||
| 143 | :type 'boolean | ||
| 144 | :group 'use-package) | ||
| 145 | |||
| 146 | (defcustom use-package-verbose nil | ||
| 147 | "Whether to report about loading and configuration details. | ||
| 148 | If you customize this, then you should require the `use-package' | ||
| 149 | feature in files that use `use-package', even if these files only | ||
| 150 | contain compiled expansions of the macros. If you don't do so, | ||
| 151 | then the expanded macros do their job silently." | ||
| 152 | :type '(choice (const :tag "Quiet, without catching errors" errors) | ||
| 153 | (const :tag "Quiet" nil) | ||
| 154 | (const :tag "Verbose" t) | ||
| 155 | (const :tag "Debug" debug)) | ||
| 156 | :group 'use-package) | ||
| 157 | |||
| 158 | (defcustom use-package-check-before-init nil | ||
| 159 | "If non-nil, check that package exists before executing its `:init' block. | ||
| 160 | This check is performed by calling `locate-library'." | ||
| 161 | :type 'boolean | ||
| 162 | :group 'use-package) | ||
| 163 | |||
| 164 | (defcustom use-package-always-defer nil | ||
| 165 | "If non-nil, assume `:defer t' unless `:demand' is used. | ||
| 166 | See also `use-package-defaults', which uses this value." | ||
| 167 | :type 'boolean | ||
| 168 | :group 'use-package) | ||
| 169 | |||
| 170 | (defcustom use-package-always-demand nil | ||
| 171 | "If non-nil, assume `:demand t' unless `:defer' is used. | ||
| 172 | See also `use-package-defaults', which uses this value." | ||
| 173 | :type 'boolean | ||
| 174 | :group 'use-package) | ||
| 175 | |||
| 176 | (defcustom use-package-defaults | ||
| 177 | '(;; this '(t) has special meaning; see `use-package-handler/:config' | ||
| 178 | (:config '(t) t) | ||
| 179 | (:init nil t) | ||
| 180 | (:catch t (lambda (name args) | ||
| 181 | (not use-package-expand-minimally))) | ||
| 182 | (:defer use-package-always-defer | ||
| 183 | (lambda (name args) | ||
| 184 | (and use-package-always-defer | ||
| 185 | (not (plist-member args :defer)) | ||
| 186 | (not (plist-member args :demand))))) | ||
| 187 | (:demand use-package-always-demand | ||
| 188 | (lambda (name args) | ||
| 189 | (and use-package-always-demand | ||
| 190 | (not (plist-member args :defer)) | ||
| 191 | (not (plist-member args :demand)))))) | ||
| 192 | "Default values for specified `use-package' keywords. | ||
| 193 | Each entry in the alist is a list of three elements: | ||
| 194 | The first element is the `use-package' keyword. | ||
| 195 | |||
| 196 | The second is a form that can be evaluated to get the default | ||
| 197 | value. It can also be a function that will receive the name of | ||
| 198 | the `use-package' declaration and the keyword plist given to | ||
| 199 | `use-package', in normalized form. The value it returns should | ||
| 200 | also be in normalized form (which is sometimes *not* what one | ||
| 201 | would normally write in a `use-package' declaration, so use | ||
| 202 | caution). | ||
| 203 | |||
| 204 | The third element is a form that can be evaluated to determine | ||
| 205 | whether or not to assign a default value; if it evaluates to nil, | ||
| 206 | then the default value is not assigned even if the keyword is not | ||
| 207 | present in the `use-package' form. This third element may also be | ||
| 208 | a function, in which case it receives the name of the package (as | ||
| 209 | a symbol) and a list of keywords (in normalized form). It should | ||
| 210 | return nil or non-nil depending on whether defaulting should be | ||
| 211 | attempted." | ||
| 212 | :type `(repeat | ||
| 213 | (list (choice :tag "Keyword" | ||
| 214 | ,@(mapcar #'(lambda (k) (list 'const k)) | ||
| 215 | use-package-keywords)) | ||
| 216 | (choice :tag "Default value" sexp function) | ||
| 217 | (choice :tag "Enable if non-nil" sexp function))) | ||
| 218 | :group 'use-package) | ||
| 219 | |||
| 220 | (defcustom use-package-merge-key-alist | ||
| 221 | '((:if . (lambda (new old) `(and ,new ,old))) | ||
| 222 | (:after . (lambda (new old) `(:all ,new ,old))) | ||
| 223 | (:defer . (lambda (new old) old)) | ||
| 224 | (:bind . (lambda (new old) (append new (list :break) old)))) | ||
| 225 | "Alist of keys and the functions used to merge multiple values. | ||
| 226 | For example, if the following form is provided: | ||
| 227 | |||
| 228 | (use-package foo :if pred1 :if pred2) | ||
| 229 | |||
| 230 | Then based on the above defaults, the merged result will be: | ||
| 231 | |||
| 232 | (use-package foo :if (and pred1 pred2)) | ||
| 233 | |||
| 234 | This is done so that, at the stage of invoking handlers, each | ||
| 235 | handler is called only once." | ||
| 236 | :type `(repeat | ||
| 237 | (cons (choice :tag "Keyword" | ||
| 238 | ,@(mapcar #'(lambda (k) (list 'const k)) | ||
| 239 | use-package-keywords) | ||
| 240 | (const :tag "Any" t)) | ||
| 241 | function)) | ||
| 242 | :group 'use-package) | ||
| 243 | |||
| 244 | (defcustom use-package-hook-name-suffix "-hook" | ||
| 245 | "Text append to the name of hooks mentioned by :hook. | ||
| 246 | Set to nil if you don't want this to happen; it's only a | ||
| 247 | convenience." | ||
| 248 | :type '(choice string (const :tag "No suffix" nil)) | ||
| 249 | :group 'use-package) | ||
| 250 | |||
| 251 | (defcustom use-package-minimum-reported-time 0.1 | ||
| 252 | "Minimal load time that will be reported. | ||
| 253 | Note that `use-package-verbose' has to be set to a non-nil value | ||
| 254 | for anything to be reported at all." | ||
| 255 | :type 'number | ||
| 256 | :group 'use-package) | ||
| 257 | |||
| 258 | (defcustom use-package-inject-hooks nil | ||
| 259 | "If non-nil, add hooks to the `:init' and `:config' sections. | ||
| 260 | In particular, for a given package `foo', the following hooks | ||
| 261 | become available: | ||
| 262 | |||
| 263 | `use-package--foo--pre-init-hook' | ||
| 264 | `use-package--foo--post-init-hook' | ||
| 265 | `use-package--foo--pre-config-hook' | ||
| 266 | `use-package--foo--post-config-hook' | ||
| 267 | |||
| 268 | This way, you can add to these hooks before evaluation of a | ||
| 269 | `use-package` declaration, and exercise some control over what | ||
| 270 | happens. | ||
| 271 | |||
| 272 | NOTE: These hooks are run even if the user does not specify an | ||
| 273 | `:init' or `:config' block, and they will happen at the regular | ||
| 274 | time when initialization and configuration would have been | ||
| 275 | performed. | ||
| 276 | |||
| 277 | NOTE: If the `pre-init' hook return a nil value, that block's | ||
| 278 | user-supplied configuration is not evaluated, so be certain to | ||
| 279 | return t if you only wish to add behavior to what the user had | ||
| 280 | specified." | ||
| 281 | :type 'boolean | ||
| 282 | :group 'use-package) | ||
| 283 | |||
| 284 | (defcustom use-package-expand-minimally nil | ||
| 285 | "If non-nil, make the expanded code as minimal as possible. | ||
| 286 | This disables: | ||
| 287 | |||
| 288 | - Printing to the *Messages* buffer of slowly-evaluating forms | ||
| 289 | - Capturing of load errors (normally redisplayed as warnings) | ||
| 290 | - Conditional loading of packages (load failures become errors) | ||
| 291 | |||
| 292 | The main advantage to this variable is that, if you know your | ||
| 293 | configuration works, it will make the byte-compiled file as | ||
| 294 | minimal as possible. It can also help with reading macro-expanded | ||
| 295 | definitions, to understand the main intent of what's happening." | ||
| 296 | :type 'boolean | ||
| 297 | :group 'use-package) | ||
| 298 | |||
| 299 | (defcustom use-package-form-regexp-eval | ||
| 300 | `(concat ,(eval-when-compile | ||
| 301 | (concat "^\\s-*(" | ||
| 302 | (regexp-opt '("use-package" "require") t) | ||
| 303 | "\\s-+\\(")) | ||
| 304 | (or (bound-and-true-p lisp-mode-symbol-regexp) | ||
| 305 | "\\(?:\\sw\\|\\s_\\|\\\\.\\)+") "\\)") | ||
| 306 | "Sexp providing regexp for finding `use-package' forms in user files. | ||
| 307 | This is used by `use-package-jump-to-package-form' and | ||
| 308 | `use-package-enable-imenu-support'." | ||
| 309 | :type 'sexp | ||
| 310 | :group 'use-package) | ||
| 311 | |||
| 312 | (defcustom use-package-enable-imenu-support nil | ||
| 313 | "If non-nil, cause imenu to see `use-package' declarations. | ||
| 314 | This is done by adjusting `lisp-imenu-generic-expression' to | ||
| 315 | include support for finding `use-package' and `require' forms. | ||
| 316 | |||
| 317 | Must be set before loading `use-package'." | ||
| 318 | :type 'boolean | ||
| 319 | :set | ||
| 320 | #'(lambda (sym value) | ||
| 321 | (eval-after-load 'lisp-mode | ||
| 322 | (if value | ||
| 323 | `(add-to-list 'lisp-imenu-generic-expression | ||
| 324 | (list "Packages" ,use-package-form-regexp-eval 2)) | ||
| 325 | `(setq lisp-imenu-generic-expression | ||
| 326 | (remove (list "Packages" ,use-package-form-regexp-eval 2) | ||
| 327 | lisp-imenu-generic-expression)))) | ||
| 328 | (set-default sym value)) | ||
| 329 | :group 'use-package) | ||
| 330 | |||
| 331 | (defconst use-package-font-lock-keywords | ||
| 332 | '(("(\\(use-package\\)\\_>[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?" | ||
| 333 | (1 font-lock-keyword-face) | ||
| 334 | (2 font-lock-constant-face nil t)))) | ||
| 335 | |||
| 336 | (font-lock-add-keywords 'emacs-lisp-mode use-package-font-lock-keywords) | ||
| 337 | |||
| 338 | (defcustom use-package-compute-statistics nil | ||
| 339 | "If non-nil, compute statistics concerned `use-package' declarations. | ||
| 340 | View the statistical report using `use-package-report'. Note that | ||
| 341 | if this option is enabled, you must require `use-package' in your | ||
| 342 | user init file at loadup time, or you will see errors concerning | ||
| 343 | undefined variables." | ||
| 344 | :type 'boolean | ||
| 345 | :group 'use-package) | ||
| 346 | |||
| 347 | (defvar use-package-statistics (make-hash-table)) | ||
| 348 | |||
| 349 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 350 | ;; | ||
| 351 | ;;; Utility functions | ||
| 352 | ;; | ||
| 353 | |||
| 354 | (defsubst use-package-error (msg) | ||
| 355 | "Report MSG as an error, so the user knows it came from this package." | ||
| 356 | (error "use-package: %s" msg)) | ||
| 357 | |||
| 358 | (defsubst use-package-concat (&rest elems) | ||
| 359 | "Delete all empty lists from ELEMS (nil or (list nil)), and append them." | ||
| 360 | (apply #'append (delete nil (delete (list nil) elems)))) | ||
| 361 | |||
| 362 | (defsubst use-package-non-nil-symbolp (sym) | ||
| 363 | (and sym (symbolp sym))) | ||
| 364 | |||
| 365 | (defsubst use-package-as-symbol (string-or-symbol) | ||
| 366 | "If STRING-OR-SYMBOL is already a symbol, return it. | ||
| 367 | Otherwise convert it to a symbol and return that." | ||
| 368 | (if (symbolp string-or-symbol) string-or-symbol | ||
| 369 | (intern string-or-symbol))) | ||
| 370 | |||
| 371 | (defsubst use-package-as-string (string-or-symbol) | ||
| 372 | "If STRING-OR-SYMBOL is already a string, return it. | ||
| 373 | Otherwise convert it to a string and return that." | ||
| 374 | (if (stringp string-or-symbol) string-or-symbol | ||
| 375 | (symbol-name string-or-symbol))) | ||
| 376 | |||
| 377 | (defsubst use-package-regex-p (re) | ||
| 378 | "Return t if RE is some regexp-like thing." | ||
| 379 | (or (and (listp re) (eq (car re) 'rx)) | ||
| 380 | (stringp re))) | ||
| 381 | |||
| 382 | (defun use-package-normalize-regex (re) | ||
| 383 | "Given some regexp-like thing in RE, resolve to a regular expression." | ||
| 384 | (cond | ||
| 385 | ((and (listp re) (eq (car re) 'rx)) (eval re)) | ||
| 386 | ((stringp re) re) | ||
| 387 | (t (error "Not recognized as regular expression: %s" re)))) | ||
| 388 | |||
| 389 | (defsubst use-package-is-pair (x car-pred cdr-pred) | ||
| 390 | "Return non-nil if X is a cons satisfying the given predicates. | ||
| 391 | CAR-PRED and CDR-PRED are applied to X's `car' and `cdr', | ||
| 392 | respectively." | ||
| 393 | (and (consp x) | ||
| 394 | (funcall car-pred (car x)) | ||
| 395 | (funcall cdr-pred (cdr x)))) | ||
| 396 | |||
| 397 | (defun use-package-as-mode (string-or-symbol) | ||
| 398 | "If STRING-OR-SYMBOL ends in `-mode' (or its name does), return | ||
| 399 | it as a symbol. Otherwise, return it as a symbol with `-mode' | ||
| 400 | appended." | ||
| 401 | (let ((string (use-package-as-string string-or-symbol))) | ||
| 402 | (intern (if (string-match "-mode\\'" string) | ||
| 403 | string | ||
| 404 | (concat string "-mode"))))) | ||
| 405 | |||
| 406 | (defsubst use-package-load-name (name &optional noerror) | ||
| 407 | "Return a form which will load or require NAME. | ||
| 408 | It does the right thing no matter if NAME is a string or symbol. | ||
| 409 | Argument NOERROR means to indicate load failures as a warning." | ||
| 410 | (if (stringp name) | ||
| 411 | `(load ,name ,noerror) | ||
| 412 | `(require ',name nil ,noerror))) | ||
| 413 | |||
| 414 | (defun use-package-hook-injector (name-string keyword body) | ||
| 415 | "Wrap pre/post hook injections around the given BODY for KEYWORD. | ||
| 416 | The BODY is a list of forms, so `((foo))' if only `foo' is being called." | ||
| 417 | (if (not use-package-inject-hooks) | ||
| 418 | body | ||
| 419 | (let ((keyword-name (substring (format "%s" keyword) 1))) | ||
| 420 | `((when (run-hook-with-args-until-failure | ||
| 421 | ',(intern (concat "use-package--" name-string | ||
| 422 | "--pre-" keyword-name "-hook"))) | ||
| 423 | ,@body | ||
| 424 | (run-hooks | ||
| 425 | ',(intern (concat "use-package--" name-string | ||
| 426 | "--post-" keyword-name "-hook")))))))) | ||
| 427 | |||
| 428 | (defun use-package-with-elapsed-timer (text body) | ||
| 429 | "BODY is a list of forms, so `((foo))' if only `foo' is being called." | ||
| 430 | (declare (indent 1)) | ||
| 431 | (if use-package-expand-minimally | ||
| 432 | body | ||
| 433 | (let ((nowvar (make-symbol "now"))) | ||
| 434 | (if (bound-and-true-p use-package-verbose) | ||
| 435 | `((let ((,nowvar (current-time))) | ||
| 436 | (message "%s..." ,text) | ||
| 437 | (prog1 | ||
| 438 | ,(macroexp-progn body) | ||
| 439 | (let ((elapsed | ||
| 440 | (float-time (time-subtract (current-time) ,nowvar)))) | ||
| 441 | (if (> elapsed ,use-package-minimum-reported-time) | ||
| 442 | (message "%s...done (%.3fs)" ,text elapsed) | ||
| 443 | (message "%s...done" ,text)))))) | ||
| 444 | body)))) | ||
| 445 | |||
| 446 | (put 'use-package-with-elapsed-timer 'lisp-indent-function 1) | ||
| 447 | |||
| 448 | (defun use-package-require (name &optional no-require body) | ||
| 449 | (if use-package-expand-minimally | ||
| 450 | (use-package-concat | ||
| 451 | (unless no-require | ||
| 452 | (list (use-package-load-name name))) | ||
| 453 | body) | ||
| 454 | (if no-require | ||
| 455 | body | ||
| 456 | (use-package-with-elapsed-timer | ||
| 457 | (format "Loading package %s" name) | ||
| 458 | `((if (not ,(use-package-load-name name t)) | ||
| 459 | (display-warning 'use-package | ||
| 460 | (format "Cannot load %s" ',name) | ||
| 461 | :error) | ||
| 462 | ,@body)))))) | ||
| 463 | |||
| 464 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 465 | ;; | ||
| 466 | ;;; Property lists | ||
| 467 | ;; | ||
| 468 | |||
| 469 | (defun use-package-plist-delete (plist property) | ||
| 470 | "Delete PROPERTY from PLIST. | ||
| 471 | This is in contrast to merely setting it to 0." | ||
| 472 | (let (p) | ||
| 473 | (while plist | ||
| 474 | (if (not (eq property (car plist))) | ||
| 475 | (setq p (plist-put p (car plist) (nth 1 plist)))) | ||
| 476 | (setq plist (cddr plist))) | ||
| 477 | p)) | ||
| 478 | |||
| 479 | (defun use-package-plist-delete-first (plist property) | ||
| 480 | "Delete PROPERTY from PLIST. | ||
| 481 | This is in contrast to merely setting it to 0." | ||
| 482 | (let (p) | ||
| 483 | (while plist | ||
| 484 | (if (eq property (car plist)) | ||
| 485 | (setq p (nconc p (cddr plist)) | ||
| 486 | plist nil) | ||
| 487 | (setq p (nconc p (list (car plist) (cadr plist))) | ||
| 488 | plist (cddr plist)))) | ||
| 489 | p)) | ||
| 490 | |||
| 491 | (defsubst use-package-plist-maybe-put (plist property value) | ||
| 492 | "Add a VALUE for PROPERTY to PLIST, if it does not already exist." | ||
| 493 | (if (plist-member plist property) | ||
| 494 | plist | ||
| 495 | (plist-put plist property value))) | ||
| 496 | |||
| 497 | (defsubst use-package-plist-cons (plist property value) | ||
| 498 | "Cons VALUE onto the head of the list at PROPERTY in PLIST." | ||
| 499 | (plist-put plist property (cons value (plist-get plist property)))) | ||
| 500 | |||
| 501 | (defsubst use-package-plist-append (plist property value) | ||
| 502 | "Append VALUE onto the front of the list at PROPERTY in PLIST." | ||
| 503 | (plist-put plist property (append value (plist-get plist property)))) | ||
| 504 | |||
| 505 | (defun use-package-split-list (pred xs) | ||
| 506 | (let ((ys (list nil)) (zs (list nil)) flip) | ||
| 507 | (cl-dolist (x xs) | ||
| 508 | (if flip | ||
| 509 | (nconc zs (list x)) | ||
| 510 | (if (funcall pred x) | ||
| 511 | (progn | ||
| 512 | (setq flip t) | ||
| 513 | (nconc zs (list x))) | ||
| 514 | (nconc ys (list x))))) | ||
| 515 | (cons (cdr ys) (cdr zs)))) | ||
| 516 | |||
| 517 | (defun use-package-split-list-at-keys (key lst) | ||
| 518 | (and lst | ||
| 519 | (let ((xs (use-package-split-list (apply-partially #'eq key) lst))) | ||
| 520 | (cons (car xs) (use-package-split-list-at-keys key (cddr xs)))))) | ||
| 521 | |||
| 522 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 523 | ;; | ||
| 524 | ;;; Keywords | ||
| 525 | ;; | ||
| 526 | |||
| 527 | (defun use-package-keyword-index (keyword) | ||
| 528 | (cl-loop named outer | ||
| 529 | with index = 0 | ||
| 530 | for k in use-package-keywords do | ||
| 531 | (if (eq k keyword) | ||
| 532 | (cl-return-from outer index)) | ||
| 533 | (cl-incf index))) | ||
| 534 | |||
| 535 | (defun use-package-normalize-plist (name input &optional plist merge-function) | ||
| 536 | "Given a pseudo-plist, normalize it to a regular plist. | ||
| 537 | The normalized key/value pairs from input are added to PLIST, | ||
| 538 | extending any keys already present." | ||
| 539 | (if (null input) | ||
| 540 | plist | ||
| 541 | (let* ((keyword (car input)) | ||
| 542 | (xs (use-package-split-list #'keywordp (cdr input))) | ||
| 543 | (args (car xs)) | ||
| 544 | (tail (cdr xs)) | ||
| 545 | (normalizer | ||
| 546 | (intern-soft (concat "use-package-normalize/" | ||
| 547 | (symbol-name keyword)))) | ||
| 548 | (arg (and (functionp normalizer) | ||
| 549 | (funcall normalizer name keyword args))) | ||
| 550 | (error-string (format "Unrecognized keyword: %s" keyword))) | ||
| 551 | (if (memq keyword use-package-keywords) | ||
| 552 | (progn | ||
| 553 | (setq plist (use-package-normalize-plist | ||
| 554 | name tail plist merge-function)) | ||
| 555 | (plist-put plist keyword | ||
| 556 | (if (plist-member plist keyword) | ||
| 557 | (funcall merge-function keyword arg | ||
| 558 | (plist-get plist keyword)) | ||
| 559 | arg))) | ||
| 560 | (if use-package-ignore-unknown-keywords | ||
| 561 | (progn | ||
| 562 | (display-warning 'use-package error-string) | ||
| 563 | (use-package-normalize-plist | ||
| 564 | name tail plist merge-function)) | ||
| 565 | (use-package-error error-string)))))) | ||
| 566 | |||
| 567 | (defun use-package-unalias-keywords (_name args) | ||
| 568 | (setq args (cl-nsubstitute :if :when args)) | ||
| 569 | (let (temp) | ||
| 570 | (while (setq temp (plist-get args :unless)) | ||
| 571 | (setq args (use-package-plist-delete-first args :unless) | ||
| 572 | args (append args `(:if (not ,temp)))))) | ||
| 573 | args) | ||
| 574 | |||
| 575 | (defun use-package-merge-keys (key new old) | ||
| 576 | (let ((merger (assq key use-package-merge-key-alist))) | ||
| 577 | (if merger | ||
| 578 | (funcall (cdr merger) new old) | ||
| 579 | (append new old)))) | ||
| 580 | |||
| 581 | (defun use-package-sort-keywords (plist) | ||
| 582 | (let (plist-grouped) | ||
| 583 | (while plist | ||
| 584 | (push (cons (car plist) (cadr plist)) | ||
| 585 | plist-grouped) | ||
| 586 | (setq plist (cddr plist))) | ||
| 587 | (let (result) | ||
| 588 | (cl-dolist | ||
| 589 | (x | ||
| 590 | (nreverse | ||
| 591 | (sort plist-grouped | ||
| 592 | #'(lambda (l r) (< (use-package-keyword-index (car l)) | ||
| 593 | (use-package-keyword-index (car r))))))) | ||
| 594 | (setq result (cons (car x) (cons (cdr x) result)))) | ||
| 595 | result))) | ||
| 596 | |||
| 597 | (defun use-package-normalize-keywords (name args) | ||
| 598 | (let* ((name-symbol (if (stringp name) (intern name) name)) | ||
| 599 | (name-string (symbol-name name-symbol))) | ||
| 600 | |||
| 601 | ;; The function `elisp--local-variables' inserts this unbound variable into | ||
| 602 | ;; macro forms to determine the locally bound variables for | ||
| 603 | ;; `elisp-completion-at-point'. It ends up throwing a lot of errors since it | ||
| 604 | ;; can occupy the position of a keyword (or look like a second argument to a | ||
| 605 | ;; keyword that takes one). Deleting it when it's at the top level should be | ||
| 606 | ;; harmless since there should be no locally bound variables to discover | ||
| 607 | ;; here anyway. | ||
| 608 | (setq args (delq 'elisp--witness--lisp args)) | ||
| 609 | |||
| 610 | ;; Reduce the set of keywords down to its most fundamental expression. | ||
| 611 | (setq args (use-package-unalias-keywords name-symbol args)) | ||
| 612 | |||
| 613 | ;; Normalize keyword values, coalescing multiple occurrences. | ||
| 614 | (setq args (use-package-normalize-plist name-symbol args nil | ||
| 615 | #'use-package-merge-keys)) | ||
| 616 | |||
| 617 | ;; Add default values for keywords not specified, when applicable. | ||
| 618 | (cl-dolist (spec use-package-defaults) | ||
| 619 | (when (let ((func (nth 2 spec))) | ||
| 620 | (if (and func (functionp func)) | ||
| 621 | (funcall func name args) | ||
| 622 | (eval func))) | ||
| 623 | (setq args (use-package-plist-maybe-put | ||
| 624 | args (nth 0 spec) | ||
| 625 | (let ((func (nth 1 spec))) | ||
| 626 | (if (and func (functionp func)) | ||
| 627 | (funcall func name args) | ||
| 628 | (eval func))))))) | ||
| 629 | |||
| 630 | ;; Determine any autoloads implied by the keywords used. | ||
| 631 | (let ((iargs args) | ||
| 632 | commands) | ||
| 633 | (while iargs | ||
| 634 | (when (keywordp (car iargs)) | ||
| 635 | (let ((autoloads | ||
| 636 | (intern-soft (concat "use-package-autoloads/" | ||
| 637 | (symbol-name (car iargs)))))) | ||
| 638 | (when (functionp autoloads) | ||
| 639 | (setq commands | ||
| 640 | ;; jww (2017-12-07): Right now we just ignored the type of | ||
| 641 | ;; the autoload being requested, and assume they are all | ||
| 642 | ;; `command'. | ||
| 643 | (append (mapcar | ||
| 644 | #'car | ||
| 645 | (funcall autoloads name-symbol (car iargs) | ||
| 646 | (cadr iargs))) | ||
| 647 | commands))))) | ||
| 648 | (setq iargs (cddr iargs))) | ||
| 649 | (when commands | ||
| 650 | (setq args | ||
| 651 | ;; Like `use-package-plist-append', but removing duplicates. | ||
| 652 | (plist-put args :commands | ||
| 653 | (delete-dups | ||
| 654 | (append commands (plist-get args :commands))))))) | ||
| 655 | |||
| 656 | ;; If byte-compiling, pre-load the package so all its symbols are in | ||
| 657 | ;; scope. This is done by prepending statements to the :preface. | ||
| 658 | (when (bound-and-true-p byte-compile-current-file) | ||
| 659 | (setq args | ||
| 660 | (use-package-plist-append | ||
| 661 | args :preface | ||
| 662 | (use-package-concat | ||
| 663 | (mapcar #'(lambda (var) `(defvar ,var)) | ||
| 664 | (plist-get args :defines)) | ||
| 665 | (mapcar #'(lambda (fn) `(declare-function ,fn ,name-string)) | ||
| 666 | (plist-get args :functions)) | ||
| 667 | `((eval-when-compile | ||
| 668 | (with-demoted-errors | ||
| 669 | ,(format "Cannot load %s: %%S" name-string) | ||
| 670 | ,(when (eq use-package-verbose 'debug) | ||
| 671 | `(message ,(format "Compiling package %s" name-string))) | ||
| 672 | ,(unless (plist-get args :no-require) | ||
| 673 | `(unless (featurep ',name-symbol) | ||
| 674 | (load ,name-string nil t)))))))))) | ||
| 675 | |||
| 676 | ;; Certain keywords imply :defer, if :demand was not specified. | ||
| 677 | (when (and (not (plist-member args :demand)) | ||
| 678 | (not (plist-member args :defer)) | ||
| 679 | (not (or (equal '(t) (plist-get args :load)) | ||
| 680 | (equal (list (use-package-as-string name)) | ||
| 681 | (mapcar #'use-package-as-string | ||
| 682 | (plist-get args :load))))) | ||
| 683 | (cl-some #'identity | ||
| 684 | (mapcar (apply-partially #'plist-member args) | ||
| 685 | use-package-deferring-keywords))) | ||
| 686 | (setq args (append args '(:defer t)))) | ||
| 687 | |||
| 688 | ;; The :load keyword overrides :no-require | ||
| 689 | (when (and (plist-member args :load) | ||
| 690 | (plist-member args :no-require)) | ||
| 691 | (setq args (use-package-plist-delete args :no-require))) | ||
| 692 | |||
| 693 | ;; If at this point no :load, :defer or :no-require has been seen, then | ||
| 694 | ;; :load the package itself. | ||
| 695 | (when (and (not (plist-member args :load)) | ||
| 696 | (not (plist-member args :defer)) | ||
| 697 | (not (plist-member args :no-require))) | ||
| 698 | (setq args (append args `(:load (,name))))) | ||
| 699 | |||
| 700 | ;; Sort the list of keywords based on the order of `use-package-keywords'. | ||
| 701 | (use-package-sort-keywords args))) | ||
| 702 | |||
| 703 | (defun use-package-process-keywords (name plist &optional state) | ||
| 704 | "Process the next keyword in the free-form property list PLIST. | ||
| 705 | The values in the PLIST have each been normalized by the function | ||
| 706 | use-package-normalize/KEYWORD (minus the colon). | ||
| 707 | |||
| 708 | STATE is a property list that the function may modify and/or | ||
| 709 | query. This is useful if a package defines multiple keywords and | ||
| 710 | wishes them to have some kind of stateful interaction. | ||
| 711 | |||
| 712 | Unless the KEYWORD being processed intends to ignore remaining | ||
| 713 | keywords, it must call this function recursively, passing in the | ||
| 714 | plist with its keyword and argument removed, and passing in the | ||
| 715 | next value for the STATE." | ||
| 716 | (declare (indent 1)) | ||
| 717 | (unless (null plist) | ||
| 718 | (let* ((keyword (car plist)) | ||
| 719 | (arg (cadr plist)) | ||
| 720 | (rest (cddr plist))) | ||
| 721 | (unless (keywordp keyword) | ||
| 722 | (use-package-error (format "%s is not a keyword" keyword))) | ||
| 723 | (let* ((handler (concat "use-package-handler/" (symbol-name keyword))) | ||
| 724 | (handler-sym (intern handler))) | ||
| 725 | (if (functionp handler-sym) | ||
| 726 | (funcall handler-sym name keyword arg rest state) | ||
| 727 | (use-package-error | ||
| 728 | (format "Keyword handler not defined: %s" handler))))))) | ||
| 729 | |||
| 730 | (put 'use-package-process-keywords 'lisp-indent-function 'defun) | ||
| 731 | |||
| 732 | (defun use-package-list-insert (elem xs &optional anchor after test) | ||
| 733 | "Insert ELEM into the list XS. | ||
| 734 | If ANCHOR is also a keyword, place the new KEYWORD before that | ||
| 735 | one. | ||
| 736 | If AFTER is non-nil, insert KEYWORD either at the end of the | ||
| 737 | keywords list, or after the ANCHOR if one has been provided. | ||
| 738 | If TEST is non-nil, it is the test used to compare ELEM to list | ||
| 739 | elements. The default is `eq'. | ||
| 740 | The modified list is returned. The original list is not modified." | ||
| 741 | (let (result) | ||
| 742 | (dolist (k xs) | ||
| 743 | (if (funcall (or test #'eq) k anchor) | ||
| 744 | (if after | ||
| 745 | (setq result (cons k result) | ||
| 746 | result (cons elem result)) | ||
| 747 | (setq result (cons elem result) | ||
| 748 | result (cons k result))) | ||
| 749 | (setq result (cons k result)))) | ||
| 750 | (if anchor | ||
| 751 | (nreverse result) | ||
| 752 | (if after | ||
| 753 | (nreverse (cons elem result)) | ||
| 754 | (cons elem (nreverse result)))))) | ||
| 755 | |||
| 756 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 757 | ;; | ||
| 758 | ;;; Argument Processing | ||
| 759 | ;; | ||
| 760 | |||
| 761 | (defun use-package-only-one (label args f) | ||
| 762 | "Call F on the first member of ARGS if it has exactly one element." | ||
| 763 | (declare (indent 1)) | ||
| 764 | (cond | ||
| 765 | ((and (listp args) (listp (cdr args)) | ||
| 766 | (= (length args) 1)) | ||
| 767 | (funcall f label (car args))) | ||
| 768 | (t | ||
| 769 | (use-package-error | ||
| 770 | (concat label " wants exactly one argument"))))) | ||
| 771 | |||
| 772 | (put 'use-package-only-one 'lisp-indent-function 'defun) | ||
| 773 | |||
| 774 | (defun use-package-as-one (label args f &optional allow-empty) | ||
| 775 | "Call F on the first element of ARGS if it has one element, or all of ARGS. | ||
| 776 | If ALLOW-EMPTY is non-nil, it's OK for ARGS to be an empty list." | ||
| 777 | (declare (indent 1)) | ||
| 778 | (if (if args | ||
| 779 | (and (listp args) (listp (cdr args))) | ||
| 780 | allow-empty) | ||
| 781 | (if (= (length args) 1) | ||
| 782 | (funcall f label (car args)) | ||
| 783 | (funcall f label args)) | ||
| 784 | (use-package-error | ||
| 785 | (concat label " wants a non-empty list")))) | ||
| 786 | |||
| 787 | (put 'use-package-as-one 'lisp-indent-function 'defun) | ||
| 788 | |||
| 789 | (defun use-package-memoize (f arg) | ||
| 790 | "Ensure the macro-expansion of F applied to ARG evaluates ARG | ||
| 791 | no more than once." | ||
| 792 | (let ((loaded (cl-gentemp "use-package--loaded")) | ||
| 793 | (result (cl-gentemp "use-package--result")) | ||
| 794 | (next (cl-gentemp "use-package--next"))) | ||
| 795 | `((defvar ,loaded nil) | ||
| 796 | (defvar ,result nil) | ||
| 797 | (defvar ,next #'(lambda () (if ,loaded ,result | ||
| 798 | (setq ,loaded t ,result ,arg)))) | ||
| 799 | ,@(funcall f `((funcall ,next)))))) | ||
| 800 | |||
| 801 | (defsubst use-package-normalize-value (_label arg) | ||
| 802 | "Normalize the Lisp value given by ARG. | ||
| 803 | The argument LABEL is ignored." | ||
| 804 | (cond ((null arg) nil) | ||
| 805 | ((eq t arg) t) | ||
| 806 | ((use-package-non-nil-symbolp arg) | ||
| 807 | `(symbol-value ',arg)) | ||
| 808 | ((functionp arg) | ||
| 809 | `(funcall #',arg)) | ||
| 810 | (t arg))) | ||
| 811 | |||
| 812 | (defun use-package-normalize-symbols (label arg &optional recursed) | ||
| 813 | "Normalize a list of symbols." | ||
| 814 | (cond | ||
| 815 | ((use-package-non-nil-symbolp arg) | ||
| 816 | (list arg)) | ||
| 817 | ((and (not recursed) (listp arg) (listp (cdr arg))) | ||
| 818 | (mapcar #'(lambda (x) (car (use-package-normalize-symbols label x t))) arg)) | ||
| 819 | (t | ||
| 820 | (use-package-error | ||
| 821 | (concat label " wants a symbol, or list of symbols"))))) | ||
| 822 | |||
| 823 | (defun use-package-normalize-symlist (_name keyword args) | ||
| 824 | (use-package-as-one (symbol-name keyword) args | ||
| 825 | #'use-package-normalize-symbols)) | ||
| 826 | |||
| 827 | (defun use-package-normalize-recursive-symbols (label arg) | ||
| 828 | "Normalize a list of symbols." | ||
| 829 | (cond | ||
| 830 | ((use-package-non-nil-symbolp arg) | ||
| 831 | arg) | ||
| 832 | ((and (listp arg) (listp (cdr arg))) | ||
| 833 | (mapcar #'(lambda (x) (use-package-normalize-recursive-symbols label x)) | ||
| 834 | arg)) | ||
| 835 | (t | ||
| 836 | (use-package-error | ||
| 837 | (concat label " wants a symbol, or nested list of symbols"))))) | ||
| 838 | |||
| 839 | (defun use-package-normalize-recursive-symlist (_name keyword args) | ||
| 840 | (use-package-as-one (symbol-name keyword) args | ||
| 841 | #'use-package-normalize-recursive-symbols)) | ||
| 842 | |||
| 843 | (defun use-package-normalize-paths (label arg &optional recursed) | ||
| 844 | "Normalize a list of filesystem paths." | ||
| 845 | (cond | ||
| 846 | ((and arg (or (use-package-non-nil-symbolp arg) (functionp arg))) | ||
| 847 | (let ((value (use-package-normalize-value label arg))) | ||
| 848 | (use-package-normalize-paths label (eval value)))) | ||
| 849 | ((stringp arg) | ||
| 850 | (let ((path (if (file-name-absolute-p arg) | ||
| 851 | arg | ||
| 852 | (expand-file-name arg user-emacs-directory)))) | ||
| 853 | (list path))) | ||
| 854 | ((and (not recursed) (listp arg) (listp (cdr arg))) | ||
| 855 | (mapcar #'(lambda (x) | ||
| 856 | (car (use-package-normalize-paths label x t))) arg)) | ||
| 857 | (t | ||
| 858 | (use-package-error | ||
| 859 | (concat label " wants a directory path, or list of paths"))))) | ||
| 860 | |||
| 861 | (defun use-package-normalize-predicate (_name keyword args) | ||
| 862 | (if (null args) | ||
| 863 | t | ||
| 864 | (use-package-only-one (symbol-name keyword) args | ||
| 865 | #'use-package-normalize-value))) | ||
| 866 | |||
| 867 | (defun use-package-normalize-form (label args) | ||
| 868 | "Given a list of forms, return it wrapped in `progn'." | ||
| 869 | (unless (listp (car args)) | ||
| 870 | (use-package-error (concat label " wants a sexp or list of sexps"))) | ||
| 871 | (mapcar #'(lambda (form) | ||
| 872 | (if (and (consp form) | ||
| 873 | (memq (car form) | ||
| 874 | '(use-package bind-key bind-key* | ||
| 875 | unbind-key bind-keys bind-keys*))) | ||
| 876 | (macroexpand form) | ||
| 877 | form)) args)) | ||
| 878 | |||
| 879 | (defun use-package-normalize-forms (_name keyword args) | ||
| 880 | (use-package-normalize-form (symbol-name keyword) args)) | ||
| 881 | |||
| 882 | (defun use-package-normalize-pairs | ||
| 883 | (key-pred val-pred name label arg &optional recursed) | ||
| 884 | "Normalize a list of pairs. | ||
| 885 | KEY-PRED and VAL-PRED are predicates recognizing valid keys and | ||
| 886 | values, respectively. | ||
| 887 | If RECURSED is non-nil, recurse into sublists." | ||
| 888 | (cond | ||
| 889 | ((funcall key-pred arg) | ||
| 890 | (list (cons arg (use-package-as-symbol name)))) | ||
| 891 | ((use-package-is-pair arg key-pred val-pred) | ||
| 892 | (list arg)) | ||
| 893 | ((and (not recursed) (listp arg) (listp (cdr arg))) | ||
| 894 | (let (last-item) | ||
| 895 | (mapcar | ||
| 896 | #'(lambda (x) | ||
| 897 | (prog1 | ||
| 898 | (let ((ret (use-package-normalize-pairs | ||
| 899 | key-pred val-pred name label x t))) | ||
| 900 | (if (and (listp ret) | ||
| 901 | (not (keywordp last-item))) | ||
| 902 | (car ret) | ||
| 903 | ret)) | ||
| 904 | (setq last-item x))) arg))) | ||
| 905 | (t arg))) | ||
| 906 | |||
| 907 | (defun use-package-recognize-function (v &optional binding additional-pred) | ||
| 908 | "A predicate that recognizes functional constructions: | ||
| 909 | nil | ||
| 910 | sym | ||
| 911 | \\='sym | ||
| 912 | (quote sym) | ||
| 913 | #\\='sym | ||
| 914 | (function sym) | ||
| 915 | (lambda () ...) | ||
| 916 | \\='(lambda () ...) | ||
| 917 | (quote (lambda () ...)) | ||
| 918 | #\\='(lambda () ...) | ||
| 919 | (function (lambda () ...))" | ||
| 920 | (or (if binding | ||
| 921 | (symbolp v) | ||
| 922 | (use-package-non-nil-symbolp v)) | ||
| 923 | (and (listp v) | ||
| 924 | (memq (car v) '(quote function)) | ||
| 925 | (use-package-non-nil-symbolp (cadr v))) | ||
| 926 | (if binding (commandp v) (functionp v)) | ||
| 927 | (and additional-pred | ||
| 928 | (funcall additional-pred v)))) | ||
| 929 | |||
| 930 | (defun use-package-normalize-function (v) | ||
| 931 | "Reduce functional constructions to one of two normal forms: | ||
| 932 | sym | ||
| 933 | #\\='(lambda () ...)" | ||
| 934 | (cond ((symbolp v) v) | ||
| 935 | ((and (listp v) | ||
| 936 | (memq (car v) '(quote function)) | ||
| 937 | (use-package-non-nil-symbolp (cadr v))) | ||
| 938 | (cadr v)) | ||
| 939 | ((and (consp v) | ||
| 940 | (eq 'lambda (car v))) | ||
| 941 | v) | ||
| 942 | ((and (listp v) | ||
| 943 | (memq (car v) '(quote function)) | ||
| 944 | (eq 'lambda (car (cadr v)))) | ||
| 945 | (cadr v)) | ||
| 946 | (t v))) | ||
| 947 | |||
| 948 | (defun use-package-normalize-commands (args) | ||
| 949 | "Map over ARGS of the form ((_ . F) ...), normalizing functional F's." | ||
| 950 | (mapcar #'(lambda (x) | ||
| 951 | (if (consp x) | ||
| 952 | (cons (car x) (use-package-normalize-function (cdr x))) | ||
| 953 | x)) | ||
| 954 | args)) | ||
| 955 | |||
| 956 | (defun use-package-normalize-mode (name keyword args) | ||
| 957 | "Normalize arguments for keywords which add regexp/mode pairs to an alist." | ||
| 958 | (use-package-as-one (symbol-name keyword) args | ||
| 959 | (apply-partially #'use-package-normalize-pairs | ||
| 960 | #'use-package-regex-p | ||
| 961 | #'use-package-recognize-function | ||
| 962 | name))) | ||
| 963 | |||
| 964 | (defun use-package-autoloads-mode (_name _keyword args) | ||
| 965 | (mapcar | ||
| 966 | #'(lambda (x) (cons (cdr x) 'command)) | ||
| 967 | (cl-remove-if-not #'(lambda (x) | ||
| 968 | (and (consp x) | ||
| 969 | (use-package-non-nil-symbolp (cdr x)))) | ||
| 970 | args))) | ||
| 971 | |||
| 972 | (defun use-package-handle-mode (name alist args rest state) | ||
| 973 | "Handle keywords which add regexp/mode pairs to an alist." | ||
| 974 | (use-package-concat | ||
| 975 | (use-package-process-keywords name rest state) | ||
| 976 | (mapcar | ||
| 977 | #'(lambda (thing) | ||
| 978 | `(add-to-list | ||
| 979 | ',alist | ||
| 980 | ',(cons (use-package-normalize-regex (car thing)) | ||
| 981 | (cdr thing)))) | ||
| 982 | (use-package-normalize-commands args)))) | ||
| 983 | |||
| 984 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 985 | ;; | ||
| 986 | ;;; Statistics | ||
| 987 | ;; | ||
| 988 | |||
| 989 | (defun use-package-reset-statistics () | ||
| 990 | "Reset statistics for `use-package'. | ||
| 991 | See also `use-package-statistics'." | ||
| 992 | (interactive) | ||
| 993 | (setq use-package-statistics (make-hash-table))) | ||
| 994 | |||
| 995 | (defun use-package-statistics-status (package) | ||
| 996 | "Return loading configuration status of PACKAGE statistics." | ||
| 997 | (cond ((gethash :config package) "Configured") | ||
| 998 | ((gethash :init package) "Initialized") | ||
| 999 | ((gethash :preface package) "Prefaced") | ||
| 1000 | ((gethash :use-package package) "Declared"))) | ||
| 1001 | |||
| 1002 | (defun use-package-statistics-last-event (package) | ||
| 1003 | "Return the date when PACKAGE's status last changed. | ||
| 1004 | The date is returned as a string." | ||
| 1005 | (or (gethash :config package) | ||
| 1006 | (gethash :init package) | ||
| 1007 | (gethash :preface package) | ||
| 1008 | (gethash :use-package package))) | ||
| 1009 | |||
| 1010 | (defun use-package-statistics-time (package) | ||
| 1011 | "Return the time is took for PACKAGE to load." | ||
| 1012 | (+ (float-time (gethash :config-secs package '(0 0 0 0))) | ||
| 1013 | (float-time (gethash :init-secs package '(0 0 0 0))) | ||
| 1014 | (float-time (gethash :preface-secs package '(0 0 0 0))) | ||
| 1015 | (float-time (gethash :use-package-secs package '(0 0 0 0))))) | ||
| 1016 | |||
| 1017 | (defun use-package-statistics-convert (package) | ||
| 1018 | "Return information about PACKAGE. | ||
| 1019 | |||
| 1020 | The information is formatted in a way suitable for | ||
| 1021 | `use-package-statistics-mode'." | ||
| 1022 | (let ((statistics (gethash package use-package-statistics))) | ||
| 1023 | (list | ||
| 1024 | package | ||
| 1025 | (vector | ||
| 1026 | (symbol-name package) | ||
| 1027 | (use-package-statistics-status statistics) | ||
| 1028 | (format-time-string | ||
| 1029 | "%H:%M:%S.%6N" | ||
| 1030 | (use-package-statistics-last-event statistics)) | ||
| 1031 | (format "%.2f" (use-package-statistics-time statistics)))))) | ||
| 1032 | |||
| 1033 | (defun use-package-report () | ||
| 1034 | "Show current statistics gathered about `use-package' declarations. | ||
| 1035 | In the table that's generated, the status field has the following | ||
| 1036 | meaning: | ||
| 1037 | Configured :config has been processed (the package is loaded!) | ||
| 1038 | Initialized :init has been processed (load status unknown) | ||
| 1039 | Prefaced :preface has been processed | ||
| 1040 | Declared the use-package declaration was seen" | ||
| 1041 | (interactive) | ||
| 1042 | (with-current-buffer (get-buffer-create "*use-package statistics*") | ||
| 1043 | (setq tabulated-list-entries | ||
| 1044 | (mapcar #'use-package-statistics-convert | ||
| 1045 | (hash-table-keys use-package-statistics))) | ||
| 1046 | (use-package-statistics-mode) | ||
| 1047 | (tabulated-list-print) | ||
| 1048 | (display-buffer (current-buffer)))) | ||
| 1049 | |||
| 1050 | (defvar use-package-statistics-status-order | ||
| 1051 | '(("Declared" . 0) | ||
| 1052 | ("Prefaced" . 1) | ||
| 1053 | ("Initialized" . 2) | ||
| 1054 | ("Configured" . 3))) | ||
| 1055 | |||
| 1056 | (define-derived-mode use-package-statistics-mode tabulated-list-mode | ||
| 1057 | "use-package statistics" | ||
| 1058 | "Show current statistics gathered about `use-package' declarations." | ||
| 1059 | (setq tabulated-list-format | ||
| 1060 | ;; The sum of column width is 80 characters: | ||
| 1061 | [("Package" 25 t) | ||
| 1062 | ("Status" 13 | ||
| 1063 | (lambda (a b) | ||
| 1064 | (< (assoc-default | ||
| 1065 | (use-package-statistics-status | ||
| 1066 | (gethash (car a) use-package-statistics)) | ||
| 1067 | use-package-statistics-status-order) | ||
| 1068 | (assoc-default | ||
| 1069 | (use-package-statistics-status | ||
| 1070 | (gethash (car b) use-package-statistics)) | ||
| 1071 | use-package-statistics-status-order)))) | ||
| 1072 | ("Last Event" 23 | ||
| 1073 | (lambda (a b) | ||
| 1074 | (< (float-time | ||
| 1075 | (use-package-statistics-last-event | ||
| 1076 | (gethash (car a) use-package-statistics))) | ||
| 1077 | (float-time | ||
| 1078 | (use-package-statistics-last-event | ||
| 1079 | (gethash (car b) use-package-statistics)))))) | ||
| 1080 | ("Time" 10 | ||
| 1081 | (lambda (a b) | ||
| 1082 | (< (use-package-statistics-time | ||
| 1083 | (gethash (car a) use-package-statistics)) | ||
| 1084 | (use-package-statistics-time | ||
| 1085 | (gethash (car b) use-package-statistics)))))]) | ||
| 1086 | (setq tabulated-list-sort-key '("Time" . t)) | ||
| 1087 | (tabulated-list-init-header)) | ||
| 1088 | |||
| 1089 | (defun use-package-statistics-gather (keyword name after) | ||
| 1090 | (let* ((hash (gethash name use-package-statistics | ||
| 1091 | (make-hash-table))) | ||
| 1092 | (before (and after (gethash keyword hash (current-time))))) | ||
| 1093 | (puthash keyword (current-time) hash) | ||
| 1094 | (when after | ||
| 1095 | (puthash (intern (concat (symbol-name keyword) "-secs")) | ||
| 1096 | (time-subtract (current-time) before) hash)) | ||
| 1097 | (puthash name hash use-package-statistics))) | ||
| 1098 | |||
| 1099 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 1100 | ;; | ||
| 1101 | ;;; Handlers | ||
| 1102 | ;; | ||
| 1103 | |||
| 1104 | ;;;; :disabled | ||
| 1105 | |||
| 1106 | ;; Don't alias this to `ignore', as that will cause the resulting | ||
| 1107 | ;; function to be interactive. | ||
| 1108 | (defun use-package-normalize/:disabled (_name _keyword _arg) | ||
| 1109 | "Do nothing, return nil.") | ||
| 1110 | |||
| 1111 | (defun use-package-handler/:disabled (name _keyword _arg rest state) | ||
| 1112 | (use-package-process-keywords name rest state)) | ||
| 1113 | |||
| 1114 | ;;;; :if, :when and :unless | ||
| 1115 | |||
| 1116 | (defun use-package-normalize-test (_name keyword args) | ||
| 1117 | (use-package-only-one (symbol-name keyword) args | ||
| 1118 | #'use-package-normalize-value)) | ||
| 1119 | |||
| 1120 | (defalias 'use-package-normalize/:if 'use-package-normalize-test) | ||
| 1121 | |||
| 1122 | (defun use-package-handler/:if (name _keyword pred rest state) | ||
| 1123 | (let ((body (use-package-process-keywords name rest state))) | ||
| 1124 | `((when ,pred ,@body)))) | ||
| 1125 | |||
| 1126 | (defalias 'use-package-normalize/:when 'use-package-normalize-test) | ||
| 1127 | |||
| 1128 | (defalias 'use-package-handler/:when 'use-package-handler/:if) | ||
| 1129 | |||
| 1130 | (defalias 'use-package-normalize/:unless 'use-package-normalize-test) | ||
| 1131 | |||
| 1132 | (defun use-package-handler/:unless (name _keyword pred rest state) | ||
| 1133 | (let ((body (use-package-process-keywords name rest state))) | ||
| 1134 | `((unless ,pred ,@body)))) | ||
| 1135 | |||
| 1136 | ;;;; :requires | ||
| 1137 | |||
| 1138 | (defalias 'use-package-normalize/:requires 'use-package-normalize-symlist) | ||
| 1139 | |||
| 1140 | (defun use-package-handler/:requires (name _keyword requires rest state) | ||
| 1141 | (let ((body (use-package-process-keywords name rest state))) | ||
| 1142 | (if (null requires) | ||
| 1143 | body | ||
| 1144 | `((when ,(if (> (length requires) 1) | ||
| 1145 | `(not (member nil (mapcar #'featurep ',requires))) | ||
| 1146 | `(featurep ',(car requires))) | ||
| 1147 | ,@body))))) | ||
| 1148 | |||
| 1149 | ;;;; :load-path | ||
| 1150 | |||
| 1151 | (defun use-package-normalize/:load-path (_name keyword args) | ||
| 1152 | (use-package-as-one (symbol-name keyword) args | ||
| 1153 | #'use-package-normalize-paths)) | ||
| 1154 | |||
| 1155 | (defun use-package-handler/:load-path (name _keyword arg rest state) | ||
| 1156 | (let ((body (use-package-process-keywords name rest state))) | ||
| 1157 | (use-package-concat | ||
| 1158 | (mapcar #'(lambda (path) | ||
| 1159 | `(eval-and-compile (add-to-list 'load-path ,path))) | ||
| 1160 | arg) | ||
| 1161 | body))) | ||
| 1162 | |||
| 1163 | ;;;; :no-require | ||
| 1164 | |||
| 1165 | (defalias 'use-package-normalize/:no-require 'use-package-normalize-predicate) | ||
| 1166 | |||
| 1167 | (defun use-package-handler/:no-require (name _keyword _arg rest state) | ||
| 1168 | (use-package-process-keywords name rest state)) | ||
| 1169 | |||
| 1170 | ;;;; :defines | ||
| 1171 | |||
| 1172 | (defalias 'use-package-normalize/:defines 'use-package-normalize-symlist) | ||
| 1173 | |||
| 1174 | (defun use-package-handler/:defines (name _keyword _arg rest state) | ||
| 1175 | (use-package-process-keywords name rest state)) | ||
| 1176 | |||
| 1177 | ;;;; :functions | ||
| 1178 | |||
| 1179 | (defalias 'use-package-normalize/:functions 'use-package-normalize-symlist) | ||
| 1180 | |||
| 1181 | (defun use-package-handler/:functions (name _keyword _arg rest state) | ||
| 1182 | (use-package-process-keywords name rest state)) | ||
| 1183 | |||
| 1184 | ;;;; :preface | ||
| 1185 | |||
| 1186 | (defalias 'use-package-normalize/:preface 'use-package-normalize-forms) | ||
| 1187 | |||
| 1188 | (defun use-package-handler/:preface (name _keyword arg rest state) | ||
| 1189 | (let ((body (use-package-process-keywords name rest state))) | ||
| 1190 | (use-package-concat | ||
| 1191 | (when use-package-compute-statistics | ||
| 1192 | `((use-package-statistics-gather :preface ',name nil))) | ||
| 1193 | (when arg | ||
| 1194 | `((eval-and-compile ,@arg))) | ||
| 1195 | body | ||
| 1196 | (when use-package-compute-statistics | ||
| 1197 | `((use-package-statistics-gather :preface ',name t)))))) | ||
| 1198 | |||
| 1199 | ;;;; :catch | ||
| 1200 | |||
| 1201 | (defvar use-package--form) | ||
| 1202 | (defvar use-package--hush-function #'(lambda (_keyword body) body)) | ||
| 1203 | |||
| 1204 | (defsubst use-package-hush (context keyword body) | ||
| 1205 | `((condition-case-unless-debug err | ||
| 1206 | ,(macroexp-progn body) | ||
| 1207 | (error (funcall ,context ,keyword err))))) | ||
| 1208 | |||
| 1209 | (defun use-package-normalize/:catch (_name keyword args) | ||
| 1210 | (if (null args) | ||
| 1211 | t | ||
| 1212 | (use-package-only-one (symbol-name keyword) args | ||
| 1213 | use-package--hush-function))) | ||
| 1214 | |||
| 1215 | (defun use-package-handler/:catch (name keyword arg rest state) | ||
| 1216 | (let* ((context (cl-gentemp "use-package--warning"))) | ||
| 1217 | (cond | ||
| 1218 | ((not arg) | ||
| 1219 | (use-package-process-keywords name rest state)) | ||
| 1220 | ((eq arg t) | ||
| 1221 | `((defvar ,context | ||
| 1222 | #'(lambda (keyword err) | ||
| 1223 | (let ((msg (format "%s/%s: %s" ',name keyword | ||
| 1224 | (error-message-string err)))) | ||
| 1225 | ,@(when (eq use-package-verbose 'debug) | ||
| 1226 | `((with-current-buffer | ||
| 1227 | (get-buffer-create "*use-package*") | ||
| 1228 | (goto-char (point-max)) | ||
| 1229 | (insert "-----\n" msg ,use-package--form) | ||
| 1230 | (emacs-lisp-mode)) | ||
| 1231 | (setq msg | ||
| 1232 | (concat msg | ||
| 1233 | " (see the *use-package* buffer)")))) | ||
| 1234 | (display-warning 'use-package msg :error)))) | ||
| 1235 | ,@(let ((use-package--hush-function | ||
| 1236 | (apply-partially #'use-package-hush context))) | ||
| 1237 | (funcall use-package--hush-function keyword | ||
| 1238 | (use-package-process-keywords name rest state))))) | ||
| 1239 | ((functionp arg) | ||
| 1240 | `((defvar ,context ,arg) | ||
| 1241 | ,@(let ((use-package--hush-function | ||
| 1242 | (apply-partially #'use-package-hush context))) | ||
| 1243 | (funcall use-package--hush-function keyword | ||
| 1244 | (use-package-process-keywords name rest state))))) | ||
| 1245 | (t | ||
| 1246 | (use-package-error "The :catch keyword expects 't' or a function"))))) | ||
| 1247 | |||
| 1248 | ;;;; :interpreter | ||
| 1249 | |||
| 1250 | (defalias 'use-package-normalize/:interpreter 'use-package-normalize-mode) | ||
| 1251 | (defalias 'use-package-autoloads/:interpreter 'use-package-autoloads-mode) | ||
| 1252 | |||
| 1253 | (defun use-package-handler/:interpreter (name _keyword arg rest state) | ||
| 1254 | (use-package-handle-mode name 'interpreter-mode-alist arg rest state)) | ||
| 1255 | |||
| 1256 | ;;;; :mode | ||
| 1257 | |||
| 1258 | (defalias 'use-package-normalize/:mode 'use-package-normalize-mode) | ||
| 1259 | (defalias 'use-package-autoloads/:mode 'use-package-autoloads-mode) | ||
| 1260 | |||
| 1261 | (defun use-package-handler/:mode (name _keyword arg rest state) | ||
| 1262 | (use-package-handle-mode name 'auto-mode-alist arg rest state)) | ||
| 1263 | |||
| 1264 | ;;;; :magic | ||
| 1265 | |||
| 1266 | (defalias 'use-package-normalize/:magic 'use-package-normalize-mode) | ||
| 1267 | (defalias 'use-package-autoloads/:magic 'use-package-autoloads-mode) | ||
| 1268 | |||
| 1269 | (defun use-package-handler/:magic (name _keyword arg rest state) | ||
| 1270 | (use-package-handle-mode name 'magic-mode-alist arg rest state)) | ||
| 1271 | |||
| 1272 | ;;;; :magic-fallback | ||
| 1273 | |||
| 1274 | (defalias 'use-package-normalize/:magic-fallback 'use-package-normalize-mode) | ||
| 1275 | (defalias 'use-package-autoloads/:magic-fallback 'use-package-autoloads-mode) | ||
| 1276 | |||
| 1277 | (defun use-package-handler/:magic-fallback (name _keyword arg rest state) | ||
| 1278 | (use-package-handle-mode name 'magic-fallback-mode-alist arg rest state)) | ||
| 1279 | |||
| 1280 | ;;;; :hook | ||
| 1281 | |||
| 1282 | (defun use-package-normalize/:hook (name keyword args) | ||
| 1283 | (use-package-as-one (symbol-name keyword) args | ||
| 1284 | #'(lambda (label arg) | ||
| 1285 | (unless (or (use-package-non-nil-symbolp arg) (consp arg)) | ||
| 1286 | (use-package-error | ||
| 1287 | (concat label " a <symbol> or (<symbol or list of symbols> . <symbol or function>)" | ||
| 1288 | " or list of these"))) | ||
| 1289 | (use-package-normalize-pairs | ||
| 1290 | #'(lambda (k) | ||
| 1291 | (or (use-package-non-nil-symbolp k) | ||
| 1292 | (and k (let ((every t)) | ||
| 1293 | (while (and every k) | ||
| 1294 | (if (and (consp k) | ||
| 1295 | (use-package-non-nil-symbolp (car k))) | ||
| 1296 | (setq k (cdr k)) | ||
| 1297 | (setq every nil))) | ||
| 1298 | every)))) | ||
| 1299 | #'use-package-recognize-function | ||
| 1300 | (if (string-suffix-p "-mode" (symbol-name name)) | ||
| 1301 | name | ||
| 1302 | (intern (concat (symbol-name name) "-mode"))) | ||
| 1303 | label arg)))) | ||
| 1304 | |||
| 1305 | (defalias 'use-package-autoloads/:hook 'use-package-autoloads-mode) | ||
| 1306 | |||
| 1307 | (defun use-package-handler/:hook (name _keyword args rest state) | ||
| 1308 | "Generate use-package custom keyword code." | ||
| 1309 | (use-package-concat | ||
| 1310 | (use-package-process-keywords name rest state) | ||
| 1311 | (cl-mapcan | ||
| 1312 | #'(lambda (def) | ||
| 1313 | (let ((syms (car def)) | ||
| 1314 | (fun (cdr def))) | ||
| 1315 | (when fun | ||
| 1316 | (mapcar | ||
| 1317 | #'(lambda (sym) | ||
| 1318 | `(add-hook | ||
| 1319 | (quote ,(intern | ||
| 1320 | (concat (symbol-name sym) | ||
| 1321 | use-package-hook-name-suffix))) | ||
| 1322 | (function ,fun))) | ||
| 1323 | (use-package-hook-handler-normalize-mode-symbols syms))))) | ||
| 1324 | (use-package-normalize-commands args)))) | ||
| 1325 | |||
| 1326 | (defun use-package-hook-handler-normalize-mode-symbols (syms) | ||
| 1327 | "Ensure that `SYMS' turns into a list of modes." | ||
| 1328 | (if (use-package-non-nil-symbolp syms) (list syms) syms)) | ||
| 1329 | |||
| 1330 | ;;;; :commands | ||
| 1331 | |||
| 1332 | (defalias 'use-package-normalize/:commands 'use-package-normalize-symlist) | ||
| 1333 | |||
| 1334 | (defun use-package-handler/:commands (name _keyword arg rest state) | ||
| 1335 | (use-package-concat | ||
| 1336 | ;; Since we deferring load, establish any necessary autoloads, and also | ||
| 1337 | ;; keep the byte-compiler happy. | ||
| 1338 | (let ((name-string (use-package-as-string name))) | ||
| 1339 | (cl-mapcan | ||
| 1340 | #'(lambda (command) | ||
| 1341 | (when (symbolp command) | ||
| 1342 | (append | ||
| 1343 | (unless (plist-get state :demand) | ||
| 1344 | `((unless (fboundp ',command) | ||
| 1345 | (autoload #',command ,name-string nil t)))) | ||
| 1346 | (when (bound-and-true-p byte-compile-current-file) | ||
| 1347 | `((eval-when-compile | ||
| 1348 | (declare-function ,command ,name-string))))))) | ||
| 1349 | (delete-dups arg))) | ||
| 1350 | (use-package-process-keywords name rest state))) | ||
| 1351 | |||
| 1352 | ;;;; :autoload | ||
| 1353 | |||
| 1354 | (defalias 'use-package-normalize/:autoload 'use-package-normalize/:commands) | ||
| 1355 | |||
| 1356 | (defun use-package-handler/:autoload (name _keyword arg rest state) | ||
| 1357 | (use-package-concat | ||
| 1358 | ;; Since we deferring load, establish any necessary autoloads, and also | ||
| 1359 | ;; keep the byte-compiler happy. | ||
| 1360 | (let ((name-string (use-package-as-string name))) | ||
| 1361 | (cl-mapcan | ||
| 1362 | #'(lambda (command) | ||
| 1363 | (when (symbolp command) | ||
| 1364 | (append | ||
| 1365 | (unless (plist-get state :demand) | ||
| 1366 | `((unless (fboundp ',command) | ||
| 1367 | (autoload #',command ,name-string)))) | ||
| 1368 | (when (bound-and-true-p byte-compile-current-file) | ||
| 1369 | `((eval-when-compile | ||
| 1370 | (declare-function ,command ,name-string))))))) | ||
| 1371 | (delete-dups arg))) | ||
| 1372 | (use-package-process-keywords name rest state))) | ||
| 1373 | |||
| 1374 | ;;;; :defer | ||
| 1375 | |||
| 1376 | (defalias 'use-package-normalize/:defer 'use-package-normalize-predicate) | ||
| 1377 | |||
| 1378 | (defun use-package-handler/:defer (name _keyword arg rest state) | ||
| 1379 | (let ((body (use-package-process-keywords name rest state))) | ||
| 1380 | (use-package-concat | ||
| 1381 | ;; Load the package after a set amount of idle time, if the argument to | ||
| 1382 | ;; `:defer' was a number. | ||
| 1383 | (when (numberp arg) | ||
| 1384 | `((run-with-idle-timer ,arg nil #'require | ||
| 1385 | ',(use-package-as-symbol name) nil t))) | ||
| 1386 | (if (or (not arg) (null body)) | ||
| 1387 | body | ||
| 1388 | `((eval-after-load ',name ',(macroexp-progn body))))))) | ||
| 1389 | |||
| 1390 | ;;;; :after | ||
| 1391 | |||
| 1392 | (defun use-package-normalize/:after (name keyword args) | ||
| 1393 | (setq args (use-package-normalize-recursive-symlist name keyword args)) | ||
| 1394 | (if (consp args) | ||
| 1395 | args | ||
| 1396 | (list args))) | ||
| 1397 | |||
| 1398 | (defun use-package-after-count-uses (features*) | ||
| 1399 | "Count the number of time the body would appear in the result." | ||
| 1400 | (cond ((use-package-non-nil-symbolp features*) | ||
| 1401 | 1) | ||
| 1402 | ((and (consp features*) | ||
| 1403 | (memq (car features*) '(:or :any))) | ||
| 1404 | (let ((num 0)) | ||
| 1405 | (cl-dolist (next (cdr features*)) | ||
| 1406 | (setq num (+ num (use-package-after-count-uses next)))) | ||
| 1407 | num)) | ||
| 1408 | ((and (consp features*) | ||
| 1409 | (memq (car features*) '(:and :all))) | ||
| 1410 | (apply #'max (mapcar #'use-package-after-count-uses | ||
| 1411 | (cdr features*)))) | ||
| 1412 | ((listp features*) | ||
| 1413 | (use-package-after-count-uses (cons :all features*))))) | ||
| 1414 | |||
| 1415 | (defun use-package-require-after-load (features* body) | ||
| 1416 | "Generate `eval-after-load' statements to represents FEATURES*. | ||
| 1417 | FEATURES* is a list containing keywords `:and' and `:all', where | ||
| 1418 | no keyword implies `:all'." | ||
| 1419 | (cond | ||
| 1420 | ((use-package-non-nil-symbolp features*) | ||
| 1421 | `((eval-after-load ',features* ',(macroexp-progn body)))) | ||
| 1422 | ((and (consp features*) | ||
| 1423 | (memq (car features*) '(:or :any))) | ||
| 1424 | (cl-mapcan #'(lambda (x) (use-package-require-after-load x body)) | ||
| 1425 | (cdr features*))) | ||
| 1426 | ((and (consp features*) | ||
| 1427 | (memq (car features*) '(:and :all))) | ||
| 1428 | (cl-dolist (next (cdr features*)) | ||
| 1429 | (setq body (use-package-require-after-load next body))) | ||
| 1430 | body) | ||
| 1431 | ((listp features*) | ||
| 1432 | (use-package-require-after-load (cons :all features*) body)))) | ||
| 1433 | |||
| 1434 | (defun use-package-handler/:after (name _keyword arg rest state) | ||
| 1435 | (let ((body (use-package-process-keywords name rest state)) | ||
| 1436 | (uses (use-package-after-count-uses arg))) | ||
| 1437 | (if (or (null uses) (null body)) | ||
| 1438 | body | ||
| 1439 | (if (<= uses 1) | ||
| 1440 | (use-package-require-after-load arg body) | ||
| 1441 | (use-package-memoize | ||
| 1442 | (apply-partially #'use-package-require-after-load arg) | ||
| 1443 | (macroexp-progn body)))))) | ||
| 1444 | |||
| 1445 | ;;;; :demand | ||
| 1446 | |||
| 1447 | (defalias 'use-package-normalize/:demand 'use-package-normalize-predicate) | ||
| 1448 | |||
| 1449 | (defun use-package-handler/:demand (name _keyword _arg rest state) | ||
| 1450 | (use-package-process-keywords name rest state)) | ||
| 1451 | |||
| 1452 | ;;;; :custom | ||
| 1453 | |||
| 1454 | (defun use-package-normalize/:custom (_name keyword args) | ||
| 1455 | "Normalize use-package custom keyword." | ||
| 1456 | (use-package-as-one (symbol-name keyword) args | ||
| 1457 | #'(lambda (label arg) | ||
| 1458 | (unless (listp arg) | ||
| 1459 | (use-package-error | ||
| 1460 | (concat label " a (<symbol> <value> [comment])" | ||
| 1461 | " or list of these"))) | ||
| 1462 | (if (use-package-non-nil-symbolp (car arg)) | ||
| 1463 | (list arg) | ||
| 1464 | arg)))) | ||
| 1465 | |||
| 1466 | (defun use-package-handler/:custom (name _keyword args rest state) | ||
| 1467 | "Generate use-package custom keyword code." | ||
| 1468 | (use-package-concat | ||
| 1469 | (if (bound-and-true-p use-package-use-theme) | ||
| 1470 | `((let ((custom--inhibit-theme-enable nil)) | ||
| 1471 | ;; Declare the theme here so use-package can be required inside | ||
| 1472 | ;; eval-and-compile without warnings about unknown theme. | ||
| 1473 | (unless (memq 'use-package custom-known-themes) | ||
| 1474 | (deftheme use-package) | ||
| 1475 | (enable-theme 'use-package) | ||
| 1476 | (setq custom-enabled-themes (remq 'use-package custom-enabled-themes))) | ||
| 1477 | (custom-theme-set-variables | ||
| 1478 | 'use-package | ||
| 1479 | ,@(mapcar | ||
| 1480 | #'(lambda (def) | ||
| 1481 | (let ((variable (nth 0 def)) | ||
| 1482 | (value (nth 1 def)) | ||
| 1483 | (comment (nth 2 def))) | ||
| 1484 | (unless (and comment (stringp comment)) | ||
| 1485 | (setq comment (format "Customized with use-package %s" name))) | ||
| 1486 | `'(,variable ,value nil () ,comment))) | ||
| 1487 | args)))) | ||
| 1488 | (mapcar | ||
| 1489 | #'(lambda (def) | ||
| 1490 | (let ((variable (nth 0 def)) | ||
| 1491 | (value (nth 1 def)) | ||
| 1492 | (comment (nth 2 def))) | ||
| 1493 | (unless (and comment (stringp comment)) | ||
| 1494 | (setq comment (format "Customized with use-package %s" name))) | ||
| 1495 | `(customize-set-variable (quote ,variable) ,value ,comment))) | ||
| 1496 | args)) | ||
| 1497 | (use-package-process-keywords name rest state))) | ||
| 1498 | |||
| 1499 | ;;;; :custom-face | ||
| 1500 | |||
| 1501 | (defun use-package-normalize/:custom-face (name-symbol _keyword arg) | ||
| 1502 | "Normalize use-package custom-face keyword." | ||
| 1503 | (let ((error-msg | ||
| 1504 | (format "%s wants a (<symbol> <face-spec> [spec-type]) or list of these" | ||
| 1505 | name-symbol))) | ||
| 1506 | (unless (listp arg) | ||
| 1507 | (use-package-error error-msg)) | ||
| 1508 | (cl-dolist (def arg arg) | ||
| 1509 | (unless (listp def) | ||
| 1510 | (use-package-error error-msg)) | ||
| 1511 | (let ((face (nth 0 def)) | ||
| 1512 | (spec (nth 1 def))) | ||
| 1513 | (when (or (not face) | ||
| 1514 | (not spec) | ||
| 1515 | (> (length def) 3)) | ||
| 1516 | (use-package-error error-msg)))))) | ||
| 1517 | |||
| 1518 | (defun use-package-handler/:custom-face (name _keyword args rest state) | ||
| 1519 | "Generate use-package custom-face keyword code." | ||
| 1520 | (use-package-concat | ||
| 1521 | (mapcar #'(lambda (def) `(apply #'face-spec-set (backquote ,def))) args) | ||
| 1522 | (use-package-process-keywords name rest state))) | ||
| 1523 | |||
| 1524 | ;;;; :init | ||
| 1525 | |||
| 1526 | (defalias 'use-package-normalize/:init 'use-package-normalize-forms) | ||
| 1527 | |||
| 1528 | (defun use-package-handler/:init (name _keyword arg rest state) | ||
| 1529 | (use-package-concat | ||
| 1530 | (when use-package-compute-statistics | ||
| 1531 | `((use-package-statistics-gather :init ',name nil))) | ||
| 1532 | (let ((init-body | ||
| 1533 | (use-package-hook-injector (use-package-as-string name) | ||
| 1534 | :init arg))) | ||
| 1535 | (when init-body | ||
| 1536 | (funcall use-package--hush-function :init | ||
| 1537 | (if use-package-check-before-init | ||
| 1538 | `((when (locate-library ,(use-package-as-string name)) | ||
| 1539 | ,@init-body)) | ||
| 1540 | init-body)))) | ||
| 1541 | (use-package-process-keywords name rest state) | ||
| 1542 | (when use-package-compute-statistics | ||
| 1543 | `((use-package-statistics-gather :init ',name t))))) | ||
| 1544 | |||
| 1545 | ;;;; :load | ||
| 1546 | |||
| 1547 | (defun use-package-normalize/:load (name keyword args) | ||
| 1548 | (setq args (use-package-normalize-recursive-symlist name keyword args)) | ||
| 1549 | (if (consp args) | ||
| 1550 | args | ||
| 1551 | (list args))) | ||
| 1552 | |||
| 1553 | (defun use-package-handler/:load (name _keyword arg rest state) | ||
| 1554 | (let ((body (use-package-process-keywords name rest state))) | ||
| 1555 | (cl-dolist (pkg arg) | ||
| 1556 | (setq body (use-package-require (if (eq t pkg) name pkg) nil body))) | ||
| 1557 | body)) | ||
| 1558 | |||
| 1559 | ;;;; :config | ||
| 1560 | |||
| 1561 | (defalias 'use-package-normalize/:config 'use-package-normalize-forms) | ||
| 1562 | |||
| 1563 | (defun use-package-handler/:config (name _keyword arg rest state) | ||
| 1564 | (let* ((body (use-package-process-keywords name rest state)) | ||
| 1565 | (name-symbol (use-package-as-symbol name))) | ||
| 1566 | (use-package-concat | ||
| 1567 | (when use-package-compute-statistics | ||
| 1568 | `((use-package-statistics-gather :config ',name nil))) | ||
| 1569 | (if (and (or (null arg) (equal arg '(t))) (not use-package-inject-hooks)) | ||
| 1570 | body | ||
| 1571 | (use-package-with-elapsed-timer | ||
| 1572 | (format "Configuring package %s" name-symbol) | ||
| 1573 | (funcall use-package--hush-function :config | ||
| 1574 | (use-package-concat | ||
| 1575 | (use-package-hook-injector | ||
| 1576 | (symbol-name name-symbol) :config arg) | ||
| 1577 | body | ||
| 1578 | (list t))))) | ||
| 1579 | (when use-package-compute-statistics | ||
| 1580 | `((use-package-statistics-gather :config ',name t)))))) | ||
| 1581 | |||
| 1582 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 1583 | ;; | ||
| 1584 | ;;; The main macro | ||
| 1585 | ;; | ||
| 1586 | |||
| 1587 | (defmacro use-package-core (name args) | ||
| 1588 | `(let* ((args* (use-package-normalize-keywords ,name ,args)) | ||
| 1589 | (use-package--form | ||
| 1590 | (if (eq use-package-verbose 'debug) | ||
| 1591 | (concat "\n\n" | ||
| 1592 | (pp-to-string `(use-package ,name ,@,args)) | ||
| 1593 | "\n -->\n\n" | ||
| 1594 | (pp-to-string `(use-package ,name ,@args*)) | ||
| 1595 | "\n ==>\n\n" | ||
| 1596 | (pp-to-string | ||
| 1597 | (macroexp-progn | ||
| 1598 | (let ((use-package-verbose 'errors) | ||
| 1599 | (use-package-expand-minimally t)) | ||
| 1600 | (use-package-process-keywords name args* | ||
| 1601 | (and (plist-get args* :demand) | ||
| 1602 | (list :demand t))))))) | ||
| 1603 | ""))) | ||
| 1604 | (use-package-process-keywords name args* | ||
| 1605 | (and (plist-get args* :demand) | ||
| 1606 | (list :demand t))))) | ||
| 1607 | |||
| 1608 | ;;;###autoload | ||
| 1609 | (defmacro use-package (name &rest args) | ||
| 1610 | "Declare an Emacs package by specifying a group of configuration options. | ||
| 1611 | |||
| 1612 | For full documentation, please see the README file that came with | ||
| 1613 | this file. Usage: | ||
| 1614 | |||
| 1615 | (use-package package-name | ||
| 1616 | [:keyword [option]]...) | ||
| 1617 | |||
| 1618 | :init Code to run before PACKAGE-NAME has been loaded. | ||
| 1619 | :config Code to run after PACKAGE-NAME has been loaded. Note that | ||
| 1620 | if loading is deferred for any reason, this code does not | ||
| 1621 | execute until the lazy load has occurred. | ||
| 1622 | :preface Code to be run before everything except `:disabled'; this | ||
| 1623 | can be used to define functions for use in `:if', or that | ||
| 1624 | should be seen by the byte-compiler. | ||
| 1625 | |||
| 1626 | :mode Form to be added to `auto-mode-alist'. | ||
| 1627 | :magic Form to be added to `magic-mode-alist'. | ||
| 1628 | :magic-fallback Form to be added to `magic-fallback-mode-alist'. | ||
| 1629 | :interpreter Form to be added to `interpreter-mode-alist'. | ||
| 1630 | |||
| 1631 | :commands Define autoloads for commands that will be defined by the | ||
| 1632 | package. This is useful if the package is being lazily | ||
| 1633 | loaded, and you wish to conditionally call functions in your | ||
| 1634 | `:init' block that are defined in the package. | ||
| 1635 | :autoload Similar to :commands, but it for no-interactive one. | ||
| 1636 | :hook Specify hook(s) to attach this package to. | ||
| 1637 | |||
| 1638 | :bind Bind keys, and define autoloads for the bound commands. | ||
| 1639 | :bind* Bind keys, and define autoloads for the bound commands, | ||
| 1640 | *overriding all minor mode bindings*. | ||
| 1641 | :bind-keymap Bind a key prefix to an auto-loaded keymap defined in the | ||
| 1642 | package. This is like `:bind', but for keymaps. | ||
| 1643 | :bind-keymap* Like `:bind-keymap', but overrides all minor mode bindings | ||
| 1644 | |||
| 1645 | :defer Defer loading of a package -- this is implied when using | ||
| 1646 | `:commands', `:bind', `:bind*', `:mode', `:magic', `:hook', | ||
| 1647 | `:magic-fallback', or `:interpreter'. This can be an integer, | ||
| 1648 | to force loading after N seconds of idle time, if the package | ||
| 1649 | has not already been loaded. | ||
| 1650 | :after Delay the use-package declaration until after the named modules | ||
| 1651 | have loaded. Once load, it will be as though the use-package | ||
| 1652 | declaration (without `:after') had been seen at that moment. | ||
| 1653 | :demand Prevent the automatic deferred loading introduced by constructs | ||
| 1654 | such as `:bind' (see `:defer' for the complete list). | ||
| 1655 | |||
| 1656 | :if EXPR Initialize and load only if EXPR evaluates to a non-nil value. | ||
| 1657 | :disabled The package is ignored completely if this keyword is present. | ||
| 1658 | :defines Declare certain variables to silence the byte-compiler. | ||
| 1659 | :functions Declare certain functions to silence the byte-compiler. | ||
| 1660 | :load-path Add to the `load-path' before attempting to load the package. | ||
| 1661 | :diminish Support for diminish.el (if installed). | ||
| 1662 | :delight Support for delight.el (if installed). | ||
| 1663 | :custom Call `Custom-set' or `set-default' with each variable | ||
| 1664 | definition without modifying the Emacs `custom-file'. | ||
| 1665 | (compare with `custom-set-variables'). | ||
| 1666 | :custom-face Call `custom-set-faces' with each face definition. | ||
| 1667 | :ensure Loads the package using package.el if necessary. | ||
| 1668 | :pin Pin the package to an archive." | ||
| 1669 | (declare (indent defun)) | ||
| 1670 | (unless (memq :disabled args) | ||
| 1671 | (macroexp-progn | ||
| 1672 | (use-package-concat | ||
| 1673 | (when use-package-compute-statistics | ||
| 1674 | `((use-package-statistics-gather :use-package ',name nil))) | ||
| 1675 | (if (eq use-package-verbose 'errors) | ||
| 1676 | (use-package-core name args) | ||
| 1677 | (condition-case-unless-debug err | ||
| 1678 | (use-package-core name args) | ||
| 1679 | (error | ||
| 1680 | (ignore | ||
| 1681 | (display-warning | ||
| 1682 | 'use-package | ||
| 1683 | (format "Failed to parse package %s: %s" | ||
| 1684 | name (error-message-string err)) :error))))) | ||
| 1685 | (when use-package-compute-statistics | ||
| 1686 | `((use-package-statistics-gather :use-package ',name t))))))) | ||
| 1687 | |||
| 1688 | (provide 'use-package-core) | ||
| 1689 | |||
| 1690 | ;;; use-package-core.el ends here | ||
diff --git a/lisp/use-package/use-package-delight.el b/lisp/use-package/use-package-delight.el new file mode 100644 index 00000000000..c6abac9a643 --- /dev/null +++ b/lisp/use-package/use-package-delight.el | |||
| @@ -0,0 +1,83 @@ | |||
| 1 | ;;; use-package-delight.el --- Support for the :delight keyword -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2012-2022 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: John Wiegley <johnw@newartisans.com> | ||
| 6 | ;; Maintainer: John Wiegley <johnw@newartisans.com> | ||
| 7 | |||
| 8 | ;; This program is free software; you can redistribute it and/or modify | ||
| 9 | ;; it under the terms of the GNU General Public License as published by | ||
| 10 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 11 | ;; (at your option) any later version. | ||
| 12 | |||
| 13 | ;; This program is distributed in the hope that it will be useful, | ||
| 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 16 | ;; GNU General Public License for more details. | ||
| 17 | |||
| 18 | ;; You should have received a copy of the GNU General Public License | ||
| 19 | ;; along with this program. If not, see <https://www.gnu.org/licenses/>. | ||
| 20 | |||
| 21 | ;;; Commentary: | ||
| 22 | |||
| 23 | ;; Provides support for the :delight keyword, which is made available by | ||
| 24 | ;; default by requiring `use-package'. | ||
| 25 | |||
| 26 | ;;; Code: | ||
| 27 | |||
| 28 | (require 'use-package-core) | ||
| 29 | |||
| 30 | (defun use-package-normalize-delight (name args) | ||
| 31 | "Normalize ARGS for a single call to `delight'." | ||
| 32 | (when (eq :eval (car args)) | ||
| 33 | ;; Handle likely common mistake. | ||
| 34 | (use-package-error ":delight mode line constructs must be quoted")) | ||
| 35 | (cond ((and (= (length args) 1) | ||
| 36 | (use-package-non-nil-symbolp (car args))) | ||
| 37 | `(,(nth 0 args) nil ,name)) | ||
| 38 | ((= (length args) 2) | ||
| 39 | `(,(nth 0 args) ,(nth 1 args) ,name)) | ||
| 40 | ((= (length args) 3) | ||
| 41 | args) | ||
| 42 | (t | ||
| 43 | (use-package-error | ||
| 44 | ":delight expects `delight' arguments or a list of them")))) | ||
| 45 | |||
| 46 | ;;;###autoload | ||
| 47 | (defun use-package-normalize/:delight (name _keyword args) | ||
| 48 | "Normalize arguments to delight." | ||
| 49 | (cond ((null args) | ||
| 50 | `((,(use-package-as-mode name) nil ,name))) | ||
| 51 | ((and (= (length args) 1) | ||
| 52 | (use-package-non-nil-symbolp (car args))) | ||
| 53 | `((,(car args) nil ,name))) | ||
| 54 | ((and (= (length args) 1) | ||
| 55 | (stringp (car args))) | ||
| 56 | `((,(use-package-as-mode name) ,(car args) ,name))) | ||
| 57 | ((and (= (length args) 1) | ||
| 58 | (listp (car args)) | ||
| 59 | (eq 'quote (caar args))) | ||
| 60 | `((,(use-package-as-mode name) ,@(cdar args) ,name))) | ||
| 61 | ((and (= (length args) 2) | ||
| 62 | (listp (nth 1 args)) | ||
| 63 | (eq 'quote (car (nth 1 args)))) | ||
| 64 | `((,(car args) ,@(cdr (nth 1 args)) ,name))) | ||
| 65 | (t (mapcar | ||
| 66 | (apply-partially #'use-package-normalize-delight name) | ||
| 67 | (if (use-package-non-nil-symbolp (car args)) | ||
| 68 | (list args) | ||
| 69 | args))))) | ||
| 70 | |||
| 71 | ;;;###autoload | ||
| 72 | (defun use-package-handler/:delight (name _keyword args rest state) | ||
| 73 | (let ((body (use-package-process-keywords name rest state))) | ||
| 74 | (use-package-concat | ||
| 75 | body | ||
| 76 | `((if (fboundp 'delight) | ||
| 77 | (delight '(,@args))))))) | ||
| 78 | |||
| 79 | (add-to-list 'use-package-keywords :delight t) | ||
| 80 | |||
| 81 | (provide 'use-package-delight) | ||
| 82 | |||
| 83 | ;;; use-package-delight.el ends here | ||
diff --git a/lisp/use-package/use-package-diminish.el b/lisp/use-package/use-package-diminish.el new file mode 100644 index 00000000000..9b8a09a2973 --- /dev/null +++ b/lisp/use-package/use-package-diminish.el | |||
| @@ -0,0 +1,72 @@ | |||
| 1 | ;;; use-package-diminish.el --- Support for the :diminish keyword -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2012-2022 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: John Wiegley <johnw@newartisans.com> | ||
| 6 | ;; Maintainer: John Wiegley <johnw@newartisans.com> | ||
| 7 | |||
| 8 | ;; This program is free software; you can redistribute it and/or modify | ||
| 9 | ;; it under the terms of the GNU General Public License as published by | ||
| 10 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 11 | ;; (at your option) any later version. | ||
| 12 | |||
| 13 | ;; This program is distributed in the hope that it will be useful, | ||
| 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 16 | ;; GNU General Public License for more details. | ||
| 17 | |||
| 18 | ;; You should have received a copy of the GNU General Public License | ||
| 19 | ;; along with this program. If not, see <https://www.gnu.org/licenses/>. | ||
| 20 | |||
| 21 | ;;; Commentary: | ||
| 22 | |||
| 23 | ;; Provides support for the :diminish keyword, which is made available by | ||
| 24 | ;; default by requiring `use-package'. | ||
| 25 | |||
| 26 | ;;; Code: | ||
| 27 | |||
| 28 | (require 'use-package-core) | ||
| 29 | |||
| 30 | (defun use-package-normalize-diminish (name label arg &optional recursed) | ||
| 31 | "Normalize the arguments to diminish down to a list of one of two forms: | ||
| 32 | SYMBOL | ||
| 33 | (SYMBOL . STRING)" | ||
| 34 | (cond | ||
| 35 | ((not arg) | ||
| 36 | (list (use-package-as-mode name))) | ||
| 37 | ((use-package-non-nil-symbolp arg) | ||
| 38 | (list arg)) | ||
| 39 | ((stringp arg) | ||
| 40 | (list (cons (use-package-as-mode name) arg))) | ||
| 41 | ((and (consp arg) (stringp (cdr arg))) | ||
| 42 | (list arg)) | ||
| 43 | ((and (not recursed) (listp arg) (listp (cdr arg))) | ||
| 44 | (mapcar #'(lambda (x) (car (use-package-normalize-diminish | ||
| 45 | name label x t))) arg)) | ||
| 46 | (t | ||
| 47 | (use-package-error | ||
| 48 | (concat label " wants a string, symbol, " | ||
| 49 | "(symbol . string) or list of these"))))) | ||
| 50 | |||
| 51 | ;;;###autoload | ||
| 52 | (defun use-package-normalize/:diminish (name keyword args) | ||
| 53 | (use-package-as-one (symbol-name keyword) args | ||
| 54 | (apply-partially #'use-package-normalize-diminish name) t)) | ||
| 55 | |||
| 56 | ;;;###autoload | ||
| 57 | (defun use-package-handler/:diminish (name _keyword arg rest state) | ||
| 58 | (let ((body (use-package-process-keywords name rest state))) | ||
| 59 | (use-package-concat | ||
| 60 | (mapcar #'(lambda (var) | ||
| 61 | `(if (fboundp 'diminish) | ||
| 62 | ,(if (consp var) | ||
| 63 | `(diminish ',(car var) ,(cdr var)) | ||
| 64 | `(diminish ',var)))) | ||
| 65 | arg) | ||
| 66 | body))) | ||
| 67 | |||
| 68 | (add-to-list 'use-package-keywords :diminish t) | ||
| 69 | |||
| 70 | (provide 'use-package-diminish) | ||
| 71 | |||
| 72 | ;;; use-package-diminish.el ends here | ||
diff --git a/lisp/use-package/use-package-ensure-system-package.el b/lisp/use-package/use-package-ensure-system-package.el new file mode 100644 index 00000000000..9c9f0797a05 --- /dev/null +++ b/lisp/use-package/use-package-ensure-system-package.el | |||
| @@ -0,0 +1,99 @@ | |||
| 1 | ;;; use-package-ensure-system-package.el --- auto install system packages -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2022 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Justin Talbott <justin@waymondo.com> | ||
| 6 | ;; Keywords: convenience, tools, extensions | ||
| 7 | ;; URL: https://github.com/waymondo/use-package-ensure-system-package | ||
| 8 | ;; Version: 0.2 | ||
| 9 | ;; Package-Requires: ((use-package "2.1") (system-packages "1.0.4")) | ||
| 10 | ;; Filename: use-package-ensure-system-package.el | ||
| 11 | |||
| 12 | ;; This program is free software; you can redistribute it and/or modify | ||
| 13 | ;; it under the terms of the GNU General Public License as published by | ||
| 14 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 15 | ;; (at your option) any later version. | ||
| 16 | |||
| 17 | ;; This program is distributed in the hope that it will be useful, | ||
| 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 20 | ;; GNU General Public License for more details. | ||
| 21 | |||
| 22 | ;; You should have received a copy of the GNU General Public License | ||
| 23 | ;; along with this program. If not, see <https://www.gnu.org/licenses/>. | ||
| 24 | |||
| 25 | ;;; Commentary: | ||
| 26 | ;; | ||
| 27 | ;; The `:ensure-system-package` keyword allows you to ensure system | ||
| 28 | ;; binaries exist alongside your `use-package` declarations. | ||
| 29 | ;; | ||
| 30 | |||
| 31 | ;;; Code: | ||
| 32 | |||
| 33 | (require 'use-package) | ||
| 34 | (require 'system-packages nil t) | ||
| 35 | |||
| 36 | (eval-when-compile | ||
| 37 | (declare-function system-packages-get-command "system-packages")) | ||
| 38 | |||
| 39 | (defvar use-package-ensure-system-package--custom-packages '() | ||
| 40 | "List of custom packages installed.") | ||
| 41 | |||
| 42 | (defun use-package-ensure-system-package-consify (arg) | ||
| 43 | "Turn ARG into a cons of (`package-name' . `install-command')." | ||
| 44 | (cond | ||
| 45 | ((stringp arg) | ||
| 46 | (cons arg `(system-packages-install ,arg))) | ||
| 47 | ((symbolp arg) | ||
| 48 | (cons arg `(system-packages-install ,(symbol-name arg)))) | ||
| 49 | ((consp arg) | ||
| 50 | (cond | ||
| 51 | ((not (cdr arg)) | ||
| 52 | (use-package-ensure-system-package-consify (car arg))) | ||
| 53 | ((stringp (cdr arg)) | ||
| 54 | (progn | ||
| 55 | (push (cdr arg) use-package-ensure-system-package--custom-packages) | ||
| 56 | (cons (car arg) `(async-shell-command ,(cdr arg))))) | ||
| 57 | (t | ||
| 58 | (cons (car arg) | ||
| 59 | `(system-packages-install ,(symbol-name (cdr arg))))))))) | ||
| 60 | |||
| 61 | (defun use-package-ensure-system-package-update-custom-packages () | ||
| 62 | (interactive) | ||
| 63 | (dolist (cmd use-package-ensure-system-package--custom-packages) | ||
| 64 | (async-shell-command cmd))) | ||
| 65 | |||
| 66 | ;;;###autoload | ||
| 67 | (defun use-package-normalize/:ensure-system-package (_name-symbol keyword args) | ||
| 68 | "Turn ARGS into a list of conses of (`package-name' . `install-command')." | ||
| 69 | (use-package-as-one (symbol-name keyword) args | ||
| 70 | (lambda (_label arg) | ||
| 71 | (cond | ||
| 72 | ((and (listp arg) (listp (cdr arg))) | ||
| 73 | (mapcar #'use-package-ensure-system-package-consify arg)) | ||
| 74 | (t | ||
| 75 | (list (use-package-ensure-system-package-consify arg))))))) | ||
| 76 | |||
| 77 | (defun use-package-ensure-system-package-exists? (file-or-exe) | ||
| 78 | "If variable is a string, ensure the file path exists. | ||
| 79 | If it is a symbol, ensure the binary exist." | ||
| 80 | (if (stringp file-or-exe) | ||
| 81 | (file-exists-p file-or-exe) | ||
| 82 | (executable-find (symbol-name file-or-exe)))) | ||
| 83 | |||
| 84 | |||
| 85 | ;;;###autoload | ||
| 86 | (defun use-package-handler/:ensure-system-package (name _keyword arg rest state) | ||
| 87 | "Execute the handler for `:ensure-system-package' keyword in `use-package'." | ||
| 88 | (let ((body (use-package-process-keywords name rest state))) | ||
| 89 | (use-package-concat | ||
| 90 | (mapcar #'(lambda (cons) | ||
| 91 | `(unless (use-package-ensure-system-package-exists? ',(car cons)) | ||
| 92 | ,(cdr cons))) arg) | ||
| 93 | body))) | ||
| 94 | |||
| 95 | (add-to-list 'use-package-keywords :ensure-system-package t) | ||
| 96 | |||
| 97 | (provide 'use-package-ensure-system-package) | ||
| 98 | |||
| 99 | ;;; use-package-ensure-system-package.el ends here | ||
diff --git a/lisp/use-package/use-package-ensure.el b/lisp/use-package/use-package-ensure.el new file mode 100644 index 00000000000..c9cc6e70c51 --- /dev/null +++ b/lisp/use-package/use-package-ensure.el | |||
| @@ -0,0 +1,206 @@ | |||
| 1 | ;;; use-package-ensure.el --- Support for the :ensure and :pin keywords -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2012-2022 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: John Wiegley <johnw@newartisans.com> | ||
| 6 | ;; Maintainer: John Wiegley <johnw@newartisans.com> | ||
| 7 | |||
| 8 | ;; This program is free software; you can redistribute it and/or modify | ||
| 9 | ;; it under the terms of the GNU General Public License as published by | ||
| 10 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 11 | ;; (at your option) any later version. | ||
| 12 | |||
| 13 | ;; This program is distributed in the hope that it will be useful, | ||
| 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 16 | ;; GNU General Public License for more details. | ||
| 17 | |||
| 18 | ;; You should have received a copy of the GNU General Public License | ||
| 19 | ;; along with this program. If not, see <https://www.gnu.org/licenses/>. | ||
| 20 | |||
| 21 | ;;; Commentary: | ||
| 22 | |||
| 23 | ;; Provides support for the :ensure and :pin keywords, which is made available | ||
| 24 | ;; by default by requiring `use-package'. | ||
| 25 | |||
| 26 | ;;; Code: | ||
| 27 | |||
| 28 | (require 'cl-lib) | ||
| 29 | (require 'use-package-core) | ||
| 30 | |||
| 31 | (defgroup use-package-ensure nil | ||
| 32 | "Support for :ensure and :pin keywords in `use-package' declarations." | ||
| 33 | :group 'use-package) | ||
| 34 | |||
| 35 | (eval-when-compile | ||
| 36 | (declare-function package-installed-p "package") | ||
| 37 | (declare-function package-read-all-archive-contents "package" ())) | ||
| 38 | |||
| 39 | (defcustom use-package-always-ensure nil | ||
| 40 | "Treat every package as though it had specified using `:ensure SEXP'. | ||
| 41 | See also `use-package-defaults', which uses this value." | ||
| 42 | :type 'sexp | ||
| 43 | :group 'use-package-ensure) | ||
| 44 | |||
| 45 | (defcustom use-package-always-pin nil | ||
| 46 | "Treat every package as though it had specified using `:pin SYM'. | ||
| 47 | See also `use-package-defaults', which uses this value." | ||
| 48 | :type 'symbol | ||
| 49 | :group 'use-package-ensure) | ||
| 50 | |||
| 51 | (defcustom use-package-ensure-function 'use-package-ensure-elpa | ||
| 52 | "Function that ensures a package is installed. | ||
| 53 | This function is called with three arguments: the name of the | ||
| 54 | package declared in the `use-package' form; the arguments passed | ||
| 55 | to all `:ensure' keywords (always a list, even if only one); and | ||
| 56 | the current `state' plist created by previous handlers. | ||
| 57 | |||
| 58 | Note that this function is called whenever `:ensure' is provided, | ||
| 59 | even if it is nil. It is up to the function to decide on the | ||
| 60 | semantics of the various values for `:ensure'. | ||
| 61 | |||
| 62 | This function should return non-nil if the package is installed. | ||
| 63 | |||
| 64 | The default value uses package.el to install the package." | ||
| 65 | :type '(choice (const :tag "package.el" use-package-ensure-elpa) | ||
| 66 | (function :tag "Custom")) | ||
| 67 | :group 'use-package-ensure) | ||
| 68 | |||
| 69 | ;;;; :pin | ||
| 70 | |||
| 71 | (defun use-package-normalize/:pin (_name keyword args) | ||
| 72 | (use-package-only-one (symbol-name keyword) args | ||
| 73 | #'(lambda (_label arg) | ||
| 74 | (cond | ||
| 75 | ((stringp arg) arg) | ||
| 76 | ((use-package-non-nil-symbolp arg) (symbol-name arg)) | ||
| 77 | (t | ||
| 78 | (use-package-error | ||
| 79 | ":pin wants an archive name (a string)")))))) | ||
| 80 | |||
| 81 | (eval-when-compile | ||
| 82 | (defvar package-pinned-packages) | ||
| 83 | (defvar package-archives)) | ||
| 84 | |||
| 85 | (defun use-package-archive-exists-p (archive) | ||
| 86 | "Check if a given ARCHIVE is enabled. | ||
| 87 | |||
| 88 | ARCHIVE can be a string or a symbol or `manual' to indicate a | ||
| 89 | manually updated package." | ||
| 90 | (if (member archive '(manual "manual")) | ||
| 91 | 't | ||
| 92 | (let ((valid nil)) | ||
| 93 | (dolist (pa package-archives) | ||
| 94 | (when (member archive (list (car pa) (intern (car pa)))) | ||
| 95 | (setq valid 't))) | ||
| 96 | valid))) | ||
| 97 | |||
| 98 | (defun use-package-pin-package (package archive) | ||
| 99 | "Pin PACKAGE to ARCHIVE." | ||
| 100 | (unless (boundp 'package-pinned-packages) | ||
| 101 | (setq package-pinned-packages ())) | ||
| 102 | (let ((archive-symbol (if (symbolp archive) archive (intern archive))) | ||
| 103 | (archive-name (if (stringp archive) archive (symbol-name archive)))) | ||
| 104 | (if (use-package-archive-exists-p archive-symbol) | ||
| 105 | (add-to-list 'package-pinned-packages (cons package archive-name)) | ||
| 106 | (error "Archive '%s' requested for package '%s' is not available" | ||
| 107 | archive-name package)) | ||
| 108 | (unless (bound-and-true-p package--initialized) | ||
| 109 | (package-initialize t)))) | ||
| 110 | |||
| 111 | (defun use-package-handler/:pin (name _keyword archive-name rest state) | ||
| 112 | (let ((body (use-package-process-keywords name rest state)) | ||
| 113 | (pin-form (if archive-name | ||
| 114 | `(use-package-pin-package ',(use-package-as-symbol name) | ||
| 115 | ,archive-name)))) | ||
| 116 | ;; Pinning should occur just before ensuring | ||
| 117 | ;; See `use-package-handler/:ensure'. | ||
| 118 | (if (bound-and-true-p byte-compile-current-file) | ||
| 119 | (eval pin-form) ; Eval when byte-compiling, | ||
| 120 | (push pin-form body)) ; or else wait until runtime. | ||
| 121 | body)) | ||
| 122 | |||
| 123 | ;;;; :ensure | ||
| 124 | |||
| 125 | (defvar package-archive-contents) | ||
| 126 | |||
| 127 | ;;;###autoload | ||
| 128 | (defun use-package-normalize/:ensure (_name keyword args) | ||
| 129 | (if (null args) | ||
| 130 | (list t) | ||
| 131 | (use-package-only-one (symbol-name keyword) args | ||
| 132 | #'(lambda (_label arg) | ||
| 133 | (cond | ||
| 134 | ((symbolp arg) | ||
| 135 | (list arg)) | ||
| 136 | ((and (listp arg) (= 3 (length arg)) | ||
| 137 | (symbolp (nth 0 arg)) | ||
| 138 | (eq :pin (nth 1 arg)) | ||
| 139 | (or (stringp (nth 2 arg)) | ||
| 140 | (symbolp (nth 2 arg)))) | ||
| 141 | (list (cons (nth 0 arg) (nth 2 arg)))) | ||
| 142 | (t | ||
| 143 | (use-package-error | ||
| 144 | (concat ":ensure wants an optional package name " | ||
| 145 | "(an unquoted symbol name), or (<symbol> :pin <string>)")))))))) | ||
| 146 | |||
| 147 | (defun use-package-ensure-elpa (name args _state &optional _no-refresh) | ||
| 148 | (dolist (ensure args) | ||
| 149 | (let ((package | ||
| 150 | (or (and (eq ensure t) (use-package-as-symbol name)) | ||
| 151 | ensure))) | ||
| 152 | (when package | ||
| 153 | (require 'package) | ||
| 154 | (when (consp package) | ||
| 155 | (use-package-pin-package (car package) (cdr package)) | ||
| 156 | (setq package (car package))) | ||
| 157 | (unless (package-installed-p package) | ||
| 158 | (condition-case-unless-debug err | ||
| 159 | (progn | ||
| 160 | (when (assoc package (bound-and-true-p | ||
| 161 | package-pinned-packages)) | ||
| 162 | (package-read-all-archive-contents)) | ||
| 163 | (if (assoc package package-archive-contents) | ||
| 164 | (package-install package) | ||
| 165 | (package-refresh-contents) | ||
| 166 | (when (assoc package (bound-and-true-p | ||
| 167 | package-pinned-packages)) | ||
| 168 | (package-read-all-archive-contents)) | ||
| 169 | (package-install package)) | ||
| 170 | t) | ||
| 171 | (error | ||
| 172 | (display-warning 'use-package | ||
| 173 | (format "Failed to install %s: %s" | ||
| 174 | name (error-message-string err)) | ||
| 175 | :error)))))))) | ||
| 176 | |||
| 177 | ;;;###autoload | ||
| 178 | (defun use-package-handler/:ensure (name _keyword ensure rest state) | ||
| 179 | (let* ((body (use-package-process-keywords name rest state))) | ||
| 180 | ;; We want to avoid installing packages when the `use-package' macro is | ||
| 181 | ;; being macro-expanded by elisp completion (see `lisp--local-variables'), | ||
| 182 | ;; but still install packages when byte-compiling, to avoid requiring | ||
| 183 | ;; `package' at runtime. | ||
| 184 | (if (bound-and-true-p byte-compile-current-file) | ||
| 185 | ;; Eval when byte-compiling, | ||
| 186 | (funcall use-package-ensure-function name ensure state) | ||
| 187 | ;; or else wait until runtime. | ||
| 188 | (push `(,use-package-ensure-function ',name ',ensure ',state) | ||
| 189 | body)) | ||
| 190 | body)) | ||
| 191 | |||
| 192 | (add-to-list 'use-package-defaults | ||
| 193 | '(:ensure (list use-package-always-ensure) | ||
| 194 | (lambda (name args) | ||
| 195 | (and use-package-always-ensure | ||
| 196 | (not (plist-member args :load-path))))) t) | ||
| 197 | |||
| 198 | (add-to-list 'use-package-defaults | ||
| 199 | '(:pin use-package-always-pin use-package-always-pin) t) | ||
| 200 | |||
| 201 | (add-to-list 'use-package-keywords :ensure) | ||
| 202 | (add-to-list 'use-package-keywords :pin) | ||
| 203 | |||
| 204 | (provide 'use-package-ensure) | ||
| 205 | |||
| 206 | ;;; use-package-ensure.el ends here | ||
diff --git a/lisp/use-package/use-package-jump.el b/lisp/use-package/use-package-jump.el new file mode 100644 index 00000000000..0c4cd20d052 --- /dev/null +++ b/lisp/use-package/use-package-jump.el | |||
| @@ -0,0 +1,70 @@ | |||
| 1 | ;;; use-package-jump.el --- Attempt to jump to a use-package declaration -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2012-2022 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: John Wiegley <johnw@newartisans.com> | ||
| 6 | ;; Maintainer: John Wiegley <johnw@newartisans.com> | ||
| 7 | |||
| 8 | ;; This program is free software; you can redistribute it and/or modify | ||
| 9 | ;; it under the terms of the GNU General Public License as published by | ||
| 10 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 11 | ;; (at your option) any later version. | ||
| 12 | |||
| 13 | ;; This program is distributed in the hope that it will be useful, | ||
| 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 16 | ;; GNU General Public License for more details. | ||
| 17 | |||
| 18 | ;; You should have received a copy of the GNU General Public License | ||
| 19 | ;; along with this program. If not, see <https://www.gnu.org/licenses/>. | ||
| 20 | |||
| 21 | ;;; Commentary: | ||
| 22 | |||
| 23 | ;; Provides the command `M-x use-package-jump-to-package-form', however it | ||
| 24 | ;; only works if the package being jumped to was required during | ||
| 25 | ;; initialization. If it was delay-loaded, it will not work. | ||
| 26 | ;; Improvements are needed. | ||
| 27 | |||
| 28 | ;;; Code: | ||
| 29 | |||
| 30 | (require 'use-package-core) | ||
| 31 | |||
| 32 | (defun use-package-find-require (package) | ||
| 33 | "Find file that required PACKAGE by searching `load-history'. | ||
| 34 | Returns an absolute file path or nil if none is found." | ||
| 35 | (catch 'suspect | ||
| 36 | (dolist (filespec load-history) | ||
| 37 | (dolist (entry (cdr filespec)) | ||
| 38 | (when (equal entry (cons 'require package)) | ||
| 39 | (throw 'suspect (car filespec))))))) | ||
| 40 | |||
| 41 | ;;;###autoload | ||
| 42 | (defun use-package-jump-to-package-form (package) | ||
| 43 | "Attempt to find and jump to the `use-package' form that loaded PACKAGE. | ||
| 44 | This will only find the form if that form actually required | ||
| 45 | PACKAGE. If PACKAGE was previously required then this function | ||
| 46 | will jump to the file that originally required PACKAGE instead." | ||
| 47 | (interactive (list (completing-read "Package: " features))) | ||
| 48 | (let* ((package (if (stringp package) (intern package) package)) | ||
| 49 | (requiring-file (use-package-find-require package)) | ||
| 50 | file location) | ||
| 51 | (if (null requiring-file) | ||
| 52 | (user-error "Can't find file requiring file; may have been autoloaded") | ||
| 53 | (setq file (if (string= (file-name-extension requiring-file) "elc") | ||
| 54 | (concat (file-name-sans-extension requiring-file) ".el") | ||
| 55 | requiring-file)) | ||
| 56 | (when (file-exists-p file) | ||
| 57 | (find-file-other-window file) | ||
| 58 | (save-excursion | ||
| 59 | (goto-char (point-min)) | ||
| 60 | (setq location | ||
| 61 | (re-search-forward | ||
| 62 | (format (eval use-package-form-regexp-eval) package) nil t))) | ||
| 63 | (if (null location) | ||
| 64 | (message "No use-package form found.") | ||
| 65 | (goto-char location) | ||
| 66 | (beginning-of-line)))))) | ||
| 67 | |||
| 68 | (provide 'use-package-jump) | ||
| 69 | |||
| 70 | ;;; use-package-jump.el ends here | ||
diff --git a/lisp/use-package/use-package-lint.el b/lisp/use-package/use-package-lint.el new file mode 100644 index 00000000000..2092c0d269c --- /dev/null +++ b/lisp/use-package/use-package-lint.el | |||
| @@ -0,0 +1,76 @@ | |||
| 1 | ;;; use-package-lint.el --- Attempt to find errors in use-package declarations -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2012-2022 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: John Wiegley <johnw@newartisans.com> | ||
| 6 | ;; Maintainer: John Wiegley <johnw@newartisans.com> | ||
| 7 | |||
| 8 | ;; This program is free software; you can redistribute it and/or modify | ||
| 9 | ;; it under the terms of the GNU General Public License as published by | ||
| 10 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 11 | ;; (at your option) any later version. | ||
| 12 | |||
| 13 | ;; This program is distributed in the hope that it will be useful, | ||
| 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 16 | ;; GNU General Public License for more details. | ||
| 17 | |||
| 18 | ;; You should have received a copy of the GNU General Public License | ||
| 19 | ;; along with this program. If not, see <https://www.gnu.org/licenses/>. | ||
| 20 | |||
| 21 | ;;; Commentary: | ||
| 22 | |||
| 23 | ;; Provides the command `M-x use-package-lint'. | ||
| 24 | |||
| 25 | ;;; Code: | ||
| 26 | |||
| 27 | (require 'cl-lib) | ||
| 28 | (require 'use-package-core) | ||
| 29 | |||
| 30 | (defun use-package-lint-declaration (name plist) | ||
| 31 | (dolist (path (plist-get plist :load-path)) | ||
| 32 | (unless (file-exists-p path) | ||
| 33 | (display-warning | ||
| 34 | 'use-package | ||
| 35 | (format "%s :load-path does not exist: %s" | ||
| 36 | name path) :error))) | ||
| 37 | |||
| 38 | (unless (or (plist-member plist :disabled) | ||
| 39 | (plist-get plist :no-require) | ||
| 40 | (locate-library (use-package-as-string name) nil | ||
| 41 | (plist-get plist :load-path))) | ||
| 42 | (display-warning | ||
| 43 | 'use-package | ||
| 44 | (format "%s module cannot be located" name) :error)) | ||
| 45 | |||
| 46 | ;; (dolist (command (plist-get plist :commands)) | ||
| 47 | ;; (unless (string= (find-lisp-object-file-name command nil) | ||
| 48 | ;; (locate-library (use-package-as-string name) nil | ||
| 49 | ;; (plist-get plist :load-path))) | ||
| 50 | ;; (display-warning | ||
| 51 | ;; 'use-package | ||
| 52 | ;; (format "%s :command is from different path: %s" | ||
| 53 | ;; name (symbol-name command)) :error))) | ||
| 54 | ) | ||
| 55 | |||
| 56 | ;;;###autoload | ||
| 57 | (defun use-package-lint () | ||
| 58 | "Check for errors in `use-package' declarations. | ||
| 59 | For example, if the module's `:if' condition is met, but even | ||
| 60 | with the specified `:load-path' the module cannot be found." | ||
| 61 | (interactive) | ||
| 62 | (save-excursion | ||
| 63 | (goto-char (point-min)) | ||
| 64 | (let ((re (eval use-package-form-regexp-eval))) | ||
| 65 | (while (re-search-forward re nil t) | ||
| 66 | (goto-char (match-beginning 0)) | ||
| 67 | (let ((decl (read (current-buffer)))) | ||
| 68 | (when (eq (car decl) 'use-package) | ||
| 69 | (use-package-lint-declaration | ||
| 70 | (use-package-as-string (cadr decl)) | ||
| 71 | (use-package-normalize-keywords | ||
| 72 | (cadr decl) (cddr decl))))))))) | ||
| 73 | |||
| 74 | (provide 'use-package-lint) | ||
| 75 | |||
| 76 | ;;; use-package-lint.el ends here | ||
diff --git a/lisp/use-package/use-package.el b/lisp/use-package/use-package.el new file mode 100644 index 00000000000..bafa0934a6d --- /dev/null +++ b/lisp/use-package/use-package.el | |||
| @@ -0,0 +1,51 @@ | |||
| 1 | ;;; use-package.el --- A configuration macro for simplifying your .emacs -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2012-2022 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: John Wiegley <johnw@newartisans.com> | ||
| 6 | ;; Maintainer: John Wiegley <johnw@newartisans.com> | ||
| 7 | ;; Created: 17 Jun 2012 | ||
| 8 | ;; Version: 2.4.4 | ||
| 9 | ;; Package-Requires: ((emacs "24.3") (bind-key "2.4")) | ||
| 10 | ;; Keywords: dotemacs startup speed config package extensions | ||
| 11 | ;; URL: https://github.com/jwiegley/use-package | ||
| 12 | |||
| 13 | ;; This program is free software; you can redistribute it and/or modify | ||
| 14 | ;; it under the terms of the GNU General Public License as published by | ||
| 15 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 16 | ;; (at your option) any later version. | ||
| 17 | |||
| 18 | ;; This program is distributed in the hope that it will be useful, | ||
| 19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 21 | ;; GNU General Public License for more details. | ||
| 22 | |||
| 23 | ;; You should have received a copy of the GNU General Public License | ||
| 24 | ;; along with this program. If not, see <https://www.gnu.org/licenses/>. | ||
| 25 | |||
| 26 | ;;; Commentary: | ||
| 27 | |||
| 28 | ;; The `use-package' declaration macro allows you to isolate package | ||
| 29 | ;; configuration in your ".emacs" in a way that is performance-oriented and, | ||
| 30 | ;; well, just tidy. I created it because I have over 80 packages that I use | ||
| 31 | ;; in Emacs, and things were getting difficult to manage. Yet with this | ||
| 32 | ;; utility my total load time is just under 1 second, with no loss of | ||
| 33 | ;; functionality! | ||
| 34 | ;; | ||
| 35 | ;; Please see README.md from the same repository for documentation. | ||
| 36 | |||
| 37 | ;;; Code: | ||
| 38 | |||
| 39 | (require 'use-package-core) | ||
| 40 | |||
| 41 | (require 'use-package-bind-key) | ||
| 42 | (require 'use-package-diminish) | ||
| 43 | (require 'use-package-delight) | ||
| 44 | (require 'use-package-ensure) | ||
| 45 | |||
| 46 | (declare-function use-package-jump-to-package-form "use-package-jump") | ||
| 47 | (autoload #'use-package-jump-to-package-form "use-package-jump" nil t) | ||
| 48 | |||
| 49 | (provide 'use-package) | ||
| 50 | |||
| 51 | ;;; use-package.el ends here | ||