masscollaborationlabs/emacs
2
0
Fork 0
mirror of https://github.com/masscollaborationlabs/emacs.git synced 2025-07-06 04:09:37 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Minor changes

Browse source
This commit is contained in:
John Wiegley 2015-03-13 03:02:47 -05:00
commit f334f230eb
2 changed files with 188 additions and 70 deletions
Download patch file Download diff file Expand all files Collapse all files

20
lisp/use-package/bind-key.el
View file

@ -41,7 +41,7 @@
;; ;;
;; (bind-key* "<C-return>" 'other-window) ;; (bind-key* "<C-return>" 'other-window)
;; ;;
;; If you want to rebind a key only in a particular key, use: ;; If you want to rebind a key only in a particular keymap, use:
;; ;;
;; (bind-key "C-c x" 'my-ctrl-c-x-command some-other-mode-map) ;; (bind-key "C-c x" 'my-ctrl-c-x-command some-other-mode-map)
;; ;;
@ -178,6 +178,7 @@ Accepts keyword arguments:
these bindings these bindings
:prefix - prefix key for these bindings :prefix - prefix key for these bindings
:prefix-docstring - docstring for the prefix-map variable :prefix-docstring - docstring for the prefix-map variable
:menu-name - optional menu string for prefix map
The rest of the arguments are conses of keybinding string and a The rest of the arguments are conses of keybinding string and a
function symbol (unquoted)." function symbol (unquoted)."
@ -185,6 +186,7 @@ function symbol (unquoted)."
(doc (plist-get args :prefix-docstring)) (doc (plist-get args :prefix-docstring))
(prefix-map (plist-get args :prefix-map)) (prefix-map (plist-get args :prefix-map))
(prefix (plist-get args :prefix)) (prefix (plist-get args :prefix))
(menu-name (plist-get args :menu-name))
(key-bindings (progn (key-bindings (progn
(while (keywordp (car args)) (while (keywordp (car args))
(pop args) (pop args)
@ -195,11 +197,15 @@ function symbol (unquoted)."
(and prefix (and prefix
(not prefix-map))) (not prefix-map)))
(error "Both :prefix-map and :prefix must be supplied")) (error "Both :prefix-map and :prefix must be supplied"))
(when (and menu-name (not prefix))
(error "If :menu-name is supplied, :prefix must be too"))
`(progn `(progn
,@(when prefix-map ,@(when prefix-map
`((defvar ,prefix-map) `((defvar ,prefix-map)
,@(when doc `((put ',prefix-map 'variable-documentation ,doc))) ,@(when doc `((put ',prefix-map 'variable-documentation ,doc)))
(define-prefix-command ',prefix-map) ,@(if menu-name
`((define-prefix-command ',prefix-map nil ,menu-name))
`((define-prefix-command ',prefix-map)))
(bind-key ,prefix ',prefix-map ,map))) (bind-key ,prefix ',prefix-map ,map)))
,@(mapcar (lambda (form) ,@(mapcar (lambda (form)
`(bind-key ,(car form) ',(cdr form) `(bind-key ,(car form) ',(cdr form)
@ -279,9 +285,9 @@ function symbol (unquoted)."
(dolist (binding (dolist (binding
(setq personal-keybindings (setq personal-keybindings
(sort personal-keybindings (sort personal-keybindings
#'(lambda (l r) (lambda (l r)
(car (compare-keybindings l r)))))) (car (compare-keybindings l r))))))
(if (not (eq (cdar last-binding) (cdar binding))) (if (not (eq (cdar last-binding) (cdar binding)))
(princ (format "\n\n%s\n%s\n\n" (princ (format "\n\n%s\n%s\n\n"
(cdar binding) (cdar binding)
@ -289,7 +295,7 @@ function symbol (unquoted)."
(if (and last-binding (if (and last-binding
(cdr (compare-keybindings last-binding binding))) (cdr (compare-keybindings last-binding binding)))
(princ "\n"))) (princ "\n")))
(let* ((key-name (caar binding)) (let* ((key-name (caar binding))
(at-present (lookup-key (or (symbol-value (cdar binding)) (at-present (lookup-key (or (symbol-value (cdar binding))
(current-global-map)) (current-global-map))
@ -314,7 +320,7 @@ function symbol (unquoted)."
(princ (if (string-match "[ \t]+\n" line) (princ (if (string-match "[ \t]+\n" line)
(replace-match "\n" t t line) (replace-match "\n" t t line)
line)))) line))))
(setq last-binding binding))))) (setq last-binding binding)))))
(provide 'bind-key) (provide 'bind-key)

238
lisp/use-package/use-package.el
View file

@ -41,20 +41,34 @@
(require 'bytecomp) (require 'bytecomp)
(require 'diminish nil t) (require 'diminish nil t)
(when (fboundp 'declare-function) (declare-function package-installed-p 'package)
(declare-function package-installed-p 'package))
(defgroup use-package nil (defgroup use-package nil
"A use-package declaration for simplifying your `.emacs'." "A use-package declaration for simplifying your `.emacs'."
:group 'startup) :group 'startup)
(defcustom use-package-verbose nil (defcustom use-package-verbose nil
"Whether to report about loading and configuration details." "Whether to report about loading and configuration details.
If you customize this, then you should require the `use-package'
feature in files that use one of the macros `use-package' or
`use-package-with-elapsed-timer', even if these files only
contain compiled expansions of the macros. If you don't do so,
then the expanded macros do their job silently."
:type 'boolean :type 'boolean
:group 'use-package) :group 'use-package)
(defcustom use-package-minimum-reported-time 0.01 (defcustom use-package-minimum-reported-time 0.01
"Minimal load time that will be reported" "Minimal load time that will be reported.
Note that `use-package-verbose' has to be set to t, for anything
to be reported at all.
If you customize this, then you should require the `use-package'
feature in files that use one of the macros `use-package' or
`use-package-with-elapsed-timer', even if these files only
contain compiled expansions of the macros. If you don't do so,
then the expanded macros do their job silently."
:type 'number :type 'number
:group 'use-package) :group 'use-package)
@ -66,13 +80,15 @@
(defmacro use-package-with-elapsed-timer (text &rest body) (defmacro use-package-with-elapsed-timer (text &rest body)
(declare (indent 1)) (declare (indent 1))
(let ((nowvar (make-symbol "now"))) (let ((nowvar (make-symbol "now")))
`(if use-package-verbose `(if (bound-and-true-p use-package-verbose)
(let ((,nowvar (current-time))) (let ((,nowvar (current-time)))
(message "%s..." ,text) (message "%s..." ,text)
(prog1 (progn ,@body) (prog1 (progn ,@body)
(let ((elapsed (let ((elapsed
(float-time (time-subtract (current-time) ,nowvar)))) (float-time (time-subtract (current-time) ,nowvar))))
(if (> elapsed ,use-package-minimum-reported-time) (if (> elapsed
(or (bound-and-true-p use-package-minimum-reported-time)
"0.01"))
(message "%s...done (%.3fs)" ,text elapsed) (message "%s...done (%.3fs)" ,text elapsed)
(message "%s...done" ,text))))) (message "%s...done" ,text)))))
,@body))) ,@body)))
@ -114,10 +130,10 @@ Return nil when the queue is empty."
(forms (gethash priority use-package-idle-forms)) (forms (gethash priority use-package-idle-forms))
(first-form (car forms)) (first-form (car forms))
(forms-remaining (cdr forms))) (forms-remaining (cdr forms)))
(if forms-remaining (if forms-remaining
(puthash priority forms-remaining use-package-idle-forms) (puthash priority forms-remaining use-package-idle-forms)
(remhash priority use-package-idle-forms)) (remhash priority use-package-idle-forms))
first-form)) first-form))
(defun use-package-idle-eval() (defun use-package-idle-eval()
"Start to eval idle-commands from the idle queue." "Start to eval idle-commands from the idle queue."
@ -140,32 +156,59 @@ Return nil when the queue is empty."
(cancel-timer use-package-idle-timer) (cancel-timer use-package-idle-timer)
(setq use-package-idle-timer nil)))) (setq use-package-idle-timer nil))))
(defun use-package-pin-package (package archive)
"Pin PACKAGE to ARCHIVE."
(unless (boundp 'package-pinned-packages)
(setq package-pinned-packages ()))
(let ((archive-symbol (if (symbolp archive) archive (intern archive)))
(archive-name (if (stringp archive) archive (symbol-name archive))))
(if (use-package--archive-exists-p archive-symbol)
(add-to-list 'package-pinned-packages (cons package archive-name))
(error (message "Archive '%s' requested for package '%s' is not available." archive-name package)))
(package-initialize t)))
(defun use-package--archive-exists-p (archive)
"Check if a given ARCHIVE is enabled.
ARCHIVE can be a string or a symbol or 'manual to indicate a manually updated package."
(if (member archive '(manual "manual"))
't
(let ((valid nil))
(dolist (pa package-archives)
(when (member archive (list (car pa) (intern (car pa))))
(setq valid 't)))
valid)))
(defun use-package-ensure-elpa (package) (defun use-package-ensure-elpa (package)
(when (not (package-installed-p package)) (when (not (package-installed-p package))
(package-install package))) (package-install package)))
(defvar use-package-keywords (defvar use-package-keywords
'( '(
:bind :bind
:commands :bind*
:config :commands
:defer :config
:defines :defer
:demand :defines
:diminish :demand
:disabled :diminish
:ensure :disabled
:idle :ensure
:idle-priority :idle
:if :idle-priority
:init :if
:interpreter :init
:load-path :interpreter
:mode :load-path
:pre-init :mode
:pre-load :pin
:requires :pre-init
) :pre-load
:requires
:bind-keymap
:bind-keymap*
)
"Keywords recognized by `use-package'.") "Keywords recognized by `use-package'.")
(defun use-package-mplist-get (plist prop) (defun use-package-mplist-get (plist prop)
@ -231,11 +274,11 @@ are all non-keywords elements that follow it."
"Error if any keyword given in ARGS is not recognized. "Error if any keyword given in ARGS is not recognized.
Return the list of recognized keywords." Return the list of recognized keywords."
(mapc (mapc
(function (function
(lambda (keyword) (lambda (keyword)
(unless (memq keyword use-package-keywords) (unless (memq keyword use-package-keywords)
(error "Unrecognized keyword: %s" keyword)))) (error "Unrecognized keyword: %s" keyword))))
(use-package-mplist-keys args))) (use-package-mplist-keys args)))
(defmacro use-package (name &rest args) (defmacro use-package (name &rest args)
"Use a package with configuration options. "Use a package with configuration options.
@ -248,6 +291,12 @@ For full documentation. please see commentary.
:init Code to run when `use-package' form evals. :init Code to run when `use-package' form evals.
:bind Perform key bindings, and define autoload for bound :bind Perform key bindings, and define autoload for bound
commands. commands.
:bind* Perform key bindings, and define autoload for bound
commands, overriding all minor mode bindings.
:bind-keymap Bind key prefix to an auto-loaded keymap that
is defined in the package. Like bind but for keymaps
instead of commands.
:bind-keymap* like bind-keymap, but overrides all minor mode bindings
:commands Define autoloads for given commands. :commands Define autoloads for given commands.
:pre-load Code to run when `use-package' form evals and before :pre-load Code to run when `use-package' form evals and before
anything else. Unlike :init this form runs before the anything else. Unlike :init this form runs before the
@ -255,7 +304,7 @@ For full documentation. please see commentary.
:mode Form to be added to `auto-mode-alist'. :mode Form to be added to `auto-mode-alist'.
:interpreter Form to be added to `interpreter-mode-alist'. :interpreter Form to be added to `interpreter-mode-alist'.
:defer Defer loading of package -- automatic :defer Defer loading of package -- automatic
if :commands, :bind, :mode or :interpreter are used. if :commands, :bind, :bind*, :mode or :interpreter are used.
:demand Prevent deferred loading in all cases. :demand Prevent deferred loading in all cases.
:config Runs if and when package loads. :config Runs if and when package loads.
:if Conditional loading. :if Conditional loading.
@ -268,7 +317,8 @@ For full documentation. please see commentary.
priority (lower priorities run first). Default priority priority (lower priorities run first). Default priority
is 5; forms with the same priority are run in the order in is 5; forms with the same priority are run in the order in
which they are evaluated. which they are evaluated.
:ensure loads package using package.el if necessary." :ensure loads package using package.el if necessary.
:pin pin package to archive."
(use-package-validate-keywords args) ; error if any bad keyword, ignore result (use-package-validate-keywords args) ; error if any bad keyword, ignore result
(let* ((commands (use-package-plist-get args :commands t t)) (let* ((commands (use-package-plist-get args :commands t t))
(pre-init-body (use-package-plist-get args :pre-init)) (pre-init-body (use-package-plist-get args :pre-init))
@ -280,6 +330,9 @@ For full documentation. please see commentary.
(idle-body (use-package-plist-get args :idle)) (idle-body (use-package-plist-get args :idle))
(idle-priority (use-package-plist-get args :idle-priority)) (idle-priority (use-package-plist-get args :idle-priority))
(keybindings-alist (use-package-plist-get args :bind t t)) (keybindings-alist (use-package-plist-get args :bind t t))
(overriding-keybindings-alist (use-package-plist-get args :bind* t t))
(keymap-alist (use-package-plist-get args :bind-keymap t t))
(overriding-keymap-alist (use-package-plist-get args :bind-keymap* t t))
(mode (use-package-plist-get args :mode t t)) (mode (use-package-plist-get args :mode t t))
(mode-alist (mode-alist
(if (stringp mode) (cons mode name) mode)) (if (stringp mode) (cons mode name) mode))
@ -288,6 +341,7 @@ For full documentation. please see commentary.
(if (stringp interpreter) (cons interpreter name) interpreter)) (if (stringp interpreter) (cons interpreter name) interpreter))
(predicate (use-package-plist-get args :if)) (predicate (use-package-plist-get args :if))
(pkg-load-path (use-package-plist-get args :load-path t t)) (pkg-load-path (use-package-plist-get args :load-path t t))
(archive-name (use-package-plist-get args :pin))
(defines-eval (if (null defines) (defines-eval (if (null defines)
nil nil
(if (listp defines) (if (listp defines)
@ -306,6 +360,9 @@ For full documentation. please see commentary.
;; force this immediately -- one off cost ;; force this immediately -- one off cost
(unless (use-package-plist-get args :disabled) (unless (use-package-plist-get args :disabled)
(when archive-name
(use-package-pin-package name archive-name))
(let* ((ensure (use-package-plist-get args :ensure)) (let* ((ensure (use-package-plist-get args :ensure))
(package-name (package-name
(or (and (eq ensure t) (or (and (eq ensure t)
@ -350,9 +407,8 @@ For full documentation. please see commentary.
(use-package-init-on-idle (lambda () ,idle-body) ,idle-priority) (use-package-init-on-idle (lambda () ,idle-body) ,idle-priority)
,init-body))) ,init-body)))
(let ((init-for-commands-or-keymaps
(let ((init-for-commands (lambda (func sym-or-list &optional keymap)
(lambda (func sym-or-list)
(let ((cons-list (if (and (consp sym-or-list) (let ((cons-list (if (and (consp sym-or-list)
(stringp (car sym-or-list))) (stringp (car sym-or-list)))
(list sym-or-list) (list sym-or-list)
@ -361,37 +417,66 @@ For full documentation. please see commentary.
(setq init-body (setq init-body
`(progn `(progn
,init-body ,init-body
,@(mapcar #'(lambda (elem) ,@(mapcar (lambda (elem)
(push (cdr elem) commands) (when (not keymap)
(funcall func elem)) (push (cdr elem) commands))
(funcall func elem))
cons-list)))))))) cons-list))))))))
(funcall init-for-commands (funcall init-for-commands-or-keymaps
#'(lambda (binding) (lambda (binding)
`(bind-key ,(car binding) `(bind-key ,(car binding)
(quote ,(cdr binding)))) (lambda () (interactive)
(use-package-autoload-keymap
(quote ,(cdr binding))
,(if (stringp name) name `',name)
nil))))
keymap-alist
t)
(funcall init-for-commands-or-keymaps
(lambda (binding)
`(bind-key ,(car binding)
(lambda () (interactive)
(use-package-autoload-keymap
(quote ,(cdr binding))
,(if (stringp name) name `',name)
t))))
overriding-keymap-alist
t)
(funcall init-for-commands-or-keymaps
(lambda (binding)
`(bind-key ,(car binding)
(quote ,(cdr binding))))
keybindings-alist) keybindings-alist)
(funcall init-for-commands (funcall init-for-commands-or-keymaps
#'(lambda (mode) (lambda (binding)
`(add-to-list 'auto-mode-alist `(bind-key* ,(car binding)
(quote ,mode))) (quote ,(cdr binding))))
overriding-keybindings-alist)
(funcall init-for-commands-or-keymaps
(lambda (mode)
`(add-to-list 'auto-mode-alist
(quote ,mode)))
mode-alist) mode-alist)
(funcall init-for-commands (funcall init-for-commands-or-keymaps
#'(lambda (interpreter) (lambda (interpreter)
`(add-to-list 'interpreter-mode-alist `(add-to-list 'interpreter-mode-alist
(quote ,interpreter))) (quote ,interpreter)))
interpreter-alist)) interpreter-alist))
`(progn `(progn
,pre-load-body ,pre-load-body
,@(mapcar ,@(mapcar
#'(lambda (path) (lambda (path)
`(add-to-list 'load-path `(add-to-list 'load-path
,(if (file-name-absolute-p path) ,(if (file-name-absolute-p path)
path path
(expand-file-name path user-emacs-directory)))) (expand-file-name path user-emacs-directory))))
(cond ((stringp pkg-load-path) (cond ((stringp pkg-load-path)
(list pkg-load-path)) (list pkg-load-path))
((functionp pkg-load-path) ((functionp pkg-load-path)
@ -411,9 +496,11 @@ For full documentation. please see commentary.
,(if (and (or commands (use-package-plist-get args :defer)) ,(if (and (or commands (use-package-plist-get args :defer))
(not (use-package-plist-get args :demand))) (not (use-package-plist-get args :demand)))
(let (form) (let (form)
(mapc #'(lambda (command) (mapc (lambda (command)
(push `(autoload (function ,command) (push `(unless (fboundp (quote ,command))
,name-string nil t) form)) (autoload (function ,command)
,name-string nil t))
form))
commands) commands)
`(when ,(or predicate t) `(when ,(or predicate t)
@ -441,6 +528,31 @@ For full documentation. please see commentary.
,config-body ,config-body
t)))))))) t))))))))
(defun use-package-autoload-keymap (keymap-symbol package override)
"Loads PACKAGE and then binds the key sequence used to invoke this function to
KEYMAP-SYMBOL. It then simulates pressing the same key sequence a again, so
that the next key pressed is routed to the newly loaded keymap.
This function supports use-package's :bind-keymap keyword. It works
by binding the given key sequence to an invocation of this function for a
particular keymap. The keymap is expected to be defined by the package. In
this way, loading the package is deferred until the prefix key sequence is
pressed."
(if (if (stringp package) (load package t) (require package nil t))
(if (and (boundp keymap-symbol) (keymapp (symbol-value keymap-symbol)))
(let ((key (key-description (this-command-keys-vector)))
(keymap (symbol-value keymap-symbol)))
(progn
(if override
`(eval `(bind-key* ,key ,keymap)) ; eval form is necessary to avoid compiler error
(bind-key key keymap))
(setq unread-command-events
(listify-key-sequence (this-command-keys-vector)))))
(error
"use-package: package %s failed to define keymap %s"
package keymap-symbol))
(error "Could not load package %s" package)))
(put 'use-package 'lisp-indent-function 'defun) (put 'use-package 'lisp-indent-function 'defun)
(defconst use-package-font-lock-keywords (defconst use-package-font-lock-keywords