[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 229582f 1/2: Merge branch 'scratch/which-key'
From: |
Justin Burkett |
Subject: |
[elpa] master 229582f 1/2: Merge branch 'scratch/which-key' |
Date: |
Thu, 17 Aug 2017 14:06:31 -0400 (EDT) |
branch: master
commit 229582fded0893ac6a8376b2838949a5468c1cfb
Merge: a3faec6 720a8f4
Author: Justin Burkett <address@hidden>
Commit: Justin Burkett <address@hidden>
Merge branch 'scratch/which-key'
---
externals-list | 1 +
packages/which-key/.gitignore | 5 +
packages/which-key/.travis.yml | 30 +
packages/which-key/Cask | 8 +
packages/which-key/LICENSE.md | 674 ++++++
packages/which-key/Makefile | 19 +
packages/which-key/README.org | 483 +++++
packages/which-key/img/which-key-bottom-split.png | Bin 0 -> 144354 bytes
packages/which-key/img/which-key-bottom.png | Bin 0 -> 32305 bytes
packages/which-key/img/which-key-minibuffer.png | Bin 0 -> 27502 bytes
packages/which-key/img/which-key-right-split.png | Bin 0 -> 194797 bytes
packages/which-key/img/which-key-right.png | Bin 0 -> 39174 bytes
packages/which-key/which-key-tests.el | 126 ++
packages/which-key/which-key.el | 2355 +++++++++++++++++++++
14 files changed, 3701 insertions(+)
diff --git a/externals-list b/externals-list
index e5fda54..ec94c83 100644
--- a/externals-list
+++ b/externals-list
@@ -91,6 +91,7 @@
("wcheck-mode" :subtree
"https://github.com/tlikonen/wcheck-mode.git")
("web-server" :subtree
"https://github.com/eschulte/emacs-web-server.git")
("websocket" :subtree
"https://github.com/ahyatt/emacs-websocket.git")
+ ("which-key" :subtree "https://github.com/justbur/emacs-which-key")
("xelb" :external "https://github.com/ch11ng/xelb.git")
("yasnippet" :subtree
"https://github.com/capitaomorte/yasnippet.git")
("ztree" :subtree "https://github.com/fourier/ztree")
diff --git a/packages/which-key/.gitignore b/packages/which-key/.gitignore
new file mode 100644
index 0000000..de0966b
--- /dev/null
+++ b/packages/which-key/.gitignore
@@ -0,0 +1,5 @@
+*~
+*.elc
+# Used to setup library paths for emacs -Q
+private-test-setup.el
+/.cask/
diff --git a/packages/which-key/.travis.yml b/packages/which-key/.travis.yml
new file mode 100644
index 0000000..b22aa13
--- /dev/null
+++ b/packages/which-key/.travis.yml
@@ -0,0 +1,30 @@
+language: generic
+sudo: false
+
+branches:
+ only:
+ - master
+
+before_install:
+ - curl -fsSkL https://gist.github.com/rejeep/ebcd57c3af83b049833b/raw > x.sh
&& source ./x.sh
+ - evm install $EVM_EMACS --use --skip
+ - cask
+
+env:
+ - EVM_EMACS=emacs-24.3-travis
+ - EVM_EMACS=emacs-24.4-travis
+ - EVM_EMACS=emacs-24.5-travis
+ - EVM_EMACS=emacs-25.1-travis
+ - EVM_EMACS=emacs-25.2-travis
+ - EVM_EMACS=emacs-git-snapshot-travis
+
+matrix:
+ fast_finish: true
+ allow_failures:
+ env:
+ - EVM_EMACS=emacs-24.3-travis
+ - EVM_EMACS=emacs-git-snapshot-travis
+
+script:
+ - emacs --version
+ - make test
diff --git a/packages/which-key/Cask b/packages/which-key/Cask
new file mode 100644
index 0000000..d8171e3
--- /dev/null
+++ b/packages/which-key/Cask
@@ -0,0 +1,8 @@
+(source gnu)
+(source melpa)
+
+(package-file "which-key.el")
+
+(development
+ (depends-on "ert"))
+
diff --git a/packages/which-key/LICENSE.md b/packages/which-key/LICENSE.md
new file mode 100644
index 0000000..9cecc1d
--- /dev/null
+++ b/packages/which-key/LICENSE.md
@@ -0,0 +1,674 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The GNU General Public License is a free, copyleft license for
+software and other kinds of works.
+
+ The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works. By contrast,
+the GNU General Public License is intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains free
+software for all its users. We, the Free Software Foundation, use the
+GNU General Public License for most of our software; it applies also to
+any other work released this way by its authors. You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+ To protect your rights, we need to prevent others from denying you
+these rights or asking you to surrender the rights. Therefore, you have
+certain responsibilities if you distribute copies of the software, or if
+you modify it: responsibilities to respect the freedom of others.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must pass on to the recipients the same
+freedoms that you received. You must make sure that they, too, receive
+or can get the source code. And you must show them these terms so they
+know their rights.
+
+ Developers that use the GNU GPL protect your rights with two steps:
+(1) assert copyright on the software, and (2) offer you this License
+giving you legal permission to copy, distribute and/or modify it.
+
+ For the developers' and authors' protection, the GPL clearly explains
+that there is no warranty for this free software. For both users' and
+authors' sake, the GPL requires that modified versions be marked as
+changed, so that their problems will not be attributed erroneously to
+authors of previous versions.
+
+ Some devices are designed to deny users access to install or run
+modified versions of the software inside them, although the manufacturer
+can do so. This is fundamentally incompatible with the aim of
+protecting users' freedom to change the software. The systematic
+pattern of such abuse occurs in the area of products for individuals to
+use, which is precisely where it is most unacceptable. Therefore, we
+have designed this version of the GPL to prohibit the practice for those
+products. If such problems arise substantially in other domains, we
+stand ready to extend this provision to those domains in future versions
+of the GPL, as needed to protect the freedom of users.
+
+ Finally, every program is threatened constantly by software patents.
+States should not allow patents to restrict development and use of
+software on general-purpose computers, but in those that do, we wish to
+avoid the special danger that patents applied to a free program could
+make it effectively proprietary. To prevent this, the GPL assures that
+patents cannot be used to render the program non-free.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ TERMS AND CONDITIONS
+
+ 0. Definitions.
+
+ "This License" refers to version 3 of the GNU General Public License.
+
+ "Copyright" also means copyright-like laws that apply to other kinds of
+works, such as semiconductor masks.
+
+ "The Program" refers to any copyrightable work licensed under this
+License. Each licensee is addressed as "you". "Licensees" and
+"recipients" may be individuals or organizations.
+
+ To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of an
+exact copy. The resulting work is called a "modified version" of the
+earlier work or a work "based on" the earlier work.
+
+ A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+ To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy. Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+ To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies. Mere interaction with a user through
+a computer network, with no transfer of a copy, is not conveying.
+
+ An interactive user interface displays "Appropriate Legal Notices"
+to the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License. If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+ 1. Source Code.
+
+ The "source code" for a work means the preferred form of the work
+for making modifications to it. "Object code" means any non-source
+form of a work.
+
+ A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+ The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form. A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+ The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities. However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work. For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+ The Corresponding Source need not include anything that users
+can regenerate automatically from other parts of the Corresponding
+Source.
+
+ The Corresponding Source for a work in source code form is that
+same work.
+
+ 2. Basic Permissions.
+
+ All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met. This License explicitly affirms your unlimited
+permission to run the unmodified Program. The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work. This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+ You may make, run and propagate covered works that you do not
+convey, without conditions so long as your license otherwise remains
+in force. You may convey covered works to others for the sole purpose
+of having them make modifications exclusively for you, or provide you
+with facilities for running those works, provided that you comply with
+the terms of this License in conveying all material for which you do
+not control copyright. Those thus making or running the covered works
+for you must do so exclusively on your behalf, under your direction
+and control, on terms that prohibit them from making any copies of
+your copyrighted material outside their relationship with you.
+
+ Conveying under any other circumstances is permitted solely under
+the conditions stated below. Sublicensing is not allowed; section 10
+makes it unnecessary.
+
+ 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+ No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+ When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such circumvention
+is effected by exercising rights under this License with respect to
+the covered work, and you disclaim any intention to limit operation or
+modification of the work as a means of enforcing, against the work's
+users, your or third parties' legal rights to forbid circumvention of
+technological measures.
+
+ 4. Conveying Verbatim Copies.
+
+ You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+ You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+ 5. Conveying Modified Source Versions.
+
+ You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these conditions:
+
+ a) The work must carry prominent notices stating that you modified
+ it, and giving a relevant date.
+
+ b) The work must carry prominent notices stating that it is
+ released under this License and any conditions added under section
+ 7. This requirement modifies the requirement in section 4 to
+ "keep intact all notices".
+
+ c) You must license the entire work, as a whole, under this
+ License to anyone who comes into possession of a copy. This
+ License will therefore apply, along with any applicable section 7
+ additional terms, to the whole of the work, and all its parts,
+ regardless of how they are packaged. This License gives no
+ permission to license the work in any other way, but it does not
+ invalidate such permission if you have separately received it.
+
+ d) If the work has interactive user interfaces, each must display
+ Appropriate Legal Notices; however, if the Program has interactive
+ interfaces that do not display Appropriate Legal Notices, your
+ work need not make them do so.
+
+ A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit. Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+ 6. Conveying Non-Source Forms.
+
+ You may convey a covered work in object code form under the terms
+of sections 4 and 5, provided that you also convey the
+machine-readable Corresponding Source under the terms of this License,
+in one of these ways:
+
+ a) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by the
+ Corresponding Source fixed on a durable physical medium
+ customarily used for software interchange.
+
+ b) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by a
+ written offer, valid for at least three years and valid for as
+ long as you offer spare parts or customer support for that product
+ model, to give anyone who possesses the object code either (1) a
+ copy of the Corresponding Source for all the software in the
+ product that is covered by this License, on a durable physical
+ medium customarily used for software interchange, for a price no
+ more than your reasonable cost of physically performing this
+ conveying of source, or (2) access to copy the
+ Corresponding Source from a network server at no charge.
+
+ c) Convey individual copies of the object code with a copy of the
+ written offer to provide the Corresponding Source. This
+ alternative is allowed only occasionally and noncommercially, and
+ only if you received the object code with such an offer, in accord
+ with subsection 6b.
+
+ d) Convey the object code by offering access from a designated
+ place (gratis or for a charge), and offer equivalent access to the
+ Corresponding Source in the same way through the same place at no
+ further charge. You need not require recipients to copy the
+ Corresponding Source along with the object code. If the place to
+ copy the object code is a network server, the Corresponding Source
+ may be on a different server (operated by you or a third party)
+ that supports equivalent copying facilities, provided you maintain
+ clear directions next to the object code saying where to find the
+ Corresponding Source. Regardless of what server hosts the
+ Corresponding Source, you remain obligated to ensure that it is
+ available for as long as needed to satisfy these requirements.
+
+ e) Convey the object code using peer-to-peer transmission, provided
+ you inform other peers where the object code and Corresponding
+ Source of the work are being offered to the general public at no
+ charge under subsection 6d.
+
+ A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+ A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal, family,
+or household purposes, or (2) anything designed or sold for incorporation
+into a dwelling. In determining whether a product is a consumer product,
+doubtful cases shall be resolved in favor of coverage. For a particular
+product received by a particular user, "normally used" refers to a
+typical or common use of that class of product, regardless of the status
+of the particular user or of the way in which the particular user
+actually uses, or expects or is expected to use, the product. A product
+is a consumer product regardless of whether the product has substantial
+commercial, industrial or non-consumer uses, unless such uses represent
+the only significant mode of use of the product.
+
+ "Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to install
+and execute modified versions of a covered work in that User Product from
+a modified version of its Corresponding Source. The information must
+suffice to ensure that the continued functioning of the modified object
+code is in no case prevented or interfered with solely because
+modification has been made.
+
+ If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information. But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+ The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or updates
+for a work that has been modified or installed by the recipient, or for
+the User Product in which it has been modified or installed. Access to a
+network may be denied when the modification itself materially and
+adversely affects the operation of the network or violates the rules and
+protocols for communication across the network.
+
+ Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+ 7. Additional Terms.
+
+ "Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law. If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+ When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it. (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.) You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+ Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders of
+that material) supplement the terms of this License with terms:
+
+ a) Disclaiming warranty or limiting liability differently from the
+ terms of sections 15 and 16 of this License; or
+
+ b) Requiring preservation of specified reasonable legal notices or
+ author attributions in that material or in the Appropriate Legal
+ Notices displayed by works containing it; or
+
+ c) Prohibiting misrepresentation of the origin of that material, or
+ requiring that modified versions of such material be marked in
+ reasonable ways as different from the original version; or
+
+ d) Limiting the use for publicity purposes of names of licensors or
+ authors of the material; or
+
+ e) Declining to grant rights under trademark law for use of some
+ trade names, trademarks, or service marks; or
+
+ f) Requiring indemnification of licensors and authors of that
+ material by anyone who conveys the material (or modified versions of
+ it) with contractual assumptions of liability to the recipient, for
+ any liability that these contractual assumptions directly impose on
+ those licensors and authors.
+
+ All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10. If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term. If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+ If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+ Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions;
+the above requirements apply either way.
+
+ 8. Termination.
+
+ You may not propagate or modify a covered work except as expressly
+provided under this License. Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+ However, if you cease all violation of this License, then your
+license from a particular copyright holder is reinstated (a)
+provisionally, unless and until the copyright holder explicitly and
+finally terminates your license, and (b) permanently, if the copyright
+holder fails to notify you of the violation by some reasonable means
+prior to 60 days after the cessation.
+
+ Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+ Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License. If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+ 9. Acceptance Not Required for Having Copies.
+
+ You are not required to accept this License in order to receive or
+run a copy of the Program. Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance. However,
+nothing other than this License grants you permission to propagate or
+modify any covered work. These actions infringe copyright if you do
+not accept this License. Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+ 10. Automatic Licensing of Downstream Recipients.
+
+ Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License. You are not responsible
+for enforcing compliance by third parties with this License.
+
+ An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations. If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+ You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License. For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+ 11. Patents.
+
+ A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based. The
+work thus licensed is called the contributor's "contributor version".
+
+ A contributor's "essential patent claims" are all patent claims
+owned or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version. For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+ Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+ In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement). To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+ If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients. "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+ If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+ A patent license is "discriminatory" if it does not include within
+the scope of its coverage, prohibits the exercise of, or is
+conditioned on the non-exercise of one or more of the rights that are
+specifically granted under this License. You may not convey a covered
+work if you are a party to an arrangement with a third party that is
+in the business of distributing software, under which you make payment
+to the third party based on the extent of your activity of conveying
+the work, and under which the third party grants, to any of the
+parties who would receive the covered work from you, a discriminatory
+patent license (a) in connection with copies of the covered work
+conveyed by you (or copies made from those copies), or (b) primarily
+for and in connection with specific products or compilations that
+contain the covered work, unless you entered into that arrangement,
+or that patent license was granted, prior to 28 March 2007.
+
+ Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+ 12. No Surrender of Others' Freedom.
+
+ If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you may
+not convey it at all. For example, if you agree to terms that obligate you
+to collect a royalty for further conveying from those to whom you convey
+the Program, the only way you could satisfy both those terms and this
+License would be to refrain entirely from conveying the Program.
+
+ 13. Use with the GNU Affero General Public License.
+
+ Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU Affero General Public License into a single
+combined work, and to convey the resulting work. The terms of this
+License will continue to apply to the part which is the covered work,
+but the special requirements of the GNU Affero General Public License,
+section 13, concerning interaction through a network will apply to the
+combination as such.
+
+ 14. Revised Versions of this License.
+
+ The Free Software Foundation may publish revised and/or new versions of
+the GNU General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the
+Program specifies that a certain numbered version of the GNU General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation. If the Program does not specify a version number of the
+GNU General Public License, you may choose any version ever published
+by the Free Software Foundation.
+
+ If the Program specifies that a proxy can decide which future
+versions of the GNU General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+ Later license versions may give you additional or different
+permissions. However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+ 15. Disclaimer of Warranty.
+
+ THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
+IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ 16. Limitation of Liability.
+
+ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+ 17. Interpretation of Sections 15 and 16.
+
+ If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+ END OF TERMS AND CONDITIONS
+
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+state the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+ {one line to give the program's name and a brief idea of what it does.}
+ Copyright (C) {year} {name of author}
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+Also add information on how to contact you by electronic and paper mail.
+
+ If the program does terminal interaction, make it output a short
+notice like this when it starts in an interactive mode:
+
+ {project} Copyright (C) {year} {fullname}
+ This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, your program's commands
+might be different; for a GUI interface, you would use an "about box".
+
+ You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU GPL, see
+<http://www.gnu.org/licenses/>.
+
+ The GNU General Public License does not permit incorporating your program
+into proprietary programs. If your program is a subroutine library, you
+may consider it more useful to permit linking proprietary applications with
+the library. If this is what you want to do, use the GNU Lesser General
+Public License instead of this License. But first, please read
+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
diff --git a/packages/which-key/Makefile b/packages/which-key/Makefile
new file mode 100644
index 0000000..facb1f8
--- /dev/null
+++ b/packages/which-key/Makefile
@@ -0,0 +1,19 @@
+.PHONY : test
+
+EMACS ?= emacs
+CASK ?= cask
+
+LOADPATH = -L .
+
+ELPA_DIR = \
+ .cask/$(shell $(EMACS) -Q --batch --eval '(princ emacs-version)')/elpa
+
+test: elpa
+ $(CASK) exec $(EMACS) -Q -batch $(LOADPATH) \
+ -l which-key-tests.el -f ert-run-tests-batch-and-exit
+
+elpa: $(ELPA_DIR)
+$(ELPA_DIR): Cask
+ $(CASK) install
+ mkdir -p $(ELPA_DIR)
+ touch $@
diff --git a/packages/which-key/README.org b/packages/which-key/README.org
new file mode 100644
index 0000000..ac8b97f
--- /dev/null
+++ b/packages/which-key/README.org
@@ -0,0 +1,483 @@
+* which-key
+[[http://melpa.org/#/which-key][http://melpa.org/packages/which-key-badge.svg]]
[[http://stable.melpa.org/#/which-key][file:http://stable.melpa.org/packages/which-key-badge.svg]]
[[https://travis-ci.org/justbur/emacs-which-key][file:https://travis-ci.org/justbur/emacs-which-key.svg?branch=master]]
+
+** Recent Changes
+*** 2016-12-20: Added =which-key-max-display-columns=
+Allows control over the number of columns in the popup. See
[[#other-options][Other Options]].
+*** 2016-11-21: Replacement list changes
+The alists controlling the replacement of key binding descriptions was
+simplified to use one centralized alist, =which-key-replacement-alist=. This
+change also allows for some new features compared to the old method. The other
+alists are deprecated. See [[#custom-string-replacement-options][Custom String
Replacement Options]].
+
+** Introduction
+=which-key= is a minor mode for Emacs that displays the key bindings following
+your currently entered incomplete command (a prefix) in a popup. For example,
+after enabling the minor mode if you enter =C-x= and wait for the default of 1
+second the minibuffer will expand with all of the available key bindings that
+follow =C-x= (or as many as space allows given your settings). This includes
+prefixes like =C-x 8= which are shown in a different face. Screenshots of what
+the popup will look like are included below. =which-key= started as a rewrite
of
+[[https://github.com/kai2nenobu/guide-key][guide-key-mode]], but the feature
sets have diverged to a certain extent.
+
+** Table of Contents :TOC_3:
+ - [[#which-key][which-key]]
+ - [[#recent-changes][Recent Changes]]
+ - [[#2016-12-20-added-which-key-max-display-columns][2016-12-20: Added
=which-key-max-display-columns=]]
+ - [[#2016-11-21-replacement-list-changes][2016-11-21: Replacement list
changes]]
+ - [[#introduction][Introduction]]
+ - [[#install][Install]]
+ - [[#melpa][MELPA]]
+ - [[#manually][Manually]]
+ - [[#initial-setup][Initial Setup]]
+ - [[#side-window-bottom-option][Side Window Bottom Option]]
+ - [[#side-window-right-option][Side Window Right Option]]
+ - [[#side-window-right-then-bottom][Side Window Right then Bottom]]
+ - [[#minibuffer-option][Minibuffer Option]]
+ - [[#additional-commands][Additional Commands]]
+ - [[#special-features-and-configuration-options][Special Features and
Configuration Options]]
+ - [[#popup-type-options][Popup Type Options]]
+ - [[#custom-string-replacement-options][Custom String Replacement
Options]]
+ - [[#sorting-options][Sorting Options]]
+ - [[#paging-options][Paging Options]]
+ - [[#face-customization-options][Face Customization Options]]
+ - [[#other-options][Other Options]]
+ - [[#support-for-third-party-libraries][Support for Third-Party Libraries]]
+ - [[#key-chord][Key-chord]]
+ - [[#evil-operators][Evil operators]]
+ - [[#god-mode][God-mode]]
+ - [[#more-examples][More Examples]]
+ - [[#nice-display-with-split-frame][Nice Display with Split Frame]]
+ - [[#thanks][Thanks]]
+
+** Install
+*** MELPA
+After setting up [[http://melpa.org][MELPA]] as a repository, use =M-x
package-install which-key= or
+your preferred method. You will need to call =which-key-mode= to enable the
+minor mode of course.
+
+*** Manually
+Add which-key.el to your =load-path= and require. Something like
+#+BEGIN_SRC emacs-lisp
+(add-to-list 'load-path "path/to/which-key.el")
+(require 'which-key)
+(which-key-mode)
+#+END_SRC
+
+** Initial Setup
+No further setup is required if you are happy with the default setup. To try
+other options, there are 3 choices of default configs that are preconfigured
+(then customize to your liking). The main choice is where you want the
which-key
+buffer to display. Screenshots of the default options are shown in the next
+sections.
+
+In each case, we show as many key bindings as we can fit in the buffer within
+the constraints. The constraints are determined by several factors, including
+your Emacs settings, the size of the current Emacs frame, and the which-key
+settings, most of which are described below.
+
+There are many substitution abilities included, which are quite flexible
+(ability to use regexp for example). This makes which-key very customizable.
+
+*** Side Window Bottom Option
+Popup side window on bottom. This is the current default. To restore this
setup use
+
+#+BEGIN_SRC emacs-lisp
+(which-key-setup-side-window-bottom)
+#+END_SRC
+
+[[./img/which-key-bottom.png]]
+
+*** Side Window Right Option
+Popup side window on right. For defaults use
+
+#+BEGIN_SRC emacs-lisp
+(which-key-setup-side-window-right)
+#+END_SRC
+
+Note the defaults are fairly conservative and will tend to not display on
+narrower frames. If you get a message saying which-key can't display the keys,
+try making your frame wider or adjusting the defaults related to the maximum
+width (see =M-x customize-group which-key=).
+
+[[./img/which-key-right.png]]
+
+*** Side Window Right then Bottom
+This is a combination of the previous two choices. It will try to use the right
+side, but if there is no room it will switch to using the bottom, which is
+usually easier to fit keys into. This setting can be helpful if the size of
+the Emacs frame changes frequently, which might be the case if you are using
+a dynamic/tiling window manager.
+
+#+BEGIN_SRC emacs-lisp
+(which-key-setup-side-window-right-bottom)
+#+END_SRC
+
+*** Minibuffer Option
+Take over the minibuffer. For the recommended configuration use
+
+#+BEGIN_SRC emacs-lisp
+(which-key-setup-minibuffer)
+#+END_SRC
+
+[[./img/which-key-minibuffer.png]]
+
+Note the maximum height of the minibuffer is controlled through the built-in
+variable =max-mini-window-height=.
+
+** Additional Commands
+- =which-key-show-top-level= will show most key bindings without a prefix. It
is
+ most and not all, because many are probably not interesting to most users.
+- =which-key-show-next-page= is the command used for paging.
+- =which-key-undo= can be used to undo the last keypress when in the middle of
a
+ key sequence.
+
+** Special Features and Configuration Options
+There are more options than the ones described here. All of the configurable
+variables are available through =M-x customize-group which-key=.
+*** Popup Type Options
+There are three different popup types that which-key can use by default to
+display the available keys. The variable =which-key-popup-type= decides which
+one is used.
+**** minibuffer
+#+BEGIN_SRC emacs-lisp
+(setq which-key-popup-type 'minibuffer)
+#+END_SRC
+Show keys in the minibuffer.
+**** side window
+#+BEGIN_SRC emacs-lisp
+(setq which-key-popup-type 'side-window)
+#+END_SRC
+Show keys in a side window. This popup type has further options:
+#+BEGIN_SRC emacs-lisp
+;; location of which-key window. valid values: top, bottom, left, right,
+;; or a list of any of the two. If it's a list, which-key will always try
+;; the first location first. It will go to the second location if there is
+;; not enough room to display any keys in the first location
+(setq which-key-side-window-location 'bottom)
+
+;; max width of which-key window, when displayed at left or right.
+;; valid values: number of columns (integer), or percentage out of current
+;; frame's width (float larger than 0 and smaller than 1)
+(setq which-key-side-window-max-width 0.33)
+
+;; max height of which-key window, when displayed at top or bottom.
+;; valid values: number of lines (integer), or percentage out of current
+;; frame's height (float larger than 0 and smaller than 1)
+(setq which-key-side-window-max-height 0.25)
+#+END_SRC
+**** frame
+
+#+BEGIN_SRC emacs-lisp
+(setq which-key-popup-type 'frame)
+#+END_SRC
+Show keys in a popup frame. This popup won't work very well in a terminal,
+where only one frame can be shown at any given moment. This popup type has
+further options:
+#+BEGIN_SRC emacs-lisp
+;; max width of which-key frame: number of columns (an integer)
+(setq which-key-frame-max-width 60)
+
+;; max height of which-key frame: number of lines (an integer)
+(setq which-key-frame-max-height 20)
+#+END_SRC
+
+**** custom
+Write your own display functions! This requires you to write three functions,
+=which-key-custom-popup-max-dimensions-function=,
+=which-key-custom-show-popup-function=, and
+=which-key-custom-hide-popup-function=. Refer to the documentation for those
+variables for more information, but here is a working example (this is the
+current implementation of side-window bottom).
+
+
+#+BEGIN_SRC emacs-lisp
+(setq which-key-popup-type 'custom)
+(defun which-key-custom-popup-max-dimensions-function (ignore)
+ (cons
+ (which-key-height-or-percentage-to-height which-key-side-window-max-height)
+ (frame-width)))
+(defun fit-horizonatally ()
+ (let ((fit-window-to-buffer-horizontally t))
+ (fit-window-to-buffer)))
+(defun which-key-custom-show-popup-function (act-popup-dim)
+ (let* ((alist '((window-width . fit-horizontally)
+ (window-height . fit-window-to-buffer))))
+ (if (get-buffer-window which-key--buffer)
+ (display-buffer-reuse-window which-key--buffer alist)
+ (display-buffer-in-major-side-window which-key--buffer 'bottom 0
alist))))
+(defun which-key-custom-hide-popup-function ()
+ (when (buffer-live-p which-key--buffer)
+ (quit-windows-on which-key--buffer)))
+#+END_SRC
+
+*** Custom String Replacement Options
+ #+NAME: #custom-string-replacement-options
+You can customize the way the keys show in the buffer using three different
+replacement methods, each of which corresponds replacement alist. The basic
idea
+of behind each alist is that you specify a selection string in the =car= of
each
+cons cell and the replacement string in the =cdr=.
+
+**** "Key-Based" replacement
+Using this method, the description of a key is replaced using a string that you
+provide. Here's an example
+
+#+BEGIN_SRC emacs-lisp
+(which-key-add-key-based-replacements
+ "C-x C-f" "find files")
+#+END_SRC
+
+where the first string is the key combination whose description you want to
+replace, in a form suitable for =kbd=. For that key combination, which-key
+overwrites the description with the second string, "find files". In the second
+type of entry you can restrict the replacements to a major-mode. For example,
+
+#+BEGIN_SRC emacs-lisp
+(which-key-add-major-mode-key-based-replacements 'org-mode
+ "C-c C-c" "Org C-c C-c"
+ "C-c C-a" "Org Attach")
+#+END_SRC
+
+Here the first entry is the major-mode followed by a list of the first type of
+entries. In case the same key combination is listed under a major-mode and by
+itself, the major-mode version takes precedence.
+
+**** Key and Description replacement
+
+The second and third methods target the text used for the keys and the
+descriptions directly. The relevant variable is =which-key-replacement-alist=.
+Here's an example of one of the default key replacements
+
+#+BEGIN_SRC emacs-lisp
+(push '(("<\\([[:alnum:]-]+\\)>" . nil) . ("\\1" . nil))
+ which-key-replacement-alist)
+#+END_SRC
+
+Each element of the outer cons cell is a cons cell of the form =(KEY
+. BINDING)=. The =car= of the outer cons determines how to match key bindings
+while the =cdr= determines how those matches are replaced. See the docstring of
+=which-key-replacement-alist= for more information.
+
+The next example shows how to replace the description.
+
+#+BEGIN_SRC emacs-lisp
+(push '((nil . "left") . (nil . "lft")) which-key-replacement-alist)
+#+END_SRC
+
+Here is an example of using key replacement to include Unicode characters in
the
+results. Unfortunately, using Unicode characters may upset the alignment of the
+which-key buffer, because Unicode characters can have different widths even in
a
+monospace font and alignment is based on character width.
+
+#+BEGIN_SRC emacs-lisp
+(add-to-list 'which-key-replacement-alist '(("TAB" . nil) . ("↹" . nil))
+(add-to-list 'which-key-replacement-alist '(("RET" . nil) . ("⏎" . nil))
+(add-to-list 'which-key-replacement-alist '(("DEL" . nil) . ("⇤" . nil))
+(add-to-list 'which-key-replacement-alist '(("SPC" . nil) . ("␣" . nil))
+#+END_SRC
+
+The =cdr= may also be a function that receives a =cons= of the form =(KEY
+. BINDING)= and produces a =cons= of the same form. This allows for interesting
+ideas like this one suggested by [[https://github.com/address@hidden in
[[https://github.com/justbur/emacs-which-key/pull/147][PR #147]].
+
+#+BEGIN_SRC emacs-lisp
+(push (cons '(nil . "paredit-mode")
+ (lambda (kb)
+ (cons (car kb)
+ (if paredit-mode
+ "[x] paredit-mode"
+ "[ ] paredit-mode"))))
+ which-key-replacement-alist)
+#+END_SRC
+
+The box will be checked if =paredit-mode= is currently active.
+
+*** Sorting Options
+By default the output is sorted by the key in a custom order. The default order
+is to sort lexicographically within each "class" of key, where the classes and
+their order are
+
+=Special (SPC, TAB, ...) < Single Character (ASCII) (a, ...) < Modifier (C-,
M-, ...) < Other=
+
+You can control the order by setting this variable. This also shows the other
+available options.
+
+#+BEGIN_SRC emacs-lisp
+;; default
+(setq which-key-sort-order 'which-key-key-order)
+;; same as default, except single characters are sorted alphabetically
+;; (setq which-key-sort-order 'which-key-key-order-alpha)
+;; same as default, except all prefix keys are grouped together at the end
+;; (setq which-key-sort-order 'which-key-prefix-then-key-order)
+;; same as default, except all keys from local maps shown first
+;; (setq which-key-sort-order 'which-key-local-then-key-order)
+;; sort based on the key description ignoring case
+;; (setq which-key-sort-order 'which-key-description-order)
+#+END_SRC
+
+*** Paging Options
+
+There are at least several prefixes that have many keys bound to them, like
+=C-x=. which-key displays as many keys as it can given your settings, but for
+these prefixes this may not be enough. The paging feature gives you the ability
+to bind a key to the function =which-key-C-h-dispatch= which will allow you to
+cycle through the pages without changing the key sequence you were in the
middle
+of typing. There are two slightly different ways of doing this.
+
+**** Method 1 (default): Using C-h (or =help-char=)
+This is the easiest way, and is turned on by default. Use
+#+BEGIN_SRC emacs-lisp
+(setq which-key-use-C-h-commands nil)
+#+END_SRC
+to disable the behavior (this will only take effect after toggling
+which-key-mode if it is already enabled). =C-h= can be used with any prefix to
+switch pages when there are multiple pages of keys. This changes the default
+behavior of Emacs which is to show a list of key bindings that apply to a
prefix.
+For example, if you were to type =C-x C-h= you would get a list of commands
that
+follow =C-x=. This uses which-key instead to show those keys, and unlike the
+Emacs default saves the incomplete prefix that you just entered so that the
next
+keystroke can complete the command.
+
+The commands are:
+ - Cycle through the pages forward with =n= (or =C-n=)
+ - Cycle backwards with =p= (or =C-p=)
+ - Undo the last entered key (!) with =u= (or =C-u=)
+ - Call the default command bound to =C-h=, usually
=describe-prefix-bindings=,
+ with =h= (or =C-h=)
+
+This is especially useful for those who like =helm-descbinds= but also want to
+use =C-h= as their which-key paging key.
+
+Note =C-h= is by default equivalent to =?= in this context.
+
+**** Method 2: Bind your own keys
+
+Essentially, all you need to do for a prefix like =C-x= is the following which
+will bind =<f5>= to the relevant command.
+
+#+BEGIN_SRC emacs-lisp
+(define-key which-key-mode-map (kbd "C-x <f5>") 'which-key-C-h-dispatch)
+#+END_SRC
+
+This is completely equivalent to
+
+#+BEGIN_SRC emacs-lisp
+(setq which-key-paging-prefixes '("C-x"))
+(setq which-key-paging-key "<f5>")
+#+END_SRC
+
+where the latter are provided for convenience if you have a lot of prefixes.
+
+*** Face Customization Options
+The faces that which-key uses are
+| Face | Applied To |
Default Definition |
+|----------------------------------------+-------------------------------+-------------------------------------------------------------|
+| =which-key-key-face= | Every key sequence |
=:inherit font-lock-constant-face= |
+| =which-key-separator-face= | The separator (→) |
=:inherit font-lock-comment-face= |
+| =which-key-note-face= | Hints and notes |
=:inherit which-key-separator-face= |
+| =which-key-special-key-face= | User-defined special keys |
=:inherit which-key-key-face :inverse-video t :weight bold= |
+| =which-key-group-description-face= | Command groups (i.e, keymaps) |
=:inherit font-lock-keyword-face= |
+| =which-key-command-description-face= | Commands not in local-map |
=:inherit font-lock-function-name-face= |
+| =which-key-local-map-description-face= | Commands in local-map |
=:inherit which-key-command-description-face= |
+
+The last two deserve some explanation. A command lives in one of many possible
+keymaps. You can distinguish between local maps, which depend on the buffer you
+are in, which modes are active, etc., and the global map which applies
+everywhere. It might be useful for you to distinguish between the two. One way
+to do this is to remove the default face from
+=which-key-command-description-face= like this
+
+#+BEGIN_SRC emacs-lisp
+ (set-face-attribute 'which-key-command-description-face nil :inherit nil)
+#+END_SRC
+
+another is to make the local map keys appear in bold
+
+#+BEGIN_SRC emacs-lisp
+ (set-face-attribute 'which-key-local-map-description-face nil :weight 'bold)
+#+END_SRC
+
+You can also use =M-x customize-face= to customize any of the above faces to
+your liking.
+
+*** Other Options
+ #+NAME: #other-options
+The options below are also available through customize. Their defaults are
+shown.
+
+#+BEGIN_SRC emacs-lisp
+ ;; Set the time delay (in seconds) for the which-key popup to appear. A
value of
+ ;; zero might cause issues so a non-zero value is recommended.
+ (setq which-key-idle-delay 1.0)
+
+ ;; Set the maximum length (in characters) for key descriptions (commands or
+ ;; prefixes). Descriptions that are longer are truncated and have ".." added.
+ (setq which-key-max-description-length 27)
+
+ ;; Use additonal padding between columns of keys. This variable specifies the
+ ;; number of spaces to add to the left of each column.
+ (setq which-key-add-column-padding 0)
+
+ ;; The maximum number of columns to display in the which-key buffer. nil
means
+ ;; don't impose a maximum.
+ (setq which-key-max-display-columns nil)
+
+ ;; Set the separator used between keys and descriptions. Change this setting
to
+ ;; an ASCII character if your font does not show the default arrow. The
second
+ ;; setting here allows for extra padding for Unicode characters. which-key
uses
+ ;; characters as a means of width measurement, so wide Unicode characters can
+ ;; throw off the calculation.
+ (setq which-key-separator " → " )
+ (setq which-key-unicode-correction 3)
+
+ ;; Set the prefix string that will be inserted in front of prefix commands
+ ;; (i.e., commands that represent a sub-map).
+ (setq which-key-prefix-prefix "+" )
+
+ ;; Set the special keys. These are automatically truncated to one character
and
+ ;; have which-key-special-key-face applied. Disabled by default. An example
+ ;; setting is
+ ;; (setq which-key-special-keys '("SPC" "TAB" "RET" "ESC" "DEL"))
+ (setq which-key-special-keys nil)
+
+ ;; Show the key prefix on the left, top, or bottom (nil means hide the
prefix).
+ ;; The prefix consists of the keys you have typed so far. which-key also
shows
+ ;; the page information along with the prefix.
+ (setq which-key-show-prefix 'left)
+
+ ;; Set to t to show the count of keys shown vs. total keys in the mode line.
+ (setq which-key-show-remaining-keys nil)
+#+END_SRC
+** Support for Third-Party Libraries
+ Some support is provided for third-party libraries which don't use standard
+ methods of looking up commands. Some of these need to be enabled
+ explicitly. This code includes some hacks, so please report any problems.
+*** Key-chord
+ Enabled by default.
+*** Evil operators
+ Evil motions and text objects following an operator like =d= are not all
+ looked up in a standard way. Support is controlled through
+ =which-key-allow-evil-operators= which should be non-nil if evil is loaded
+ before which-key and through =which-key-show-operator-state-maps= which
+ needs to be enabled explicitly because it is more of a hack. The former
+ allows for the inner and outer text object maps to show, while the latter
+ shows motions as well.
+*** God-mode
+ Call =(which-key-enable-god-mode-support)= after loading god-mode to enable
+ support for god-mode key sequences. This is new and experimental, so please
+ report any issues.
+** More Examples
+*** Nice Display with Split Frame
+Unlike guide-key, which-key looks good even if the frame is split into several
+windows.
+#+CAPTION: which-key in a frame with 3 horizontal splits
+[[./img/which-key-right-split.png]]
+
+#+CAPTION: which-key in a frame with 2 vertical splits
+[[./img/which-key-bottom-split.png]]
+
+** Thanks
+Special thanks to
+- [[https://github.com/address@hidden for helping with the initial development
and finding many bugs.
+- [[https://github/address@hidden who among other things adapted the code to
make
+ =which-key-show-top-level= possible.
diff --git a/packages/which-key/img/which-key-bottom-split.png
b/packages/which-key/img/which-key-bottom-split.png
new file mode 100644
index 0000000..a13057e
Binary files /dev/null and b/packages/which-key/img/which-key-bottom-split.png
differ
diff --git a/packages/which-key/img/which-key-bottom.png
b/packages/which-key/img/which-key-bottom.png
new file mode 100644
index 0000000..19f1f52
Binary files /dev/null and b/packages/which-key/img/which-key-bottom.png differ
diff --git a/packages/which-key/img/which-key-minibuffer.png
b/packages/which-key/img/which-key-minibuffer.png
new file mode 100644
index 0000000..702e175
Binary files /dev/null and b/packages/which-key/img/which-key-minibuffer.png
differ
diff --git a/packages/which-key/img/which-key-right-split.png
b/packages/which-key/img/which-key-right-split.png
new file mode 100644
index 0000000..581ae68
Binary files /dev/null and b/packages/which-key/img/which-key-right-split.png
differ
diff --git a/packages/which-key/img/which-key-right.png
b/packages/which-key/img/which-key-right.png
new file mode 100644
index 0000000..e95d3d0
Binary files /dev/null and b/packages/which-key/img/which-key-right.png differ
diff --git a/packages/which-key/which-key-tests.el
b/packages/which-key/which-key-tests.el
new file mode 100644
index 0000000..5c17ab7
--- /dev/null
+++ b/packages/which-key/which-key-tests.el
@@ -0,0 +1,126 @@
+;;; which-key-tests.el --- Tests for which-key.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Justin Burkett <address@hidden>
+;; Maintainer: Justin Burkett <address@hidden>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Tests for which-key.el
+
+;;; Code:
+
+(require 'which-key)
+(require 'ert)
+
+(ert-deftest which-key-test-prefix-declaration ()
+ "Test `which-key-declare-prefixes' and
+`which-key-declare-prefixes-for-mode'. See Bug #109."
+ (let* ((major-mode 'test-mode)
+ which-key-replacement-alist)
+ (which-key-add-key-based-replacements
+ "SPC C-c" '("complete" . "complete title")
+ "SPC C-k" "cancel")
+ (which-key-add-major-mode-key-based-replacements 'test-mode
+ "C-c C-c" '("complete" . "complete title")
+ "C-c C-k" "cancel")
+ (should (equal
+ (which-key--maybe-replace '("SPC C-k" . ""))
+ '("SPC C-k" . "cancel")))
+ (should (equal
+ (which-key--maybe-replace '("C-c C-c" . ""))
+ '("C-c C-c" . "complete")))))
+
+(ert-deftest which-key-test--maybe-replace ()
+ "Test `which-key--maybe-replace'. See #154"
+ (let ((which-key-replacement-alist
+ '((("C-c [a-d]" . nil) . ("C-c a" . "c-c a"))
+ (("C-c .+" . nil) . ("C-c *" . "c-c *"))))
+ (test-mode-1 t)
+ (test-mode-2 nil)
+ which-key-allow-multiple-replacements)
+ (which-key-add-key-based-replacements
+ "C-c ." "test ."
+ "SPC ." "SPC ."
+ "C-c \\" "regexp quoting"
+ "C-c [" "bad regexp"
+ "SPC t1" (lambda (kb)
+ (cons (car kb)
+ (if test-mode-1
+ "[x] test mode"
+ "[ ] test mode")))
+ "SPC t2" (lambda (kb)
+ (cons (car kb)
+ (if test-mode-2
+ "[x] test mode"
+ "[ ] test mode"))))
+ (should (equal
+ (which-key--maybe-replace '("C-c g" . "test"))
+ '("C-c *" . "c-c *")))
+ (should (equal
+ (which-key--maybe-replace '("C-c b" . "test"))
+ '("C-c a" . "c-c a")))
+ (should (equal
+ (which-key--maybe-replace '("C-c ." . "not test ."))
+ '("C-c ." . "test .")))
+ (should (not
+ (equal
+ (which-key--maybe-replace '("C-c +" . "not test ."))
+ '("C-c ." . "test ."))))
+ (should (equal
+ (which-key--maybe-replace '("C-c [" . "orig bad regexp"))
+ '("C-c [" . "bad regexp")))
+ (should (equal
+ (which-key--maybe-replace '("C-c \\" . "pre quoting"))
+ '("C-c \\" . "regexp quoting")))
+ ;; see #155
+ (should (equal
+ (which-key--maybe-replace '("SPC . ." . "don't replace"))
+ '("SPC . ." . "don't replace")))
+ (should (equal
+ (which-key--maybe-replace '("SPC t 1" . "test mode"))
+ '("SPC t 1" . "[x] test mode")))
+ (should (equal
+ (which-key--maybe-replace '("SPC t 2" . "test mode"))
+ '("SPC t 2" . "[ ] test mode")))))
+
+(ert-deftest which-key-test--maybe-replace-multiple ()
+ "Test `which-key-allow-multiple-replacements'. See #156."
+ (let ((which-key-replacement-alist
+ '(((nil . "helm") . (nil . "HLM"))
+ ((nil . "projectile") . (nil . "PRJTL"))))
+ (which-key-allow-multiple-replacements t))
+ (should (equal
+ (which-key--maybe-replace '("C-c C-c" . "helm-x"))
+ '("C-c C-c" . "HLM-x")))
+ (should (equal
+ (which-key--maybe-replace '("C-c C-c" . "projectile-x"))
+ '("C-c C-c" . "PRJTL-x")))
+ (should (equal
+ (which-key--maybe-replace '("C-c C-c" . "helm-projectile-x"))
+ '("C-c C-c" . "HLM-PRJTL-x")))))
+
+(ert-deftest which-key-test--key-extraction ()
+ "Test `which-key--extract-key'. See #161."
+ (should (equal (which-key--extract-key "SPC a") "a"))
+ (should (equal (which-key--extract-key "C-x a") "a"))
+ (should (equal (which-key--extract-key "<left> b a") "a"))
+ (should (equal (which-key--extract-key "<left> a .. c") "a .. c"))
+ (should (equal (which-key--extract-key "M-a a .. c") "a .. c")))
+
+(provide 'which-key-tests)
+;;; which-key-tests.el ends here
diff --git a/packages/which-key/which-key.el b/packages/which-key/which-key.el
new file mode 100644
index 0000000..78b1665
--- /dev/null
+++ b/packages/which-key/which-key.el
@@ -0,0 +1,2355 @@
+;;; which-key.el --- Display available keybindings in popup -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Justin Burkett <address@hidden>
+;; Maintainer: Justin Burkett <address@hidden>
+;; URL: https://github.com/justbur/emacs-which-key
+;; Version: 3.0.1
+;; Keywords:
+;; Package-Requires: ((emacs "24.4"))
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; which-key provides the minor mode which-key-mode for Emacs. The mode
displays
+;; the key bindings following your currently entered incomplete command (a
+;; prefix) in a popup. For example, after enabling the minor mode if you enter
+;; C-x and wait for the default of 1 second the minibuffer will expand with all
+;; of the available key bindings that follow C-x (or as many as space allows
+;; given your settings). This includes prefixes like C-x 8 which are shown in a
+;; different face. Screenshots of what the popup will look like along with
+;; information about additional features can be found at
+;; https://github.com/justbur/emacs-which-key.
+;;
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'button)
+(require 'regexp-opt)
+
+;; For compiler
+(defvar evil-operator-shortcut-map)
+(defvar evil-operator-state-map)
+(defvar evil-motion-state-map)
+(defvar golden-ratio-mode)
+(declare-function evil-get-command-property "ext:evil-common.el")
+
+;;; Options
+
+(defgroup which-key nil
+ "Customization options for which-key-mode"
+ :group 'help
+ :prefix "which-key-")
+
+(defcustom which-key-idle-delay 1.0
+ "Delay (in seconds) for which-key buffer to popup. A value of zero
+might lead to issues, so a non-zero value is recommended
+(see https://github.com/justbur/emacs-which-key/issues/134)."
+ :group 'which-key
+ :type 'float)
+
+(defcustom which-key-idle-secondary-delay nil
+ "Once the which-key buffer shows once for a key sequence reduce
+the idle time to this amount (in seconds). This makes it possible
+to shorten the delay for subsequent popups in the same key
+sequence. The default is for this value to be nil, which disables
+this behavior."
+ :group 'which-key
+ :type 'float)
+
+(defcustom which-key-echo-keystrokes (if (and echo-keystrokes
+ (> (+ echo-keystrokes 0.01)
+ which-key-idle-delay))
+ (/ (float which-key-idle-delay) 4)
+ echo-keystrokes)
+ "Value to use for `echo-keystrokes'.
+This only applies if `which-key-popup-type' is minibuffer or
+`which-key-show-prefix' is echo. It needs to be less than
+`which-key-idle-delay' or else the keystroke echo will erase the
+which-key popup."
+ :group 'which-key
+ :type 'float)
+
+(defcustom which-key-max-description-length 27
+ "Truncate the description of keys to this length.
+Also adds \"..\". If nil, disable any truncation."
+ :group 'which-key
+ :type 'integer)
+
+(defcustom which-key-add-column-padding 0
+ "Additional padding (number of spaces) to add to the left of
+each key column."
+ :group 'which-key
+ :type 'integer)
+
+(defcustom which-key-unicode-correction 3
+ "Correction for wide unicode characters.
+Since we measure width in terms of the number of characters,
+Unicode characters that are wider than ASCII characters throw off
+the calculation for available width in the which-key buffer. This
+variable allows you to adjust for the wide unicode characters by
+artificially reducing the available width in the buffer.
+
+The default of 3 means allow for the total extra width
+contributed by any wide unicode characters to be up to one
+additional ASCII character in the which-key buffer. Increase this
+number if you are seeing charaters get cutoff on the right side
+of the which-key popup."
+ :group 'which-key
+ :type 'integer)
+
+(defcustom which-key-dont-use-unicode nil
+ "If non-nil, don't use any unicode characters in default setup."
+ :group 'which-key
+ :type 'integer)
+
+(defcustom which-key-separator
+ (if which-key-dont-use-unicode " : " " → ")
+ "Separator to use between key and description. Default is \" →
+\", unless `which-key-dont-use-unicode' is non nil, in which case
+the default is \" : \"."
+ :group 'which-key
+ :type 'string)
+
+(defcustom which-key-prefix-prefix "+"
+ "String to insert in front of prefix commands (i.e., commands
+that represent a sub-map). Default is \"+\"."
+ :group 'which-key
+ :type 'string)
+
+(defcustom which-key-compute-remaps nil
+ "If non-nil, show remapped command if a command has been
+remapped given the currently active keymaps."
+ :group 'which-key
+ :type 'boolean)
+
+(defvar which-key-key-replacement-alist nil)
+(make-obsolete-variable 'which-key-key-replacement-alist
+ 'which-key-replacement-alist "2016-11-21")
+(defvar which-key-description-replacement-alist nil)
+(make-obsolete-variable 'which-key-description-replacement-alist
+ 'which-key-replacement-alist "2016-11-21")
+(defvar which-key-key-based-description-replacement-alist nil)
+(make-obsolete-variable 'which-key-key-based-description-replacement-alist
+ 'which-key-replacement-alist "2016-11-21")
+
+(defcustom which-key-replacement-alist
+ (delq nil
+ `(((nil . "Prefix Command") . (nil . "prefix"))
+ ((nil . "\\`\\?\\?\\'") . (nil . "lambda"))
+ ((nil . "which-key-show-next-page-no-cycle") . (nil . "wk next pg"))
+ (("<\\([[:alnum:]-]+\\)>") . ("\\1"))
+ ,@(unless which-key-dont-use-unicode
+ '((("left") . ("←"))
+ (("right") . ("→"))))))
+ "Association list to determine how to manipulate descriptions
+of key bindings in the which-key popup. Each element of the list
+is a nested cons cell with the format
+
+\(MATCH CONS . REPLACEMENT\).
+
+The MATCH CONS determines when a replacement should occur and
+REPLACEMENT determines how the replacement should occur. Each may
+have the format \(KEY REGEXP . BINDING REGEXP\). For the
+replacement to apply the key binding must match both the KEY
+REGEXP and the BINDING REGEXP. A value of nil in either position
+can be used to match every possibility. The replacement is
+performed by using `replace-regexp-in-string' on the KEY REGEXP
+from the MATCH CONS and REPLACEMENT when it is a cons cell, and
+then similarly for the BINDING REGEXP. A nil value in the BINDING
+REGEXP position cancels the replacement. For example, the entry
+
+\(\(nil . \"Prefix Command\"\) . \(nil . \"prefix\"\)\)
+
+matches any binding with the descriptions \"Prefix Command\" and
+replaces the description with \"prefix\", ignoring the
+corresponding key.
+
+REPLACEMENT may also be a function taking a cons cell
+\(KEY . BINDING\) and producing a new corresponding cons cell.
+
+If REPLACEMENT is anything other than a cons cell \(and non nil\)
+the key binding is ignored by which-key.
+
+Finally, you can multiple replacements to occur for a given key
+binding by setting `which-key-allow-multiple-replacements' to a
+non-nil value."
+ :group 'which-key
+ :type '(alist :key-type (cons (choice regexp nil)
+ (choice regexp nil))
+ :value-type (cons (choice string nil)
+ (choice string nil))))
+
+(when (bound-and-true-p which-key-key-replacement-alist)
+ (mapc
+ (lambda (repl)
+ (push (cons (cons (car repl) nil) (cons (cdr repl) nil))
+ which-key-replacement-alist))
+ which-key-key-replacement-alist))
+(when (bound-and-true-p which-key-description-replacement-alist)
+ (mapc
+ (lambda (repl)
+ (push (cons (cons nil (car repl)) (cons nil (cdr repl)))
+ which-key-replacement-alist))
+ which-key-description-replacement-alist))
+
+(defcustom which-key-allow-multiple-replacements nil
+ "Allow a key binding to match and be modified by multiple
+elements in `which-key-replacement-alist' if non-nil. When nil,
+only the first match is used to perform replacements from
+`which-key-replacement-alist'."
+ :group 'which-key
+ :type 'boolean)
+
+(defcustom which-key-highlighted-command-list '()
+ "A list of strings and/or cons cells used to highlight certain
+commands. If the element is a string, assume it is a regexp
+pattern for matching command names and use
+`which-key-highlighted-command-face' for any matching names. If
+the element is a cons cell, it should take the form (regexp .
+face to apply)."
+ :group 'which-key
+ :type '(repeat (choice string (cons regexp face))))
+
+(defcustom which-key-special-keys '()
+ "These keys will automatically be truncated to one character
+and have `which-key-special-key-face' applied to them. This is
+disabled by default. Try this to see the effect.
+
+\(setq which-key-special-keys '(\"SPC\" \"TAB\" \"RET\" \"ESC\" \"DEL\")\)"
+ :group 'which-key
+ :type '(repeat string))
+
+(defcustom which-key-buffer-name " *which-key*"
+ "Name of which-key buffer."
+ :group 'which-key
+ :type 'string)
+
+(defcustom which-key-show-prefix 'echo
+ "Whether to and where to display the current prefix sequence.
+Possible choices are echo for echo area (the default), left, top
+and nil. Nil turns the feature off."
+ :group 'which-key
+ :type '(radio (const :tag "Left of the keys" left)
+ (const :tag "In the first line" top)
+ (const :tag "In the last line" bottom)
+ (const :tag "In the echo area" echo)
+ (const :tag "In the mode-line" mode-line)
+ (const :tag "Hide" nil)))
+
+(defcustom which-key-popup-type 'side-window
+ "Supported types are minibuffer, side-window, frame, and custom."
+ :group 'which-key
+ :type '(radio (const :tag "Show in minibuffer" minibuffer)
+ (const :tag "Show in side window" side-window)
+ (const :tag "Show in popup frame" frame)
+ (const :tag "Use your custom display functions" custom)))
+
+(defcustom which-key-min-display-lines 1
+ "The minimum number of horizontal lines to display in the
+ which-key buffer."
+ :group 'which-key
+ :type 'integer)
+
+(defcustom which-key-max-display-columns nil
+ "The maximum number of columns to display in the which-key
+buffer. nil means don't impose a maximum."
+ :group 'which-key
+ :type 'integer)
+
+(defcustom which-key-side-window-location 'bottom
+ "Location of which-key popup when `which-key-popup-type' is side-window.
+Should be one of top, bottom, left or right. You can also specify
+a list of two locations, like (right bottom). In this case, the
+first location is tried. If there is not enough room, the second
+location is tried."
+ :group 'which-key
+ :type '(radio (const right)
+ (const bottom)
+ (const left)
+ (const top)
+ (const (right bottom))
+ (const (bottom right))))
+
+(defcustom which-key-side-window-slot 0
+ "The `slot' to use for `display-buffer-in-side-window' when
+`which-key-popup-type' is 'side-window. Quoting from the
+docstring of `display-buffer-in-side-window',
+
+‘slot’ if non-nil, specifies the window slot where to display
+ BUFFER. A value of zero or nil means use the middle slot on
+ the specified side. A negative value means use a slot
+ preceding (that is, above or on the left of) the middle slot.
+ A positive value means use a slot following (that is, below or
+ on the right of) the middle slot. The default is zero."
+ :group 'which-key
+ :type 'integer)
+
+(defcustom which-key-side-window-max-width 0.333
+ "Maximum width of which-key popup when type is side-window and
+location is left or right.
+This variable can also be a number between 0 and 1. In that case, it denotes
+a percentage out of the frame's width."
+ :group 'which-key
+ :type 'float)
+
+(defcustom which-key-side-window-max-height 0.25
+ "Maximum height of which-key popup when type is side-window and
+location is top or bottom.
+This variable can also be a number between 0 and 1. In that case, it denotes
+a percentage out of the frame's height."
+ :group 'which-key
+ :type 'float)
+
+(defcustom which-key-frame-max-width 60
+ "Maximum width of which-key popup when type is frame."
+ :group 'which-key
+ :type 'integer)
+
+(defcustom which-key-frame-max-height 20
+ "Maximum height of which-key popup when type is frame."
+ :group 'which-key
+ :type 'integer)
+
+(defcustom which-key-allow-imprecise-window-fit nil
+ "If non-nil allow which-key to use a less intensive method of
+fitting the popup window to the buffer. If you are noticing lag
+when the which-key popup displays turning this on may help.
+
+See https://github.com/justbur/emacs-which-key/issues/130"
+ :group 'which-key
+ :type 'boolean)
+
+(defcustom which-key-show-remaining-keys nil
+ "Show remaining keys in last slot, when keys are hidden."
+ :group 'which-key
+ :type '(radio (const :tag "Yes" t)
+ (const :tag "No" nil)))
+
+(defcustom which-key-sort-order 'which-key-key-order
+ "If nil, do not resort the output from
+`describe-buffer-bindings' which groups by mode. Ordering options
+are
+
+1. `which-key-key-order': by key (default)
+2. `which-key-key-order-alpha': by key using alphabetical order
+3. `which-key-description-order': by description
+4. `which-key-prefix-then-key-order': prefix (no prefix first) then key
+5. `which-key-local-then-key-order': local binding then key
+
+See the README and the docstrings for those functions for more
+information."
+ :group 'which-key
+ :type '(choice (function-item which-key-key-order)
+ (function-item which-key-key-order-alpha)
+ (function-item which-key-description-order)
+ (function-item which-key-prefix-then-key-order)
+ (function-item which-key-local-then-key-order)))
+
+(defcustom which-key-sort-uppercase-first t
+ "If non-nil, uppercase comes before lowercase in sorting
+function chosen in `which-key-sort-order'. Otherwise, the order
+is reversed."
+ :group 'which-key
+ :type 'boolean)
+
+(defcustom which-key-paging-prefixes '()
+ "Enable paging for these prefixes."
+ :group 'which-key
+ :type '(repeat string))
+
+(defcustom which-key-paging-key "<f5>"
+ "Key to use for changing pages. Bound after each of the
+prefixes in `which-key-paging-prefixes'"
+ :group 'which-key
+ :type 'string)
+
+;; (defcustom which-key-undo-key nil
+;; "Key (string) to use for undoing keypresses. Bound recursively
+;; in each of the maps in `which-key-undo-keymaps'."
+;; :group 'which-key
+;; :type 'string)
+
+;; (defcustom which-key-undo-keymaps '()
+;; "Keymaps in which to bind `which-key-undo-key'"
+;; :group 'which-key
+;; :type '(repeat symbol))
+
+(defcustom which-key-use-C-h-commands t
+ "Use C-h for paging if non-nil. Normally C-h after a prefix
+ calls `describe-prefix-bindings'. This changes that command to
+ a which-key paging command when which-key-mode is active."
+ :group 'which-key
+ :type 'boolean)
+
+(defcustom which-key-is-verbose nil
+ "Whether to warn about potential mistakes in configuration."
+ :group 'which-key
+ :type 'boolean)
+
+(defvar which-key-C-h-map
+ (let ((map (make-sparse-keymap)))
+ (dolist (bind '(("\C-a" . which-key-abort)
+ ("a" . which-key-abort)
+ ("\C-h" . which-key-show-standard-help)
+ ("h" . which-key-show-standard-help)
+ ("\C-n" . which-key-show-next-page-cycle)
+ ("n" . which-key-show-next-page-cycle)
+ ("\C-p" . which-key-show-previous-page-cycle)
+ ("p" . which-key-show-previous-page-cycle)
+ ("\C-u" . which-key-undo-key)
+ ("u" . which-key-undo-key)))
+ (define-key map (car bind) (cdr bind)))
+ map)
+ "Keymap for C-h commands.")
+
+(defvar which-key--paging-functions '(which-key-C-h-dispatch
+ which-key-turn-page
+ which-key-show-next-page-cycle
+ which-key-show-next-page-no-cycle
+ which-key-show-previous-page-cycle
+ which-key-show-previous-page-no-cycle
+ which-key-undo-key
+ which-key-undo))
+
+(defcustom which-key-hide-alt-key-translations t
+ "Hide key translations using Alt key if non nil.
+These translations are not relevant most of the times since a lot
+of terminals issue META modifier for the Alt key.
+
+See
http://www.gnu.org/software/emacs/manual/html_node/emacs/Modifier-Keys.html"
+ :group 'which-key
+ :type 'boolean)
+
+(defcustom which-key-delay-functions nil
+ "A list of functions that may decide whether to delay the
+which-key popup based on the current incomplete key
+sequence. Each function in the list is run with two arguments,
+the current key sequence as produced by `key-description' and the
+length of the key sequence. If the popup should be delayed based
+on that key sequence, the function should return the delay time
+in seconds. Returning nil means no delay. The first function in
+this list to return a value is the value that is used.
+
+The delay time is effectively added to the normal
+`which-key-idle-delay'."
+ :group 'which-key
+ :type '(repeat function))
+
+(defcustom which-key-allow-regexps nil
+ "A list of regexp strings to use to filter key sequences. When
+non-nil, for a key sequence to trigger the which-key popup it
+must match one of the regexps in this list. The format of the key
+sequences is what is produced by `key-description'."
+ :group 'which-key
+ :type '(repeat regexp))
+
+(defcustom which-key-inhibit-regexps nil
+ "Similar to `which-key-allow-regexps', a list of regexp strings
+to use to filter key sequences. When non-nil, for a key sequence
+to trigger the which-key popup it cannot match one of the regexps
+in this list. The format of the key sequences is what is produced
+by `key-description'."
+ :group 'which-key
+ :type '(repeat regexp))
+
+(defcustom which-key-show-transient-maps nil
+ "Show keymaps created by `set-transient-map' when applicable.
+
+More specifically, detect when `overriding-terminal-local-map' is
+set (this is the keymap used by `set-transient-map') and display
+it."
+ :group 'which-key
+ :type 'boolean)
+
+;; Hooks
+(defcustom which-key-init-buffer-hook '()
+ "Hook run when which-key buffer is initialized."
+ :group 'which-key
+ :type 'hook)
+
+;;;; Faces
+
+(defgroup which-key-faces nil
+ "Faces for which-key-mode"
+ :group 'which-key
+ :prefix "which-key-")
+
+(defface which-key-key-face
+ '((t . (:inherit font-lock-constant-face)))
+ "Face for which-key keys"
+ :group 'which-key-faces)
+
+(defface which-key-separator-face
+ '((t . (:inherit font-lock-comment-face)))
+ "Face for the separator (default separator is an arrow)"
+ :group 'which-key-faces)
+
+(defface which-key-note-face
+ '((t . (:inherit which-key-separator-face)))
+ "Face for notes or hints occasionally provided"
+ :group 'which-key-faces)
+
+(defface which-key-command-description-face
+ '((t . (:inherit font-lock-function-name-face)))
+ "Face for the key description when it is a command"
+ :group 'which-key-faces)
+
+(defface which-key-local-map-description-face
+ '((t . (:inherit which-key-command-description-face)))
+ "Face for the key description when it is found in `current-local-map'"
+ :group 'which-key-faces)
+
+(defface which-key-highlighted-command-face
+ '((t . (:inherit which-key-command-description-face :underline t)))
+ "Default face for the command description when it is a command
+and it matches a string in `which-key-highlighted-command-list'."
+ :group 'which-key-faces)
+
+(defface which-key-group-description-face
+ '((t . (:inherit font-lock-keyword-face)))
+ "Face for the key description when it is a group or prefix"
+ :group 'which-key-faces)
+
+(defface which-key-special-key-face
+ '((t . (:inherit which-key-key-face :inverse-video t :weight bold)))
+ "Face for special keys (SPC, TAB, RET)"
+ :group 'which-key-faces)
+
+;;;; Custom popup
+
+(defcustom which-key-custom-popup-max-dimensions-function nil
+ "Variable to hold a custom max-dimensions function.
+Will be passed the width of the active window and is expected to
+return the maximum height in lines and width in characters of the
+which-key popup in the form a cons cell (height . width)."
+ :group 'which-key
+ :type 'function)
+
+(defcustom which-key-custom-hide-popup-function nil
+ "Variable to hold a custom hide-popup function.
+It takes no arguments and the return value is ignored."
+ :group 'which-key
+ :type 'function)
+
+(defcustom which-key-custom-show-popup-function nil
+ "Variable to hold a custom show-popup function.
+Will be passed the required dimensions in the form (height .
+width) in lines and characters respectively. The return value is
+ignored."
+ :group 'which-key
+ :type 'function)
+
+(defcustom which-key-lighter " WK"
+ "Minor mode lighter to use in the mode-line."
+ :group 'which-key
+ :type 'string)
+
+(defvar which-key-inhibit nil
+ "Prevent which-key from popping up momentarily by setting this
+to a non-nil value for the execution of a command. Like this
+
+\(let \(\(which-key-inhibit t\)\)
+...\)")
+
+(defvar which-key-keymap-history nil
+ "History of keymap selections in functions like
+`which-key-show-keymap'.")
+
+;;; Internal Vars
+
+(defvar which-key--buffer nil
+ "Internal: Holds reference to which-key buffer.")
+(defvar which-key--timer nil
+ "Internal: Holds reference to open window timer.")
+(defvar which-key--secondary-timer-active nil
+ "Internal: Non-nil if the secondary timer is active.")
+(defvar which-key--paging-timer nil
+ "Internal: Holds reference to timer for paging.")
+(defvar which-key--frame nil
+ "Internal: Holds reference to which-key frame.
+Used when `which-key-popup-type' is frame.")
+(defvar which-key--echo-keystrokes-backup nil
+ "Internal: Backup the initial value of `echo-keystrokes'.")
+(defvar which-key--prefix-help-cmd-backup nil
+ "Internal: Backup the value of `prefix-help-command'.")
+(defvar which-key--pages-plist nil
+ "Internal: Holds page objects")
+(defvar which-key--current-prefix nil
+ "Internal: Holds current prefix")
+(defvar which-key--current-page-n nil
+ "Internal: Current pages of showing buffer. Nil means no buffer
+showing.")
+(defvar which-key--on-last-page nil
+ "Internal: Non-nil if showing last page.")
+(defvar which-key--last-try-2-loc nil
+ "Internal: Last location of side-window when two locations
+used.")
+(defvar which-key--multiple-locations nil)
+(defvar which-key--using-top-level nil)
+(defvar which-key--using-show-keymap nil)
+(defvar which-key--using-show-operator-keymap nil)
+(defvar which-key--inhibit-next-operator-popup nil)
+(defvar which-key--current-show-keymap-name nil)
+(defvar which-key--prior-show-keymap-args nil)
+(defvar which-key--previous-frame-size nil)
+(defvar which-key--prefix-title-alist nil)
+(defvar which-key--debug nil)
+
+(make-obsolete-variable 'which-key-prefix-name-alist nil "2016-10-05")
+(make-obsolete-variable 'which-key-prefix-title-alist nil "2016-10-05")
+
+;;; Third-party library support
+;;;; Evil
+
+(defcustom which-key-allow-evil-operators (boundp 'evil-this-operator)
+ "Allow popup to show for evil operators. The popup is normally
+ inhibited in the middle of commands, but setting this to
+ non-nil will override this behavior for evil operators."
+ :group 'which-key
+ :type 'boolean)
+
+(defcustom which-key-show-operator-state-maps nil
+ "Experimental: Try to show the right keys following an evil
+command that reads a motion, such as \"y\", \"d\" and \"c\" from
+normal state. This is experimental, because there might be some
+valid keys missing and it might be showing some invalid keys."
+ :group 'which-key
+ :type 'boolean)
+
+;;;;; God-mode
+
+(defvar which-key--god-mode-support-enabled nil
+ "Support god-mode if non-nil. This is experimental,
+so you need to explicitly opt-in for now. Please report any
+problems at github.")
+
+(defvar which-key--god-mode-key-string nil
+ "Holds key string to use for god-mode support.")
+
+(defadvice god-mode-lookup-command
+ (around which-key--god-mode-lookup-command-advice disable)
+ (setq which-key--god-mode-key-string (ad-get-arg 0))
+ (unwind-protect
+ ad-do-it
+ (when (bound-and-true-p which-key-mode)
+ (which-key--hide-popup))))
+
+(defun which-key-enable-god-mode-support (&optional disable)
+ "Enable support for god-mode if non-nil. This is experimental,
+so you need to explicitly opt-in for now. Please report any
+problems at github. If DISABLE is non-nil disable support."
+ (interactive "P")
+ (setq which-key--god-mode-support-enabled (null disable))
+ (if disable
+ (ad-disable-advice
+ 'god-mode-lookup-command
+ 'around 'which-key--god-mode-lookup-command-advice)
+ (ad-enable-advice
+ 'god-mode-lookup-command
+ 'around 'which-key--god-mode-lookup-command-advice))
+ (ad-activate 'god-mode-lookup-command))
+
+;;; Mode
+
+;;;###autoload
+(define-minor-mode which-key-mode
+ "Toggle which-key-mode."
+ :global t
+ :lighter which-key-lighter
+ :keymap (let ((map (make-sparse-keymap)))
+ (mapc
+ (lambda (prefix)
+ (define-key map
+ (kbd (concat prefix " " which-key-paging-key))
+ #'which-key-C-h-dispatch))
+ which-key-paging-prefixes)
+ map)
+ (if which-key-mode
+ (progn
+ (setq which-key--echo-keystrokes-backup echo-keystrokes)
+ (when (or (eq which-key-show-prefix 'echo)
+ (eq which-key-popup-type 'minibuffer))
+ (which-key--setup-echo-keystrokes))
+ (unless (member prefix-help-command which-key--paging-functions)
+ (setq which-key--prefix-help-cmd-backup prefix-help-command))
+ (when which-key-use-C-h-commands
+ (setq prefix-help-command #'which-key-C-h-dispatch))
+ (when which-key-show-remaining-keys
+ (add-hook 'pre-command-hook #'which-key--lighter-restore))
+ (add-hook 'pre-command-hook #'which-key--hide-popup)
+ (add-hook 'focus-out-hook #'which-key--stop-timer)
+ (add-hook 'focus-in-hook #'which-key--start-timer)
+ (add-hook 'window-configuration-change-hook
+ 'which-key--hide-popup-on-frame-size-change)
+ (which-key--start-timer))
+ (setq echo-keystrokes which-key--echo-keystrokes-backup)
+ (when which-key--prefix-help-cmd-backup
+ (setq prefix-help-command which-key--prefix-help-cmd-backup))
+ (when which-key-show-remaining-keys
+ (remove-hook 'pre-command-hook #'which-key--lighter-restore))
+ (remove-hook 'pre-command-hook #'which-key--hide-popup)
+ (remove-hook 'focus-out-hook #'which-key--stop-timer)
+ (remove-hook 'focus-in-hook #'which-key--start-timer)
+ (remove-hook 'window-configuration-change-hook
+ 'which-key--hide-popup-on-frame-size-change)
+ (which-key--stop-timer)))
+
+(defun which-key--init-buffer ()
+ "Initialize which-key buffer"
+ (unless (buffer-live-p which-key--buffer)
+ (setq which-key--buffer (get-buffer-create which-key-buffer-name))
+ (with-current-buffer which-key--buffer
+ ;; suppress confusing minibuffer message
+ (let (message-log-max)
+ (toggle-truncate-lines 1)
+ (message ""))
+ (setq-local cursor-type nil)
+ (setq-local cursor-in-non-selected-windows nil)
+ (setq-local mode-line-format nil)
+ (setq-local word-wrap nil)
+ (setq-local show-trailing-whitespace nil)
+ (run-hooks 'which-key-init-buffer-hook))))
+
+(defun which-key--setup-echo-keystrokes ()
+ "Reduce `echo-keystrokes' if necessary (it will interfere if
+it's set too high)."
+ (when (and echo-keystrokes
+ (> (abs (- echo-keystrokes which-key-echo-keystrokes)) 0.000001))
+ (if (> which-key-idle-delay which-key-echo-keystrokes)
+ (setq echo-keystrokes which-key-echo-keystrokes)
+ (setq which-key-echo-keystrokes (/ (float which-key-idle-delay) 4)
+ echo-keystrokes which-key-echo-keystrokes))))
+
+(defun which-key-remove-default-unicode-chars ()
+ "Use of `which-key-dont-use-unicode' is preferred to this
+function, but it's included here in case someone cannot set that
+variable early enough in their configuration, if they are using a
+starter kit for example."
+ (when (string-equal which-key-separator " → ")
+ (setq which-key-separator " : "))
+ (setq which-key-key-replacement-alist
+ (delete '("left" . "←") which-key-key-replacement-alist))
+ (setq which-key-key-replacement-alist
+ (delete '("right" . "→") which-key-key-replacement-alist)))
+
+;;; Default configuration functions for use by users.
+
+;;;###autoload
+(defun which-key-setup-side-window-right ()
+ "Apply suggested settings for side-window that opens on right."
+ (interactive)
+ (setq which-key-popup-type 'side-window
+ which-key-side-window-location 'right
+ which-key-show-prefix 'top))
+
+;;;###autoload
+(defun which-key-setup-side-window-right-bottom ()
+ "Apply suggested settings for side-window that opens on right
+if there is space and the bottom otherwise."
+ (interactive)
+ (setq which-key-popup-type 'side-window
+ which-key-side-window-location '(right bottom)
+ which-key-show-prefix 'top))
+
+;;;###autoload
+(defun which-key-setup-side-window-bottom ()
+ "Apply suggested settings for side-window that opens on
+bottom."
+ (interactive)
+ (which-key--setup-echo-keystrokes)
+ (setq which-key-popup-type 'side-window
+ which-key-side-window-location 'bottom
+ which-key-show-prefix 'echo))
+
+;;;###autoload
+(defun which-key-setup-minibuffer ()
+ "Apply suggested settings for minibuffer."
+ (interactive)
+ (which-key--setup-echo-keystrokes)
+ (setq which-key-popup-type 'minibuffer
+ which-key-show-prefix 'left))
+
+;;; Helper functions to modify replacement lists.
+
+;;;###autoload
+(defun which-key-add-key-based-replacements
+ (key-sequence replacement &rest more)
+ "Replace the description of KEY-SEQUENCE with REPLACEMENT.
+KEY-SEQUENCE is a string suitable for use in `kbd'. REPLACEMENT
+may either be a string, as in
+
+\(which-key-add-key-based-replacements \"C-x 1\" \"maximize\"\)
+
+a cons of two strings as in
+
+\(which-key-add-key-based-replacements \"C-x 8\"
+ '(\"unicode\" . \"Unicode keys\")\)
+
+or a function that takes a \(KEY . BINDING\) cons and returns a
+replacement.
+
+In the second case, the second string is used to provide a longer
+name for the keys under a prefix.
+
+MORE allows you to specifcy additional KEY REPLACEMENT pairs. All
+replacements are added to
+`which-key-key-based-description-replacement-alist'."
+ ;; TODO: Make interactive
+ (while key-sequence
+ ;; normalize key sequences before adding
+ (let ((key-seq (key-description (kbd key-sequence)))
+ (replace (or (and (functionp replacement) replacement)
+ (car-safe replacement)
+ replacement)))
+ (push (cons (cons (concat "\\`" (regexp-quote key-seq) "\\'") nil)
+ (if (functionp replace) replace (cons nil replace)))
+ which-key-replacement-alist)
+ (when (and (not (functionp replacement)) (consp replacement))
+ (push (cons key-seq (cdr-safe replacement))
+ which-key--prefix-title-alist)))
+ (setq key-sequence (pop more) replacement (pop more))))
+(put 'which-key-add-key-based-replacements 'lisp-indent-function 'defun)
+
+;;;###autoload
+(defun which-key-add-major-mode-key-based-replacements
+ (mode key-sequence replacement &rest more)
+ "Functions like `which-key-add-key-based-replacements'.
+The difference is that MODE specifies the `major-mode' that must
+be active for KEY-SEQUENCE and REPLACEMENT (MORE contains
+addition KEY-SEQUENCE REPLACEMENT pairs) to apply."
+ ;; TODO: Make interactive
+ (when (not (symbolp mode))
+ (error "MODE should be a symbol corresponding to a value of major-mode"))
+ (let ((mode-alist
+ (or (cdr-safe (assq mode which-key-replacement-alist)) (list)))
+ (title-mode-alist
+ (or (cdr-safe (assq mode which-key--prefix-title-alist)) (list))))
+ (while key-sequence
+ ;; normalize key sequences before adding
+ (let ((key-seq (key-description (kbd key-sequence)))
+ (replace (or (and (functionp replacement) replacement)
+ (car-safe replacement)
+ replacement)))
+ (push (cons (cons (concat "\\`" (regexp-quote key-seq) "\\'") nil)
+ (if (functionp replace) replace (cons nil replace)))
+ mode-alist)
+ (when (and (not (functionp replacement)) (consp replacement))
+ (push (cons key-seq (cdr-safe replacement))
+ title-mode-alist)))
+ (setq key-sequence (pop more) replacement (pop more)))
+ (if (assq mode which-key-replacement-alist)
+ (setcdr (assq mode which-key-replacement-alist) mode-alist)
+ (push (cons mode mode-alist) which-key-replacement-alist))
+ (if (assq mode which-key--prefix-title-alist)
+ (setcdr (assq mode which-key--prefix-title-alist) title-mode-alist)
+ (push (cons mode title-mode-alist) which-key--prefix-title-alist))))
+(put 'which-key-add-major-mode-key-based-replacements
+ 'lisp-indent-function 'defun)
+
+(defalias 'which-key-add-prefix-title 'which-key-add-key-based-replacements)
+(make-obsolete 'which-key-add-prefix-title
+ 'which-key-add-key-based-replacements
+ "2016-10-05")
+
+(defalias 'which-key-declare-prefixes 'which-key-add-key-based-replacements)
+(make-obsolete 'which-key-declare-prefixes
+ 'which-key-add-key-based-replacements
+ "2016-10-05")
+
+(defalias 'which-key-declare-prefixes-for-mode
+ 'which-key-add-major-mode-key-based-replacements)
+(make-obsolete 'which-key-declare-prefixes-for-mode
+ 'which-key-add-major-mode-key-based-replacements
+ "2016-10-05")
+
+(defun which-key-define-key-recursively (map key def &optional at-root)
+ "Recursively bind KEY in MAP to DEF on every level of MAP except the first.
+If AT-ROOT is non-nil the binding is also placed at the root of MAP."
+ (when at-root (define-key map key def))
+ (map-keymap
+ (lambda (_ev df)
+ (when (keymapp df)
+ (which-key-define-key-recursively df key def t)))
+ map))
+
+;;; Functions for computing window sizes
+
+(defun which-key--text-width-to-total (text-width)
+ "Convert window text-width to window total-width.
+TEXT-WIDTH is the desired text width of the window. The function
+calculates what total width is required for a window in the
+selected to have a text-width of TEXT-WIDTH columns. The
+calculation considers possible fringes and scroll bars. This
+function assumes that the desired window has the same character
+width as the frame."
+ (let ((char-width (frame-char-width)))
+ (+ text-width
+ (/ (frame-fringe-width) char-width)
+ (/ (frame-scroll-bar-width) char-width)
+ (if (which-key--char-enlarged-p) 1 0)
+ ;; add padding to account for possible wide (unicode) characters
+ 3)))
+
+(defun which-key--total-width-to-text (total-width)
+ "Convert window total-width to window text-width.
+TOTAL-WIDTH is the desired total width of the window. The function calculates
+what text width fits such a window. The calculation considers possible fringes
+and scroll bars. This function assumes that the desired window has the same
+character width as the frame."
+ (let ((char-width (frame-char-width)))
+ (- total-width
+ (/ (frame-fringe-width) char-width)
+ (/ (frame-scroll-bar-width) char-width)
+ (if (which-key--char-enlarged-p) 1 0)
+ ;; add padding to account for possible wide (unicode) characters
+ 3)))
+
+(defun which-key--char-enlarged-p (&optional _frame)
+ (> (frame-char-width)
+ (/ (float (frame-pixel-width)) (window-total-width (frame-root-window)))))
+
+(defun which-key--char-reduced-p (&optional _frame)
+ (< (frame-char-width)
+ (/ (float (frame-pixel-width)) (window-total-width (frame-root-window)))))
+
+(defun which-key--char-exact-p (&optional _frame)
+ (= (frame-char-width)
+ (/ (float (frame-pixel-width)) (window-total-width (frame-root-window)))))
+
+(defun which-key--width-or-percentage-to-width (width-or-percentage)
+ "Return window total width.
+If WIDTH-OR-PERCENTAGE is a whole number, return it unchanged. Otherwise, it
+should be a percentage (a number between 0 and 1) out of the frame's width.
+More precisely, it should be a percentage out of the frame's root window's
+total width."
+ (if (wholenump width-or-percentage)
+ width-or-percentage
+ (round (* width-or-percentage (window-total-width (frame-root-window))))))
+
+(defun which-key--height-or-percentage-to-height (height-or-percentage)
+ "Return window total height.
+If HEIGHT-OR-PERCENTAGE is a whole number, return it unchanged. Otherwise, it
+should be a percentage (a number between 0 and 1) out of the frame's height.
+More precisely, it should be a percentage out of the frame's root window's
+total height."
+ (if (wholenump height-or-percentage)
+ height-or-percentage
+ (round (* height-or-percentage (window-total-height
(frame-root-window))))))
+
+(defun which-key--frame-size-changed-p ()
+ "Non-nil if a change in frame size is detected."
+ (let ((new-size (cons (frame-width) (frame-height))))
+ (cond ((null which-key--previous-frame-size)
+ (setq which-key--previous-frame-size new-size)
+ nil)
+ ((not (equal which-key--previous-frame-size new-size))
+ (setq which-key--previous-frame-size new-size)))))
+
+;;; Show/hide which-key buffer
+
+(defun which-key--hide-popup ()
+ "This function is called to hide the which-key buffer."
+ (unless (member real-this-command which-key--paging-functions)
+ (setq which-key--current-page-n nil
+ which-key--current-prefix nil
+ which-key--using-top-level nil
+ which-key--using-show-keymap nil
+ which-key--using-show-operator-keymap nil
+ which-key--current-show-keymap-name nil
+ which-key--prior-show-keymap-args nil
+ which-key--on-last-page nil)
+ (when (and which-key-idle-secondary-delay
+ which-key--secondary-timer-active)
+ (which-key--start-timer))
+ (which-key--lighter-restore)
+ (cl-case which-key-popup-type
+ ;; Not necessary to hide minibuffer
+ ;; (minibuffer (which-key--hide-buffer-minibuffer))
+ (side-window (which-key--hide-buffer-side-window))
+ (frame (which-key--hide-buffer-frame))
+ (custom (funcall which-key-custom-hide-popup-function)))))
+
+(defun which-key--hide-popup-ignore-command ()
+ "Version of `which-key--hide-popup' without the check of
+`real-this-command'."
+ (cl-case which-key-popup-type
+ (side-window (which-key--hide-buffer-side-window))
+ (frame (which-key--hide-buffer-frame))
+ (custom (funcall which-key-custom-hide-popup-function))))
+
+(defun which-key--hide-popup-on-frame-size-change ()
+ "Hide which-key popup if the frame is resized (to trigger a new
+popup)."
+ (when (which-key--frame-size-changed-p)
+ (which-key--hide-popup)))
+
+(defun which-key--hide-buffer-side-window ()
+ "Hide which-key buffer when side-window popup is used."
+ (when (buffer-live-p which-key--buffer)
+ ;; in case which-key buffer was shown in an existing window, `quit-window'
+ ;; will re-show the previous buffer, instead of closing the window
+ (quit-windows-on which-key--buffer)))
+
+(defun which-key--hide-buffer-frame ()
+ "Hide which-key buffer when frame popup is used."
+ (when (frame-live-p which-key--frame)
+ (delete-frame which-key--frame)))
+
+(defun which-key--popup-showing-p ()
+ (window-live-p (get-buffer-window which-key--buffer)))
+
+(defun which-key--show-popup (act-popup-dim)
+ "Show the which-key buffer.
+ACT-POPUP-DIM includes the dimensions, (height . width) of the
+buffer text to be displayed in the popup. Return nil if no window
+is shown, or if there is no need to start the closing timer."
+ (when (and (> (car act-popup-dim) 0) (> (cdr act-popup-dim) 0))
+ (cl-case which-key-popup-type
+ ;; Not called for minibuffer
+ ;; (minibuffer (which-key--show-buffer-minibuffer act-popup-dim))
+ (side-window (which-key--show-buffer-side-window act-popup-dim))
+ (frame (which-key--show-buffer-frame act-popup-dim))
+ (custom (funcall which-key-custom-show-popup-function act-popup-dim)))))
+
+(defun which-key--fit-buffer-to-window-horizontally
+ (&optional window &rest params)
+ "Slightly modified version of `fit-buffer-to-window'.
+Use &rest params because `fit-buffer-to-window' has a different
+call signature in different emacs versions"
+ (let ((fit-window-to-buffer-horizontally t))
+ (apply #'fit-window-to-buffer window params)))
+
+(defun which-key--show-buffer-side-window (act-popup-dim)
+ "Show which-key buffer when popup type is side-window."
+ (let* ((height (car act-popup-dim))
+ (width (cdr act-popup-dim))
+ (alist
+ (if which-key-allow-imprecise-window-fit
+ `((window-width . ,(which-key--text-width-to-total width))
+ (window-height . ,height)
+ (side . ,which-key-side-window-location)
+ (slot . ,which-key-side-window-slot))
+ `((window-width . which-key--fit-buffer-to-window-horizontally)
+ (window-height . (lambda (w) (fit-window-to-buffer w nil 1)))
+ (side . ,which-key-side-window-location)
+ (slot . ,which-key-side-window-slot)))))
+ ;; Previously used `display-buffer-in-major-side-window' here, but
+ ;; apparently that is meant to be an internal function. See emacs bug
#24828
+ ;; and advice given there.
+ (cond
+ ((eq which-key--multiple-locations t)
+ ;; possibly want to switch sides in this case so we can't reuse the
window
+ (delete-windows-on which-key--buffer)
+ (display-buffer-in-side-window which-key--buffer alist))
+ ((get-buffer-window which-key--buffer)
+ (display-buffer-reuse-window which-key--buffer alist))
+ (t
+ (display-buffer-in-side-window which-key--buffer alist)))))
+
+(defun which-key--show-buffer-frame (act-popup-dim)
+ "Show which-key buffer when popup type is frame."
+ (let* (;(orig-window (selected-window))
+ (frame-height (+ (car act-popup-dim)
+ (if (with-current-buffer which-key--buffer
+ mode-line-format)
+ 1
+ 0)))
+ ;; without adding 2, frame sometimes isn't wide enough for the buffer.
+ ;; this is probably because of the fringes. however, setting fringes
+ ;; sizes to 0 (instead of adding 2) didn't always make the frame wide
+ ;; enough. don't know why it is so.
+ (frame-width (+ (cdr act-popup-dim) 2))
+ (new-window (if (and (frame-live-p which-key--frame)
+ (eq which-key--buffer
+ (window-buffer
+ (frame-root-window which-key--frame))))
+ (which-key--show-buffer-reuse-frame
+ frame-height frame-width)
+ (which-key--show-buffer-new-frame
+ frame-height frame-width))))
+ (when new-window
+ ;; display successful
+ (setq which-key--frame (window-frame new-window))
+ new-window)))
+
+(defun which-key--show-buffer-new-frame (frame-height frame-width)
+ "Helper for `which-key--show-buffer-frame'."
+ (let* ((frame-params `((height . ,frame-height)
+ (width . ,frame-width)
+ ;; tell the window manager to respect the given sizes
+ (user-size . t)
+ ;; which-key frame doesn't need a minibuffer
+ (minibuffer . nil)
+ (name . "which-key")
+ ;; no need for scroll bars in which-key frame
+ (vertical-scroll-bars . nil)
+ ;; (left-fringe . 0)
+ ;; (right-fringe . 0)
+ ;; (right-divider-width . 0)
+ ;; make sure frame is visible
+ (visibility . t)))
+ (alist `((pop-up-frame-parameters . ,frame-params)))
+ (orig-frame (selected-frame))
+ (new-window (display-buffer-pop-up-frame which-key--buffer alist)))
+ (when new-window
+ ;; display successful
+ (redirect-frame-focus (window-frame new-window) orig-frame)
+ new-window)))
+
+(defun which-key--show-buffer-reuse-frame (frame-height frame-width)
+ "Helper for `which-key--show-buffer-frame'."
+ (let ((window
+ (display-buffer-reuse-window
+ which-key--buffer `((reusable-frames . ,which-key--frame)))))
+ (when window
+ ;; display successful
+ (set-frame-size (window-frame window) frame-width frame-height)
+ window)))
+
+;;; Max dimension of available window functions
+
+(defun which-key--popup-max-dimensions ()
+ "Dimesion functions should return the maximum possible (height
+. width) of the intended popup. SELECTED-WINDOW-WIDTH is the
+width of currently active window, not the which-key buffer
+window."
+ (cl-case which-key-popup-type
+ (minibuffer (which-key--minibuffer-max-dimensions))
+ (side-window (which-key--side-window-max-dimensions))
+ (frame (which-key--frame-max-dimensions))
+ (custom (funcall which-key-custom-popup-max-dimensions-function
+ (window-width)))))
+
+(defun which-key--minibuffer-max-dimensions ()
+ "Return max-dimensions of minibuffer (height . width).
+Measured in lines and characters respectively."
+ (cons
+ ;; height
+ (if (floatp max-mini-window-height)
+ (floor (* (frame-text-lines)
+ max-mini-window-height))
+ max-mini-window-height)
+ ;; width
+ (max 0 (- (frame-text-cols) which-key-unicode-correction))))
+
+(defun which-key--side-window-max-dimensions ()
+ "Return max-dimensions of the side-window popup (height .
+width) in lines and characters respectively."
+ (cons
+ ;; height
+ (if (member which-key-side-window-location '(left right))
+ ;; 1 is a kludge to make sure there is no overlap
+ (- (frame-height) (window-text-height (minibuffer-window)) 1)
+ ;; (window-mode-line-height which-key--window))
+ ;; FIXME: change to something like
+ ;; (min which-*-height (calculate-max-height))
+ (which-key--height-or-percentage-to-height
+ which-key-side-window-max-height))
+ ;; width
+ (max 0
+ (- (if (member which-key-side-window-location '(left right))
+ (which-key--total-width-to-text
+ (which-key--width-or-percentage-to-width
+ which-key-side-window-max-width))
+ (which-key--total-width-to-text
+ (which-key--width-or-percentage-to-width
+ 1.0)))
+ which-key-unicode-correction))))
+
+(defun which-key--frame-max-dimensions ()
+ "Return max-dimensions of the frame popup (height .
+width) in lines and characters respectively."
+ (cons which-key-frame-max-height which-key-frame-max-width))
+
+;;; Sorting functions
+
+(defun which-key--string< (a b &optional alpha)
+ (let* ((da (downcase a))
+ (db (downcase b)))
+ (cond ((string-equal da db)
+ (if which-key-sort-uppercase-first
+ (string-lessp a b)
+ (not (string-lessp a b))))
+ (alpha (string-lessp da db))
+ (t (string-lessp a b)))))
+
+(defun which-key--key-description< (a b &optional alpha)
+ "Sorting function used for `which-key-key-order' and
+`which-key-key-order-alpha'."
+ (save-match-data
+ (let* ((rngrgxp "^\\([^ ]+\\) \\.\\. [^ ]+")
+ (a (if (string-match rngrgxp a) (match-string 1 a) a))
+ (b (if (string-match rngrgxp b) (match-string 1 b) b))
+ (aem? (string-equal a ""))
+ (bem? (string-equal b ""))
+ (a1? (= 1 (length a)))
+ (b1? (= 1 (length b)))
+ (srgxp "^\\(RET\\|SPC\\|TAB\\|DEL\\|LFD\\|ESC\\|NUL\\)")
+ (asp? (string-match-p srgxp a))
+ (bsp? (string-match-p srgxp b))
+ (prrgxp "^\\(M\\|C\\|S\\|A\\|H\\|s\\)-")
+ (apr? (string-match-p prrgxp a))
+ (bpr? (string-match-p prrgxp b))
+ (afn? (string-match-p "<f[0-9]+>" a))
+ (bfn? (string-match-p "<f[0-9]+>" b)))
+ (cond ((or aem? bem?) (and aem? (not bem?)))
+ ((and asp? bsp?)
+ (if (string-equal (substring a 0 3) (substring b 0 3))
+ (which-key--key-description<
+ (substring a 3) (substring b 3) alpha)
+ (which-key--string< a b alpha)))
+ ((or asp? bsp?) asp?)
+ ((and a1? b1?) (which-key--string< a b alpha))
+ ((or a1? b1?) a1?)
+ ((and afn? bfn?)
+ (< (string-to-number
+ (replace-regexp-in-string "<f\\([0-9]+\\)>" "\\1" a))
+ (string-to-number
+ (replace-regexp-in-string "<f\\([0-9]+\\)>" "\\1" b))))
+ ((or afn? bfn?) afn?)
+ ((and apr? bpr?)
+ (if (string-equal (substring a 0 2) (substring b 0 2))
+ (which-key--key-description<
+ (substring a 2) (substring b 2) alpha)
+ (which-key--string< a b alpha)))
+ ((or apr? bpr?) apr?)
+ (t (which-key--string< a b alpha))))))
+
+(defsubst which-key-key-order-alpha (acons bcons)
+ "Order key descriptions A and B.
+Order is lexicographic within a \"class\", where the classes and
+the ordering of classes are listed below.
+
+special (SPC,TAB,...) < single char < mod (C-,M-,...) < other.
+Sorts single characters alphabetically with lowercase coming
+before upper."
+ (which-key--key-description< (car acons) (car bcons) t))
+
+(defsubst which-key-key-order (acons bcons)
+ "Order key descriptions A and B.
+Order is lexicographic within a \"class\", where the classes and
+the ordering of classes are listed below.
+
+special (SPC,TAB,...) < single char < mod (C-,M-,...) < other."
+ (which-key--key-description< (car acons) (car bcons)))
+
+(defsubst which-key-description-order (acons bcons)
+ "Order descriptions of A and B.
+Uses `string-lessp' after applying lowercase."
+ (string-lessp (downcase (cdr acons)) (downcase (cdr bcons))))
+
+(defsubst which-key--group-p (description)
+ (or (string-match-p "^\\(group:\\|Prefix\\)" description)
+ (keymapp (intern description))))
+
+(defun which-key-prefix-then-key-order (acons bcons)
+ "Order first by whether A and/or B is a prefix with no prefix
+coming before a prefix. Within these categories order using
+`which-key-key-order'."
+ (let ((apref? (which-key--group-p (cdr acons)))
+ (bpref? (which-key--group-p (cdr bcons))))
+ (if (not (eq apref? bpref?))
+ (and (not apref?) bpref?)
+ (which-key-key-order acons bcons))))
+
+(defun which-key-prefix-then-key-order-reverse (acons bcons)
+ "Order first by whether A and/or B is a prefix with prefix
+coming before a prefix. Within these categories order using
+`which-key-key-order'."
+ (let ((apref? (which-key--group-p (cdr acons)))
+ (bpref? (which-key--group-p (cdr bcons))))
+ (if (not (eq apref? bpref?))
+ (and apref? (not bpref?))
+ (which-key-key-order acons bcons))))
+
+(defun which-key-local-then-key-order (acons bcons)
+ "Order first by whether A and/or B is a local binding with
+local bindings coming first. Within these categories order using
+`which-key-key-order'."
+ (let ((aloc? (which-key--local-binding-p acons))
+ (bloc? (which-key--local-binding-p bcons)))
+ (if (not (eq aloc? bloc?))
+ (and aloc? (not bloc?))
+ (which-key-key-order acons bcons))))
+
+;;; Functions for retrieving and formatting keys
+
+(defsubst which-key--string-width (maybe-string)
+ "If MAYBE-STRING is a string use `which-key--string-width' o/w return 0."
+ (if (stringp maybe-string) (string-width maybe-string) 0))
+
+(defsubst which-key--safe-lookup-key (keymap key)
+ "Version of `lookup-key' that allows KEYMAP to be nil. KEY is not checked."
+ (when (keymapp keymap) (lookup-key keymap key)))
+
+(defsubst which-key--butlast-string (str)
+ (mapconcat #'identity (butlast (split-string str)) " "))
+
+(defun which-key--get-replacements (key-binding &optional use-major-mode)
+ (let ((alist (or (and use-major-mode
+ (cdr-safe
+ (assq major-mode which-key-replacement-alist)))
+ which-key-replacement-alist))
+ res case-fold-search)
+ (catch 'res
+ (dolist (replacement alist)
+ ;; these are mode specific ones to ignore. The mode specific case is
+ ;; handled in the selection of alist
+ (unless (symbolp (car replacement))
+ (let ((key-regexp (caar replacement))
+ (binding-regexp (cdar replacement)))
+ (when (and (or (null key-regexp)
+ (string-match-p key-regexp
+ (car key-binding)))
+ (or (null binding-regexp)
+ (string-match-p binding-regexp
+ (cdr key-binding))))
+ (push replacement res)
+ (when (not which-key-allow-multiple-replacements)
+ (throw 'res res)))))))
+ (nreverse res)))
+
+(defun which-key--maybe-replace (key-binding)
+ "Use `which-key--replacement-alist' to maybe replace KEY-BINDING.
+KEY-BINDING is a cons cell of the form \(KEY . BINDING\) each of
+which are strings. KEY is of the form produced by `key-binding'."
+ (let* ((mode-res (which-key--get-replacements key-binding t))
+ (all-repls (or mode-res
+ (which-key--get-replacements key-binding))))
+ (dolist (repl all-repls key-binding)
+ (setq key-binding
+ (cond ((or (not (consp repl)) (null (cdr repl)))
+ key-binding)
+ ((functionp (cdr repl))
+ (funcall (cdr repl) key-binding))
+ ((consp (cdr repl))
+ (cons
+ (cond ((and (caar repl) (cadr repl))
+ (replace-regexp-in-string
+ (caar repl) (cadr repl) (car key-binding) t))
+ ((cadr repl) (cadr repl))
+ (t (car key-binding)))
+ (cond ((and (cdar repl) (cddr repl))
+ (replace-regexp-in-string
+ (cdar repl) (cddr repl) (cdr key-binding) t))
+ ((cddr repl) (cddr repl))
+ (t (cdr key-binding))))))))))
+
+(defsubst which-key--current-key-list (&optional key-str)
+ (append (listify-key-sequence which-key--current-prefix)
+ (when key-str
+ (listify-key-sequence (kbd key-str)))))
+
+(defsubst which-key--current-key-string (&optional key-str)
+ (key-description (which-key--current-key-list key-str)))
+
+(defun which-key--local-binding-p (keydesc)
+ (eq (which-key--safe-lookup-key
+ (current-local-map) (kbd (which-key--current-key-string (car keydesc))))
+ (intern (cdr keydesc))))
+
+(defun which-key--maybe-get-prefix-title (keys)
+ "KEYS is a string produced by `key-description'.
+A title is possibly returned using
+`which-key--prefix-title-alist'. An empty stiring is returned if
+no title exists."
+ (cond
+ ((not (string-equal keys ""))
+ (let* ((title-res
+ (cdr-safe (assoc-string keys which-key--prefix-title-alist)))
+ (repl-res
+ (cdr-safe (which-key--maybe-replace (cons keys ""))))
+ (binding (key-binding (kbd keys)))
+ (alternate (when (and binding (symbolp binding))
+ (symbol-name binding))))
+ (cond (title-res title-res)
+ ((not (string-equal repl-res "")) repl-res)
+ ((and (eq which-key-show-prefix 'echo) alternate)
+ alternate)
+ ((and (member which-key-show-prefix '(bottom top))
+ (eq which-key-side-window-location 'bottom)
+ echo-keystrokes)
+ (if alternate alternate
+ (concat "Following " keys)))
+ (t ""))))
+ (which-key--using-top-level "Top-level bindings")
+ (which-key--current-show-keymap-name
+ which-key--current-show-keymap-name)
+ (t "")))
+
+(defun which-key--propertize-key (key)
+ "Add a face to KEY.
+If KEY contains any \"special keys\" defined in
+`which-key-special-keys' then truncate and add the corresponding
+`which-key-special-key-face'."
+ (let ((key-w-face (propertize key 'face 'which-key-key-face))
+ (regexp (concat "\\("
+ (mapconcat 'identity which-key-special-keys
+ "\\|") "\\)"))
+ case-fold-search)
+ (save-match-data
+ (if (and which-key-special-keys
+ (string-match regexp key))
+ (let ((beg (match-beginning 0)) (end (match-end 0)))
+ (concat (substring key-w-face 0 beg)
+ (propertize (substring key-w-face beg (1+ beg))
+ 'face 'which-key-special-key-face)
+ (substring key-w-face end
+ (which-key--string-width key-w-face))))
+ key-w-face))))
+
+(defsubst which-key--truncate-description (desc)
+ "Truncate DESC description to `which-key-max-description-length'."
+ (if (and which-key-max-description-length
+ (> (length desc) which-key-max-description-length))
+ (concat (substring desc 0 which-key-max-description-length) "..")
+ desc))
+
+(defun which-key--highlight-face (description)
+ "Return the highlight face for DESCRIPTION if it has one."
+ (let (face)
+ (dolist (el which-key-highlighted-command-list)
+ (unless face
+ (cond ((consp el)
+ (when (string-match-p (car el) description)
+ (setq face (cdr el))))
+ ((stringp el)
+ (when (string-match-p el description)
+ (setq face 'which-key-highlighted-command-face)))
+ (t
+ (message "which-key: warning: element %s of \
+which-key-highlighted-command-list is not a string or a cons
+cell" el)))))
+ face))
+
+(defun which-key--propertize-description
+ (description group local hl-face &optional original-description)
+ "Add face to DESCRIPTION where the face chosen depends on
+whether the description represents a group or a command. Also
+make some minor adjustments to the description string, like
+removing a \"group:\" prefix.
+
+ORIGINAL-DESCRIPTION is the description given by
+`describe-buffer-bindings'."
+ (let* ((desc description)
+ (desc (if (string-match-p "^group:" desc)
+ (substring desc 6) desc))
+ (desc (if group (concat which-key-prefix-prefix desc) desc))
+ (desc (which-key--truncate-description desc)))
+ (make-text-button desc nil
+ 'face (cond (hl-face hl-face)
+ (group 'which-key-group-description-face)
+ (local 'which-key-local-map-description-face)
+ (t 'which-key-command-description-face))
+ 'help-echo (cond
+ ((and original-description
+ (fboundp (intern original-description))
+ (documentation (intern original-description))
+ ;; tooltip-mode doesn't exist in emacs-nox
+ (boundp 'tooltip-mode) tooltip-mode)
+ (documentation (intern original-description)))
+ ((and original-description
+ (fboundp (intern original-description))
+ (documentation (intern original-description))
+ (let* ((doc (documentation
+ (intern original-description)))
+ (str (replace-regexp-in-string "\n" " " doc))
+ (max (floor (* (frame-width) 0.8))))
+ (if (> (length str) max)
+ (concat (substring str 0 max) "...")
+ str))))))
+ desc))
+
+(defun which-key--extract-key (key-str)
+ "Pull the last key (or key range) out of KEY-STR."
+ (save-match-data
+ (let ((key-range-regexp "\\`.*\\([^ \t]+ \\.\\. [^ \t]+\\)\\'"))
+ (if (string-match key-range-regexp key-str)
+ (match-string 1 key-str)
+ (car (last (split-string key-str " ")))))))
+
+(defun which-key--format-and-replace (unformatted)
+ "Take a list of (key . desc) cons cells in UNFORMATTED, add
+faces and perform replacements according to the three replacement
+alists. Returns a list (key separator description)."
+ (let ((sep-w-face
+ (propertize which-key-separator 'face 'which-key-separator-face))
+ (local-map (current-local-map))
+ new-list)
+ (dolist (key-binding unformatted)
+ (let* ((key (car key-binding))
+ (orig-desc (cdr key-binding))
+ (group (which-key--group-p orig-desc))
+ ;; At top-level prefix is nil
+ (keys (if which-key--current-prefix
+ (concat (which-key--current-key-string) " " key)
+ key))
+ (local (eq (which-key--safe-lookup-key local-map (kbd keys))
+ (intern orig-desc)))
+ (hl-face (which-key--highlight-face orig-desc))
+ (key-binding (which-key--maybe-replace (cons keys orig-desc))))
+ (when (consp key-binding)
+ (push
+ (list (which-key--propertize-key
+ (which-key--extract-key (car key-binding)))
+ sep-w-face
+ (which-key--propertize-description
+ (cdr key-binding) group local hl-face orig-desc))
+ new-list))))
+ (nreverse new-list)))
+
+(defun which-key--get-keymap-bindings (keymap &optional filter)
+ "Retrieve top-level bindings from KEYMAP."
+ (let (bindings)
+ (map-keymap
+ (lambda (ev def)
+ (unless (and (functionp filter) (funcall filter ev def))
+ (cl-pushnew
+ (cons (key-description (list ev))
+ (cond ((keymapp def) "Prefix Command")
+ ((symbolp def) (copy-sequence (symbol-name def)))
+ ((eq 'lambda (car-safe def)) "lambda")
+ (t (format "%s" def))))
+ bindings :test (lambda (a b) (string= (car a) (car b))))))
+ keymap)
+ bindings))
+
+(defun which-key--compute-binding (binding)
+ "Replace BINDING with remapped binding if it exists.
+
+Requires `which-key-compute-remaps' to be non-nil"
+ (let (remap)
+ (if (and which-key-compute-remaps
+ (setq remap (command-remapping (intern binding))))
+ (copy-sequence (symbol-name remap))
+ binding)))
+
+(defun which-key--get-current-bindings ()
+ "Generate a list of current active bindings."
+ (let ((key-str-qt (regexp-quote (key-description which-key--current-prefix)))
+ (buffer (current-buffer))
+ (ignore-bindings '("self-insert-command" "ignore"
+ "ignore-event" "company-ignore"))
+ (ignore-keys-regexp
+ (eval-when-compile
+ (regexp-opt '("mouse-" "wheel-" "remap" "drag-" "scroll-bar"
+ "select-window" "switch-frame" "-state"))))
+ (ignore-sections-regexp
+ (eval-when-compile
+ (regexp-opt '("Key translations" "Function key map translations"
+ "Input decoding map translations")))))
+ (with-temp-buffer
+ (setq-local indent-tabs-mode t)
+ (setq-local tab-width 8)
+ (describe-buffer-bindings buffer which-key--current-prefix)
+ (goto-char (point-min))
+ (let ((header-p (not (= (char-after) ?\f)))
+ bindings header)
+ (while (not (eobp))
+ (cond
+ (header-p
+ (setq header (buffer-substring-no-properties
+ (point)
+ (line-end-position)))
+ (setq header-p nil)
+ (forward-line 3))
+ ((= (char-after) ?\f)
+ (setq header-p t))
+ ((looking-at "^[ \t]*$"))
+ ((or (not (string-match-p ignore-sections-regexp header))
+ which-key--current-prefix)
+ (let ((binding-start (save-excursion
+ (and (re-search-forward "\t+" nil t)
+ (match-end 0))))
+ key binding)
+ (when binding-start
+ (setq key (buffer-substring-no-properties
+ (point) binding-start))
+ (setq binding (buffer-substring-no-properties
+ binding-start
+ (line-end-position)))
+ (save-match-data
+ (cond
+ ((member binding ignore-bindings))
+ ((string-match-p ignore-keys-regexp key))
+ ((and which-key--current-prefix
+ (string-match (format "^%s[ \t]\\([^ \t]+\\)[ \t]+$"
+ key-str-qt) key))
+ (unless (assoc-string (match-string 1 key) bindings)
+ (push (cons (match-string 1 key)
+ (which-key--compute-binding binding))
+ bindings)))
+ ((and which-key--current-prefix
+ (string-match
+ (format
+ "^%s[ \t]\\([^ \t]+\\) \\.\\. %s[ \t]\\([^ \t]+\\)[
\t]+$"
+ key-str-qt key-str-qt) key))
+ (let ((stripped-key (concat (match-string 1 key)
+ " \.\. "
+ (match-string 2 key))))
+ (unless (assoc-string stripped-key bindings)
+ (push (cons stripped-key
+ (which-key--compute-binding binding))
+ bindings))))
+ ((string-match
+ "^\\([^ \t]+\\|[^ \t]+ \\.\\. [^ \t]+\\)[ \t]+$" key)
+ (unless (assoc-string (match-string 1 key) bindings)
+ (push (cons (match-string 1 key)
+ (which-key--compute-binding binding))
+ bindings)))))))))
+ (forward-line))
+ (nreverse bindings)))))
+
+(defun which-key--get-formatted-key-bindings (&optional bindings)
+ "Uses `describe-buffer-bindings' to collect the key bindings in
+BUFFER that follow the key sequence KEY-SEQ."
+ (let* ((unformatted (if bindings bindings
(which-key--get-current-bindings))))
+ (when which-key-sort-order
+ (setq unformatted
+ (sort unformatted which-key-sort-order)))
+ (which-key--format-and-replace unformatted)))
+
+;;; Functions for laying out which-key buffer pages
+
+(defun which-key--normalize-columns (columns)
+ "Pad COLUMNS to the same length using empty strings."
+ (let ((max-len (cl-reduce (lambda (a x) (max a (length x))) columns
+ :initial-value 0)))
+ (mapcar
+ (lambda (c)
+ (if (< (length c) max-len)
+ (append c (make-list (- max-len (length c)) ""))
+ c))
+ columns)))
+
+(defsubst which-key--join-columns (columns)
+ "Transpose columns into rows, concat rows into lines and rows into page."
+ (let* ((padded (which-key--normalize-columns (nreverse columns)))
+ (rows (apply #'cl-mapcar #'list padded)))
+ (mapconcat (lambda (row) (mapconcat #'identity row " ")) rows "\n")))
+
+(defsubst which-key--max-len (keys index)
+ "Internal function for finding the max length of the INDEX
+element in each list element of KEYS."
+ (cl-reduce
+ (lambda (x y) (max x (which-key--string-width (nth index y))))
+ keys :initial-value 0))
+
+(defun which-key--pad-column (col-keys)
+ "Take a column of (key separator description) COL-KEYS,
+calculate the max width in the column and pad all cells out to
+that width."
+ (let* ((col-key-width (+ which-key-add-column-padding
+ (which-key--max-len col-keys 0)))
+ (col-sep-width (which-key--max-len col-keys 1))
+ (col-desc-width (which-key--max-len col-keys 2))
+ (col-width (+ 1 col-key-width col-sep-width col-desc-width)))
+ (cons col-width
+ (mapcar (lambda (k)
+ (format (concat "%" (int-to-string col-key-width)
+ "s%s%-" (int-to-string col-desc-width) "s")
+ (nth 0 k) (nth 1 k) (nth 2 k)))
+ col-keys))))
+
+(defun which-key--partition-list (n list)
+ "Partition LIST into N-sized sublists."
+ (let (res)
+ (while list
+ (setq res (cons (cl-subseq list 0 (min n (length list))) res)
+ list (nthcdr n list)))
+ (nreverse res)))
+
+(defun which-key--list-to-pages (keys avl-lines avl-width)
+ "Convert list of KEYS to columns based on dimensions AVL-LINES and AVL-WIDTH.
+Returns a plist that holds the page strings, as well as
+metadata."
+ (let ((cols-w-widths (mapcar #'which-key--pad-column
+ (which-key--partition-list avl-lines keys)))
+ (page-width 0) (n-pages 0) (n-keys 0) (n-columns 0)
+ page-cols pages page-widths keys/page col)
+ (if (> (apply #'max (mapcar #'car cols-w-widths)) avl-width)
+ ;; give up if no columns fit
+ (list :pages nil :page-height 0 :page-widths '(0)
+ :keys/page '(0) :n-pages 0 :tot-keys 0)
+ (while cols-w-widths
+ ;; start new page
+ (cl-incf n-pages)
+ (setq col (pop cols-w-widths))
+ (setq page-cols (list (cdr col)))
+ (setq page-width (car col))
+ (setq n-keys (length (cdr col)))
+ (setq n-columns 1)
+ ;; add additional columns as long as they fit
+ (while (and cols-w-widths
+ (or (null which-key-max-display-columns)
+ (< n-columns which-key-max-display-columns))
+ (<= (+ (caar cols-w-widths) page-width) avl-width))
+ (setq col (pop cols-w-widths))
+ (push (cdr col) page-cols)
+ (cl-incf page-width (car col))
+ (cl-incf n-keys (length (cdr col)))
+ (cl-incf n-columns))
+ (push (which-key--join-columns page-cols) pages)
+ (push n-keys keys/page)
+ (push page-width page-widths))
+ (list :pages (nreverse pages) :page-height avl-lines
+ :page-widths (nreverse page-widths)
+ :keys/page (reverse keys/page) :n-pages n-pages
+ :tot-keys (apply #'+ keys/page)))))
+
+(defun which-key--create-pages-1
+ (keys available-lines available-width &optional min-lines vertical)
+ "Create page strings using `which-key--list-to-pages'.
+Will try to find the best number of rows and columns using the
+given dimensions and the length and widths of ITEMS. Use VERTICAL
+if the ITEMS are laid out vertically and the number of columns
+should be minimized."
+ (let ((result (which-key--list-to-pages
+ keys available-lines available-width))
+ (min-lines (or min-lines 0))
+ found prev-result)
+ (if (or vertical
+ (> (plist-get result :n-pages) 1)
+ (= 1 available-lines))
+ result
+ ;; simple search for a fitting page
+ (while (and (> available-lines min-lines)
+ (not found))
+ (setq available-lines (- available-lines 1)
+ prev-result result
+ result (which-key--list-to-pages
+ keys available-lines available-width)
+ found (> (plist-get result :n-pages) 1)))
+ (if found prev-result result))))
+
+(defun which-key--create-pages (keys)
+ "Create page strings using `which-key--list-to-pages'.
+Will try to find the best number of rows and columns using the
+given dimensions and the length and wdiths of KEYS. SEL-WIN-WIDTH
+is the width of the live window."
+ (let* ((max-dims (which-key--popup-max-dimensions))
+ (max-lines (car max-dims))
+ (max-width (cdr max-dims))
+ (prefix-keys-desc (key-description which-key--current-prefix))
+ (full-prefix (which-key--full-prefix prefix-keys-desc))
+ (prefix (when (eq which-key-show-prefix 'left)
+ (+ 2 (which-key--string-width full-prefix))))
+ (prefix-top-bottom (member which-key-show-prefix '(bottom top)))
+ (avl-lines (if prefix-top-bottom (- max-lines 1) max-lines))
+ (min-lines (min avl-lines which-key-min-display-lines))
+ (avl-width (if prefix (- max-width prefix) max-width))
+ (vertical (and (eq which-key-popup-type 'side-window)
+ (member which-key-side-window-location '(left
right)))))
+ (which-key--create-pages-1 keys avl-lines avl-width min-lines vertical)))
+
+(defun which-key--lighter-status (page-n)
+ "Possibly show number of keys and total in the mode line."
+ (when which-key-show-remaining-keys
+ (let ((n-shown (nth page-n (plist-get which-key--pages-plist :keys/page)))
+ (n-tot (plist-get which-key--pages-plist :tot-keys)))
+ (setcar (cdr (assq 'which-key-mode minor-mode-alist))
+ (format " WK: %s/%s keys" n-shown n-tot)))))
+
+(defun which-key--lighter-restore ()
+ "Restore the lighter for which-key."
+ (when which-key-show-remaining-keys
+ (setcar (cdr (assq 'which-key-mode minor-mode-alist))
+ which-key-lighter)))
+
+(defun which-key--echo (text)
+ "Echo TEXT to minibuffer without logging."
+ (let (message-log-max)
+ (message "%s" text)))
+
+(defun which-key--next-page-hint (prefix-keys)
+ "Return string for next page hint."
+ (let* ((paging-key (concat prefix-keys " " which-key-paging-key))
+ (paging-key-bound (eq 'which-key-C-h-dispatch
+ (key-binding (kbd paging-key))))
+ (key (if paging-key-bound which-key-paging-key "C-h")))
+ (when (and which-key-use-C-h-commands
+ (or which-key--using-show-operator-keymap
+ (not (and which-key-allow-evil-operators
+ (bound-and-true-p evil-this-operator)))))
+ (propertize (format "[%s paging/help]" key)
+ 'face 'which-key-note-face))))
+
+(eval-and-compile
+ (if (fboundp 'universal-argument--description)
+ (defalias 'which-key--universal-argument--description
+ 'universal-argument--description)
+ (defun which-key--universal-argument--description ()
+ ;; Backport of the definition of universal-argument--description in
+ ;; emacs25 on 2015-12-04
+ (when prefix-arg
+ (concat "C-u"
+ (pcase prefix-arg
+ (`(-) " -")
+ (`(,(and (pred integerp) n))
+ (let ((str ""))
+ (while (and (> n 4) (= (mod n 4) 0))
+ (setq str (concat str " C-u"))
+ (setq n (/ n 4)))
+ (if (= n 4) str (format " %s" prefix-arg))))
+ (_ (format " %s" prefix-arg))))))))
+
+(defun which-key--full-prefix (prefix-keys &optional -prefix-arg
dont-prop-keys)
+ "Return a description of the full key sequence up to now,
+including prefix arguments."
+ (let* ((left (eq which-key-show-prefix 'left))
+ (prefix-arg (if -prefix-arg -prefix-arg prefix-arg))
+ (str (concat
+ (which-key--universal-argument--description)
+ (when prefix-arg " ")
+ prefix-keys))
+ (dash (if (and which-key--current-prefix
+ (null left)) "-" "")))
+ (if (or (eq which-key-show-prefix 'echo) dont-prop-keys)
+ (concat str dash)
+ (concat (which-key--propertize-key str)
+ (propertize dash 'face 'which-key-key-face)))))
+
+(defun which-key--get-popup-map ()
+ "Generate transient-map for use in the top level binding display."
+ (unless which-key--current-prefix
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd which-key-paging-key) #'which-key-C-h-dispatch)
+ (when which-key-use-C-h-commands
+ ;; Show next page even when C-h is pressed
+ (define-key map (kbd "C-h") #'which-key-C-h-dispatch))
+ map)))
+
+(defun which-key--process-page (page-n pages-plist)
+ "Add information to the basic list of key bindings, including
+if applicable the current prefix, the name of the current prefix,
+and a page count."
+ (let* ((page (nth page-n (plist-get pages-plist :pages)))
+ (height (plist-get pages-plist :page-height))
+ (n-pages (plist-get pages-plist :n-pages))
+ (prefix-keys (key-description which-key--current-prefix))
+ (full-prefix (which-key--full-prefix prefix-keys))
+ (nxt-pg-hint (which-key--next-page-hint prefix-keys))
+ ;; not used in left case
+ (status-line
+ (concat (propertize (which-key--maybe-get-prefix-title
+ (which-key--current-key-string))
+ 'face 'which-key-note-face)
+ (when (< 1 n-pages)
+ (propertize (format " (%s of %s)"
+ (1+ page-n) n-pages)
+ 'face 'which-key-note-face)))))
+ (pcase which-key-show-prefix
+ (`left
+ (let* ((page-cnt (propertize (format "%s/%s" (1+ page-n) n-pages)
+ 'face 'which-key-separator-face))
+ (first-col-width (+ 2 (max (which-key--string-width full-prefix)
+ (which-key--string-width page-cnt))))
+ (prefix (format (concat "%-" (int-to-string first-col-width) "s")
+ full-prefix))
+ (page-cnt (if (> n-pages 1)
+ (format
+ (concat "%-" (int-to-string first-col-width) "s")
+ page-cnt)
+ (make-string first-col-width 32)))
+ lines first-line new-end)
+ (if (= 1 height)
+ (cons (concat prefix page) nil)
+ (setq lines (split-string page "\n")
+ first-line (concat prefix (car lines) "\n" page-cnt)
+ new-end (concat "\n" (make-string first-col-width 32)))
+ (cons
+ (concat first-line (mapconcat #'identity (cdr lines) new-end))
+ nil))))
+ (`top
+ (cons
+ (concat (when (or (= 0 echo-keystrokes)
+ (not (eq which-key-side-window-location 'bottom)))
+ (concat full-prefix " "))
+ status-line " " nxt-pg-hint "\n" page)
+ nil))
+ (`bottom
+ (cons
+ (concat page "\n"
+ (when (or (= 0 echo-keystrokes)
+ (not (eq which-key-side-window-location 'bottom)))
+ (concat full-prefix " "))
+ status-line " " nxt-pg-hint)
+ nil))
+ (`echo
+ (cons page
+ (lambda ()
+ (which-key--echo
+ (concat full-prefix (when prefix-keys " ")
+ status-line (when status-line " ")
+ nxt-pg-hint)))))
+ (`mode-line
+ (cons page
+ (lambda ()
+ (with-current-buffer which-key--buffer
+ (setq-local mode-line-format
+ (concat " " full-prefix
+ " " status-line
+ " " nxt-pg-hint))))))
+ (_ (cons page nil)))))
+
+(defun which-key--show-page (n)
+ "Show page N, starting from 0."
+ (which-key--init-buffer) ;; in case it was killed
+ (let ((n-pages (plist-get which-key--pages-plist :n-pages))
+ (prefix-keys (key-description which-key--current-prefix))
+ page-n golden-ratio-mode)
+ (if (= 0 n-pages)
+ (message "%s- which-key can't show keys: There is not \
+enough space based on your settings and frame size." prefix-keys)
+ (setq page-n (mod n n-pages))
+ (setq which-key--current-page-n page-n)
+ (when (= n-pages (1+ n)) (setq which-key--on-last-page t))
+ (let ((page-echo (which-key--process-page page-n which-key--pages-plist))
+ (height (plist-get which-key--pages-plist :page-height))
+ (width
+ (nth page-n (plist-get which-key--pages-plist :page-widths))))
+ (which-key--lighter-status page-n)
+ (if (eq which-key-popup-type 'minibuffer)
+ (which-key--echo (car page-echo))
+ (with-current-buffer which-key--buffer
+ (erase-buffer)
+ (insert (car page-echo))
+ (goto-char (point-min)))
+ (when (cdr page-echo) (funcall (cdr page-echo)))
+ (which-key--show-popup (cons height width)))))
+ ;; used for paging at top-level
+ (if (fboundp 'set-transient-map)
+ (set-transient-map (which-key--get-popup-map))
+ (with-no-warnings
+ (set-temporary-overlay-map (which-key--get-popup-map))))))
+
+;;; Paging functions
+
+;;;###autoload
+(defun which-key-reload-key-sequence (key-seq)
+ "Simulate entering the key sequence KEY-SEQ.
+KEY-SEQ should be a list of events as produced by
+`listify-key-sequence'. Any prefix arguments that were used are
+reapplied to the new key sequence."
+ (let ((next-event (mapcar (lambda (ev) (cons t ev)) key-seq)))
+ (setq prefix-arg current-prefix-arg
+ unread-command-events next-event)))
+
+(defun which-key-turn-page (delta)
+ "Show the next page of keys."
+ (let ((next-page (if which-key--current-page-n
+ (+ which-key--current-page-n delta) 0)))
+ (which-key-reload-key-sequence (which-key--current-key-list))
+ (if which-key--last-try-2-loc
+ (let ((which-key-side-window-location which-key--last-try-2-loc)
+ (which-key--multiple-locations t))
+ (which-key--show-page next-page))
+ (which-key--show-page next-page))
+ (which-key--start-paging-timer)))
+
+;;;###autoload
+(defun which-key-show-standard-help ()
+ "Call the command in `which-key--prefix-help-cmd-backup'.
+Usually this is `describe-prefix-bindings'."
+ (interactive)
+ (let ((which-key-inhibit t))
+ (which-key--hide-popup-ignore-command)
+ (cond ((eq which-key--prefix-help-cmd-backup
+ 'describe-prefix-bindings)
+ ;; This is essentially what `describe-prefix-bindings' does
+ (describe-bindings
+ (kbd (which-key--current-key-string))))
+ ((functionp which-key--prefix-help-cmd-backup)
+ (funcall which-key--prefix-help-cmd-backup)))))
+
+;;;###autoload
+(defun which-key-show-next-page-no-cycle ()
+ "Show next page of keys unless on the last page, in which case
+call `which-key-show-standard-help'."
+ (interactive)
+ (let ((which-key-inhibit t))
+ (if (and which-key--current-page-n
+ which-key--on-last-page)
+ (which-key-show-standard-help)
+ (which-key-turn-page 1))))
+
+;;;###autoload
+(defun which-key-show-previous-page-no-cycle ()
+ "Show previous page of keys unless on the first page, in which
+case do nothing."
+ (interactive)
+ (let ((which-key-inhibit t))
+ (if (and which-key--current-page-n
+ (eq which-key--current-page-n 0))
+ (which-key-turn-page 0)
+ (which-key-turn-page -1))))
+
+;;;###autoload
+(defun which-key-show-next-page-cycle ()
+ "Show the next page of keys, cycling from end to beginning
+after last page."
+ (interactive)
+ (let ((which-key-inhibit t))
+ (which-key-turn-page 1)))
+
+;;;###autoload
+(defun which-key-show-previous-page-cycle ()
+ "Show the previous page of keys, cycling from beginning to end
+after first page."
+ (interactive)
+ (let ((which-key-inhibit t))
+ (which-key-turn-page -1)))
+
+;;;###autoload
+(defun which-key-show-top-level ()
+ "Show top-level bindings."
+ (interactive)
+ (setq which-key--using-top-level t)
+ (which-key--create-buffer-and-show nil))
+
+;;;###autoload
+(defun which-key-undo-key ()
+ "Undo last keypress and force which-key update."
+ (interactive)
+ (let* ((key-lst (butlast (which-key--current-key-list)))
+ (which-key-inhibit t))
+ (cond ((stringp which-key--current-show-keymap-name)
+ (if (keymapp (cdr (car-safe which-key--prior-show-keymap-args)))
+ (let ((args (pop which-key--prior-show-keymap-args)))
+ (which-key--show-keymap (car args) (cdr args)))
+ (which-key--hide-popup)))
+ (key-lst
+ (which-key-reload-key-sequence key-lst)
+ (which-key--create-buffer-and-show (apply #'vector key-lst)))
+ (t (which-key-show-top-level)))))
+(defalias 'which-key-undo 'which-key-undo-key)
+
+(defun which-key-abort ()
+ "Abort key sequence."
+ (interactive)
+ (let ((which-key-inhibit t))
+ (which-key--hide-popup-ignore-command)
+ (keyboard-quit)))
+
+;;;###autoload
+(defun which-key-C-h-dispatch ()
+ "Dispatch C-h commands by looking up key in
+`which-key-C-h-map'. This command is always accessible (from any
+prefix) if `which-key-use-C-h-commands' is non nil."
+ (interactive)
+ (if (not (which-key--popup-showing-p))
+ (which-key-show-standard-help)
+ (let* ((prefix-keys (key-description which-key--current-prefix))
+ (full-prefix (which-key--full-prefix prefix-keys current-prefix-arg
t))
+ (prompt (concat (when (string-equal prefix-keys "")
+ (propertize
+ (concat " "
+ (or which-key--current-show-keymap-name
+ "Top-level bindings"))
+ 'face 'which-key-note-face))
+ full-prefix
+ (propertize
+ (substitute-command-keys
+ (concat
+ " \\<which-key-C-h-map>"
+ " \\[which-key-show-next-page-cycle]"
+ which-key-separator "next-page,"
+ " \\[which-key-show-previous-page-cycle]"
+ which-key-separator "previous-page,"
+ " \\[which-key-undo-key]"
+ which-key-separator "undo-key,"
+ " \\[which-key-show-standard-help]"
+ which-key-separator "help,"
+ " \\[which-key-abort]"
+ which-key-separator "abort"))
+ 'face 'which-key-note-face)))
+ (key (string (read-key prompt)))
+ (cmd (lookup-key which-key-C-h-map key))
+ (which-key-inhibit t))
+ (if cmd (funcall cmd) (which-key-turn-page 0)))))
+
+;;; Update
+
+(defun which-key--any-match-p (regexps string)
+ "Non-nil if any of REGEXPS match STRING."
+ (catch 'match
+ (dolist (regexp regexps)
+ (when (string-match-p regexp string)
+ (throw 'match t)))))
+
+(defun which-key--try-2-side-windows (keys page-n loc1 loc2 &rest _ignore)
+ "Try to show KEYS (PAGE-N) in LOC1 first.
+
+Only if no keys fit fallback to LOC2."
+ (let (pages1)
+ (let ((which-key-side-window-location loc1)
+ (which-key--multiple-locations t))
+ (setq pages1 (which-key--create-pages keys)))
+ (if (< 0 (plist-get pages1 :n-pages))
+ (progn
+ (setq which-key--pages-plist pages1)
+ (let ((which-key-side-window-location loc1)
+ (which-key--multiple-locations t))
+ (which-key--show-page page-n))
+ loc1)
+ (let ((which-key-side-window-location loc2)
+ (which-key--multiple-locations t))
+ (setq which-key--pages-plist
+ (which-key--create-pages keys))
+ (which-key--show-page page-n)
+ loc2))))
+
+(defun which-key-show-keymap ()
+ "Show the top-level bindings in KEYMAP using which-key. KEYMAP
+is selected interactively from all available keymaps."
+ (interactive)
+ (let ((keymap-sym (intern
+ (completing-read
+ "Keymap: " obarray
+ (lambda (m)
+ (and (boundp m)
+ (keymapp (symbol-value m))
+ (not (equal (symbol-value m)
+ (make-sparse-keymap)))))
+ t nil 'which-key-keymap-history))))
+ (which-key--show-keymap (symbol-name keymap-sym)
+ (symbol-value keymap-sym))))
+
+(defun which-key-show-minor-mode-keymap ()
+ "Show the top-level bindings in KEYMAP using which-key. KEYMAP
+is selected interactively by mode in `minor-mode-map-alist'."
+ (interactive)
+ (let ((mode-sym
+ (intern
+ (completing-read
+ "Minor Mode: "
+ (mapcar 'car
+ (cl-remove-if-not
+ (lambda (entry)
+ (and (symbol-value (car entry))
+ (not (equal (cdr entry) (make-sparse-keymap)))))
+ minor-mode-map-alist))
+ nil t nil 'which-key-keymap-history))))
+ (which-key--show-keymap (symbol-name mode-sym)
+ (cdr (assq mode-sym minor-mode-map-alist)))))
+
+(defun which-key--show-keymap (keymap-name keymap &optional prior-args)
+ (setq which-key--current-prefix nil
+ which-key--current-show-keymap-name keymap-name
+ which-key--using-show-keymap t)
+ (when prior-args (push prior-args which-key--prior-show-keymap-args))
+ (when (keymapp keymap)
+ (let ((formatted-keys (which-key--get-formatted-key-bindings
+ (which-key--get-keymap-bindings keymap))))
+ (cond ((= (length formatted-keys) 0)
+ (message "which-key: Keymap empty"))
+ ((listp which-key-side-window-location)
+ (setq which-key--last-try-2-loc
+ (apply #'which-key--try-2-side-windows
+ formatted-keys 0 which-key-side-window-location)))
+ (t (setq which-key--pages-plist
+ (which-key--create-pages formatted-keys))
+ (which-key--show-page 0)))))
+ (let* ((key (key-description (list (read-key))))
+ (next-def (lookup-key keymap (kbd key))))
+ (cond ((and which-key-use-C-h-commands (string= "C-h" key))
+ (which-key-C-h-dispatch))
+ ((keymapp next-def)
+ (which-key--hide-popup-ignore-command)
+ (which-key--show-keymap (concat keymap-name " " key) next-def
+ (cons keymap-name keymap)))
+ (t (which-key--hide-popup)))))
+
+(defun which-key--evil-operator-filter (_ev def)
+ (and (functionp def)
+ (evil-get-command-property def :suppress-operator)))
+
+(defun which-key--show-evil-operator-keymap ()
+ (if which-key--inhibit-next-operator-popup
+ (setq which-key--inhibit-next-operator-popup nil)
+ (let ((keymap
+ (make-composed-keymap (list evil-operator-shortcut-map
+ evil-operator-state-map
+ evil-motion-state-map))))
+ (setq which-key--current-prefix nil
+ which-key--current-show-keymap-name "evil operator/motion keys"
+ which-key--using-show-operator-keymap t)
+ (when (keymapp keymap)
+ (let ((formatted-keys (which-key--get-formatted-key-bindings
+ (which-key--get-keymap-bindings
+ keymap 'which-key--evil-operator-filter))))
+ (cond ((= (length formatted-keys) 0)
+ (message "which-key: Keymap empty"))
+ ((listp which-key-side-window-location)
+ (setq which-key--last-try-2-loc
+ (apply #'which-key--try-2-side-windows
+ formatted-keys 0
which-key-side-window-location)))
+ (t (setq which-key--pages-plist
+ (which-key--create-pages formatted-keys))
+ (which-key--show-page 0)))))
+ (let* ((key (key-description (list (read-key)))))
+ (when (string= key "`")
+ ;; evil-goto-mark reads the next char manually
+ (setq which-key--inhibit-next-operator-popup t))
+ (cond ((and which-key-use-C-h-commands (string= "C-h" key))
+ (which-key-C-h-dispatch))
+ ((string= key "ESC")
+ (which-key--hide-popup)
+ (keyboard-quit))
+ (t
+ (which-key--hide-popup)
+ (setq unread-command-events (listify-key-sequence key))))))))
+
+(defun which-key--create-buffer-and-show (&optional prefix-keys from-keymap)
+ "Fill `which-key--buffer' with key descriptions and reformat.
+Finally, show the buffer."
+ (setq which-key--current-prefix prefix-keys
+ which-key--last-try-2-loc nil)
+ (let ((start-time (when which-key--debug (current-time)))
+ (formatted-keys (which-key--get-formatted-key-bindings
+ (when from-keymap
+ (which-key--get-keymap-bindings from-keymap))))
+ (prefix-keys (key-description which-key--current-prefix)))
+ (cond ((= (length formatted-keys) 0)
+ (message "%s- which-key: There are no keys to show" prefix-keys))
+ ((listp which-key-side-window-location)
+ (setq which-key--last-try-2-loc
+ (apply #'which-key--try-2-side-windows
+ formatted-keys 0 which-key-side-window-location)))
+ (t (setq which-key--pages-plist
+ (which-key--create-pages formatted-keys))
+ (which-key--show-page 0)))
+ (when which-key--debug
+ (message "On prefix \"%s\" which-key took %.0f ms." prefix-keys
+ (* 1000 (float-time (time-since start-time)))))))
+
+(defun which-key--update ()
+ "Function run by timer to possibly trigger
+`which-key--create-buffer-and-show'."
+ (let ((prefix-keys (this-single-command-keys))
+ delay-time)
+ (when (and (equal prefix-keys [key-chord])
+ (bound-and-true-p key-chord-mode))
+ (setq prefix-keys
+ (condition-case nil
+ (let ((rkeys (recent-keys)))
+ (vector 'key-chord
+ ;; Take the two preceding the last one, because the
+ ;; read-event call in key-chord seems to add a
+ ;; spurious key press to this list. Note this is
+ ;; different from guide-key's method which didn't
work
+ ;; for me.
+ (aref rkeys (- (length rkeys) 3))
+ (aref rkeys (- (length rkeys) 2))))
+ (error (progn
+ (message "which-key error in key-chord handling")
+ [key-chord])))))
+ (when (and which-key--god-mode-support-enabled
+ (bound-and-true-p god-local-mode)
+ (eq this-command 'god-mode-self-insert))
+ (setq prefix-keys (when which-key--god-mode-key-string
+ (kbd which-key--god-mode-key-string))))
+ (cond ((and (> (length prefix-keys) 0)
+ (or (keymapp (key-binding prefix-keys))
+ ;; Some keymaps are stored here like iso-transl-ctl-x-8-map
+ (keymapp (which-key--safe-lookup-key
+ key-translation-map prefix-keys))
+ ;; just in case someone uses one of these
+ (keymapp (which-key--safe-lookup-key
+ function-key-map prefix-keys)))
+ (not which-key-inhibit)
+ (or (null which-key-allow-regexps)
+ (which-key--any-match-p
+ which-key-allow-regexps (key-description prefix-keys)))
+ (or (null which-key-inhibit-regexps)
+ (not
+ (which-key--any-match-p
+ which-key-inhibit-regexps (key-description
prefix-keys))))
+ ;; Do not display the popup if a command is currently being
+ ;; executed
+ (or (and which-key-allow-evil-operators
+ (bound-and-true-p evil-this-operator))
+ (and which-key--god-mode-support-enabled
+ (bound-and-true-p god-local-mode)
+ (eq this-command 'god-mode-self-insert))
+ (null this-command)))
+ (when (and (not (equal prefix-keys which-key--current-prefix))
+ (or (null which-key-delay-functions)
+ (null (setq delay-time
+ (run-hook-with-args-until-success
+ 'which-key-delay-functions
+ (key-description prefix-keys)
+ (length prefix-keys))))
+ (sit-for delay-time)))
+ (which-key--create-buffer-and-show prefix-keys)
+ (when (and which-key-idle-secondary-delay
+ (not which-key--secondary-timer-active))
+ (which-key--start-timer which-key-idle-secondary-delay t))))
+ ((and which-key-show-transient-maps
+ (keymapp overriding-terminal-local-map)
+ ;; basic test for it being a hydra
+ (not (eq (lookup-key overriding-terminal-local-map "\C-u")
+ 'hydra--universal-argument)))
+ (which-key--create-buffer-and-show
+ nil overriding-terminal-local-map))
+ ((and which-key-show-operator-state-maps
+ (bound-and-true-p evil-state)
+ (eq evil-state 'operator)
+ (not which-key--using-show-operator-keymap))
+ (which-key--show-evil-operator-keymap))
+ ((and which-key--current-page-n
+ (not which-key--using-top-level)
+ (not which-key--using-show-operator-keymap)
+ (not which-key--using-show-keymap))
+ (which-key--hide-popup)))))
+
+;;; Timers
+
+(defun which-key--start-timer (&optional delay secondary)
+ "Activate idle timer to trigger `which-key--update'."
+ (which-key--stop-timer)
+ (setq which-key--secondary-timer-active secondary)
+ (setq which-key--timer
+ (run-with-idle-timer
+ (if delay
+ delay
+ which-key-idle-delay) t #'which-key--update)))
+
+(defun which-key--stop-timer ()
+ "Deactivate idle timer for `which-key--update'."
+ (when which-key--timer (cancel-timer which-key--timer)))
+
+(defun which-key--start-paging-timer ()
+ "Activate timer to restart which-key after paging."
+ (when which-key--paging-timer (cancel-timer which-key--paging-timer))
+ (which-key--stop-timer)
+ (setq which-key--paging-timer
+ (run-with-idle-timer
+ 0.2 t (lambda ()
+ (when (or (not (member real-last-command
+ which-key--paging-functions))
+ (and (< 0 (length (this-single-command-keys)))
+ (not (equal which-key--current-prefix
+ (this-single-command-keys)))))
+ (setq which-key--current-page-n nil
+ which-key--on-last-page nil)
+ (cancel-timer which-key--paging-timer)
+ (which-key--start-timer))))))
+
+(provide 'which-key)
+;;; which-key.el ends here