Merge pull request from waymondo/use-package-chords-autoloading-and-mapping-improvements

GitHub-reference: https://github.com/jwiegley/use-package/issues/778
This commit is contained in:
John Wiegley 2022-08-07 08:56:56 -07:00 committed by GitHub
commit b1fbfe66eb
3 changed files with 225 additions and 23 deletions

View file

@ -1,11 +1,11 @@
;;; bind-chord.el --- key-chord binding helper for use-package-chords -*- lexical-binding: t; -*-
;; Copyright (C) 2015-2017 Justin Talbott
;; Copyright (C) 2015-2019 Justin Talbott
;; Author: Justin Talbott <justin@waymondo.com>
;; Keywords: convenience, tools, extensions
;; URL: https://github.com/waymondo/use-package-chords
;; Version: 0.2
;; URL: https://github.com/jwiegley/use-package
;; Version: 0.2.1
;; Package-Requires: ((bind-key "1.0") (key-chord "0.6"))
;; Filename: bind-chord.el
;; License: GNU General Public License version 3, or (at your option) any later version
@ -30,6 +30,63 @@
(bind-key (vector 'key-chord ,key1 ,key2) ,command ,keymap)
(bind-key (vector 'key-chord ,key2 ,key1) ,command ,keymap)))))
(defun bind-chords-form (args keymap)
"Bind multiple chords at once.
Accepts keyword arguments:
:map MAP - a keymap into which the keybindings should be
added
The rest of the arguments are conses of keybinding string and a
function symbol (unquoted)."
(let (map pkg)
(let ((cont t))
(while (and cont args)
(if (cond ((eq :map (car args))
(setq map (cadr args)))
((eq :package (car args))
(setq pkg (cadr args))))
(setq args (cddr args))
(setq cont nil))))
(unless map (setq map keymap))
(let (first next)
(while args
(if (keywordp (car args))
(progn
(setq next args)
(setq args nil))
(if first
(nconc first (list (car args)))
(setq first (list (car args))))
(setq args (cdr args))))
(cl-flet
((wrap (map bindings)
(if (and map pkg (not (memq map '(global-map
override-global-map))))
`((if (boundp ',map)
,(macroexp-progn bindings)
(eval-after-load
,(if (symbolp pkg) `',pkg pkg)
',(macroexp-progn bindings))))
bindings)))
(append
(wrap map
(cl-mapcan
(lambda (form)
(let ((fun (and (cdr form) (list 'function (cdr form)))))
(if (and map (not (eq map 'global-map)))
`((bind-chord ,(car form) ,fun ,map))
`((bind-chord ,(car form) ,fun nil)))))
first))
(when next
(bind-chords-form (if pkg
(cons :package (cons pkg next))
next) map)))))))
;;;###autoload
(defmacro bind-chords (&rest args)
"Bind multiple chords at once.
@ -39,23 +96,7 @@ Accepts keyword argument:
The rest of the arguments are conses of keybinding string and a
function symbol (unquoted)."
(let* ((map (plist-get args :map))
(maps (if (listp map) map (list map)))
(key-bindings (progn
(while (keywordp (car args))
(pop args)
(pop args))
args)))
(macroexp-progn
(apply
#'nconc
(mapcar (lambda (form)
(if maps
(mapcar
#'(lambda (m)
`(bind-chord ,(car form) ',(cdr form) ,m)) maps)
`((bind-chord ,(car form) ',(cdr form)))))
key-bindings)))))
(macroexp-progn (bind-chords-form args nil)))
(provide 'bind-chord)

View file

@ -1,11 +1,11 @@
;;; use-package-chords.el --- key-chord keyword for use-package -*- lexical-binding: t; -*-
;; Copyright (C) 2015-2017 Justin Talbott
;; Copyright (C) 2015-2019 Justin Talbott
;; Author: Justin Talbott <justin@waymondo.com>
;; Keywords: convenience, tools, extensions
;; URL: https://github.com/waymondo/use-package-chords
;; Version: 0.2
;; URL: https://github.com/jwiegley/use-package
;; Version: 0.2.1
;; Package-Requires: ((use-package "2.1") (bind-key "1.0") (bind-chord "0.2") (key-chord "0.6"))
;; Filename: use-package-chords.el
;; License: GNU General Public License version 3, or (at your option) any later version

View file

@ -0,0 +1,161 @@
;;; use-package-chords-tests.el --- Tests for use-package-chords.el -*- lexical-binding: t; -*-
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 3, or (at
;; your option) any later version.
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;
;;; Code:
(require 'use-package)
(require 'use-package-tests)
(require 'use-package-chords)
(defmacro match-expansion (form &rest value)
`(should (pcase (expand-minimally ,form)
,@(mapcar #'(lambda (x) (list x t)) value))))
(defun use-package-test-normalize-chord (&rest args)
(apply #'use-package-normalize-binder 'foo :chords args))
(ert-deftest use-package-test-normalize/:chords-1 ()
(should (equal (use-package-test-normalize-chord
'(("C-a" . alpha)))
'(("C-a" . alpha)))))
(ert-deftest use-package-test-normalize/:chords-2 ()
(should (equal (use-package-test-normalize-chord
'(("C-a" . alpha)
:map foo-map
("C-b" . beta)))
'(("C-a" . alpha)
:map foo-map
("C-b" . beta)))))
(ert-deftest use-package-test-normalize/:chords-3 ()
(should (equal (use-package-test-normalize-chord
'(:map foo-map
("C-a" . alpha)
("C-b" . beta)))
'(:map foo-map
("C-a" . alpha)
("C-b" . beta)))))
(ert-deftest use-package-test/:chords-1 ()
(match-expansion
(use-package foo :chords ("C-k" . key1) ("C-u" . key2))
`(progn
(unless
(fboundp 'key1)
(autoload #'key1 "foo" nil t))
(unless
(fboundp 'key2)
(autoload #'key2 "foo" nil t))
(bind-chord "C-k" #'key1 nil)
(bind-chord "C-u" #'key2 nil))))
(ert-deftest use-package-test/:chords-2 ()
(match-expansion
(use-package foo :chords (("C-k" . key1) ("C-u" . key2)))
`(progn
(unless (fboundp 'key1)
(autoload #'key1 "foo" nil t))
(unless (fboundp 'key2)
(autoload #'key2 "foo" nil t))
(bind-chord "C-k" #'key1 nil)
(bind-chord "C-u" #'key2 nil))))
(ert-deftest use-package-test/:chords-3 ()
(match-expansion
(use-package foo :chords (:map my-map ("C-k" . key1) ("C-u" . key2)))
`(progn
(unless
(fboundp 'key1)
(autoload #'key1 "foo" nil t))
(unless
(fboundp 'key2)
(autoload #'key2 "foo" nil t))
(if
(boundp 'my-map)
(progn
(bind-chord "C-k" #'key1 my-map)
(bind-chord "C-u" #'key2 my-map))
(eval-after-load 'foo
'(progn
(bind-chord "C-k" #'key1 my-map)
(bind-chord "C-u" #'key2 my-map)))))))
(ert-deftest use-package-test/:chords-4 ()
(should-error
(match-expansion
(use-package foo :chords :map my-map ("C-k" . key1) ("C-u" . key2))
`(bind-chords :package foo))))
(ert-deftest use-package-test/:chords-5 ()
(match-expansion
(use-package foo :chords ("C-k" . key1) (:map my-map ("C-u" . key2)))
`(progn
(unless (fboundp 'key1)
(autoload #'key1 "foo" nil t))
(unless (fboundp 'key2)
(autoload #'key2 "foo" nil t))
(progn
(bind-chord "C-k" #'key1 nil)
(if
(boundp 'my-map)
(bind-chord "C-u" #'key2 my-map)
(eval-after-load 'foo
'(bind-chord "C-u" #'key2 my-map)))))))
(ert-deftest use-package-test/:chords-6 ()
(match-expansion
(use-package foo
:chords
("C-k" . key1)
(:map my-map ("C-u" . key2))
(:map my-map2 ("C-u" . key3)))
`(progn
(unless
(fboundp 'key1)
(autoload #'key1 "foo" nil t))
(unless
(fboundp 'key2)
(autoload #'key2 "foo" nil t))
(unless
(fboundp 'key3)
(autoload #'key3 "foo" nil t))
(progn
(bind-chord "C-k" #'key1 nil)
(if
(boundp 'my-map)
(bind-chord "C-u" #'key2 my-map)
(eval-after-load 'foo
'(bind-chord "C-u" #'key2 my-map)))
(if
(boundp 'my-map2)
(bind-chord "C-u" #'key3 my-map2)
(eval-after-load 'foo
'(bind-chord "C-u" #'key3 my-map2)))))))
;; Local Variables:
;; indent-tabs-mode: nil
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; use-package-tests.el ends here